1 package Catalyst::Authentication::Credential::HTTP;
2 use base qw/Catalyst::Authentication::Credential::Password/;
13 __PACKAGE__->mk_accessors(qw/_config realm/);
16 our $VERSION = "1.002";
19 my ($class, $config, $app, $realm) = @_;
21 my $self = { _config => $config, _debug => $app->debug };
26 my $type = $self->_config->{'type'} ||= 'any';
28 if (!grep /$type/, ('basic', 'digest', 'any')) {
29 Catalyst::Exception->throw(__PACKAGE__ . " used with unsupported authentication type: " . $type);
35 my ( $self, $c, $realm, $auth_info ) = @_;
38 $auth = $self->authenticate_digest($c, $realm, $auth_info) if $self->_is_http_auth_type('digest');
39 return $auth if $auth;
41 $auth = $self->authenticate_basic($c, $realm, $auth_info) if $self->_is_http_auth_type('basic');
42 return $auth if $auth;
44 $self->authorization_required_response($c, $realm, $auth_info);
45 die $Catalyst::DETACH;
48 sub authenticate_basic {
49 my ( $self, $c, $realm, $auth_info ) = @_;
51 $c->log->debug('Checking http basic authentication.') if $c->debug;
53 my $headers = $c->req->headers;
55 if ( my ( $username, $password ) = $headers->authorization_basic ) {
56 my $user_obj = $realm->find_user( { username => $username }, $c);
58 if ($self->check_password($user_obj, {$self->_config->{password_field} => $password})) {
59 $c->set_authenticated($user_obj);
64 $c->log->debug("Unable to locate user matching user info provided") if $c->debug;
72 sub authenticate_digest {
73 my ( $self, $c, $realm, $auth_info ) = @_;
75 $c->log->debug('Checking http digest authentication.') if $c->debug;
77 my $headers = $c->req->headers;
78 my @authorization = $headers->header('Authorization');
79 foreach my $authorization (@authorization) {
80 next unless $authorization =~ m{^Digest};
82 my @key_val = split /=/, $_, 2;
83 $key_val[0] = lc $key_val[0];
84 $key_val[1] =~ s{"}{}g; # remove the quotes
86 } split /,\s?/, substr( $authorization, 7 ); #7 == length "Digest "
88 my $opaque = $res{opaque};
89 my $nonce = $self->get_digest_authorization_nonce( $c, __PACKAGE__ . '::opaque:' . $opaque );
92 $c->log->debug('Checking authentication parameters.')
95 my $uri = '/' . $c->request->path;
96 my $algorithm = $res{algorithm} || 'MD5';
97 my $nonce_count = '0x' . $res{nc};
99 my $check = $uri eq $res{uri}
100 && ( exists $res{username} )
101 && ( exists $res{qop} )
102 && ( exists $res{cnonce} )
103 && ( exists $res{nc} )
104 && $algorithm eq $nonce->algorithm
105 && hex($nonce_count) > hex( $nonce->nonce_count )
106 && $res{nonce} eq $nonce->nonce; # TODO: set Stale instead
109 $c->log->debug('Digest authentication failed. Bad request.')
111 $c->res->status(400); # bad request
112 Carp::confess $Catalyst::DETACH;
115 $c->log->debug('Checking authentication response.')
118 my $username = $res{username};
122 unless ( $user = $auth_info->{user} ) {
123 $user = $realm->find_user( { username => $username }, $c);
125 unless ($user) { # no user, no authentication
126 $c->log->debug("Unable to locate user matching user info provided") if $c->debug;
130 # everything looks good, let's check the response
131 # calculate H(A2) as per spec
132 my $ctx = Digest::MD5->new;
133 $ctx->add( join( ':', $c->request->method, $res{uri} ) );
134 if ( $res{qop} eq 'auth-int' ) {
136 Digest::MD5::md5_hex( $c->request->body ); # not sure here
137 $ctx->add( ':', $digest );
139 my $A2_digest = $ctx->hexdigest;
141 # the idea of the for loop:
142 # if we do not want to store the plain password in our user store,
143 # we can store md5_hex("$username:$realm:$password") instead
144 my $password_field = $self->_config->{password_field};
145 for my $r ( 0 .. 1 ) {
146 # FIXME - Do not assume accessor is called password.
147 # calculate H(A1) as per spec
148 my $A1_digest = $r ? $user->$password_field() : do {
149 $ctx = Digest::MD5->new;
150 $ctx->add( join( ':', $username, $realm->name, $user->$password_field() ) );
153 if ( $nonce->algorithm eq 'MD5-sess' ) {
154 $ctx = Digest::MD5->new;
155 $ctx->add( join( ':', $A1_digest, $res{nonce}, $res{cnonce} ) );
156 $A1_digest = $ctx->hexdigest;
159 my $digest_in = join( ':',
160 $A1_digest, $res{nonce},
161 $res{qop} ? ( $res{nc}, $res{cnonce}, $res{qop} ) : (),
163 my $rq_digest = Digest::MD5::md5_hex($digest_in);
164 $nonce->nonce_count($nonce_count);
165 $c->cache->set( __PACKAGE__ . '::opaque:' . $nonce->opaque,
167 if ($rq_digest eq $res{response}) {
168 $c->set_authenticated($user);
179 die "A cache is needed for http digest authentication."
180 unless $c->can('cache');
184 sub _is_http_auth_type {
185 my ( $self, $type ) = @_;
186 my $cfgtype = lc( $self->_config->{'type'} || 'any' );
187 return 1 if $cfgtype eq 'any' || $cfgtype eq lc $type;
191 sub authorization_required_response {
192 my ( $self, $c, $realm, $auth_info ) = @_;
194 $c->res->status(401);
195 $c->res->content_type('text/plain');
196 if (exists $self->_config->{authorization_required_message}) {
197 # If you set the key to undef, don't stamp on the body.
198 $c->res->body($self->_config->{authorization_required_message})
199 if defined $c->res->body($self->_config->{authorization_required_message});
202 $c->res->body('Authorization required.');
205 # *DONT* short circuit
207 $ok++ if $self->_create_digest_auth_response($c, $auth_info);
208 $ok++ if $self->_create_basic_auth_response($c, $auth_info);
211 die 'Could not build authorization required response. '
212 . 'Did you configure a valid authentication http type: '
213 . 'basic, digest, any';
218 sub _add_authentication_header {
219 my ( $c, $header ) = @_;
220 $c->response->headers->push_header( 'WWW-Authenticate' => $header );
224 sub _create_digest_auth_response {
225 my ( $self, $c, $opts ) = @_;
227 return unless $self->_is_http_auth_type('digest');
229 if ( my $digest = $self->_build_digest_auth_header( $c, $opts ) ) {
230 _add_authentication_header( $c, $digest );
237 sub _create_basic_auth_response {
238 my ( $self, $c, $opts ) = @_;
240 return unless $self->_is_http_auth_type('basic');
242 if ( my $basic = $self->_build_basic_auth_header( $c, $opts ) ) {
243 _add_authentication_header( $c, $basic );
250 sub _build_auth_header_realm {
253 if ( my $realm = $self->realm ) {
254 my $realm_name = String::Escape::qprintable($realm->name);
255 $realm_name = qq{"$realm_name"} unless $realm_name =~ /^"/;
256 return 'realm=' . $realm_name;
261 sub _build_auth_header_domain {
262 my ( $self, $c, $opts ) = @_;
264 if ( my $domain = $opts->{domain} ) {
265 Catalyst::Exception->throw("domain must be an array reference")
266 unless ref($domain) && ref($domain) eq "ARRAY";
269 $self->_config->{use_uri_for}
270 ? ( map { $c->uri_for($_) } @$domain )
271 : ( map { URI::Escape::uri_escape($_) } @$domain );
273 return qq{domain="@uris"};
278 sub _build_auth_header_common {
279 my ( $self, $c, $opts ) = @_;
282 $self->_build_auth_header_realm(),
283 $self->_build_auth_header_domain($c, $opts),
287 sub _build_basic_auth_header {
288 my ( $self, $c, $opts ) = @_;
289 return _join_auth_header_parts( Basic => $self->_build_auth_header_common( $c, $opts ) );
292 sub _build_digest_auth_header {
293 my ( $self, $c, $opts ) = @_;
295 my $nonce = $self->_digest_auth_nonce($c, $opts);
297 my $key = __PACKAGE__ . '::opaque:' . $nonce->opaque;
299 $self->store_digest_authorization_nonce( $c, $key, $nonce );
301 return _join_auth_header_parts( Digest =>
302 $self->_build_auth_header_common($c, $opts),
303 map { sprintf '%s="%s"', $_, $nonce->$_ } qw(
312 sub _digest_auth_nonce {
313 my ( $self, $c, $opts ) = @_;
315 my $package = __PACKAGE__ . '::Nonce';
317 my $nonce = $package->new;
319 if ( my $algorithm = $opts->{algorithm} || $self->_config->{algorithm}) {
320 $nonce->algorithm( $algorithm );
326 sub _join_auth_header_parts {
327 my ( $type, @parts ) = @_;
328 return "$type " . join(", ", @parts );
331 sub get_digest_authorization_nonce {
332 my ( $self, $c, $key ) = @_;
335 return $c->cache->get( $key );
338 sub store_digest_authorization_nonce {
339 my ( $self, $c, $key, $nonce ) = @_;
342 return $c->cache->set( $key, $nonce );
345 package Catalyst::Authentication::Credential::HTTP::Nonce;
348 use base qw[ Class::Accessor::Fast ];
351 our $VERSION = '0.02';
353 __PACKAGE__->mk_accessors(qw[ nonce nonce_count qop opaque algorithm ]);
357 my $self = $class->SUPER::new(@_);
359 $self->nonce( Data::UUID->new->create_b64 );
360 $self->opaque( Data::UUID->new->create_b64 );
361 $self->qop('auth,auth-int');
362 $self->nonce_count('0x0');
363 $self->algorithm('MD5');
376 Catalyst::Authentication::Credential::HTTP - HTTP Basic and Digest authentication
385 __PACKAGE__->config( authentication => {
390 type => 'any', # or 'digest' or 'basic'
391 password_type => 'clear',
392 password_field => 'password'
397 Mufasa => { password => "Circle Of Life", },
405 my ( $self, $c ) = @_;
407 $c->authenticate({ realm => "example" });
408 # either user gets authenticated or 401 is sent
414 __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate });
418 This module lets you use HTTP authentication with
419 L<Catalyst::Plugin::Authentication>. Both basic and digest authentication
420 are currently supported.
422 When authentication is required, this module sets a status of 401, and
423 the body of the response to 'Authorization required.'. To override
424 this and set your own content, check for the C<< $c->res->status ==
425 401 >> in your C<end> action, and change the body accordingly.
433 A nonce is a one-time value sent with each digest authentication
434 request header. The value must always be unique, so per default the
435 last value of the nonce is kept using L<Catalyst::Plugin::Cache>. To
436 change this behaviour, override the
437 C<store_digest_authorization_nonce> and
438 C<get_digest_authorization_nonce> methods as shown below.
446 =item new $config, $c, $realm
450 =item authenticate $c, $realm, \%auth_info
452 Tries to authenticate the user, and if that fails calls
453 C<authorization_required_response> and detaches the current action call stack.
455 Looks inside C<< $c->request->headers >> and processes the digest and basic
456 (badly named) authorization header.
458 This will only try the methods set in the configuration. First digest, then basic.
460 This method just passes the options through untouched. See the next two methods for what \%auth_info can contain.
462 =item authenticate_basic $c, $realm, \%auth_info
464 Acts like L<Catalyst::Authentication::Credential::Password>, and will lookup the user's password as detailed in that module.
466 =item authenticate_digest $c, $realm, \%auth_info
468 Assumes that your user object has a hard coded method which returns a clear text password.
470 =item authorization_required_response $c, $realm, \%auth_info
472 Sets C<< $c->response >> to the correct status code, and adds the correct
473 header to demand authentication data from the user agent.
475 Typically used by C<authenticate>, but may be invoked manually.
477 %opts can contain C<domain> and C<algorithm>, which are used to build
480 =item store_digest_authorization_nonce $c, $key, $nonce
482 =item get_digest_authorization_nonce $c, $key
484 Set or get the C<$nonce> object used by the digest auth mode.
486 You may override these methods. By default they will call C<get> and C<set> on
493 All configuration is stored in C<< YourApp->config(authentication => { yourrealm => { credential => { class => 'HTTP', %config } } } >>.
495 This should be a hash, and it can contain the following entries:
501 Can be either C<any> (the default), C<basic> or C<digest>.
503 This controls C<authorization_required_response> and C<authenticate>, but
504 not the "manual" methods.
506 =item authorization_required_message
508 Set this to a string to override the default body content "Authorization required.", or set to undef to suppress body content being generated.
514 When using digest authentication, this module will only work together
515 with authentication stores whose User objects have a C<password>
516 method that returns the plain-text password. It will not work together
517 with L<Catalyst::Authentication::Store::Htpasswd>, or
518 L<Catalyst::Authentication::Store::DBIC> stores whose
519 C<password> methods return a hashed or salted version of the password.
523 Updated to current name space and currently maintained
524 by: Tomas Doran C<bobtfish@bobtfish.net>.
530 =item Yuval Kogman, C<nothingmuch@woobling.org>
534 =item Sascha Kiefer C<esskar@cpan.org>
540 RFC 2617 (or its successors), L<Catalyst::Plugin::Cache>, L<Catalyst::Plugin::Authentication>
542 =head1 COPYRIGHT & LICENSE
544 Copyright (c) 2005-2008 the aforementioned authors. All rights
545 reserved. This program is free software; you can redistribute
546 it and/or modify it under the same terms as Perl itself.