3 package Catalyst::Plugin::Authentication::Credential::HTTP;
4 use base qw/Catalyst::Plugin::Authentication::Credential::Password/;
14 our $VERSION = "0.07";
16 sub authenticate_http {
17 my ( $c, @args ) = @_;
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);
23 sub get_http_auth_store {
24 my ( $c, %opts ) = @_;
26 my $store = $opts{store} || $c->config->{authentication}{http}{store} || return;
30 : $c->get_auth_store($store);
33 sub authenticate_basic {
34 my ( $c, %opts ) = @_;
36 $c->log->debug('Checking http basic authentication.') if $c->debug;
38 my $headers = $c->req->headers;
40 if ( my ( $username, $password ) = $headers->authorization_basic ) {
44 unless ( $user = $opts{user} ) {
45 if ( my $store = $c->get_http_auth_store(%opts) ) {
46 $user = $store->get_user($username);
52 return $c->login( $user, $password );
58 sub authenticate_digest {
59 my ( $c, %opts ) = @_;
61 $c->log->debug('Checking http digest authentication.') if $c->debug;
63 my $headers = $c->req->headers;
64 my @authorization = $headers->header('Authorization');
65 foreach my $authorization (@authorization) {
66 next unless $authorization =~ m{^Digest};
69 my @key_val = split /=/, $_, 2;
70 $key_val[0] = lc $key_val[0];
71 $key_val[1] =~ s{"}{}g; # remove the quotes
73 } split /,\s?/, substr( $authorization, 7 ); #7 == length "Digest "
75 my $opaque = $res{opaque};
76 my $nonce = $c->get_digest_authorization_nonce( __PACKAGE__ . '::opaque:' . $opaque );
79 $c->log->debug('Checking authentication parameters.')
82 my $uri = '/' . $c->request->path;
83 my $algorithm = $res{algorithm} || 'MD5';
84 my $nonce_count = '0x' . $res{nc};
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
96 $c->log->debug('Digest authentication failed. Bad request.')
98 $c->res->status(400); # bad request
99 die $Catalyst::DETACH;
102 $c->log->debug('Checking authentication response.')
105 my $username = $res{username};
106 my $realm = $res{realm};
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);
116 unless ($user) { # no user, no authentication
117 $c->log->debug('Unknown user: $user.') if $c->debug;
121 # everything looks good, let's check the response
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' ) {
128 Digest::MD5::md5_hex( $c->request->body ); # not sure here
129 $ctx->add( ':', $digest );
131 my $A2_digest = $ctx->hexdigest;
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 ) {
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 ) );
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;
150 my $rq_digest = Digest::MD5::md5_hex(
152 $A1_digest, $res{nonce},
153 $res{qop} ? ( $res{nc}, $res{cnonce}, $res{qop} ) : (),
157 $nonce->nonce_count($nonce_count);
158 $c->cache->set( __PACKAGE__ . '::opaque:' . $nonce->opaque,
161 return $c->login( $user, $user->password )
162 if $rq_digest eq $res{response};
172 die "A cache is needed for http digest authentication."
173 unless $c->can('cache');
176 sub _is_http_auth_type {
177 my ( $c, $type ) = @_;
179 my $cfgtype = lc( $c->config->{authentication}{http}{type} || 'any' );
180 return 1 if $cfgtype eq 'any' || $cfgtype eq lc $type;
184 sub authorization_required {
185 my ( $c, @args ) = @_;
187 return 1 if $c->authenticate_http(@args);
189 $c->authorization_required_response(@args);
191 die $Catalyst::DETACH;
194 sub authorization_required_response {
195 my ( $c, %opts ) = @_;
197 $c->res->status(401);
199 # *DONT* short circuit
201 $ok++ if $c->_create_digest_auth_response(\%opts);
202 $ok++ if $c->_create_basic_auth_response(\%opts);
205 die 'Could not build authorization required response. '
206 . 'Did you configure a valid authentication http type: '
207 . 'basic, digest, any';
211 sub _add_authentication_header {
212 my ( $c, $header ) = @_;
213 $c->res->headers->push_header( 'WWW-Authenticate' => $header );
216 sub _create_digest_auth_response {
217 my ( $c, $opts ) = @_;
219 return unless $c->_is_http_auth_type('digest');
221 if ( my $digest = $c->_build_digest_auth_header( $opts ) ) {
222 $c->_add_authentication_header( $digest );
229 sub _create_basic_auth_response {
230 my ( $c, $opts ) = @_;
232 return unless $c->_is_http_auth_type('basic');
234 if ( my $basic = $c->_build_basic_auth_header( $opts ) ) {
235 $c->_add_authentication_header( $basic );
242 sub _build_auth_header_realm {
243 my ( $c, $opts ) = @_;
245 if ( my $realm = $opts->{realm} ) {
246 return 'realm=' . String::Escape::qprintable($realm);
252 sub _build_auth_header_domain {
253 my ( $c, $opts ) = @_;
255 if ( my $domain = $opts->{domain} ) {
256 Catalyst::Exception->throw("domain must be an array reference")
257 unless ref($domain) && ref($domain) eq "ARRAY";
260 $c->config->{authentication}{http}{use_uri_for}
261 ? ( map { $c->uri_for($_) } @$domain )
262 : ( map { URI::Escape::uri_escape($_) } @$domain );
264 return qq{domain="@uris"};
270 sub _build_auth_header_common {
271 my ( $c, $opts ) = @_;
274 $c->_build_auth_header_realm($opts),
275 $c->_build_auth_header_domain($opts),
279 sub _build_basic_auth_header {
280 my ( $c, $opts ) = @_;
281 return $c->_join_auth_header_parts( Basic => $c->_build_auth_header_common( $opts ) );
284 sub _build_digest_auth_header {
285 my ( $c, $opts ) = @_;
287 my $nonce = $c->_digest_auth_nonce($opts);
289 my $key = __PACKAGE__ . '::opaque:' . $nonce->opaque;
291 $c->store_digest_authorization_nonce( $key, $nonce );
293 return $c->_join_auth_header_parts( Digest =>
294 $c->_build_auth_header_common($opts),
295 map { sprintf '%s="%s"', $_, $nonce->$_ } qw(
304 sub _digest_auth_nonce {
305 my ( $c, $opts ) = @_;
307 my $package = __PACKAGE__ . '::Nonce';
309 my $nonce = $package->new;
311 if ( my $algorithm = $opts->{algorithm} || $c->config->{authentication}{http}{algorithm}) {
312 $nonce->algorithm( $algorithm );
318 sub _join_auth_header_parts {
319 my ( $c, $type, @parts ) = @_;
320 return "$type " . join(", ", @parts );
323 sub get_digest_authorization_nonce {
324 my ( $c, $key ) = @_;
327 $c->cache->get( $key );
330 sub store_digest_authorization_nonce {
331 my ( $c, $key, $nonce ) = @_;
334 $c->cache->set( $key, $nonce );
337 package Catalyst::Plugin::Authentication::Credential::HTTP::Nonce;
340 use base qw[ Class::Accessor::Fast ];
343 our $VERSION = "0.01";
345 __PACKAGE__->mk_accessors(qw[ nonce nonce_count qop opaque algorithm ]);
349 my $self = $class->SUPER::new(@_);
351 $self->nonce( Data::UUID->new->create_b64 );
352 $self->opaque( Data::UUID->new->create_b64 );
353 $self->qop('auth,auth-int');
354 $self->nonce_count('0x0');
355 $self->algorithm('MD5');
368 Catalyst::Plugin::Authentication::Credential::HTTP - HTTP Basic and Digest authentication
375 Authentication::Store::Moose
376 Authentication::Credential::HTTP
379 __PACKAGE__->config->{authentication}{http}{type} = 'any'; # or 'digest' or 'basic'
380 __PACKAGE__->config->{authentication}{users} = {
381 Mufasa => { password => "Circle Of Life", },
385 my ( $self, $c ) = @_;
387 $c->authorization_required( realm => "foo" ); # named after the status code ;-)
389 # either user gets authenticated or 401 is sent
395 __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate_http });
398 my ( $self, $c ) = @_;
400 $c->authorization_required_response( realm => "foo" );
406 This moduule lets you use HTTP authentication with
407 L<Catalyst::Plugin::Authentication>. Both basic and digest authentication
408 are currently supported.
414 =item authorization_required %opts
416 Tries to C<authenticate_http>, and if that fails calls
417 C<authorization_required_response> and detaches the current action call stack.
419 This method just passes the options through untouched.
421 =item authenticate_http %opts
423 Looks inside C<< $c->request->headers >> and processes the digest and basic
424 (badly named) authorization header.
426 This will only try the methods set in the configuration.
428 See the next two methods for what %opts can contain.
430 =item authenticate_basic %opts
432 =item authenticate_digest %opts
434 Try to authenticate one of the methods without checking if the method is
435 allowed in the configuration.
437 %opts can contain C<store> (either an object or a name), C<user> (to disregard
438 %the username from the header altogether, overriding it with a username or user
441 =item authorization_required_response %opts
443 Sets C<< $c->response >> to the correct status code, and adds the correct
444 header to demand authentication data from the user agent.
446 Typically used by C<authorization_required>, but may be invoked manually.
448 %opts can contain C<realm>, C<domain> and C<algorithm>, which are used to build
451 =item store_digest_authorization_nonce $key, $nonce
453 =item get_digest_authorization_nonce $key
455 Set or get the C<$nonce> object used by the digest auth mode.
457 You may override these methods. By default they will call C<get> and C<set> on
464 All configuration is stored in C<< YourApp->config->{authentication}{http} >>.
466 This should be a hash, and it can contain the following entries:
472 Either a name or an object -- the default store to use for HTTP authentication.
476 Can be either C<any> (the default), C<basic> or C<digest>.
478 This controls C<authorization_required_response> and C<authenticate_http>, but
479 not the "manual" methods.
485 Yuval Kogman, C<nothingmuch@woobling.org>
489 Sascha Kiefer C<esskar@cpan.org>
491 =head1 COPYRIGHT & LICENSE
493 Copyright (c) 2005-2006 the aforementioned authors. All rights
494 reserved. This program is free software; you can redistribute
495 it and/or modify it under the same terms as Perl itself.