File Coverage

blib/lib/Apache/AuthenURL.pm
Criterion Covered Total %
statement 11 14 78.5
branch n/a
condition 1 2 50.0
subroutine 4 4 100.0
pod n/a
total 16 20 80.0


line stmt bran cond sub pod time code
1             package Apache::AuthenURL;
2              
3 1     1   8421 use strict;
  1         4  
  1         310  
4              
5 1     1   6 use vars qw{$VERSION};
  1         2  
  1         95  
6             $VERSION = '2.05';
7              
8             # setting the constants to help identify which version of mod_perl
9             # is installed
10 1   50 1   6 use constant MP2 => eval { require mod_perl2; 1 } || 0;
  1         11  
  1         2  
11              
12             # test for the version of mod_perl, and use the appropriate libraries
13             BEGIN {
14 1     1   2 if (MP2) {
15             require Apache2::Access;
16             require Apache2::Connection;
17             require Apache2::Const;
18             require Apache2::Log;
19             require Apache2::RequestRec;
20             require Apache2::RequestUtil;
21             Apache2::Const->import(-compile => 'HTTP_UNAUTHORIZED',
22             'HTTP_INTERNAL_SERVER_ERROR', 'OK');
23             } else {
24 1         2492 require mod_perl;
25 0           require Apache::Constants;
26 0           require Apache::Log;
27 0           Apache::Constants->import('HTTP_UNAUTHORIZED',
28             'HTTP_INTERNAL_SERVER_ERROR', 'OK');
29             }
30             }
31              
32             use LWP::UserAgent;
33              
34             my $prefix = "Apache::AuthenURL";
35              
36             my(%Config) = (
37             'AuthenURL_url' => '',
38             'AuthenURL_method' => '',
39             'AuthenURL_proxy' => '',
40             );
41              
42             sub handler {
43             my($r) = @_;
44              
45             my($response, $sent_pwd) = $r->get_basic_auth_pw;
46              
47             return (MP2 ? Apache2::Const::OK : Apache::Constants::OK)
48             unless $r->is_initial_req;
49              
50             return $response if $response; # decline if not Basic
51              
52             my($key, $val);
53             my $attr = { };
54             while(($key, $val) = each %Config) {
55             $val = $r->dir_config($key) || $val;
56             $key =~ s/^AuthenURL_//;
57             $attr->{$key} = $val;
58             }
59            
60             return check($r, $attr, $sent_pwd);
61             }
62            
63             sub check {
64             my($r, $attr, $sent_pwd) = @_;
65              
66             my $user = MP2 ? $r->user : $r->connection->user;
67              
68             unless ( $attr->{method} ) {
69             $r->log->warn("$prefix: missing METHOD (defaulting to GET) for URI: " .
70             $r->uri);
71             $attr->{method} = "GET";
72             }
73              
74             unless ( $attr->{url} ) {
75             $r->log->error("$prefix is missing the URL", $r->uri);
76             return MP2 ? Apache2::Const::HTTP_INTERNAL_SERVER_ERROR :
77             Apache::Constants::HTTP_INTERNAL_SERVER_ERROR;
78             }
79              
80             my $lwp_ua = new LWP::UserAgent;
81             if($attr->{proxy}) {
82             $lwp_ua->proxy('http', $attr->{proxy});
83             }
84             $lwp_ua->use_alarm(0);
85             my $lwp_req = new HTTP::Request $attr->{method} => $attr->{url};
86             unless( defined $lwp_req ) {
87             $r->log->error("$prefix: LWP failed to use METHOD: ", $attr->{method},
88             " to connect to URL: ", $attr->{url}, $r->uri);
89             return MP2 ? Apache2::Const::HTTP_INTERNAL_SERVER_ERROR :
90             Apache::Constants::HTTP_INTERNAL_SERVER_ERROR;
91             }
92            
93             $lwp_req->authorization_basic($user, $sent_pwd);
94             my $lwp_res = $lwp_ua->request($lwp_req);
95             unless( $lwp_res->is_success ) {
96             $r->log->debug("$prefix: LWP user $user: " . $attr->{url} . " " .
97             $lwp_res->status_line . " ", $r->uri);
98             $r->note_basic_auth_failure;
99             return MP2 ? Apache2::Const::HTTP_UNAUTHORIZED :
100             Apache::Constants::HTTP_UNAUTHORIZED;
101             }
102             $r->log->debug("$prefix: LWP user $user: " . $attr->{url} . " " .
103             $lwp_res->status_line . " ", $r->uri);
104              
105             return MP2 ? Apache2::Const::OK : Apache::Constants::OK;
106            
107             }
108             1;
109            
110             __END__