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.003";
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 {
251 my ( $self, $c, $opts ) = @_;
252 if ( my $realm_name = String::Escape::qprintable($opts->{realm} ? $opts->{realm} : $self->realm->name) ) {
253 $realm_name = qq{"$realm_name"} unless $realm_name =~ /^"/;
254 return 'realm=' . $realm_name;
259 sub _build_auth_header_domain {
260 my ( $self, $c, $opts ) = @_;
261 if ( my $domain = $opts->{domain} ) {
262 Catalyst::Exception->throw("domain must be an array reference")
263 unless ref($domain) && ref($domain) eq "ARRAY";
266 $self->_config->{use_uri_for}
267 ? ( map { $c->uri_for($_) } @$domain )
268 : ( map { URI::Escape::uri_escape($_) } @$domain );
270 return qq{domain="@uris"};
275 sub _build_auth_header_common {
276 my ( $self, $c, $opts ) = @_;
277 warn("HERE Opts $opts");
279 $self->_build_auth_header_realm($c, $opts),
280 $self->_build_auth_header_domain($c, $opts),
284 sub _build_basic_auth_header {
285 my ( $self, $c, $opts ) = @_;
286 return _join_auth_header_parts( Basic => $self->_build_auth_header_common( $c, $opts ) );
289 sub _build_digest_auth_header {
290 my ( $self, $c, $opts ) = @_;
292 my $nonce = $self->_digest_auth_nonce($c, $opts);
294 my $key = __PACKAGE__ . '::opaque:' . $nonce->opaque;
296 $self->store_digest_authorization_nonce( $c, $key, $nonce );
298 return _join_auth_header_parts( Digest =>
299 $self->_build_auth_header_common($c, $opts),
300 map { sprintf '%s="%s"', $_, $nonce->$_ } qw(
309 sub _digest_auth_nonce {
310 my ( $self, $c, $opts ) = @_;
312 my $package = __PACKAGE__ . '::Nonce';
314 my $nonce = $package->new;
316 if ( my $algorithm = $opts->{algorithm} || $self->_config->{algorithm}) {
317 $nonce->algorithm( $algorithm );
323 sub _join_auth_header_parts {
324 my ( $type, @parts ) = @_;
325 return "$type " . join(", ", @parts );
328 sub get_digest_authorization_nonce {
329 my ( $self, $c, $key ) = @_;
332 return $c->cache->get( $key );
335 sub store_digest_authorization_nonce {
336 my ( $self, $c, $key, $nonce ) = @_;
339 return $c->cache->set( $key, $nonce );
342 package Catalyst::Authentication::Credential::HTTP::Nonce;
345 use base qw[ Class::Accessor::Fast ];
348 our $VERSION = '0.02';
350 __PACKAGE__->mk_accessors(qw[ nonce nonce_count qop opaque algorithm ]);
354 my $self = $class->SUPER::new(@_);
356 $self->nonce( Data::UUID->new->create_b64 );
357 $self->opaque( Data::UUID->new->create_b64 );
358 $self->qop('auth,auth-int');
359 $self->nonce_count('0x0');
360 $self->algorithm('MD5');
373 Catalyst::Authentication::Credential::HTTP - HTTP Basic and Digest authentication
382 __PACKAGE__->config( authentication => {
387 type => 'any', # or 'digest' or 'basic'
388 password_type => 'clear',
389 password_field => 'password'
394 Mufasa => { password => "Circle Of Life", },
402 my ( $self, $c ) = @_;
404 $c->authenticate({ realm => "example" });
405 # either user gets authenticated or 401 is sent
406 # Note that the authentication realm sent to the client is overridden
407 # here, but this does not affect the Catalyst::Authentication::Realm
408 # used for authentication.
413 sub always_auth : Local {
414 my ( $self, $c ) = @_;
416 # Force authorization headers onto the response so that the user
417 # is asked again for authentication, even if they successfully
419 my $realm = $c->get_auth_realm('example');
420 $realm->credential->authorization_required_response($c, $realm);
424 __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate });
428 This module lets you use HTTP authentication with
429 L<Catalyst::Plugin::Authentication>. Both basic and digest authentication
430 are currently supported.
432 When authentication is required, this module sets a status of 401, and
433 the body of the response to 'Authorization required.'. To override
434 this and set your own content, check for the C<< $c->res->status ==
435 401 >> in your C<end> action, and change the body accordingly.
443 A nonce is a one-time value sent with each digest authentication
444 request header. The value must always be unique, so per default the
445 last value of the nonce is kept using L<Catalyst::Plugin::Cache>. To
446 change this behaviour, override the
447 C<store_digest_authorization_nonce> and
448 C<get_digest_authorization_nonce> methods as shown below.
456 =item new $config, $c, $realm
460 =item authenticate $c, $realm, \%auth_info
462 Tries to authenticate the user, and if that fails calls
463 C<authorization_required_response> and detaches the current action call stack.
465 Looks inside C<< $c->request->headers >> and processes the digest and basic
466 (badly named) authorization header.
468 This will only try the methods set in the configuration. First digest, then basic.
470 The %auth_info hash can contain a number of keys which control the authentication behaviour:
476 Sets the HTTP authentication realm presented to the client. Note this does not alter the
477 Catalyst::Authentication::Realm object used for the authentication.
481 Array reference to domains used to build the authorization headers.
485 =item authenticate_basic $c, $realm, \%auth_info
487 Performs HTTP basic authentication.
489 =item authenticate_digest $c, $realm, \%auth_info
491 Performs HTTP digest authentication. Note that the password_type B<must> by I<clear> for
492 digest authentication to succeed.
494 =item authorization_required_response $c, $realm, \%auth_info
496 Sets C<< $c->response >> to the correct status code, and adds the correct
497 header to demand authentication data from the user agent.
499 Typically used by C<authenticate>, but may be invoked manually.
501 %opts can contain C<domain> and C<algorithm>, which are used to build
504 =item store_digest_authorization_nonce $c, $key, $nonce
506 =item get_digest_authorization_nonce $c, $key
508 Set or get the C<$nonce> object used by the digest auth mode.
510 You may override these methods. By default they will call C<get> and C<set> on
517 All configuration is stored in C<< YourApp->config(authentication => { yourrealm => { credential => { class => 'HTTP', %config } } } >>.
519 This should be a hash, and it can contain the following entries:
525 Can be either C<any> (the default), C<basic> or C<digest>.
527 This controls C<authorization_required_response> and C<authenticate>, but
528 not the "manual" methods.
530 =item authorization_required_message
532 Set this to a string to override the default body content "Authorization required.", or set to undef to suppress body content being generated.
536 The type of password returned by the user object. Same usage as in
537 L<Catalyst::Authentication::Credential::Password|Catalyst::Authentication::Credential::Password/passwprd_type>
541 The name of accessor used to retrieve the value of the password field from the user object. Same usage as in
542 L<Catalyst::Authentication::Credential::Password|Catalyst::Authentication::Credential::Password/password_field>
546 If this configuration key has a true value, then the domain(s) for the authorization header will be
547 run through $c->uri_for()
553 When using digest authentication, this module will only work together
554 with authentication stores whose User objects have a C<password>
555 method that returns the plain-text password. It will not work together
556 with L<Catalyst::Authentication::Store::Htpasswd>, or
557 L<Catalyst::Authentication::Store::DBIC> stores whose
558 C<password> methods return a hashed or salted version of the password.
562 Updated to current name space and currently maintained
563 by: Tomas Doran C<bobtfish@bobtfish.net>.
569 =item Yuval Kogman, C<nothingmuch@woobling.org>
573 =item Sascha Kiefer C<esskar@cpan.org>
579 RFC 2617 (or its successors), L<Catalyst::Plugin::Cache>, L<Catalyst::Plugin::Authentication>
581 =head1 COPYRIGHT & LICENSE
583 Copyright (c) 2005-2008 the aforementioned authors. All rights
584 reserved. This program is free software; you can redistribute
585 it and/or modify it under the same terms as Perl itself.