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.017';
  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 __PACKAGE__->mk_accessors(qw[ nonce nonce_count qop opaque algorithm ]);
 383
 384 sub new {
 385     my $class = shift;
 386     my $self  = $class->SUPER::new(@_);
 387
 388     $self->nonce( Data::UUID->new->create_b64 );
 389     $self->opaque( Data::UUID->new->create_b64 );
 390     $self->qop('auth,auth-int');
 391     $self->nonce_count('0x0');
 392     $self->algorithm('MD5');
 393
 394     return $self;
 395 }
 396
 397 1;
 398
 399 __END__
 400
 401 =pod
 402
 403 =head1 NAME
 404
 405 Catalyst::Authentication::Credential::HTTP - HTTP Basic and Digest authentication
 406 for Catalyst.
 407
 408 =head1 SYNOPSIS
 409
 410     use Catalyst qw/
 411         Authentication
 412     /;
 413
 414     __PACKAGE__->config( authentication => {
 415         default_realm => 'example',
 416         realms => {
 417             example => {
 418                 credential => {
 419                     class => 'HTTP',
 420                     type  => 'any', # or 'digest' or 'basic'
 421                     password_type  => 'clear',
 422                     password_field => 'password'
 423                 },
 424                 store => {
 425                     class => 'Minimal',
 426                     users => {
 427                         Mufasa => { password => "Circle Of Life", },
 428                     },
 429                 },
 430             },
 431         }
 432     });
 433
 434     sub foo : Local {
 435         my ( $self, $c ) = @_;
 436
 437         $c->authenticate({}, "example");
 438         # either user gets authenticated or 401 is sent
 439         # Note that the authentication realm sent to the client (in the
 440         # RFC 2617 sense) is overridden here, but this *does not*
 441         # effect the Catalyst::Authentication::Realm used for
 442         # authentication - to do that, you need
 443         # $c->authenticate({}, 'otherrealm')
 444
 445         do_stuff();
 446     }
 447
 448     sub always_auth : Local {
 449         my ( $self, $c ) = @_;
 450
 451         # Force authorization headers onto the response so that the user
 452         # is asked again for authentication, even if they successfully
 453         # authenticated.
 454         my $realm = $c->get_auth_realm('example');
 455         $realm->credential->authorization_required_response($c, $realm);
 456     }
 457
 458     # with ACL plugin
 459     __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate });
 460
 461 =head1 DESCRIPTION
 462
 463 This module lets you use HTTP authentication with
 464 L<Catalyst::Plugin::Authentication>. Both basic and digest authentication
 465 are currently supported.
 466
 467 When authentication is required, this module sets a status of 401, and
 468 the body of the response to 'Authorization required.'. To override
 469 this and set your own content, check for the C<< $c->res->status ==
 470 401 >> in your C<end> action, and change the body accordingly.
 471
 472 =head2 TERMS
 473
 474 =over 4
 475
 476 =item Nonce
 477
 478 A nonce is a one-time value sent with each digest authentication
 479 request header. The value must always be unique, so per default the
 480 last value of the nonce is kept using L<Catalyst::Plugin::Cache>. To
 481 change this behaviour, override the
 482 C<store_digest_authorization_nonce> and
 483 C<get_digest_authorization_nonce> methods as shown below.
 484
 485 =back
 486
 487 =head1 METHODS
 488
 489 =over 4
 490
 491 =item new $config, $c, $realm
 492
 493 Simple constructor.
 494
 495 =item init
 496
 497 Validates that $config is ok.
 498
 499 =item authenticate $c, $realm, \%auth_info
 500
 501 Tries to authenticate the user, and if that fails calls
 502 C<authorization_required_response> and detaches the current action call stack.
 503
 504 Looks inside C<< $c->request->headers >> and processes the digest and basic
 505 (badly named) authorization header.
 506
 507 This will only try the methods set in the configuration. First digest, then basic.
 508
 509 The %auth_info hash can contain a number of keys which control the authentication behaviour:
 510
 511 =over
 512
 513 =item realm
 514
 515 Sets the HTTP authentication realm presented to the client. Note this does not alter the
 516 Catalyst::Authentication::Realm object used for the authentication.
 517
 518 =item domain
 519
 520 Array reference to domains used to build the authorization headers.
 521
 522 This list of domains defines the protection space. If a domain URI is an
 523 absolute path (starts with /), it is relative to the root URL of the server being accessed.
 524 An absolute URI in this list may refer to a different server than the one being accessed.
 525
 526 The client will use this list to determine the set of URIs for which the same authentication
 527 information may be sent.
 528
 529 If this is omitted or its value is empty, the client will assume that the
 530 protection space consists of all URIs on the responding server.
 531
 532 Therefore, if your application is not hosted at the root of this domain, and you want to
 533 prevent the authentication credentials for this application being sent to any other applications.
 534 then you should use the I<use_uri_for> configuration option, and pass a domain of I</>.
 535
 536 =back
 537
 538 =item authenticate_basic $c, $realm, \%auth_info
 539
 540 Performs HTTP basic authentication.
 541
 542 =item authenticate_digest $c, $realm, \%auth_info
 543
 544 Performs HTTP digest authentication.
 545
 546 The password_type B<must> be I<clear> for digest authentication to
 547 succeed.  If you do not want to store your user passwords as clear
 548 text, you may instead store the MD5 digest in hex of the string
 549 '$username:$realm:$password'.
 550
 551 L<Catalyst::Plugin::Cache> is used for persistent storage of the nonce
 552 values (see L</Nonce>).  It must be loaded in your application, unless
 553 you override the C<store_digest_authorization_nonce> and
 554 C<get_digest_authorization_nonce> methods as shown below.
 555
 556 Takes an additional parameter of I<algorithm>, the possible values of which are 'MD5' (the default)
 557 and 'MD5-sess'. For more information about 'MD5-sess', see section 3.2.2.2 in RFC 2617.
 558
 559 =item authorization_required_response $c, $realm, \%auth_info
 560
 561 Sets C<< $c->response >> to the correct status code, and adds the correct
 562 header to demand authentication data from the user agent.
 563
 564 Typically used by C<authenticate>, but may be invoked manually.
 565
 566 %opts can contain C<domain> and C<algorithm>, which are used to build
 567 %the digest header.
 568
 569 =item store_digest_authorization_nonce $c, $key, $nonce
 570
 571 =item get_digest_authorization_nonce $c, $key
 572
 573 Set or get the C<$nonce> object used by the digest auth mode.
 574
 575 You may override these methods. By default they will call C<get> and C<set> on
 576 C<< $c->cache >>.
 577
 578 =item authentication_failed
 579
 580 Sets the 401 response and calls C<< $ctx->detach >>.
 581
 582 =back
 583
 584 =head1 CONFIGURATION
 585
 586 All configuration is stored in C<< YourApp->config('Plugin::Authentication' => { yourrealm => { credential => { class => 'HTTP', %config } } } >>.
 587
 588 This should be a hash, and it can contain the following entries:
 589
 590 =over
 591
 592 =item type
 593
 594 Can be either C<any> (the default), C<basic> or C<digest>.
 595
 596 This controls C<authorization_required_response> and C<authenticate>, but
 597 not the "manual" methods.
 598
 599 =item authorization_required_message
 600
 601 Set this to a string to override the default body content "Authorization required.", or set to undef to suppress body content being generated.
 602
 603 =item password_type
 604
 605 The type of password returned by the user object. Same usage as in
 606 L<Catalyst::Authentication::Credential::Password|Catalyst::Authentication::Credential::Password/password_type>
 607
 608 =item password_field
 609
 610 The name of accessor used to retrieve the value of the password field from the user object. Same usage as in
 611 L<Catalyst::Authentication::Credential::Password|Catalyst::Authentication::Credential::Password/password_field>
 612
 613 =item username_field
 614
 615 The field name that the user's username is mapped into when finding the user from the realm. Defaults to 'username'.
 616
 617 =item use_uri_for
 618
 619 If this configuration key has a true value, then the domain(s) for the authorization header will be
 620 run through $c->uri_for(). Use this configuration option if your application is not running at the root
 621 of your domain, and you want to ensure that authentication credentials from your application are not shared with
 622 other applications on the same server.
 623
 624 =item require_ssl
 625
 626 If this configuration key has a true value then authentication will be denied
 627 (and a 401 issued in normal circumstances) unless the request is via https.
 628
 629 =item no_unprompted_authorization_required
 630
 631 Causes authentication to fail as normal modules do, without calling
 632 C<< $c->detach >>. This means that the basic auth credential can be used as
 633 part of the progressive realm.
 634
 635 However use like this is probably not optimum it also means that users in
 636 browsers ill never get a HTTP authenticate dialogue box (unless you manually
 637 return a 401 response in your application), and even some automated
 638 user agents (for APIs) will not send the Authorization header without
 639 specific manipulation of the request headers.
 640
 641 =item broken_dotnet_digest_without_query_string
 642
 643 Enables support for .NET (or other similarly broken clients), which
 644 fails to include the query string in the uri in the digest
 645 Authorization header, contrary to rfc2617.
 646
 647 This option has no effect on clients that include the query string;
 648 they will continue to work as normal.
 649
 650 =back
 651
 652 =head1 RESTRICTIONS
 653
 654 When using digest authentication, this module will only work together
 655 with authentication stores whose User objects have a C<password>
 656 method that returns the plain-text password. It will not work together
 657 with L<Catalyst::Authentication::Store::Htpasswd>, or
 658 L<Catalyst::Authentication::Store::DBIC> stores whose
 659 C<password> methods return a hashed or salted version of the password.
 660
 661 =head1 AUTHORS
 662
 663 Updated to current name space and currently maintained
 664 by: Tomas Doran C<bobtfish@bobtfish.net>.
 665
 666 Original module by:
 667
 668 =over
 669
 670 =item Yuval Kogman, C<nothingmuch@woobling.org>
 671
 672 =item Jess Robinson
 673
 674 =item Sascha Kiefer C<esskar@cpan.org>
 675
 676 =back
 677
 678 =head1 CONTRIBUTORS
 679
 680 Patches contributed by:
 681
 682 =over
 683
 684 =item Peter Corlett
 685
 686 =item Devin Austin (dhoss) C<dhoss@cpan.org>
 687
 688 =item Ronald J Kimball
 689
 690 =back
 691
 692 =head1 SEE ALSO
 693
 694 RFC 2617 (or its successors), L<Catalyst::Plugin::Cache>, L<Catalyst::Plugin::Authentication>
 695
 696 =head1 COPYRIGHT & LICENSE
 697
 698         Copyright (c) 2005-2008 the aforementioned authors. All rights
 699         reserved. This program is free software; you can redistribute
 700         it and/or modify it under the same terms as Perl itself.
 701
 702 =cut
 703