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__ |