lib/Catalyst/Authentication/Credential/HTTP.pm

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