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