Commit | Line | Data |
a14203f8 |
1 | #!/usr/bin/perl |
2 | |
a14203f8 |
3 | package Catalyst::Plugin::Authentication::Credential::HTTP; |
a14203f8 |
4 | use base qw/Catalyst::Plugin::Authentication::Credential::Password/; |
5 | |
a14203f8 |
6 | use strict; |
a14203f8 |
7 | use warnings; |
8 | |
a14203f8 |
9 | use String::Escape (); |
a14203f8 |
10 | use URI::Escape (); |
a14203f8 |
11 | use Catalyst (); |
a14203f8 |
12 | use Digest::MD5 (); |
13 | |
a14203f8 |
14 | our $VERSION = "0.05"; |
15 | |
a14203f8 |
16 | sub authenticate_http { |
ac92fd52 |
17 | my ( $c, @args ) = @_; |
a14203f8 |
18 | |
ac92fd52 |
19 | return 1 if $c->_is_http_auth_type('digest') && $c->authenticate_digest(@args); |
20 | return 1 if $c->_is_http_auth_type('basic') && $c->authenticate_basic(@args); |
a14203f8 |
21 | } |
22 | |
ac92fd52 |
23 | sub get_http_auth_store { |
24 | my ( $c, %opts ) = @_; |
25 | $opts{store} || $c->config->{authentication}{http}{store}; |
26 | } |
a14203f8 |
27 | |
28 | sub authenticate_basic { |
ac92fd52 |
29 | my ( $c, %opts ) = @_; |
a14203f8 |
30 | |
31 | $c->log->debug('Checking http basic authentication.') if $c->debug; |
32 | |
a14203f8 |
33 | my $headers = $c->req->headers; |
34 | |
ac92fd52 |
35 | if ( my ( $username, $password ) = $headers->authorization_basic ) { |
a14203f8 |
36 | |
ac92fd52 |
37 | my $user; |
a14203f8 |
38 | |
ac92fd52 |
39 | unless ( $user = $opts{user} ) { |
40 | if ( my $store = $c->get_http_auth_store(%opts) ) { |
41 | $user = $store->get_user($username); |
42 | } else { |
43 | $user = $username; |
44 | } |
a14203f8 |
45 | } |
46 | |
a14203f8 |
47 | return $c->login( $user, $password ); |
a14203f8 |
48 | } |
49 | |
a14203f8 |
50 | return 0; |
a14203f8 |
51 | } |
52 | |
a14203f8 |
53 | sub authenticate_digest { |
ac92fd52 |
54 | my ( $c, %opts ) = @_; |
a14203f8 |
55 | |
56 | $c->log->debug('Checking http digest authentication.') if $c->debug; |
57 | |
a14203f8 |
58 | my $headers = $c->req->headers; |
a14203f8 |
59 | my @authorization = $headers->header('Authorization'); |
a14203f8 |
60 | foreach my $authorization (@authorization) { |
a14203f8 |
61 | next unless $authorization =~ m{^Digest}; |
62 | |
a14203f8 |
63 | my %res = map { |
a14203f8 |
64 | my @key_val = split /=/, $_, 2; |
a14203f8 |
65 | $key_val[0] = lc $key_val[0]; |
a14203f8 |
66 | $key_val[1] =~ s{"}{}g; # remove the quotes |
a14203f8 |
67 | @key_val; |
a14203f8 |
68 | } split /,\s?/, substr( $authorization, 7 ); #7 == length "Digest " |
69 | |
a14203f8 |
70 | my $opaque = $res{opaque}; |
ac92fd52 |
71 | my $nonce = $c->_get_digest_authorization_nonce( __PACKAGE__ . '::opaque:' . $opaque ); |
a14203f8 |
72 | next unless $nonce; |
73 | |
a14203f8 |
74 | $c->log->debug('Checking authentication parameters.') |
a14203f8 |
75 | if $c->debug; |
76 | |
a14203f8 |
77 | my $uri = '/' . $c->request->path; |
a14203f8 |
78 | my $algorithm = $res{algorithm} || 'MD5'; |
a14203f8 |
79 | my $nonce_count = '0x' . $res{nc}; |
80 | |
a14203f8 |
81 | my $check = $uri eq $res{uri} |
a14203f8 |
82 | && ( exists $res{username} ) |
a14203f8 |
83 | && ( exists $res{qop} ) |
a14203f8 |
84 | && ( exists $res{cnonce} ) |
a14203f8 |
85 | && ( exists $res{nc} ) |
a14203f8 |
86 | && $algorithm eq $nonce->algorithm |
a14203f8 |
87 | && hex($nonce_count) > hex( $nonce->nonce_count ) |
a14203f8 |
88 | && $res{nonce} eq $nonce->nonce; # TODO: set Stale instead |
89 | |
a14203f8 |
90 | unless ($check) { |
a14203f8 |
91 | $c->log->debug('Digest authentication failed. Bad request.') |
a14203f8 |
92 | if $c->debug; |
a14203f8 |
93 | $c->res->status(400); # bad request |
a14203f8 |
94 | die $Catalyst::DETACH; |
a14203f8 |
95 | } |
96 | |
a14203f8 |
97 | $c->log->debug('Checking authentication response.') |
a14203f8 |
98 | if $c->debug; |
99 | |
a14203f8 |
100 | my $username = $res{username}; |
a14203f8 |
101 | my $realm = $res{realm}; |
102 | |
a14203f8 |
103 | my $user; |
ac92fd52 |
104 | my $store = $opts{store} |
105 | || $c->config->{authentication}{http}{store} |
a14203f8 |
106 | || $c->default_auth_store; |
107 | |
108 | $user = $store->get_user($username) if $store; |
109 | |
110 | unless ($user) { # no user, no authentication |
a14203f8 |
111 | $c->log->debug('Unknown user: $user.') if $c->debug; |
a14203f8 |
112 | return 0; |
a14203f8 |
113 | } |
114 | |
a14203f8 |
115 | # everything looks good, let's check the response |
116 | |
a14203f8 |
117 | # calculate H(A2) as per spec |
a14203f8 |
118 | my $ctx = Digest::MD5->new; |
a14203f8 |
119 | $ctx->add( join( ':', $c->request->method, $res{uri} ) ); |
a14203f8 |
120 | if ( $res{qop} eq 'auth-int' ) { |
a14203f8 |
121 | my $digest = |
a14203f8 |
122 | Digest::MD5::md5_hex( $c->request->body ); # not sure here |
a14203f8 |
123 | $ctx->add( ':', $digest ); |
a14203f8 |
124 | } |
a14203f8 |
125 | my $A2_digest = $ctx->hexdigest; |
126 | |
a14203f8 |
127 | # the idea of the for loop: |
a14203f8 |
128 | # if we do not want to store the plain password in our user store, |
a14203f8 |
129 | # we can store md5_hex("$username:$realm:$password") instead |
a14203f8 |
130 | for my $r ( 0 .. 1 ) { |
131 | |
a14203f8 |
132 | # calculate H(A1) as per spec |
a14203f8 |
133 | my $A1_digest = $r ? $user->password : do { |
a14203f8 |
134 | $ctx = Digest::MD5->new; |
a14203f8 |
135 | $ctx->add( join( ':', $username, $realm, $user->password ) ); |
a14203f8 |
136 | $ctx->hexdigest; |
a14203f8 |
137 | }; |
a14203f8 |
138 | if ( $nonce->algorithm eq 'MD5-sess' ) { |
a14203f8 |
139 | $ctx = Digest::MD5->new; |
a14203f8 |
140 | $ctx->add( join( ':', $A1_digest, $res{nonce}, $res{cnonce} ) ); |
a14203f8 |
141 | $A1_digest = $ctx->hexdigest; |
a14203f8 |
142 | } |
143 | |
a14203f8 |
144 | my $rq_digest = Digest::MD5::md5_hex( |
a14203f8 |
145 | join( ':', |
a14203f8 |
146 | $A1_digest, $res{nonce}, |
a14203f8 |
147 | $res{qop} ? ( $res{nc}, $res{cnonce}, $res{qop} ) : (), |
a14203f8 |
148 | $A2_digest ) |
a14203f8 |
149 | ); |
150 | |
a14203f8 |
151 | $nonce->nonce_count($nonce_count); |
a14203f8 |
152 | $c->cache->set( __PACKAGE__ . '::opaque:' . $nonce->opaque, |
a14203f8 |
153 | $nonce ); |
154 | |
a14203f8 |
155 | return $c->login( $user, $user->password ) |
a14203f8 |
156 | if $rq_digest eq $res{response}; |
a14203f8 |
157 | } |
a14203f8 |
158 | } |
159 | |
a14203f8 |
160 | return 0; |
a14203f8 |
161 | } |
162 | |
a14203f8 |
163 | sub _check_cache { |
a14203f8 |
164 | my $c = shift; |
165 | |
a14203f8 |
166 | die "A cache is needed for http digest authentication." |
a14203f8 |
167 | unless $c->can('cache'); |
a14203f8 |
168 | } |
169 | |
ac92fd52 |
170 | sub _is_http_auth_type { |
a14203f8 |
171 | my ( $c, $type ) = @_; |
172 | |
a14203f8 |
173 | my $cfgtype = lc( $c->config->{authentication}{http}{type} || 'any' ); |
a14203f8 |
174 | return 1 if $cfgtype eq 'any' || $cfgtype eq lc $type; |
a14203f8 |
175 | return 0; |
a14203f8 |
176 | } |
177 | |
a14203f8 |
178 | sub authorization_required { |
ac92fd52 |
179 | my ( $c, @args ) = @_; |
a14203f8 |
180 | |
ac92fd52 |
181 | return 1 if $c->authenticate_http(@args); |
182 | |
183 | $c->authorization_required_response(@args); |
a14203f8 |
184 | |
185 | die $Catalyst::DETACH; |
a14203f8 |
186 | } |
187 | |
a14203f8 |
188 | sub authorization_required_response { |
a14203f8 |
189 | my ( $c, %opts ) = @_; |
190 | |
a14203f8 |
191 | $c->res->status(401); |
192 | |
ac92fd52 |
193 | # *DONT* short circuit |
194 | my $ok; |
195 | $ok++ if $c->_create_digest_auth_response(\%opts); |
196 | $ok++ if $c->_create_basic_auth_response(\%opts); |
a14203f8 |
197 | |
ac92fd52 |
198 | unless ( $ok ) { |
199 | die 'Could not build authorization required response. ' |
200 | . 'Did you configure a valid authentication http type: ' |
201 | . 'basic, digest, any'; |
202 | } |
a14203f8 |
203 | } |
204 | |
ac92fd52 |
205 | sub _add_authentication_header { |
206 | my ( $c, $header ) = @_; |
207 | $c->res->headers->push_header( 'WWW-Authenticate' => $header ); |
208 | } |
a14203f8 |
209 | |
ac92fd52 |
210 | sub _create_digest_auth_response { |
211 | my ( $c, $opts ) = @_; |
212 | |
213 | return unless $c->_is_http_auth_type('digest'); |
214 | |
215 | if ( my $digest = $c->_build_digest_auth_header( $opts ) ) { |
216 | $c->_add_authentication_header( $digest ); |
217 | return 1; |
218 | } |
a14203f8 |
219 | |
ac92fd52 |
220 | return; |
221 | } |
a14203f8 |
222 | |
ac92fd52 |
223 | sub _create_basic_auth_response { |
224 | my ( $c, $opts ) = @_; |
225 | |
226 | return unless $c->_is_http_auth_type('basic'); |
a14203f8 |
227 | |
ac92fd52 |
228 | if ( my $basic = $c->_build_basic_auth_header( $opts ) ) { |
229 | $c->_add_authentication_header( $basic ); |
230 | return 1; |
231 | } |
a14203f8 |
232 | |
ac92fd52 |
233 | return; |
234 | } |
a14203f8 |
235 | |
ac92fd52 |
236 | sub _build_auth_header_realm { |
237 | my ( $c, $opts ) = @_; |
a14203f8 |
238 | |
239 | if ( my $realm = $opts->{realm} ) { |
ac92fd52 |
240 | return 'realm=' . String::Escape::qprintable($realm); |
241 | } else { |
242 | return; |
a14203f8 |
243 | } |
ac92fd52 |
244 | } |
a14203f8 |
245 | |
ac92fd52 |
246 | sub _build_auth_header_domain { |
247 | my ( $c, $opts ) = @_; |
a14203f8 |
248 | |
249 | if ( my $domain = $opts->{domain} ) { |
a14203f8 |
250 | Catalyst::Excpetion->throw("domain must be an array reference") |
a14203f8 |
251 | unless ref($domain) && ref($domain) eq "ARRAY"; |
252 | |
a14203f8 |
253 | my @uris = |
a14203f8 |
254 | $c->config->{authentication}{http}{use_uri_for} |
a14203f8 |
255 | ? ( map { $c->uri_for($_) } @$domain ) |
a14203f8 |
256 | : ( map { URI::Escape::uri_escape($_) } @$domain ); |
257 | |
ac92fd52 |
258 | return qq{domain="@uris"}; |
259 | } else { |
260 | return; |
a14203f8 |
261 | } |
ac92fd52 |
262 | } |
a14203f8 |
263 | |
ac92fd52 |
264 | sub _build_auth_header_common { |
265 | my ( $c, $opts ) = @_; |
a14203f8 |
266 | |
ac92fd52 |
267 | return ( |
268 | $c->_build_auth_header_realm($opts), |
269 | $c->_build_auth_header_domain($opts), |
270 | ); |
271 | } |
a14203f8 |
272 | |
ac92fd52 |
273 | sub _build_basic_auth_header { |
274 | my ( $c, $opts ) = @_; |
275 | return $c->_join_auth_header_parts( Basic => $c->_build_auth_header_common ); |
276 | } |
a14203f8 |
277 | |
ac92fd52 |
278 | sub _build_digest_auth_header { |
279 | my ( $c, $opts ) = @_; |
a14203f8 |
280 | |
ac92fd52 |
281 | my $nonce = $c->_digest_auth_nonce($opts); |
a14203f8 |
282 | |
ac92fd52 |
283 | my $key = __PACKAGE__ . '::opaque:' . $nonce->opaque; |
284 | |
285 | $c->_store_digest_authorization_nonce( $key, $nonce ); |
a14203f8 |
286 | |
ac92fd52 |
287 | return $c->_join_auth_header_parts( Digest => |
288 | $c->_build_auth_header_common($opts), |
289 | map { sprintf '%s="%s"', $_, $nonce->$_ } qw( |
290 | qop |
291 | nonce |
292 | opaque |
293 | algorithm |
294 | ), |
295 | ); |
296 | } |
a14203f8 |
297 | |
ac92fd52 |
298 | sub _digest_auth_nonce { |
299 | my ( $c, $opts ) = @_; |
a14203f8 |
300 | |
ac92fd52 |
301 | my $package = __PACKAGE__ . '::Nonce'; |
a14203f8 |
302 | |
ac92fd52 |
303 | my $nonce = $package->new; |
a14203f8 |
304 | |
ac92fd52 |
305 | my $algorithm = $opts->{algorithm} |
306 | || $c->config->{authentication}{http}{algorithm} |
307 | || $nonce->algorithm; |
a14203f8 |
308 | |
ac92fd52 |
309 | $nonce->algorithm( $algorithm ); |
a14203f8 |
310 | |
ac92fd52 |
311 | return $nonce; |
312 | } |
a14203f8 |
313 | |
ac92fd52 |
314 | sub _join_auth_header_parts { |
315 | my ( $c, $type, @parts ) = @_; |
316 | return "$type " . join(", ", @parts ); |
317 | } |
a14203f8 |
318 | |
ac92fd52 |
319 | sub _get_digest_authorization_nonce { |
320 | my ( $c, $key ) = @_; |
a14203f8 |
321 | |
ac92fd52 |
322 | $c->_check_cache; |
323 | $c->cache->get( $key ); |
a14203f8 |
324 | } |
325 | |
ac92fd52 |
326 | sub _store_digest_authorization_nonce { |
327 | my ( $c, $key, $nonce ) = @_; |
a14203f8 |
328 | |
ac92fd52 |
329 | $c->_check_cache; |
330 | $c->cache->set( $key, $nonce ); |
331 | } |
a14203f8 |
332 | |
333 | package Catalyst::Plugin::Authentication::Credential::HTTP::Nonce; |
334 | |
a14203f8 |
335 | use strict; |
a14203f8 |
336 | use base qw[ Class::Accessor::Fast ]; |
a14203f8 |
337 | use Data::UUID (); |
338 | |
a14203f8 |
339 | our $VERSION = "0.01"; |
340 | |
a14203f8 |
341 | __PACKAGE__->mk_accessors(qw[ nonce nonce_count qop opaque algorithm ]); |
342 | |
a14203f8 |
343 | sub new { |
a14203f8 |
344 | my $class = shift; |
a14203f8 |
345 | my $self = $class->SUPER::new(@_); |
346 | |
a14203f8 |
347 | $self->nonce( Data::UUID->new->create_b64 ); |
a14203f8 |
348 | $self->opaque( Data::UUID->new->create_b64 ); |
a14203f8 |
349 | $self->qop('auth,auth-int'); |
a14203f8 |
350 | $self->nonce_count('0x0'); |
a14203f8 |
351 | $self->algorithm('MD5'); |
352 | |
a14203f8 |
353 | return $self; |
a14203f8 |
354 | } |
355 | |
a14203f8 |
356 | 1; |
357 | |
a14203f8 |
358 | __END__ |
359 | |
a14203f8 |
360 | =pod |
361 | |
a14203f8 |
362 | =head1 NAME |
363 | |
a14203f8 |
364 | Catalyst::Plugin::Authentication::Credential::HTTP - HTTP Basic and Digest authentication |
a14203f8 |
365 | for Catlayst. |
366 | |
a14203f8 |
367 | =head1 SYNOPSIS |
368 | |
a14203f8 |
369 | use Catalyst qw/ |
a14203f8 |
370 | Authentication |
a14203f8 |
371 | Authentication::Store::Moose |
a14203f8 |
372 | Authentication::Credential::HTTP |
a14203f8 |
373 | /; |
374 | |
3bb378d2 |
375 | __PACKAGE__->config->{authentication}{http}{type} = 'any'; # or 'digest' or 'basic' |
376 | __PACKAGE__->config->{authentication}{users} = { |
377 | Mufasa => { password => "Circle Of Life", }, |
a14203f8 |
378 | }; |
379 | |
a14203f8 |
380 | sub foo : Local { |
a14203f8 |
381 | my ( $self, $c ) = @_; |
382 | |
a14203f8 |
383 | $c->authorization_required( realm => "foo" ); # named after the status code ;-) |
384 | |
a14203f8 |
385 | # either user gets authenticated or 401 is sent |
386 | |
a14203f8 |
387 | do_stuff(); |
a14203f8 |
388 | } |
389 | |
a14203f8 |
390 | # with ACL plugin |
a14203f8 |
391 | __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate_http }); |
392 | |
a14203f8 |
393 | sub end : Private { |
a14203f8 |
394 | my ( $self, $c ) = @_; |
395 | |
a14203f8 |
396 | $c->authorization_required_response( realm => "foo" ); |
a14203f8 |
397 | $c->error(0); |
a14203f8 |
398 | } |
399 | |
a14203f8 |
400 | =head1 DESCRIPTION |
401 | |
a14203f8 |
402 | This moduule lets you use HTTP authentication with |
a14203f8 |
403 | L<Catalyst::Plugin::Authentication>. Both basic and digest authentication |
a14203f8 |
404 | are currently supported. |
405 | |
a14203f8 |
406 | =head1 METHODS |
407 | |
a14203f8 |
408 | =over 4 |
409 | |
a14203f8 |
410 | =item authorization_required |
411 | |
a14203f8 |
412 | Tries to C<authenticate_http>, and if that fails calls |
a14203f8 |
413 | C<authorization_required_response> and detaches the current action call stack. |
414 | |
a14203f8 |
415 | =item authenticate_http |
416 | |
a14203f8 |
417 | Looks inside C<< $c->request->headers >> and processes the digest and basic |
a14203f8 |
418 | (badly named) authorization header. |
419 | |
a14203f8 |
420 | =item authorization_required_response |
421 | |
a14203f8 |
422 | Sets C<< $c->response >> to the correct status code, and adds the correct |
a14203f8 |
423 | header to demand authentication data from the user agent. |
424 | |
a14203f8 |
425 | =back |
426 | |
a14203f8 |
427 | =head1 AUTHORS |
428 | |
a14203f8 |
429 | Yuval Kogman, C<nothingmuch@woobling.org> |
430 | |
a14203f8 |
431 | Jess Robinson |
432 | |
a14203f8 |
433 | Sascha Kiefer C<esskar@cpan.org> |
434 | |
a14203f8 |
435 | =head1 COPYRIGHT & LICENSE |
436 | |
a14203f8 |
437 | Copyright (c) 2005-2006 the aforementioned authors. All rights |
a14203f8 |
438 | reserved. This program is free software; you can redistribute |
a14203f8 |
439 | it and/or modify it under the same terms as Perl itself. |
440 | |
a14203f8 |
441 | =cut |