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