lib/Catalyst/Authentication/Credential/HTTP.pm

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