Commit | Line | Data |
eebdb0e4 |
1 | package Catalyst::Authentication::Credential::HTTP; |
2 | use base qw/Catalyst::Authentication::Credential::Password/; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
7 | use String::Escape (); |
8 | use URI::Escape (); |
9 | use Catalyst (); |
10 | use Digest::MD5 (); |
11 | |
12 | our $VERSION = "0.11"; |
13 | |
14 | sub authenticate_http { |
15 | my ( $c, @args ) = @_; |
16 | |
17 | return 1 if $c->_is_http_auth_type('digest') && $c->authenticate_digest(@args); |
18 | return 1 if $c->_is_http_auth_type('basic') && $c->authenticate_basic(@args); |
19 | return; |
20 | } |
21 | |
22 | sub get_http_auth_store { |
23 | my ( $c, %opts ) = @_; |
24 | |
25 | my $store = $opts{store} || $c->config->{authentication}{http}{store} || return; |
26 | |
27 | return ref $store |
28 | ? $store |
29 | : $c->get_auth_store($store); |
30 | } |
31 | |
32 | sub authenticate_basic { |
33 | my ( $c, %opts ) = @_; |
34 | |
35 | $c->log->debug('Checking http basic authentication.') if $c->debug; |
36 | |
37 | my $headers = $c->req->headers; |
38 | |
39 | if ( my ( $username, $password ) = $headers->authorization_basic ) { |
40 | |
41 | my $user; |
42 | |
43 | unless ( $user = $opts{user} ) { |
44 | if ( my $store = $c->get_http_auth_store(%opts) ) { |
45 | $user = $store->get_user($username); |
46 | } else { |
47 | $user = $username; |
48 | } |
49 | } |
50 | |
51 | return $c->login( $user, $password ); |
52 | } |
53 | |
54 | return 0; |
55 | } |
56 | |
57 | sub authenticate_digest { |
58 | my ( $c, %opts ) = @_; |
59 | |
60 | $c->log->debug('Checking http digest authentication.') if $c->debug; |
61 | |
62 | my $headers = $c->req->headers; |
63 | my @authorization = $headers->header('Authorization'); |
64 | foreach my $authorization (@authorization) { |
65 | next unless $authorization =~ m{^Digest}; |
66 | |
67 | my %res = map { |
68 | my @key_val = split /=/, $_, 2; |
69 | $key_val[0] = lc $key_val[0]; |
70 | $key_val[1] =~ s{"}{}g; # remove the quotes |
71 | @key_val; |
72 | } split /,\s?/, substr( $authorization, 7 ); #7 == length "Digest " |
73 | |
74 | my $opaque = $res{opaque}; |
75 | my $nonce = $c->get_digest_authorization_nonce( __PACKAGE__ . '::opaque:' . $opaque ); |
76 | next unless $nonce; |
77 | |
78 | $c->log->debug('Checking authentication parameters.') |
79 | if $c->debug; |
80 | |
81 | my $uri = '/' . $c->request->path; |
82 | my $algorithm = $res{algorithm} || 'MD5'; |
83 | my $nonce_count = '0x' . $res{nc}; |
84 | |
85 | my $check = $uri eq $res{uri} |
86 | && ( exists $res{username} ) |
87 | && ( exists $res{qop} ) |
88 | && ( exists $res{cnonce} ) |
89 | && ( exists $res{nc} ) |
90 | && $algorithm eq $nonce->algorithm |
91 | && hex($nonce_count) > hex( $nonce->nonce_count ) |
92 | && $res{nonce} eq $nonce->nonce; # TODO: set Stale instead |
93 | |
94 | unless ($check) { |
95 | $c->log->debug('Digest authentication failed. Bad request.') |
96 | if $c->debug; |
97 | $c->res->status(400); # bad request |
98 | die $Catalyst::DETACH; |
99 | } |
100 | |
101 | $c->log->debug('Checking authentication response.') |
102 | if $c->debug; |
103 | |
104 | my $username = $res{username}; |
105 | my $realm = $res{realm}; |
106 | |
107 | my $user; |
108 | |
109 | unless ( $user = $opts{user} ) { |
110 | if ( my $store = $c->get_http_auth_store(%opts) || $c->default_auth_store ) { |
111 | $user = $store->get_user($username); |
112 | } |
113 | } |
114 | |
115 | unless ($user) { # no user, no authentication |
116 | $c->log->debug('Unknown user: $user.') if $c->debug; |
117 | return 0; |
118 | } |
119 | |
120 | # everything looks good, let's check the response |
121 | |
122 | # calculate H(A2) as per spec |
123 | my $ctx = Digest::MD5->new; |
124 | $ctx->add( join( ':', $c->request->method, $res{uri} ) ); |
125 | if ( $res{qop} eq 'auth-int' ) { |
126 | my $digest = |
127 | Digest::MD5::md5_hex( $c->request->body ); # not sure here |
128 | $ctx->add( ':', $digest ); |
129 | } |
130 | my $A2_digest = $ctx->hexdigest; |
131 | |
132 | # the idea of the for loop: |
133 | # if we do not want to store the plain password in our user store, |
134 | # we can store md5_hex("$username:$realm:$password") instead |
135 | for my $r ( 0 .. 1 ) { |
136 | |
137 | # calculate H(A1) as per spec |
138 | my $A1_digest = $r ? $user->password : do { |
139 | $ctx = Digest::MD5->new; |
140 | $ctx->add( join( ':', $username, $realm, $user->password ) ); |
141 | $ctx->hexdigest; |
142 | }; |
143 | if ( $nonce->algorithm eq 'MD5-sess' ) { |
144 | $ctx = Digest::MD5->new; |
145 | $ctx->add( join( ':', $A1_digest, $res{nonce}, $res{cnonce} ) ); |
146 | $A1_digest = $ctx->hexdigest; |
147 | } |
148 | |
149 | my $rq_digest = Digest::MD5::md5_hex( |
150 | join( ':', |
151 | $A1_digest, $res{nonce}, |
152 | $res{qop} ? ( $res{nc}, $res{cnonce}, $res{qop} ) : (), |
153 | $A2_digest ) |
154 | ); |
155 | |
156 | $nonce->nonce_count($nonce_count); |
157 | $c->cache->set( __PACKAGE__ . '::opaque:' . $nonce->opaque, |
158 | $nonce ); |
159 | |
160 | return $c->login( $user, $user->password ) |
161 | if $rq_digest eq $res{response}; |
162 | } |
163 | } |
164 | |
165 | return 0; |
166 | } |
167 | |
168 | sub _check_cache { |
169 | my $c = shift; |
170 | |
171 | die "A cache is needed for http digest authentication." |
172 | unless $c->can('cache'); |
173 | return; |
174 | } |
175 | |
176 | sub _is_http_auth_type { |
177 | my ( $c, $type ) = @_; |
178 | |
179 | my $cfgtype = lc( $c->config->{authentication}{http}{type} || 'any' ); |
180 | return 1 if $cfgtype eq 'any' || $cfgtype eq lc $type; |
181 | return 0; |
182 | } |
183 | |
184 | sub authorization_required { |
185 | my ( $c, @args ) = @_; |
186 | |
187 | return 1 if $c->authenticate_http(@args); |
188 | |
189 | $c->authorization_required_response(@args); |
190 | |
191 | die $Catalyst::DETACH; |
192 | } |
193 | |
194 | sub authorization_required_response { |
195 | my ( $c, %opts ) = @_; |
196 | |
197 | $c->res->status(401); |
198 | $c->res->content_type('text/plain'); |
199 | $c->res->body($c->config->{authentication}{http}{authorization_required_message} || |
200 | $opts{authorization_required_message} || |
201 | 'Authorization required.'); |
202 | |
203 | # *DONT* short circuit |
204 | my $ok; |
205 | $ok++ if $c->_create_digest_auth_response(\%opts); |
206 | $ok++ if $c->_create_basic_auth_response(\%opts); |
207 | |
208 | unless ( $ok ) { |
209 | die 'Could not build authorization required response. ' |
210 | . 'Did you configure a valid authentication http type: ' |
211 | . 'basic, digest, any'; |
212 | } |
213 | return; |
214 | } |
215 | |
216 | sub _add_authentication_header { |
217 | my ( $c, $header ) = @_; |
218 | $c->res->headers->push_header( 'WWW-Authenticate' => $header ); |
219 | return; |
220 | } |
221 | |
222 | sub _create_digest_auth_response { |
223 | my ( $c, $opts ) = @_; |
224 | |
225 | return unless $c->_is_http_auth_type('digest'); |
226 | |
227 | if ( my $digest = $c->_build_digest_auth_header( $opts ) ) { |
228 | $c->_add_authentication_header( $digest ); |
229 | return 1; |
230 | } |
231 | |
232 | return; |
233 | } |
234 | |
235 | sub _create_basic_auth_response { |
236 | my ( $c, $opts ) = @_; |
237 | |
238 | return unless $c->_is_http_auth_type('basic'); |
239 | |
240 | if ( my $basic = $c->_build_basic_auth_header( $opts ) ) { |
241 | $c->_add_authentication_header( $basic ); |
242 | return 1; |
243 | } |
244 | |
245 | return; |
246 | } |
247 | |
248 | sub _build_auth_header_realm { |
249 | my ( $c, $opts ) = @_; |
250 | |
251 | if ( my $realm = $opts->{realm} ) { |
252 | return 'realm=' . String::Escape::qprintable($realm); |
253 | } |
254 | return; |
255 | } |
256 | |
257 | sub _build_auth_header_domain { |
258 | my ( $c, $opts ) = @_; |
259 | |
260 | if ( my $domain = $opts->{domain} ) { |
261 | Catalyst::Exception->throw("domain must be an array reference") |
262 | unless ref($domain) && ref($domain) eq "ARRAY"; |
263 | |
264 | my @uris = |
265 | $c->config->{authentication}{http}{use_uri_for} |
266 | ? ( map { $c->uri_for($_) } @$domain ) |
267 | : ( map { URI::Escape::uri_escape($_) } @$domain ); |
268 | |
269 | return qq{domain="@uris"}; |
270 | } |
271 | return; |
272 | } |
273 | |
274 | sub _build_auth_header_common { |
275 | my ( $c, $opts ) = @_; |
276 | |
277 | return ( |
278 | $c->_build_auth_header_realm($opts), |
279 | $c->_build_auth_header_domain($opts), |
280 | ); |
281 | } |
282 | |
283 | sub _build_basic_auth_header { |
284 | my ( $c, $opts ) = @_; |
285 | return $c->_join_auth_header_parts( Basic => $c->_build_auth_header_common( $opts ) ); |
286 | } |
287 | |
288 | sub _build_digest_auth_header { |
289 | my ( $c, $opts ) = @_; |
290 | |
291 | my $nonce = $c->_digest_auth_nonce($opts); |
292 | |
293 | my $key = __PACKAGE__ . '::opaque:' . $nonce->opaque; |
294 | |
295 | $c->store_digest_authorization_nonce( $key, $nonce ); |
296 | |
297 | return $c->_join_auth_header_parts( Digest => |
298 | $c->_build_auth_header_common($opts), |
299 | map { sprintf '%s="%s"', $_, $nonce->$_ } qw( |
300 | qop |
301 | nonce |
302 | opaque |
303 | algorithm |
304 | ), |
305 | ); |
306 | } |
307 | |
308 | sub _digest_auth_nonce { |
309 | my ( $c, $opts ) = @_; |
310 | |
311 | my $package = __PACKAGE__ . '::Nonce'; |
312 | |
313 | my $nonce = $package->new; |
314 | |
315 | if ( my $algorithm = $opts->{algorithm} || $c->config->{authentication}{http}{algorithm}) { |
316 | $nonce->algorithm( $algorithm ); |
317 | } |
318 | |
319 | return $nonce; |
320 | } |
321 | |
322 | sub _join_auth_header_parts { |
323 | my ( $c, $type, @parts ) = @_; |
324 | return "$type " . join(", ", @parts ); |
325 | } |
326 | |
327 | sub get_digest_authorization_nonce { |
328 | my ( $c, $key ) = @_; |
329 | |
330 | $c->_check_cache; |
331 | return $c->cache->get( $key ); |
332 | } |
333 | |
334 | sub store_digest_authorization_nonce { |
335 | my ( $c, $key, $nonce ) = @_; |
336 | |
337 | $c->_check_cache; |
338 | return $c->cache->set( $key, $nonce ); |
339 | } |
340 | |
341 | package Catalyst::Authentication::Credential::HTTP::Nonce; |
342 | |
343 | use strict; |
344 | use base qw[ Class::Accessor::Fast ]; |
345 | use Data::UUID (); |
346 | |
347 | our $VERSION = '0.02'; |
348 | |
349 | __PACKAGE__->mk_accessors(qw[ nonce nonce_count qop opaque algorithm ]); |
350 | |
351 | sub new { |
352 | my $class = shift; |
353 | my $self = $class->SUPER::new(@_); |
354 | |
355 | $self->nonce( Data::UUID->new->create_b64 ); |
356 | $self->opaque( Data::UUID->new->create_b64 ); |
357 | $self->qop('auth,auth-int'); |
358 | $self->nonce_count('0x0'); |
359 | $self->algorithm('MD5'); |
360 | |
361 | return $self; |
362 | } |
363 | |
364 | 1; |
365 | |
366 | __END__ |
367 | |
368 | =pod |
369 | |
370 | =head1 NAME |
371 | |
372 | Catalyst::Authentication::Credential::HTTP - HTTP Basic and Digest authentication |
373 | for Catalyst. |
374 | |
375 | =head1 SYNOPSIS |
376 | |
377 | use Catalyst qw/ |
378 | Authentication |
379 | Authentication::Store::Minimal |
380 | Authentication::Credential::HTTP |
381 | /; |
382 | |
383 | __PACKAGE__->config->{authentication}{http}{type} = 'any'; # or 'digest' or 'basic' |
384 | __PACKAGE__->config->{authentication}{users} = { |
385 | Mufasa => { password => "Circle Of Life", }, |
386 | }; |
387 | |
388 | sub foo : Local { |
389 | my ( $self, $c ) = @_; |
390 | |
391 | $c->authorization_required( realm => "foo" ); # named after the status code ;-) |
392 | |
393 | # either user gets authenticated or 401 is sent |
394 | |
395 | do_stuff(); |
396 | } |
397 | |
398 | # with ACL plugin |
399 | __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate_http }); |
400 | |
401 | sub end : Private { |
402 | my ( $self, $c ) = @_; |
403 | |
404 | $c->authorization_required_response( realm => "foo" ); |
405 | $c->error(0); |
406 | } |
407 | |
408 | =head1 DESCRIPTION |
409 | |
410 | This module lets you use HTTP authentication with |
411 | L<Catalyst::Plugin::Authentication>. Both basic and digest authentication |
412 | are currently supported. |
413 | |
414 | When authentication is required, this module sets a status of 401, and |
415 | the body of the response to 'Authorization required.'. To override |
416 | this and set your own content, check for the C<< $c->res->status == |
417 | 401 >> in your C<end> action, and change the body accordingly. |
418 | |
419 | =head2 TERMS |
420 | |
421 | =over 4 |
422 | |
423 | =item Nonce |
424 | |
425 | A nonce is a one-time value sent with each digest authentication |
426 | request header. The value must always be unique, so per default the |
427 | last value of the nonce is kept using L<Catalyst::Plugin::Cache>. To |
428 | change this behaviour, override the |
429 | C<store_digest_authorization_nonce> and |
430 | C<get_digest_authorization_nonce> methods as shown below. |
431 | |
432 | =back |
433 | |
434 | =head1 METHODS |
435 | |
436 | =over 4 |
437 | |
438 | =item authorization_required %opts |
439 | |
440 | Tries to C<authenticate_http>, and if that fails calls |
441 | C<authorization_required_response> and detaches the current action call stack. |
442 | |
443 | This method just passes the options through untouched. |
444 | |
445 | =item authenticate_http %opts |
446 | |
447 | Looks inside C<< $c->request->headers >> and processes the digest and basic |
448 | (badly named) authorization header. |
449 | |
450 | This will only try the methods set in the configuration. First digest, then basic. |
451 | |
452 | See the next two methods for what %opts can contain. |
453 | |
454 | =item authenticate_basic %opts |
455 | |
456 | =item authenticate_digest %opts |
457 | |
458 | Try to authenticate one of the methods without checking if the method is |
459 | allowed in the configuration. |
460 | |
461 | %opts can contain C<store> (either an object or a name), C<user> (to disregard |
462 | %the username from the header altogether, overriding it with a username or user |
463 | %object). |
464 | |
465 | =item authorization_required_response %opts |
466 | |
467 | Sets C<< $c->response >> to the correct status code, and adds the correct |
468 | header to demand authentication data from the user agent. |
469 | |
470 | Typically used by C<authorization_required>, but may be invoked manually. |
471 | |
472 | %opts can contain C<realm>, C<domain> and C<algorithm>, which are used to build |
473 | %the digest header. |
474 | |
475 | =item store_digest_authorization_nonce $key, $nonce |
476 | |
477 | =item get_digest_authorization_nonce $key |
478 | |
479 | Set or get the C<$nonce> object used by the digest auth mode. |
480 | |
481 | You may override these methods. By default they will call C<get> and C<set> on |
482 | C<< $c->cache >>. |
483 | |
484 | =item get_http_auth_store %opts |
485 | |
486 | =back |
487 | |
488 | =head1 CONFIGURATION |
489 | |
490 | All configuration is stored in C<< YourApp->config->{authentication}{http} >>. |
491 | |
492 | This should be a hash, and it can contain the following entries: |
493 | |
494 | =over 4 |
495 | |
496 | =item store |
497 | |
498 | Either a name or an object -- the default store to use for HTTP authentication. |
499 | |
500 | =item type |
501 | |
502 | Can be either C<any> (the default), C<basic> or C<digest>. |
503 | |
504 | This controls C<authorization_required_response> and C<authenticate_http>, but |
505 | not the "manual" methods. |
506 | |
507 | =item authorization_required_message |
508 | |
509 | Set this to a string to override the default body content "Authorization required." |
510 | |
511 | =back |
512 | |
513 | =head1 RESTRICTIONS |
514 | |
515 | When using digest authentication, this module will only work together |
516 | with authentication stores whose User objects have a C<password> |
517 | method that returns the plain-text password. It will not work together |
518 | with L<Catalyst::Authentication::Store::Htpasswd>, or |
519 | L<Catalyst::Authentication::Store::DBIC> stores whose |
520 | C<password> methods return a hashed or salted version of the password. |
521 | |
522 | =head1 AUTHORS |
523 | |
524 | Yuval Kogman, C<nothingmuch@woobling.org> |
525 | |
526 | Jess Robinson |
527 | |
528 | Sascha Kiefer C<esskar@cpan.org> |
529 | |
530 | Tomas Doran C<bobtfish@bobtfish.net> |
531 | |
532 | =head1 SEE ALSO |
533 | |
534 | RFC 2617 (or its successors), L<Catalyst::Plugin::Cache>, L<Catalyst::Plugin::Authentication> |
535 | |
536 | =head1 COPYRIGHT & LICENSE |
537 | |
538 | Copyright (c) 2005-2006 the aforementioned authors. All rights |
539 | reserved. This program is free software; you can redistribute |
540 | it and/or modify it under the same terms as Perl itself. |
541 | |
542 | =cut |
543 | |