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.08";
  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         return 'realm=' . String::Escape::qprintable($realm);
 251     } else {
 252         return;
 253     }
 254 }
 255
 256 sub _build_auth_header_domain {
 257     my ( $c, $opts ) = @_;
 258
 259     if ( my $domain = $opts->{domain} ) {
 260         Catalyst::Exception->throw("domain must be an array reference")
 261           unless ref($domain) && ref($domain) eq "ARRAY";
 262
 263         my @uris =
 264           $c->config->{authentication}{http}{use_uri_for}
 265           ? ( map { $c->uri_for($_) } @$domain )
 266           : ( map { URI::Escape::uri_escape($_) } @$domain );
 267
 268         return qq{domain="@uris"};
 269     } else {
 270         return;
 271     }
 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     $c->cache->get( $key );
 332 }
 333
 334 sub store_digest_authorization_nonce {
 335     my ( $c, $key, $nonce ) = @_;
 336
 337     $c->_check_cache;
 338     $c->cache->set( $key, $nonce );
 339 }
 340
 341 package Catalyst::Plugin::Authentication::Credential::HTTP::Nonce;
 342
 343 use strict;
 344 use base qw[ Class::Accessor::Fast ];
 345 use Data::UUID ();
 346
 347 our $VERSION = "0.01";
 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::Plugin::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 moduule 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 =back
 485
 486 =head1 CONFIGURATION
 487
 488 All configuration is stored in C<< YourApp->config->{authentication}{http} >>.
 489
 490 This should be a hash, and it can contain the following entries:
 491
 492 =over 4
 493
 494 =item store
 495
 496 Either a name or an object -- the default store to use for HTTP authentication.
 497
 498 =item type
 499
 500 Can be either C<any> (the default), C<basic> or C<digest>.
 501
 502 This controls C<authorization_required_response> and C<authenticate_http>, but
 503 not the "manual" methods.
 504
 505 =item authorization_required_message
 506
 507 Set this to a string to override the default body content "Authorization required."
 508
 509 =back
 510
 511 =head1 RESTRICTIONS
 512
 513 When using digest authentication, this module will only work together
 514 with authentication stores whose User objects have a C<password>
 515 method that returns the plain-text password. It will not work together
 516 with L<Catalyst::Authentication::Store::Htpasswd>, or
 517 L<Catalyst::Plugin::Authentication::Store::DBIC> stores whose
 518 C<password> methods return a hashed or salted version of the password.
 519
 520 =head1 AUTHORS
 521
 522 Yuval Kogman, C<nothingmuch@woobling.org>
 523
 524 Jess Robinson
 525
 526 Sascha Kiefer C<esskar@cpan.org>
 527
 528 =head1 SEE ALSO
 529
 530 RFC 2617 (or its successors), L<Catalyst::Plugin::Cache>, L<Catalyst::Plugin::Authentication>
 531
 532 =head1 COPYRIGHT & LICENSE
 533
 534         Copyright (c) 2005-2006 the aforementioned authors. All rights
 535         reserved. This program is free software; you can redistribute
 536         it and/or modify it under the same terms as Perl itself.
 537
 538 =cut