lib/Catalyst/Plugin/Authentication/Credential/HTTP.pm

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