lib/Catalyst/Authentication/Credential/HTTP.pm

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