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 our $VERSION = "0.11";
  13
  14 sub authenticate_http {
  15     my ( $c, @args ) = @_;
  16
  17     return 1 if $c->_is_http_auth_type('digest') && $c->authenticate_digest(@args);
  18     return 1 if $c->_is_http_auth_type('basic')  && $c->authenticate_basic(@args);
  19     return;
  20 }
  21
  22 sub get_http_auth_store {
  23     my ( $c, %opts ) = @_;
  24
  25     my $store = $opts{store} || $c->config->{authentication}{http}{store} || return;
  26
  27     return ref $store
  28         ? $store
  29         : $c->get_auth_store($store);
  30 }
  31
  32 sub authenticate_basic {
  33     my ( $c, %opts ) = @_;
  34
  35     $c->log->debug('Checking http basic authentication.') if $c->debug;
  36
  37     my $headers = $c->req->headers;
  38
  39     if ( my ( $username, $password ) = $headers->authorization_basic ) {
  40
  41         my $user;
  42
  43         unless ( $user = $opts{user} ) {
  44             if ( my $store = $c->get_http_auth_store(%opts) ) {
  45                 $user = $store->get_user($username);
  46             } else {
  47                 $user = $username;
  48             }
  49         }
  50
  51         return $c->login( $user, $password );
  52     }
  53
  54     return 0;
  55 }
  56
  57 sub authenticate_digest {
  58     my ( $c, %opts ) = @_;
  59
  60     $c->log->debug('Checking http digest authentication.') if $c->debug;
  61
  62     my $headers       = $c->req->headers;
  63     my @authorization = $headers->header('Authorization');
  64     foreach my $authorization (@authorization) {
  65         next unless $authorization =~ m{^Digest};
  66
  67         my %res = map {
  68             my @key_val = split /=/, $_, 2;
  69             $key_val[0] = lc $key_val[0];
  70             $key_val[1] =~ s{"}{}g;    # remove the quotes
  71             @key_val;
  72         } split /,\s?/, substr( $authorization, 7 );    #7 == length "Digest "
  73
  74         my $opaque = $res{opaque};
  75         my $nonce  = $c->get_digest_authorization_nonce( __PACKAGE__ . '::opaque:' . $opaque );
  76         next unless $nonce;
  77
  78         $c->log->debug('Checking authentication parameters.')
  79           if $c->debug;
  80
  81         my $uri         = '/' . $c->request->path;
  82         my $algorithm   = $res{algorithm} || 'MD5';
  83         my $nonce_count = '0x' . $res{nc};
  84
  85         my $check = $uri eq $res{uri}
  86           && ( exists $res{username} )
  87           && ( exists $res{qop} )
  88           && ( exists $res{cnonce} )
  89           && ( exists $res{nc} )
  90           && $algorithm eq $nonce->algorithm
  91           && hex($nonce_count) > hex( $nonce->nonce_count )
  92           && $res{nonce} eq $nonce->nonce;    # TODO: set Stale instead
  93
  94         unless ($check) {
  95             $c->log->debug('Digest authentication failed. Bad request.')
  96               if $c->debug;
  97             $c->res->status(400);             # bad request
  98             die $Catalyst::DETACH;
  99         }
 100
 101         $c->log->debug('Checking authentication response.')
 102           if $c->debug;
 103
 104         my $username = $res{username};
 105         my $realm    = $res{realm};
 106
 107         my $user;
 108
 109         unless ( $user = $opts{user} ) {
 110             if ( my $store = $c->get_http_auth_store(%opts) || $c->default_auth_store ) {
 111                 $user = $store->get_user($username);
 112             }
 113         }
 114
 115         unless ($user) {    # no user, no authentication
 116             $c->log->debug('Unknown user: $user.') if $c->debug;
 117             return 0;
 118         }
 119
 120         # everything looks good, let's check the response
 121
 122         # calculate H(A2) as per spec
 123         my $ctx = Digest::MD5->new;
 124         $ctx->add( join( ':', $c->request->method, $res{uri} ) );
 125         if ( $res{qop} eq 'auth-int' ) {
 126             my $digest =
 127               Digest::MD5::md5_hex( $c->request->body );    # not sure here
 128             $ctx->add( ':', $digest );
 129         }
 130         my $A2_digest = $ctx->hexdigest;
 131
 132         # the idea of the for loop:
 133         # if we do not want to store the plain password in our user store,
 134         # we can store md5_hex("$username:$realm:$password") instead
 135         for my $r ( 0 .. 1 ) {
 136
 137             # calculate H(A1) as per spec
 138             my $A1_digest = $r ? $user->password : do {
 139                 $ctx = Digest::MD5->new;
 140                 $ctx->add( join( ':', $username, $realm, $user->password ) );
 141                 $ctx->hexdigest;
 142             };
 143             if ( $nonce->algorithm eq 'MD5-sess' ) {
 144                 $ctx = Digest::MD5->new;
 145                 $ctx->add( join( ':', $A1_digest, $res{nonce}, $res{cnonce} ) );
 146                 $A1_digest = $ctx->hexdigest;
 147             }
 148
 149             my $rq_digest = Digest::MD5::md5_hex(
 150                 join( ':',
 151                     $A1_digest, $res{nonce},
 152                     $res{qop} ? ( $res{nc}, $res{cnonce}, $res{qop} ) : (),
 153                     $A2_digest )
 154             );
 155
 156             $nonce->nonce_count($nonce_count);
 157             $c->cache->set( __PACKAGE__ . '::opaque:' . $nonce->opaque,
 158                 $nonce );
 159
 160             return $c->login( $user, $user->password )
 161               if $rq_digest eq $res{response};
 162         }
 163     }
 164
 165     return 0;
 166 }
 167
 168 sub _check_cache {
 169     my $c = shift;
 170
 171     die "A cache is needed for http digest authentication."
 172       unless $c->can('cache');
 173     return;
 174 }
 175
 176 sub _is_http_auth_type {
 177     my ( $c, $type ) = @_;
 178
 179     my $cfgtype = lc( $c->config->{authentication}{http}{type} || 'any' );
 180     return 1 if $cfgtype eq 'any' || $cfgtype eq lc $type;
 181     return 0;
 182 }
 183
 184 sub authorization_required {
 185     my ( $c, @args ) = @_;
 186
 187     return 1 if $c->authenticate_http(@args);
 188
 189     $c->authorization_required_response(@args);
 190
 191     die $Catalyst::DETACH;
 192 }
 193
 194 sub authorization_required_response {
 195     my ( $c, %opts ) = @_;
 196
 197     $c->res->status(401);
 198     $c->res->content_type('text/plain');
 199     $c->res->body($c->config->{authentication}{http}{authorization_required_message} ||
 200                   $opts{authorization_required_message} ||
 201                   'Authorization required.');
 202
 203     # *DONT* short circuit
 204     my $ok;
 205     $ok++ if $c->_create_digest_auth_response(\%opts);
 206     $ok++ if $c->_create_basic_auth_response(\%opts);
 207
 208     unless ( $ok ) {
 209         die 'Could not build authorization required response. '
 210         . 'Did you configure a valid authentication http type: '
 211         . 'basic, digest, any';
 212     }
 213     return;
 214 }
 215
 216 sub _add_authentication_header {
 217     my ( $c, $header ) = @_;
 218     $c->res->headers->push_header( 'WWW-Authenticate' => $header );
 219     return;
 220 }
 221
 222 sub _create_digest_auth_response {
 223     my ( $c, $opts ) = @_;
 224
 225     return unless $c->_is_http_auth_type('digest');
 226
 227     if ( my $digest = $c->_build_digest_auth_header( $opts ) ) {
 228         $c->_add_authentication_header( $digest );
 229         return 1;
 230     }
 231
 232     return;
 233 }
 234
 235 sub _create_basic_auth_response {
 236     my ( $c, $opts ) = @_;
 237
 238     return unless $c->_is_http_auth_type('basic');
 239
 240     if ( my $basic = $c->_build_basic_auth_header( $opts ) ) {
 241         $c->_add_authentication_header( $basic );
 242         return 1;
 243     }
 244
 245     return;
 246 }
 247
 248 sub _build_auth_header_realm {
 249     my ( $c, $opts ) = @_;
 250
 251     if ( my $realm = $opts->{realm} ) {
 252         return 'realm=' . String::Escape::qprintable($realm);
 253     }
 254     return;
 255 }
 256
 257 sub _build_auth_header_domain {
 258     my ( $c, $opts ) = @_;
 259
 260     if ( my $domain = $opts->{domain} ) {
 261         Catalyst::Exception->throw("domain must be an array reference")
 262           unless ref($domain) && ref($domain) eq "ARRAY";
 263
 264         my @uris =
 265           $c->config->{authentication}{http}{use_uri_for}
 266           ? ( map { $c->uri_for($_) } @$domain )
 267           : ( map { URI::Escape::uri_escape($_) } @$domain );
 268
 269         return qq{domain="@uris"};
 270     }
 271     return;
 272 }
 273
 274 sub _build_auth_header_common {
 275     my ( $c, $opts ) = @_;
 276
 277     return (
 278         $c->_build_auth_header_realm($opts),
 279         $c->_build_auth_header_domain($opts),
 280     );
 281 }
 282
 283 sub _build_basic_auth_header {
 284     my ( $c, $opts ) = @_;
 285     return $c->_join_auth_header_parts( Basic => $c->_build_auth_header_common( $opts ) );
 286 }
 287
 288 sub _build_digest_auth_header {
 289     my ( $c, $opts ) = @_;
 290
 291     my $nonce = $c->_digest_auth_nonce($opts);
 292
 293     my $key = __PACKAGE__ . '::opaque:' . $nonce->opaque;
 294
 295     $c->store_digest_authorization_nonce( $key, $nonce );
 296
 297     return $c->_join_auth_header_parts( Digest =>
 298         $c->_build_auth_header_common($opts),
 299         map { sprintf '%s="%s"', $_, $nonce->$_ } qw(
 300             qop
 301             nonce
 302             opaque
 303             algorithm
 304         ),
 305     );
 306 }
 307
 308 sub _digest_auth_nonce {
 309     my ( $c, $opts ) = @_;
 310
 311     my $package = __PACKAGE__ . '::Nonce';
 312
 313     my $nonce   = $package->new;
 314
 315     if ( my $algorithm = $opts->{algorithm} || $c->config->{authentication}{http}{algorithm}) {
 316         $nonce->algorithm( $algorithm );
 317     }
 318
 319     return $nonce;
 320 }
 321
 322 sub _join_auth_header_parts {
 323     my ( $c, $type, @parts ) = @_;
 324     return "$type " . join(", ", @parts );
 325 }
 326
 327 sub get_digest_authorization_nonce {
 328     my ( $c, $key ) = @_;
 329
 330     $c->_check_cache;
 331     return $c->cache->get( $key );
 332 }
 333
 334 sub store_digest_authorization_nonce {
 335     my ( $c, $key, $nonce ) = @_;
 336
 337     $c->_check_cache;
 338     return $c->cache->set( $key, $nonce );
 339 }
 340
 341 package Catalyst::Authentication::Credential::HTTP::Nonce;
 342
 343 use strict;
 344 use base qw[ Class::Accessor::Fast ];
 345 use Data::UUID ();
 346
 347 our $VERSION = '0.02';
 348
 349 __PACKAGE__->mk_accessors(qw[ nonce nonce_count qop opaque algorithm ]);
 350
 351 sub new {
 352     my $class = shift;
 353     my $self  = $class->SUPER::new(@_);
 354
 355     $self->nonce( Data::UUID->new->create_b64 );
 356     $self->opaque( Data::UUID->new->create_b64 );
 357     $self->qop('auth,auth-int');
 358     $self->nonce_count('0x0');
 359     $self->algorithm('MD5');
 360
 361     return $self;
 362 }
 363
 364 1;
 365
 366 __END__
 367
 368 =pod
 369
 370 =head1 NAME
 371
 372 Catalyst::Authentication::Credential::HTTP - HTTP Basic and Digest authentication
 373 for Catalyst.
 374
 375 =head1 SYNOPSIS
 376
 377     use Catalyst qw/
 378         Authentication
 379         Authentication::Store::Minimal
 380         Authentication::Credential::HTTP
 381     /;
 382
 383     __PACKAGE__->config->{authentication}{http}{type} = 'any'; # or 'digest' or 'basic'
 384     __PACKAGE__->config->{authentication}{users} = {
 385         Mufasa => { password => "Circle Of Life", },
 386     };
 387
 388     sub foo : Local {
 389         my ( $self, $c ) = @_;
 390
 391         $c->authorization_required( realm => "foo" ); # named after the status code ;-)
 392
 393         # either user gets authenticated or 401 is sent
 394
 395         do_stuff();
 396     }
 397
 398     # with ACL plugin
 399     __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate_http });
 400
 401     sub end : Private {
 402         my ( $self, $c ) = @_;
 403
 404         $c->authorization_required_response( realm => "foo" );
 405         $c->error(0);
 406     }
 407
 408 =head1 DESCRIPTION
 409
 410 This module lets you use HTTP authentication with
 411 L<Catalyst::Plugin::Authentication>. Both basic and digest authentication
 412 are currently supported.
 413
 414 When authentication is required, this module sets a status of 401, and
 415 the body of the response to 'Authorization required.'. To override
 416 this and set your own content, check for the C<< $c->res->status ==
 417 401 >> in your C<end> action, and change the body accordingly.
 418
 419 =head2 TERMS
 420
 421 =over 4
 422
 423 =item Nonce
 424
 425 A nonce is a one-time value sent with each digest authentication
 426 request header. The value must always be unique, so per default the
 427 last value of the nonce is kept using L<Catalyst::Plugin::Cache>. To
 428 change this behaviour, override the
 429 C<store_digest_authorization_nonce> and
 430 C<get_digest_authorization_nonce> methods as shown below.
 431
 432 =back
 433
 434 =head1 METHODS
 435
 436 =over 4
 437
 438 =item authorization_required %opts
 439
 440 Tries to C<authenticate_http>, and if that fails calls
 441 C<authorization_required_response> and detaches the current action call stack.
 442
 443 This method just passes the options through untouched.
 444
 445 =item authenticate_http %opts
 446
 447 Looks inside C<< $c->request->headers >> and processes the digest and basic
 448 (badly named) authorization header.
 449
 450 This will only try the methods set in the configuration. First digest, then basic.
 451
 452 See the next two methods for what %opts can contain.
 453
 454 =item authenticate_basic %opts
 455
 456 =item authenticate_digest %opts
 457
 458 Try to authenticate one of the methods without checking if the method is
 459 allowed in the configuration.
 460
 461 %opts can contain C<store> (either an object or a name), C<user> (to disregard
 462 %the username from the header altogether, overriding it with a username or user
 463 %object).
 464
 465 =item authorization_required_response %opts
 466
 467 Sets C<< $c->response >> to the correct status code, and adds the correct
 468 header to demand authentication data from the user agent.
 469
 470 Typically used by C<authorization_required>, but may be invoked manually.
 471
 472 %opts can contain C<realm>, C<domain> and C<algorithm>, which are used to build
 473 %the digest header.
 474
 475 =item store_digest_authorization_nonce $key, $nonce
 476
 477 =item get_digest_authorization_nonce $key
 478
 479 Set or get the C<$nonce> object used by the digest auth mode.
 480
 481 You may override these methods. By default they will call C<get> and C<set> on
 482 C<< $c->cache >>.
 483
 484 =item get_http_auth_store %opts
 485
 486 =back
 487
 488 =head1 CONFIGURATION
 489
 490 All configuration is stored in C<< YourApp->config->{authentication}{http} >>.
 491
 492 This should be a hash, and it can contain the following entries:
 493
 494 =over 4
 495
 496 =item store
 497
 498 Either a name or an object -- the default store to use for HTTP authentication.
 499
 500 =item type
 501
 502 Can be either C<any> (the default), C<basic> or C<digest>.
 503
 504 This controls C<authorization_required_response> and C<authenticate_http>, but
 505 not the "manual" methods.
 506
 507 =item authorization_required_message
 508
 509 Set this to a string to override the default body content "Authorization required."
 510
 511 =back
 512
 513 =head1 RESTRICTIONS
 514
 515 When using digest authentication, this module will only work together
 516 with authentication stores whose User objects have a C<password>
 517 method that returns the plain-text password. It will not work together
 518 with L<Catalyst::Authentication::Store::Htpasswd>, or
 519 L<Catalyst::Authentication::Store::DBIC> stores whose
 520 C<password> methods return a hashed or salted version of the password.
 521
 522 =head1 AUTHORS
 523
 524 Yuval Kogman, C<nothingmuch@woobling.org>
 525
 526 Jess Robinson
 527
 528 Sascha Kiefer C<esskar@cpan.org>
 529
 530 Tomas Doran C<bobtfish@bobtfish.net>
 531
 532 =head1 SEE ALSO
 533
 534 RFC 2617 (or its successors), L<Catalyst::Plugin::Cache>, L<Catalyst::Plugin::Authentication>
 535
 536 =head1 COPYRIGHT & LICENSE
 537
 538         Copyright (c) 2005-2006 the aforementioned authors. All rights
 539         reserved. This program is free software; you can redistribute
 540         it and/or modify it under the same terms as Perl itself.
 541
 542 =cut
 543