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.13";
  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 - Superseded / deprecated module
 375 providing HTTP Basic and Digest authentication for Catalyst applications.
 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 DEPRECATION NOTICE
 411
 412 Please note that this module is B<DEPRECATED>, it has been Superseded by
 413 L<Catalyst::Authentication::Credential::HTTP>, please use that module in
 414 any new projects.
 415
 416 Porting existing projects to use the new module should also be easy, and
 417 if there are any facilities in this module which you cannot see how to achieve
 418 in the new module then I<please contact the maintainer> as this is a bug and
 419 I<will be fixed>.
 420
 421 Let me say that again: B<THIS MODULE IS NOT SUPPORTED>, use
 422 L<Catalyst::Authentication::Credential::HTTP> instead.
 423
 424 =head1 DESCRIPTION
 425
 426 This moduule lets you use HTTP authentication with
 427 L<Catalyst::Plugin::Authentication>. Both basic and digest authentication
 428 are currently supported.
 429
 430 When authentication is required, this module sets a status of 401, and
 431 the body of the response to 'Authorization required.'. To override
 432 this and set your own content, check for the C<< $c->res->status ==
 433 401 >> in your C<end> action, and change the body accordingly.
 434
 435 =head2 TERMS
 436
 437 =over 4
 438
 439 =item Nonce
 440
 441 A nonce is a one-time value sent with each digest authentication
 442 request header. The value must always be unique, so per default the
 443 last value of the nonce is kept using L<Catalyst::Plugin::Cache>. To
 444 change this behaviour, override the
 445 C<store_digest_authorization_nonce> and
 446 C<get_digest_authorization_nonce> methods as shown below.
 447
 448 =back
 449
 450 =head1 METHODS
 451
 452 =over 4
 453
 454 =item authorization_required %opts
 455
 456 Tries to C<authenticate_http>, and if that fails calls
 457 C<authorization_required_response> and detaches the current action call stack.
 458
 459 This method just passes the options through untouched.
 460
 461 =item authenticate_http %opts
 462
 463 Looks inside C<< $c->request->headers >> and processes the digest and basic
 464 (badly named) authorization header.
 465
 466 This will only try the methods set in the configuration. First digest, then basic.
 467
 468 See the next two methods for what %opts can contain.
 469
 470 =item authenticate_basic %opts
 471
 472 =item authenticate_digest %opts
 473
 474 Try to authenticate one of the methods without checking if the method is
 475 allowed in the configuration.
 476
 477 %opts can contain C<store> (either an object or a name), C<user> (to disregard
 478 %the username from the header altogether, overriding it with a username or user
 479 %object).
 480
 481 =item authorization_required_response %opts
 482
 483 Sets C<< $c->response >> to the correct status code, and adds the correct
 484 header to demand authentication data from the user agent.
 485
 486 Typically used by C<authorization_required>, but may be invoked manually.
 487
 488 %opts can contain C<realm>, C<domain> and C<algorithm>, which are used to build
 489 %the digest header.
 490
 491 =item store_digest_authorization_nonce $key, $nonce
 492
 493 =item get_digest_authorization_nonce $key
 494
 495 Set or get the C<$nonce> object used by the digest auth mode.
 496
 497 You may override these methods. By default they will call C<get> and C<set> on
 498 C<< $c->cache >>.
 499
 500 =item get_http_auth_store %opts
 501
 502 =back
 503
 504 =head1 CONFIGURATION
 505
 506 All configuration is stored in C<< YourApp->config->{authentication}{http} >>.
 507
 508 This should be a hash, and it can contain the following entries:
 509
 510 =over 4
 511
 512 =item store
 513
 514 Either a name or an object -- the default store to use for HTTP authentication.
 515
 516 =item type
 517
 518 Can be either C<any> (the default), C<basic> or C<digest>.
 519
 520 This controls C<authorization_required_response> and C<authenticate_http>, but
 521 not the "manual" methods.
 522
 523 =item authorization_required_message
 524
 525 Set this to a string to override the default body content "Authorization required."
 526
 527 =back
 528
 529 =head1 RESTRICTIONS
 530
 531 When using digest authentication, this module will only work together
 532 with authentication stores whose User objects have a C<password>
 533 method that returns the plain-text password. It will not work together
 534 with L<Catalyst::Authentication::Store::Htpasswd>, or
 535 L<Catalyst::Plugin::Authentication::Store::DBIC> stores whose
 536 C<password> methods return a hashed or salted version of the password.
 537
 538 =head1 AUTHORS
 539
 540 Yuval Kogman, C<nothingmuch@woobling.org>
 541
 542 Jess Robinson
 543
 544 Sascha Kiefer C<esskar@cpan.org>
 545
 546 =head1 SEE ALSO
 547
 548 RFC 2617 (or its successors), L<Catalyst::Plugin::Cache>, L<Catalyst::Plugin::Authentication>
 549
 550 =head1 COPYRIGHT & LICENSE
 551
 552         Copyright (c) 2005-2006 the aforementioned authors. All rights
 553         reserved. This program is free software; you can redistribute
 554         it and/or modify it under the same terms as Perl itself.
 555
 556 =cut