Commit | Line | Data |
1e64d768 |
1 | package Catalyst::Plugin::Authentication::Credential::HTTP::Proxy; |
2 | use base qw/Catalyst::Plugin::Authentication::Credential::Password/; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
7 | use String::Escape (); |
8 | use URI::Escape (); |
9 | use Catalyst (); |
10 | use Catalyst::Plugin::Authentication::Credential::HTTP::User; |
11 | use Carp qw/croak/; |
12 | |
c46e37e2 |
13 | our $VERSION = "0.02"; |
1e64d768 |
14 | |
15 | sub authenticate_http_proxy { |
16 | my $c = shift; |
17 | |
18 | my $headers = $c->req->headers; |
19 | |
20 | croak "url setting required for authentication" |
21 | unless $c->config->{authentication}{http_proxy}{url}; |
22 | if ( my ( $user, $password ) = $headers->authorization_basic ) { |
23 | |
24 | my $ua=Catalyst::Plugin::Authentication::Credential::HTTP::User->new; |
25 | $ua->credentials($user,$password); |
26 | my $resp= $ua->get($c->config->{authentication}{http_proxy}{url}); |
27 | if ( $resp->is_success ) { |
28 | if ( my $store = $c->config->{authentication}{http_proxy}{store} ) { |
29 | $user = $store->get_user($user); |
30 | } elsif ( my $user_obj = $c->get_user($user) ) { |
31 | $user = $user_obj; |
32 | } |
33 | unless ($user) { |
34 | $c->log->debug("User '$user' doesn't exist in the default store") |
35 | if $c->debug; |
36 | return; |
37 | } |
38 | $c->set_authenticated($user); |
39 | return 1; |
40 | } elsif ( $c->debug ) { |
41 | $c->log->info('Remote authentication failed:'.$resp->message); |
42 | return 0; |
43 | } |
44 | } elsif ( $c->debug ) { |
45 | $c->log->info('No credentials provided for basic auth'); |
46 | return 0; |
47 | } |
48 | } |
49 | |
50 | sub authorization_required { |
51 | my ( $c, %opts ) = @_; |
52 | |
53 | return 1 if $c->authenticate_http_proxy; |
54 | |
55 | $c->authorization_required_response( %opts ); |
56 | |
57 | die $Catalyst::DETACH; |
58 | } |
59 | |
60 | sub authorization_required_response { |
61 | my ( $c, %opts ) = @_; |
62 | |
63 | $c->res->status(401); |
64 | |
65 | my @opts; |
66 | |
67 | if ( my $realm = $opts{realm} ) { |
68 | push @opts, sprintf 'realm=%s', String::Escape::qprintable($realm); |
69 | } |
70 | |
71 | if ( my $domain = $opts{domain} ) { |
72 | Catalyst::Excpetion->throw("domain must be an array reference") |
73 | unless ref($domain) && ref($domain) eq "ARRAY"; |
74 | |
75 | my @uris = |
76 | $c->config->{authentication}{http}{use_uri_for} |
77 | ? ( map { $c->uri_for($_) } @$domain ) |
78 | : ( map { URI::Escape::uri_escape($_) } @$domain ); |
79 | |
80 | push @opts, qq{domain="@uris"}; |
81 | } |
82 | |
83 | $c->res->headers->www_authenticate(join " ", "Basic", @opts); |
84 | } |
85 | |
86 | __PACKAGE__; |
87 | |
88 | __END__ |
89 | |
90 | =pod |
91 | |
92 | =head1 NAME |
93 | |
c46e37e2 |
94 | Catalyst::Plugin::Authentication::Credential::HTTP::Proxy - HTTP Proxy authentication |
1e64d768 |
95 | for Catlayst. |
96 | |
97 | =head1 SYNOPSIS |
98 | |
99 | use Catalyst qw/ |
100 | Authentication |
101 | Authentication::Store::Moose |
102 | Authentication::Store::Elk |
103 | Authentication::Credential::HTTP::Proxy |
104 | /; |
105 | |
106 | $c->config->{authentication}{http_proxy}= { |
107 | url =>'http://elkland.no/auth', |
108 | store => 'Authentication::Store::Moose' |
109 | }; |
110 | |
111 | sub foo : Local { |
112 | my ( $self, $c ) = @_; |
113 | |
114 | $c->authorization_required( realm => "foo" ); # named after the status code ;-) |
115 | |
116 | # either user gets authenticated or 401 is sent |
117 | |
118 | do_stuff(); |
119 | } |
120 | |
121 | # with ACL plugin |
122 | __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate_http }); |
123 | |
124 | sub end : Private { |
125 | my ( $self, $c ) = @_; |
126 | |
127 | $c->authorization_required_response( realm => "foo" ); |
128 | $c->error(0); |
129 | } |
130 | |
131 | =head1 DESCRIPTION |
132 | |
133 | This moduule lets you use HTTP Proxy authentication with |
134 | L<Catalyst::Plugin::Authentication>. |
135 | |
136 | Currently this module only supports the Basic scheme, but upon request Digest |
137 | will also be added. Patches welcome! |
138 | |
139 | |
140 | =head1 CONFIG |
141 | |
142 | This module reads config from $c->config->{authentication}{http_proxy}. The following settings |
143 | are supported: |
144 | |
145 | =over 4 |
146 | |
147 | =item url |
148 | |
149 | Required. A url protected with basic authentication to authenticate against. |
150 | |
151 | =item store |
152 | |
153 | To specify what store to use. will use the default store if not set. |
154 | |
c46e37e2 |
155 | =back |
1e64d768 |
156 | |
157 | =head1 METHODS |
158 | |
159 | =over 4 |
160 | |
161 | =item authorization_required |
162 | |
163 | Tries to C<authenticate_http_proxy>, and if that fails calls |
164 | C<authorization_required_response> and detaches the current action call stack. |
165 | |
166 | =item authenticate_http_proxy |
167 | |
168 | Looks inside C<< $c->request->headers >> and processes the basic (badly named) |
169 | authorization header. Then authenticates this against the provided url. |
170 | |
171 | =item authorization_required_response |
172 | |
173 | Sets C<< $c->response >> to the correct status code, and adds the correct |
174 | header to demand authentication data from the user agent. |
175 | |
176 | =back |
177 | |
178 | =head1 AUTHORS |
179 | |
180 | Marcus Ramberg <mramberg@cpan.org |
181 | |
182 | =head1 COPYRIGHT & LICENSE |
183 | |
184 | Copyright (c) 2005 the aforementioned authors. All rights |
185 | reserved. This program is free software; you can redistribute |
186 | it and/or modify it under the same terms as Perl itself. |
187 | |
188 | =cut |
189 | |