File Coverage

blib/lib/Gantry/Control/C/AuthzBase.pm
Criterion Covered Total %
statement 10 46 21.7
branch 0 22 0.0
condition 1 3 33.3
subroutine 4 5 80.0
pod 1 1 100.0
total 16 77 20.7


line stmt bran cond sub pod time code
1             package Gantry::Control::C::AuthzBase;
2              
3 1     1   1744 use strict;
  1         3  
  1         57  
4              
5 1   33     88 use constant MP2 => (
6             exists $ENV{MOD_PERL_API_VERSION} and
7             $ENV{MOD_PERL_API_VERSION} >= 2
8 1     1   6 );
  1         2  
9              
10             # must explicitly import for mod_perl2
11             BEGIN {
12 1     1   740 if (MP2) {
13             require Gantry::Engine::MP20;
14             Gantry::Engine::MP20->import();
15             }
16             }
17              
18             ######################################################################
19             # Main Execution Begins Here #
20             ######################################################################
21             sub handler : method {
22 0     0 1 0 my ( $self, $r ) = @_;
23              
24 0         0 my $user_model = $self->user_model();
25 0         0 my $group_members_model = $self->group_members_model();
26              
27             # Check Exclude paths
28 0 0       0 if ( $r->dir_config( 'exclude_path' ) ) {
29 0         0 foreach my $p ( split( /\s*;\s*/, $r->dir_config( 'exclude_path' ) ) ) {
30 0 0       0 if ( $r->path_info =~ /^$p$/ ) {
31 0         0 return( $self->status_const( 'OK' ) );
32             }
33             }
34             } # end if exclude_path
35              
36 0         0 my $user = $r->user;
37              
38 0 0       0 if ( $user ) {
39 0         0 my $requires = $r->requires;
40 0         0 my %groups;
41              
42 0 0       0 unless ( $requires ) {
43             # Force disconnect from database due to failure.
44 0         0 $user_model->disconnect();
45              
46 0         0 return( $self->status_const( 'DECLINED' ) );
47             }
48              
49             # get user id
50 0         0 my @user_row = $user_model->search( user_name => $user );
51              
52             # get groups for user
53 0         0 my @group_rows = $group_members_model->search(
54             user_id => $user_row[0]->user_id
55             );
56              
57 0         0 foreach ( @group_rows ) {
58 0         0 $groups{$_->group_id->name} = 1;
59             }
60              
61             # Check out what we have to auth against.
62 0         0 for my $entry ( @$requires ) {
63 0         0 my ( $req, @rest ) = split( /\s+/, $entry->{requirement} );
64 0         0 $req = lc( $req );
65              
66 0 0       0 if ( $req eq 'valid-user' ) {
    0          
    0          
67             #$r->log_error( "authz: valid-user $user" );
68 0         0 return( $self->status_const( 'OK' ) );
69             }
70             elsif ( $req eq 'user' ) {
71 0         0 for ( @rest ) {
72             #$r->log_error( "authz: user check $user $_ " );
73 0 0       0 return( $self->status_const( 'OK' ) ) if ( $user eq $_ );
74             }
75             }
76             elsif ( $req eq 'group' ) {
77 0         0 for ( @rest ) {
78 0 0       0 return( $self->status_const( 'OK' ) )
79             if ( exists $groups{$_} );
80             }
81             }
82             else {
83 0         0 $r->log_error( "authz: unknown $req" );
84             }
85              
86             }
87             } # end: if user
88              
89 0         0 $r->note_basic_auth_failure;
90              
91             # Force disconnect from database due to failure.
92 0         0 $user_model->disconnect();
93              
94 0         0 return( $self->status_const( 'HTTP_UNAUTHORIZED' ) );
95              
96             } # END $self->handler
97              
98             #-------------------------------------------------
99             # $self->import( $self, @options )
100             #-------------------------------------------------
101             sub import {
102 1     1   12 my ( $self, @options ) = @_;
103            
104 1         3 my( $engine, $tplugin );
105            
106 1         10 foreach (@options) {
107            
108             # Import the proper engine
109 0 0         if (/^-Engine=(.*)$/) {
110 0           $engine = "Gantry::Engine::$1";
111 0           eval( "use $engine" );
112 0 0         if ( $@ ) {
113 0           die "unable to load engine $1 ($@)";
114             }
115             }
116            
117             }
118            
119             } # end: import
120             # EOF
121             1;
122              
123             __END__