1 package Catalyst::Authentication::Credential::HTTP;
2 use base qw/Catalyst::Authentication::Credential::Password/;
12 __PACKAGE__->mk_accessors(qw/
14 authorization_required_message
23 our $VERSION = '1.009';
26 my ($class, $config, $app, $realm) = @_;
28 $config->{username_field} ||= 'username';
29 # _config is shity back-compat with our base class.
30 my $self = { %$config, _config => $config, _debug => $app->debug };
41 my $type = $self->type || 'any';
43 if (!grep /$type/, ('basic', 'digest', 'any')) {
44 Catalyst::Exception->throw(__PACKAGE__ . " used with unsupported authentication type: " . $type);
50 my ( $self, $c, $realm, $auth_info ) = @_;
53 $auth = $self->authenticate_digest($c, $realm, $auth_info) if $self->_is_http_auth_type('digest');
54 return $auth if $auth;
56 $auth = $self->authenticate_basic($c, $realm, $auth_info) if $self->_is_http_auth_type('basic');
57 return $auth if $auth;
59 $self->authorization_required_response($c, $realm, $auth_info);
60 die $Catalyst::DETACH;
63 sub authenticate_basic {
64 my ( $self, $c, $realm, $auth_info ) = @_;
66 $c->log->debug('Checking http basic authentication.') if $c->debug;
68 my $headers = $c->req->headers;
70 if ( my ( $username, $password ) = $headers->authorization_basic ) {
71 my $user_obj = $realm->find_user( { $self->username_field => $username }, $c);
74 $opts->{$self->password_field} = $password
75 if $self->password_field;
76 if ($self->check_password($user_obj, $opts)) {
81 $c->log->debug("Unable to locate user matching user info provided") if $c->debug;
89 sub authenticate_digest {
90 my ( $self, $c, $realm, $auth_info ) = @_;
92 $c->log->debug('Checking http digest authentication.') if $c->debug;
94 my $headers = $c->req->headers;
95 my @authorization = $headers->header('Authorization');
96 foreach my $authorization (@authorization) {
97 next unless $authorization =~ m{^Digest};
99 my @key_val = split /=/, $_, 2;
100 $key_val[0] = lc $key_val[0];
101 $key_val[1] =~ s{"}{}g; # remove the quotes
103 } split /,\s?/, substr( $authorization, 7 ); #7 == length "Digest "
105 my $opaque = $res{opaque};
106 my $nonce = $self->get_digest_authorization_nonce( $c, __PACKAGE__ . '::opaque:' . $opaque );
109 $c->log->debug('Checking authentication parameters.')
112 my $uri = $c->request->uri->path_query;
113 my $algorithm = $res{algorithm} || 'MD5';
114 my $nonce_count = '0x' . $res{nc};
116 my $check = $uri eq $res{uri}
117 && ( exists $res{username} )
118 && ( exists $res{qop} )
119 && ( exists $res{cnonce} )
120 && ( exists $res{nc} )
121 && $algorithm eq $nonce->algorithm
122 && hex($nonce_count) > hex( $nonce->nonce_count )
123 && $res{nonce} eq $nonce->nonce; # TODO: set Stale instead
126 $c->log->debug('Digest authentication failed. Bad request.')
128 $c->res->status(400); # bad request
129 Carp::confess $Catalyst::DETACH;
132 $c->log->debug('Checking authentication response.')
135 my $username = $res{username};
139 unless ( $user_obj = $auth_info->{user} ) {
140 $user_obj = $realm->find_user( { $self->username_field => $username }, $c);
142 unless ($user_obj) { # no user, no authentication
143 $c->log->debug("Unable to locate user matching user info provided") if $c->debug;
147 # everything looks good, let's check the response
148 # calculate H(A2) as per spec
149 my $ctx = Digest::MD5->new;
150 $ctx->add( join( ':', $c->request->method, $res{uri} ) );
151 if ( $res{qop} eq 'auth-int' ) {
153 Digest::MD5::md5_hex( $c->request->body ); # not sure here
154 $ctx->add( ':', $digest );
156 my $A2_digest = $ctx->hexdigest;
158 # the idea of the for loop:
159 # if we do not want to store the plain password in our user store,
160 # we can store md5_hex("$username:$realm:$password") instead
161 my $password_field = $self->password_field;
162 for my $r ( 0 .. 1 ) {
163 # calculate H(A1) as per spec
164 my $A1_digest = $r ? $user_obj->$password_field() : do {
165 $ctx = Digest::MD5->new;
166 $ctx->add( join( ':', $username, $realm->name, $user_obj->$password_field() ) );
169 if ( $nonce->algorithm eq 'MD5-sess' ) {
170 $ctx = Digest::MD5->new;
171 $ctx->add( join( ':', $A1_digest, $res{nonce}, $res{cnonce} ) );
172 $A1_digest = $ctx->hexdigest;
175 my $digest_in = join( ':',
176 $A1_digest, $res{nonce},
177 $res{qop} ? ( $res{nc}, $res{cnonce}, $res{qop} ) : (),
179 my $rq_digest = Digest::MD5::md5_hex($digest_in);
180 $nonce->nonce_count($nonce_count);
181 $c->cache->set( __PACKAGE__ . '::opaque:' . $nonce->opaque,
183 if ($rq_digest eq $res{response}) {
194 die "A cache is needed for http digest authentication."
195 unless $c->can('cache');
199 sub _is_http_auth_type {
200 my ( $self, $type ) = @_;
201 my $cfgtype = lc( $self->type );
202 return 1 if $cfgtype eq 'any' || $cfgtype eq lc $type;
206 sub authorization_required_response {
207 my ( $self, $c, $realm, $auth_info ) = @_;
209 $c->res->status(401);
210 $c->res->content_type('text/plain');
211 if (exists $self->{authorization_required_message}) {
212 # If you set the key to undef, don't stamp on the body.
213 $c->res->body($self->authorization_required_message)
214 if defined $self->authorization_required_message;
217 $c->res->body('Authorization required.');
220 # *DONT* short circuit
222 $ok++ if $self->_create_digest_auth_response($c, $auth_info);
223 $ok++ if $self->_create_basic_auth_response($c, $auth_info);
226 die 'Could not build authorization required response. '
227 . 'Did you configure a valid authentication http type: '
228 . 'basic, digest, any';
233 sub _add_authentication_header {
234 my ( $c, $header ) = @_;
235 $c->response->headers->push_header( 'WWW-Authenticate' => $header );
239 sub _create_digest_auth_response {
240 my ( $self, $c, $opts ) = @_;
242 return unless $self->_is_http_auth_type('digest');
244 if ( my $digest = $self->_build_digest_auth_header( $c, $opts ) ) {
245 _add_authentication_header( $c, $digest );
252 sub _create_basic_auth_response {
253 my ( $self, $c, $opts ) = @_;
255 return unless $self->_is_http_auth_type('basic');
257 if ( my $basic = $self->_build_basic_auth_header( $c, $opts ) ) {
258 _add_authentication_header( $c, $basic );
265 sub _build_auth_header_realm {
266 my ( $self, $c, $opts ) = @_;
267 if ( my $realm_name = String::Escape::qprintable($opts->{realm} ? $opts->{realm} : $self->realm->name) ) {
268 $realm_name = qq{"$realm_name"} unless $realm_name =~ /^"/;
269 return 'realm=' . $realm_name;
274 sub _build_auth_header_domain {
275 my ( $self, $c, $opts ) = @_;
276 if ( my $domain = $opts->{domain} ) {
277 Catalyst::Exception->throw("domain must be an array reference")
278 unless ref($domain) && ref($domain) eq "ARRAY";
282 ? ( map { $c->uri_for($_) } @$domain )
283 : ( map { URI::Escape::uri_escape($_) } @$domain );
285 return qq{domain="@uris"};
290 sub _build_auth_header_common {
291 my ( $self, $c, $opts ) = @_;
293 $self->_build_auth_header_realm($c, $opts),
294 $self->_build_auth_header_domain($c, $opts),
298 sub _build_basic_auth_header {
299 my ( $self, $c, $opts ) = @_;
300 return _join_auth_header_parts( Basic => $self->_build_auth_header_common( $c, $opts ) );
303 sub _build_digest_auth_header {
304 my ( $self, $c, $opts ) = @_;
306 my $nonce = $self->_digest_auth_nonce($c, $opts);
308 my $key = __PACKAGE__ . '::opaque:' . $nonce->opaque;
310 $self->store_digest_authorization_nonce( $c, $key, $nonce );
312 return _join_auth_header_parts( Digest =>
313 $self->_build_auth_header_common($c, $opts),
314 map { sprintf '%s="%s"', $_, $nonce->$_ } qw(
323 sub _digest_auth_nonce {
324 my ( $self, $c, $opts ) = @_;
326 my $package = __PACKAGE__ . '::Nonce';
328 my $nonce = $package->new;
330 if ( my $algorithm = $opts->{algorithm} || $self->algorithm) {
331 $nonce->algorithm( $algorithm );
337 sub _join_auth_header_parts {
338 my ( $type, @parts ) = @_;
339 return "$type " . join(", ", @parts );
342 sub get_digest_authorization_nonce {
343 my ( $self, $c, $key ) = @_;
346 return $c->cache->get( $key );
349 sub store_digest_authorization_nonce {
350 my ( $self, $c, $key, $nonce ) = @_;
353 return $c->cache->set( $key, $nonce );
356 package Catalyst::Authentication::Credential::HTTP::Nonce;
359 use base qw[ Class::Accessor::Fast ];
362 our $VERSION = '0.02';
364 __PACKAGE__->mk_accessors(qw[ nonce nonce_count qop opaque algorithm ]);
368 my $self = $class->SUPER::new(@_);
370 $self->nonce( Data::UUID->new->create_b64 );
371 $self->opaque( Data::UUID->new->create_b64 );
372 $self->qop('auth,auth-int');
373 $self->nonce_count('0x0');
374 $self->algorithm('MD5');
387 Catalyst::Authentication::Credential::HTTP - HTTP Basic and Digest authentication
396 __PACKAGE__->config( authentication => {
397 default_realm => 'example',
402 type => 'any', # or 'digest' or 'basic'
403 password_type => 'clear',
404 password_field => 'password'
409 Mufasa => { password => "Circle Of Life", },
417 my ( $self, $c ) = @_;
419 $c->authenticate({ realm => "example" });
420 # either user gets authenticated or 401 is sent
421 # Note that the authentication realm sent to the client (in the
422 # RFC 2617 sense) is overridden here, but this *does not*
423 # effect the Catalyst::Authentication::Realm used for
424 # authentication - to do that, you need
425 # $c->authenticate({}, 'otherrealm')
430 sub always_auth : Local {
431 my ( $self, $c ) = @_;
433 # Force authorization headers onto the response so that the user
434 # is asked again for authentication, even if they successfully
436 my $realm = $c->get_auth_realm('example');
437 $realm->credential->authorization_required_response($c, $realm);
441 __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate });
445 This module lets you use HTTP authentication with
446 L<Catalyst::Plugin::Authentication>. Both basic and digest authentication
447 are currently supported.
449 When authentication is required, this module sets a status of 401, and
450 the body of the response to 'Authorization required.'. To override
451 this and set your own content, check for the C<< $c->res->status ==
452 401 >> in your C<end> action, and change the body accordingly.
460 A nonce is a one-time value sent with each digest authentication
461 request header. The value must always be unique, so per default the
462 last value of the nonce is kept using L<Catalyst::Plugin::Cache>. To
463 change this behaviour, override the
464 C<store_digest_authorization_nonce> and
465 C<get_digest_authorization_nonce> methods as shown below.
473 =item new $config, $c, $realm
479 Validates that $config is ok.
481 =item authenticate $c, $realm, \%auth_info
483 Tries to authenticate the user, and if that fails calls
484 C<authorization_required_response> and detaches the current action call stack.
486 Looks inside C<< $c->request->headers >> and processes the digest and basic
487 (badly named) authorization header.
489 This will only try the methods set in the configuration. First digest, then basic.
491 The %auth_info hash can contain a number of keys which control the authentication behaviour:
497 Sets the HTTP authentication realm presented to the client. Note this does not alter the
498 Catalyst::Authentication::Realm object used for the authentication.
502 Array reference to domains used to build the authorization headers.
504 This list of domains defines the protection space. If a domain URI is an
505 absolute path (starts with /), it is relative to the root URL of the server being accessed.
506 An absolute URI in this list may refer to a different server than the one being accessed.
508 The client will use this list to determine the set of URIs for which the same authentication
509 information may be sent.
511 If this is omitted or its value is empty, the client will assume that the
512 protection space consists of all URIs on the responding server.
514 Therefore, if your application is not hosted at the root of this domain, and you want to
515 prevent the authentication credentials for this application being sent to any other applications.
516 then you should use the I<use_uri_for> configuration option, and pass a domain of I</>.
520 =item authenticate_basic $c, $realm, \%auth_info
522 Performs HTTP basic authentication.
524 =item authenticate_digest $c, $realm, \%auth_info
526 Performs HTTP digest authentication. Note that the password_type B<must> by I<clear> for
527 digest authentication to succeed, and you must have L<Catalyst::Plugin::Session> in
528 your application as digest authentication needs to store persistent data.
530 Note - if you do not want to store your user passwords as clear text, then it is possible
531 to store instead the MD5 digest in hex of the string '$username:$realm:$password'
533 Takes an additional parameter of I<algorithm>, the possible values of which are 'MD5' (the default)
534 and 'MD5-sess'. For more information about 'MD5-sess', see section 3.2.2.2 in RFC 2617.
536 =item authorization_required_response $c, $realm, \%auth_info
538 Sets C<< $c->response >> to the correct status code, and adds the correct
539 header to demand authentication data from the user agent.
541 Typically used by C<authenticate>, but may be invoked manually.
543 %opts can contain C<domain> and C<algorithm>, which are used to build
546 =item store_digest_authorization_nonce $c, $key, $nonce
548 =item get_digest_authorization_nonce $c, $key
550 Set or get the C<$nonce> object used by the digest auth mode.
552 You may override these methods. By default they will call C<get> and C<set> on
559 All configuration is stored in C<< YourApp->config(authentication => { yourrealm => { credential => { class => 'HTTP', %config } } } >>.
561 This should be a hash, and it can contain the following entries:
567 Can be either C<any> (the default), C<basic> or C<digest>.
569 This controls C<authorization_required_response> and C<authenticate>, but
570 not the "manual" methods.
572 =item authorization_required_message
574 Set this to a string to override the default body content "Authorization required.", or set to undef to suppress body content being generated.
578 The type of password returned by the user object. Same usage as in
579 L<Catalyst::Authentication::Credential::Password|Catalyst::Authentication::Credential::Password/password_type>
583 The name of accessor used to retrieve the value of the password field from the user object. Same usage as in
584 L<Catalyst::Authentication::Credential::Password|Catalyst::Authentication::Credential::Password/password_field>
588 The field name that the user's username is mapped into when finding the user from the realm. Defaults to 'username'.
592 If this configuration key has a true value, then the domain(s) for the authorization header will be
593 run through $c->uri_for(). Use this configuration option if your application is not running at the root
594 of your domain, and you want to ensure that authentication credentials from your application are not shared with
595 other applications on the same server.
601 When using digest authentication, this module will only work together
602 with authentication stores whose User objects have a C<password>
603 method that returns the plain-text password. It will not work together
604 with L<Catalyst::Authentication::Store::Htpasswd>, or
605 L<Catalyst::Authentication::Store::DBIC> stores whose
606 C<password> methods return a hashed or salted version of the password.
610 Updated to current name space and currently maintained
611 by: Tomas Doran C<bobtfish@bobtfish.net>.
617 =item Yuval Kogman, C<nothingmuch@woobling.org>
621 =item Sascha Kiefer C<esskar@cpan.org>
627 Patches contributed by:
637 RFC 2617 (or its successors), L<Catalyst::Plugin::Cache>, L<Catalyst::Plugin::Authentication>
639 =head1 COPYRIGHT & LICENSE
641 Copyright (c) 2005-2008 the aforementioned authors. All rights
642 reserved. This program is free software; you can redistribute
643 it and/or modify it under the same terms as Perl itself.