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