lib/Catalyst/Authentication/Credential/HTTP.pm

   1 package Catalyst::Authentication::Credential::HTTP;
   2 use base qw/Catalyst::Authentication::Credential::Password/;
   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.008';
  17
  18 sub new {
  19     my ($class, $config, $app, $realm) = @_;
  20
  21     $config->{username_field} ||= 'username';
  22     my $self = { _config => $config, _debug => $app->debug };
  23     bless $self, $class;
  24
  25     $self->realm($realm);
  26
  27     $self->init;
  28     return $self;
  29 }
  30
  31 sub init {
  32     my ($self) = @_;
  33     my $type = $self->_config->{'type'} ||= 'any';
  34
  35     if (!grep /$type/, ('basic', 'digest', 'any')) {
  36         Catalyst::Exception->throw(__PACKAGE__ . " used with unsupported authentication type: " . $type);
  37     }
  38 }
  39
  40 sub authenticate {
  41     my ( $self, $c, $realm, $auth_info ) = @_;
  42     my $auth;
  43
  44     $auth = $self->authenticate_digest($c, $realm, $auth_info) if $self->_is_http_auth_type('digest');
  45     return $auth if $auth;
  46
  47     $auth = $self->authenticate_basic($c, $realm, $auth_info) if $self->_is_http_auth_type('basic');
  48     return $auth if $auth;
  49
  50     $self->authorization_required_response($c, $realm, $auth_info);
  51     die $Catalyst::DETACH;
  52 }
  53
  54 sub authenticate_basic {
  55     my ( $self, $c, $realm, $auth_info ) = @_;
  56
  57     $c->log->debug('Checking http basic authentication.') if $c->debug;
  58
  59     my $headers = $c->req->headers;
  60
  61     if ( my ( $username, $password ) = $headers->authorization_basic ) {
  62             my $user_obj = $realm->find_user( { $self->_config->{username_field} => $username }, $c);
  63             if (ref($user_obj)) {
  64             my $opts = {};
  65             $opts->{$self->_config->{password_field}} = $password
  66                 if $self->_config->{password_field};
  67             if ($self->check_password($user_obj, $opts)) {
  68                 return $user_obj;
  69             }
  70         }
  71         else {
  72             $c->log->debug("Unable to locate user matching user info provided") if $c->debug;
  73             return;
  74         }
  75     }
  76
  77     return;
  78 }
  79
  80 sub authenticate_digest {
  81     my ( $self, $c, $realm, $auth_info ) = @_;
  82
  83     $c->log->debug('Checking http digest authentication.') if $c->debug;
  84
  85     my $headers       = $c->req->headers;
  86     my @authorization = $headers->header('Authorization');
  87     foreach my $authorization (@authorization) {
  88         next unless $authorization =~ m{^Digest};
  89         my %res = map {
  90             my @key_val = split /=/, $_, 2;
  91             $key_val[0] = lc $key_val[0];
  92             $key_val[1] =~ s{"}{}g;    # remove the quotes
  93             @key_val;
  94         } split /,\s?/, substr( $authorization, 7 );    #7 == length "Digest "
  95
  96         my $opaque = $res{opaque};
  97         my $nonce  = $self->get_digest_authorization_nonce( $c, __PACKAGE__ . '::opaque:' . $opaque );
  98         next unless $nonce;
  99
 100         $c->log->debug('Checking authentication parameters.')
 101           if $c->debug;
 102
 103         my $uri         = $c->request->uri->path_query;
 104         my $algorithm   = $res{algorithm} || 'MD5';
 105         my $nonce_count = '0x' . $res{nc};
 106
 107         my $check = $uri eq $res{uri}
 108           && ( exists $res{username} )
 109           && ( exists $res{qop} )
 110           && ( exists $res{cnonce} )
 111           && ( exists $res{nc} )
 112           && $algorithm eq $nonce->algorithm
 113           && hex($nonce_count) > hex( $nonce->nonce_count )
 114           && $res{nonce} eq $nonce->nonce;    # TODO: set Stale instead
 115
 116         unless ($check) {
 117             $c->log->debug('Digest authentication failed. Bad request.')
 118               if $c->debug;
 119             $c->res->status(400);             # bad request
 120             Carp::confess $Catalyst::DETACH;
 121         }
 122
 123         $c->log->debug('Checking authentication response.')
 124           if $c->debug;
 125
 126         my $username = $res{username};
 127
 128         my $user_obj;
 129
 130         unless ( $user_obj = $auth_info->{user} ) {
 131             $user_obj = $realm->find_user( { $self->_config->{username_field} => $username }, $c);
 132         }
 133         unless ($user_obj) {    # no user, no authentication
 134             $c->log->debug("Unable to locate user matching user info provided") if $c->debug;
 135             return;
 136         }
 137
 138         # everything looks good, let's check the response
 139         # calculate H(A2) as per spec
 140         my $ctx = Digest::MD5->new;
 141         $ctx->add( join( ':', $c->request->method, $res{uri} ) );
 142         if ( $res{qop} eq 'auth-int' ) {
 143             my $digest =
 144               Digest::MD5::md5_hex( $c->request->body );    # not sure here
 145             $ctx->add( ':', $digest );
 146         }
 147         my $A2_digest = $ctx->hexdigest;
 148
 149         # the idea of the for loop:
 150         # if we do not want to store the plain password in our user store,
 151         # we can store md5_hex("$username:$realm:$password") instead
 152         my $password_field = $self->_config->{password_field};
 153         for my $r ( 0 .. 1 ) {
 154             # calculate H(A1) as per spec
 155             my $A1_digest = $r ? $user_obj->$password_field() : do {
 156                 $ctx = Digest::MD5->new;
 157                 $ctx->add( join( ':', $username, $realm->name, $user_obj->$password_field() ) );
 158                 $ctx->hexdigest;
 159             };
 160             if ( $nonce->algorithm eq 'MD5-sess' ) {
 161                 $ctx = Digest::MD5->new;
 162                 $ctx->add( join( ':', $A1_digest, $res{nonce}, $res{cnonce} ) );
 163                 $A1_digest = $ctx->hexdigest;
 164             }
 165
 166             my $digest_in = join( ':',
 167                     $A1_digest, $res{nonce},
 168                     $res{qop} ? ( $res{nc}, $res{cnonce}, $res{qop} ) : (),
 169                     $A2_digest );
 170             my $rq_digest = Digest::MD5::md5_hex($digest_in);
 171             $nonce->nonce_count($nonce_count);
 172             $c->cache->set( __PACKAGE__ . '::opaque:' . $nonce->opaque,
 173                 $nonce );
 174             if ($rq_digest eq $res{response}) {
 175                 return $user_obj;
 176             }
 177         }
 178     }
 179     return;
 180 }
 181
 182 sub _check_cache {
 183     my $c = shift;
 184
 185     die "A cache is needed for http digest authentication."
 186       unless $c->can('cache');
 187     return;
 188 }
 189
 190 sub _is_http_auth_type {
 191     my ( $self, $type ) = @_;
 192     my $cfgtype = lc( $self->_config->{'type'} || 'any' );
 193     return 1 if $cfgtype eq 'any' || $cfgtype eq lc $type;
 194     return 0;
 195 }
 196
 197 sub authorization_required_response {
 198     my ( $self, $c, $realm, $auth_info ) = @_;
 199
 200     $c->res->status(401);
 201     $c->res->content_type('text/plain');
 202     if (exists $self->_config->{authorization_required_message}) {
 203         # If you set the key to undef, don't stamp on the body.
 204         $c->res->body($self->_config->{authorization_required_message})
 205             if defined $c->res->body($self->_config->{authorization_required_message});
 206     }
 207     else {
 208         $c->res->body('Authorization required.');
 209     }
 210
 211     # *DONT* short circuit
 212     my $ok;
 213     $ok++ if $self->_create_digest_auth_response($c, $auth_info);
 214     $ok++ if $self->_create_basic_auth_response($c, $auth_info);
 215
 216     unless ( $ok ) {
 217         die 'Could not build authorization required response. '
 218         . 'Did you configure a valid authentication http type: '
 219         . 'basic, digest, any';
 220     }
 221     return;
 222 }
 223
 224 sub _add_authentication_header {
 225     my ( $c, $header ) = @_;
 226     $c->response->headers->push_header( 'WWW-Authenticate' => $header );
 227     return;
 228 }
 229
 230 sub _create_digest_auth_response {
 231     my ( $self, $c, $opts ) = @_;
 232
 233     return unless $self->_is_http_auth_type('digest');
 234
 235     if ( my $digest = $self->_build_digest_auth_header( $c, $opts ) ) {
 236         _add_authentication_header( $c, $digest );
 237         return 1;
 238     }
 239
 240     return;
 241 }
 242
 243 sub _create_basic_auth_response {
 244     my ( $self, $c, $opts ) = @_;
 245
 246     return unless $self->_is_http_auth_type('basic');
 247
 248     if ( my $basic = $self->_build_basic_auth_header( $c, $opts ) ) {
 249         _add_authentication_header( $c, $basic );
 250         return 1;
 251     }
 252
 253     return;
 254 }
 255
 256 sub _build_auth_header_realm {
 257     my ( $self, $c, $opts ) = @_;
 258     if ( my $realm_name = String::Escape::qprintable($opts->{realm} ? $opts->{realm} : $self->realm->name) ) {
 259         $realm_name = qq{"$realm_name"} unless $realm_name =~ /^"/;
 260         return 'realm=' . $realm_name;
 261     }
 262     return;
 263 }
 264
 265 sub _build_auth_header_domain {
 266     my ( $self, $c, $opts ) = @_;
 267     if ( my $domain = $opts->{domain} ) {
 268         Catalyst::Exception->throw("domain must be an array reference")
 269           unless ref($domain) && ref($domain) eq "ARRAY";
 270
 271         my @uris =
 272           $self->_config->{use_uri_for}
 273           ? ( map { $c->uri_for($_) } @$domain )
 274           : ( map { URI::Escape::uri_escape($_) } @$domain );
 275
 276         return qq{domain="@uris"};
 277     }
 278     return;
 279 }
 280
 281 sub _build_auth_header_common {
 282     my ( $self, $c, $opts ) = @_;
 283     return (
 284         $self->_build_auth_header_realm($c, $opts),
 285         $self->_build_auth_header_domain($c, $opts),
 286     );
 287 }
 288
 289 sub _build_basic_auth_header {
 290     my ( $self, $c, $opts ) = @_;
 291     return _join_auth_header_parts( Basic => $self->_build_auth_header_common( $c, $opts ) );
 292 }
 293
 294 sub _build_digest_auth_header {
 295     my ( $self, $c, $opts ) = @_;
 296
 297     my $nonce = $self->_digest_auth_nonce($c, $opts);
 298
 299     my $key = __PACKAGE__ . '::opaque:' . $nonce->opaque;
 300
 301     $self->store_digest_authorization_nonce( $c, $key, $nonce );
 302
 303     return _join_auth_header_parts( Digest =>
 304         $self->_build_auth_header_common($c, $opts),
 305         map { sprintf '%s="%s"', $_, $nonce->$_ } qw(
 306             qop
 307             nonce
 308             opaque
 309             algorithm
 310         ),
 311     );
 312 }
 313
 314 sub _digest_auth_nonce {
 315     my ( $self, $c, $opts ) = @_;
 316
 317     my $package = __PACKAGE__ . '::Nonce';
 318
 319     my $nonce   = $package->new;
 320
 321     if ( my $algorithm = $opts->{algorithm} || $self->_config->{algorithm}) {
 322         $nonce->algorithm( $algorithm );
 323     }
 324
 325     return $nonce;
 326 }
 327
 328 sub _join_auth_header_parts {
 329     my ( $type, @parts ) = @_;
 330     return "$type " . join(", ", @parts );
 331 }
 332
 333 sub get_digest_authorization_nonce {
 334     my ( $self, $c, $key ) = @_;
 335
 336     _check_cache($c);
 337     return $c->cache->get( $key );
 338 }
 339
 340 sub store_digest_authorization_nonce {
 341     my ( $self, $c, $key, $nonce ) = @_;
 342
 343     _check_cache($c);
 344     return $c->cache->set( $key, $nonce );
 345 }
 346
 347 package Catalyst::Authentication::Credential::HTTP::Nonce;
 348
 349 use strict;
 350 use base qw[ Class::Accessor::Fast ];
 351 use Data::UUID ();
 352
 353 our $VERSION = '0.02';
 354
 355 __PACKAGE__->mk_accessors(qw[ nonce nonce_count qop opaque algorithm ]);
 356
 357 sub new {
 358     my $class = shift;
 359     my $self  = $class->SUPER::new(@_);
 360
 361     $self->nonce( Data::UUID->new->create_b64 );
 362     $self->opaque( Data::UUID->new->create_b64 );
 363     $self->qop('auth,auth-int');
 364     $self->nonce_count('0x0');
 365     $self->algorithm('MD5');
 366
 367     return $self;
 368 }
 369
 370 1;
 371
 372 __END__
 373
 374 =pod
 375
 376 =head1 NAME
 377
 378 Catalyst::Authentication::Credential::HTTP - HTTP Basic and Digest authentication
 379 for Catalyst.
 380
 381 =head1 SYNOPSIS
 382
 383     use Catalyst qw/
 384         Authentication
 385     /;
 386
 387     __PACKAGE__->config( authentication => {
 388         default_realm => 'example',
 389         realms => {
 390             example => {
 391                 credential => {
 392                     class => 'HTTP',
 393                     type  => 'any', # or 'digest' or 'basic'
 394                     password_type  => 'clear',
 395                     password_field => 'password'
 396                 },
 397                 store => {
 398                     class => 'Minimal',
 399                     users => {
 400                         Mufasa => { password => "Circle Of Life", },
 401                     },
 402                 },
 403             },
 404         }
 405     });
 406
 407     sub foo : Local {
 408         my ( $self, $c ) = @_;
 409
 410         $c->authenticate({ realm => "example" });
 411         # either user gets authenticated or 401 is sent
 412         # Note that the authentication realm sent to the client (in the
 413         # RFC 2617 sense) is overridden here, but this *does not*
 414         # effect the Catalyst::Authentication::Realm used for
 415         # authentication - to do that, you need
 416         # $c->authenticate({}, 'otherrealm')
 417
 418         do_stuff();
 419     }
 420
 421     sub always_auth : Local {
 422         my ( $self, $c ) = @_;
 423
 424         # Force authorization headers onto the response so that the user
 425         # is asked again for authentication, even if they successfully
 426         # authenticated.
 427         my $realm = $c->get_auth_realm('example');
 428         $realm->credential->authorization_required_response($c, $realm);
 429     }
 430
 431     # with ACL plugin
 432     __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate });
 433
 434 =head1 DESCRIPTION
 435
 436 This module lets you use HTTP authentication with
 437 L<Catalyst::Plugin::Authentication>. Both basic and digest authentication
 438 are currently supported.
 439
 440 When authentication is required, this module sets a status of 401, and
 441 the body of the response to 'Authorization required.'. To override
 442 this and set your own content, check for the C<< $c->res->status ==
 443 401 >> in your C<end> action, and change the body accordingly.
 444
 445 =head2 TERMS
 446
 447 =over 4
 448
 449 =item Nonce
 450
 451 A nonce is a one-time value sent with each digest authentication
 452 request header. The value must always be unique, so per default the
 453 last value of the nonce is kept using L<Catalyst::Plugin::Cache>. To
 454 change this behaviour, override the
 455 C<store_digest_authorization_nonce> and
 456 C<get_digest_authorization_nonce> methods as shown below.
 457
 458 =back
 459
 460 =head1 METHODS
 461
 462 =over 4
 463
 464 =item new $config, $c, $realm
 465
 466 Simple constructor.
 467
 468 =item init
 469
 470 Validates that $config is ok.
 471
 472 =item authenticate $c, $realm, \%auth_info
 473
 474 Tries to authenticate the user, and if that fails calls
 475 C<authorization_required_response> and detaches the current action call stack.
 476
 477 Looks inside C<< $c->request->headers >> and processes the digest and basic
 478 (badly named) authorization header.
 479
 480 This will only try the methods set in the configuration. First digest, then basic.
 481
 482 The %auth_info hash can contain a number of keys which control the authentication behaviour:
 483
 484 =over
 485
 486 =item realm
 487
 488 Sets the HTTP authentication realm presented to the client. Note this does not alter the
 489 Catalyst::Authentication::Realm object used for the authentication.
 490
 491 =item domain
 492
 493 Array reference to domains used to build the authorization headers.
 494
 495 This list of domains defines the protection space. If a domain URI is an
 496 absolute path (starts with /), it is relative to the root URL of the server being accessed.
 497 An absolute URI in this list may refer to a different server than the one being accessed.
 498
 499 The client will use this list to determine the set of URIs for which the same authentication
 500 information may be sent.
 501
 502 If this is omitted or its value is empty, the client will assume that the
 503 protection space consists of all URIs on the responding server.
 504
 505 Therefore, if your application is not hosted at the root of this domain, and you want to
 506 prevent the authentication credentials for this application being sent to any other applications.
 507 then you should use the I<use_uri_for> configuration option, and pass a domain of I</>.
 508
 509 =back
 510
 511 =item authenticate_basic $c, $realm, \%auth_info
 512
 513 Performs HTTP basic authentication.
 514
 515 =item authenticate_digest $c, $realm, \%auth_info
 516
 517 Performs HTTP digest authentication. Note that the password_type B<must> by I<clear> for
 518 digest authentication to succeed, and you must have L<Catalyst::Plugin::Session> in
 519 your application as digest authentication needs to store persistent data.
 520
 521 Note - if you do not want to store your user passwords as clear text, then it is possible
 522 to store instead the MD5 digest in hex of the string '$username:$realm:$password'
 523
 524 Takes an additional parameter of I<algorithm>, the possible values of which are 'MD5' (the default)
 525 and 'MD5-sess'. For more information about 'MD5-sess', see section 3.2.2.2 in RFC 2617.
 526
 527 =item authorization_required_response $c, $realm, \%auth_info
 528
 529 Sets C<< $c->response >> to the correct status code, and adds the correct
 530 header to demand authentication data from the user agent.
 531
 532 Typically used by C<authenticate>, but may be invoked manually.
 533
 534 %opts can contain C<domain> and C<algorithm>, which are used to build
 535 %the digest header.
 536
 537 =item store_digest_authorization_nonce $c, $key, $nonce
 538
 539 =item get_digest_authorization_nonce $c, $key
 540
 541 Set or get the C<$nonce> object used by the digest auth mode.
 542
 543 You may override these methods. By default they will call C<get> and C<set> on
 544 C<< $c->cache >>.
 545
 546 =back
 547
 548 =head1 CONFIGURATION
 549
 550 All configuration is stored in C<< YourApp->config(authentication => { yourrealm => { credential => { class => 'HTTP', %config } } } >>.
 551
 552 This should be a hash, and it can contain the following entries:
 553
 554 =over
 555
 556 =item type
 557
 558 Can be either C<any> (the default), C<basic> or C<digest>.
 559
 560 This controls C<authorization_required_response> and C<authenticate>, but
 561 not the "manual" methods.
 562
 563 =item authorization_required_message
 564
 565 Set this to a string to override the default body content "Authorization required.", or set to undef to suppress body content being generated.
 566
 567 =item password_type
 568
 569 The type of password returned by the user object. Same usage as in
 570 L<Catalyst::Authentication::Credential::Password|Catalyst::Authentication::Credential::Password/password_type>
 571
 572 =item password_field
 573
 574 The name of accessor used to retrieve the value of the password field from the user object. Same usage as in
 575 L<Catalyst::Authentication::Credential::Password|Catalyst::Authentication::Credential::Password/password_field>
 576
 577 =item username_field
 578
 579 The field name that the user's username is mapped into when finding the user from the realm. Defaults to 'username'.
 580
 581 =item use_uri_for
 582
 583 If this configuration key has a true value, then the domain(s) for the authorization header will be
 584 run through $c->uri_for(). Use this configuration option if your application is not running at the root
 585 of your domain, and you want to ensure that authentication credentials from your application are not shared with
 586 other applications on the same server.
 587
 588 =back
 589
 590 =head1 RESTRICTIONS
 591
 592 When using digest authentication, this module will only work together
 593 with authentication stores whose User objects have a C<password>
 594 method that returns the plain-text password. It will not work together
 595 with L<Catalyst::Authentication::Store::Htpasswd>, or
 596 L<Catalyst::Authentication::Store::DBIC> stores whose
 597 C<password> methods return a hashed or salted version of the password.
 598
 599 =head1 AUTHORS
 600
 601 Updated to current name space and currently maintained
 602 by: Tomas Doran C<bobtfish@bobtfish.net>.
 603
 604 Original module by:
 605
 606 =over
 607
 608 =item Yuval Kogman, C<nothingmuch@woobling.org>
 609
 610 =item Jess Robinson
 611
 612 =item Sascha Kiefer C<esskar@cpan.org>
 613
 614 =back
 615
 616 =head1 CONTRIBUTORS
 617
 618 Patches contributed by:
 619
 620 =over
 621
 622 =item Peter Corlett
 623
 624 =back
 625
 626 =head1 SEE ALSO
 627
 628 RFC 2617 (or its successors), L<Catalyst::Plugin::Cache>, L<Catalyst::Plugin::Authentication>
 629
 630 =head1 COPYRIGHT & LICENSE
 631
 632         Copyright (c) 2005-2008 the aforementioned authors. All rights
 633         reserved. This program is free software; you can redistribute
 634         it and/or modify it under the same terms as Perl itself.
 635
 636 =cut
 637