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

   1 #!/usr/bin/perl\r
   2 \r
   3 package Catalyst::Plugin::Authentication::Credential::HTTP;\r
   4 use base qw/Catalyst::Plugin::Authentication::Credential::Password/;\r
   5 \r
   6 use strict;\r
   7 use warnings;\r
   8 \r
   9 use String::Escape ();\r
  10 use URI::Escape    ();\r
  11 use Catalyst       ();\r
  12 use Digest::MD5    ();\r
  13 \r
  14 our $VERSION = "0.05";\r
  15 \r
  16 sub authenticate_http {\r
  17     my $c = shift;\r
  18 \r
  19     return $c->authenticate_digest || $c->authenticate_basic;\r
  20 }\r
  21 \r
  22 sub authenticate_basic {\r
  23     my $c = shift;\r
  24 \r
  25     $c->log->debug('Checking http basic authentication.') if $c->debug;\r
  26 \r
  27     my $headers = $c->req->headers;\r
  28 \r
  29     if ( my ( $user, $password ) = $headers->authorization_basic ) {\r
  30 \r
  31         if ( my $store = $c->config->{authentication}{http}{store} ) {\r
  32             $user = $store->get_user($user);\r
  33         }\r
  34 \r
  35         return $c->login( $user, $password );\r
  36     }\r
  37 \r
  38     return 0;\r
  39 }\r
  40 \r
  41 sub authenticate_digest {\r
  42     my $c = shift;\r
  43 \r
  44     $c->log->debug('Checking http digest authentication.') if $c->debug;\r
  45 \r
  46     my $headers       = $c->req->headers;\r
  47     my @authorization = $headers->header('Authorization');\r
  48     foreach my $authorization (@authorization) {\r
  49         next unless $authorization =~ m{^Digest};\r
  50 \r
  51         $c->_check_cache;\r
  52 \r
  53         my %res = map {\r
  54             my @key_val = split /=/, $_, 2;\r
  55             $key_val[0] = lc $key_val[0];\r
  56             $key_val[1] =~ s{"}{}g;    # remove the quotes\r
  57             @key_val;\r
  58         } split /,\s?/, substr( $authorization, 7 );    #7 == length "Digest "\r
  59 \r
  60         my $opaque = $res{opaque};\r
  61         my $nonce  = $c->cache->get( __PACKAGE__ . '::opaque:' . $opaque );\r
  62         next unless $nonce;\r
  63 \r
  64         $c->log->debug('Checking authentication parameters.')\r
  65           if $c->debug;\r
  66 \r
  67         my $uri         = '/' . $c->request->path;\r
  68         my $algorithm   = $res{algorithm} || 'MD5';\r
  69         my $nonce_count = '0x' . $res{nc};\r
  70 \r
  71         my $check = $uri eq $res{uri}\r
  72           && ( exists $res{username} )\r
  73           && ( exists $res{qop} )\r
  74           && ( exists $res{cnonce} )\r
  75           && ( exists $res{nc} )\r
  76           && $algorithm eq $nonce->algorithm\r
  77           && hex($nonce_count) > hex( $nonce->nonce_count )\r
  78           && $res{nonce} eq $nonce->nonce;    # TODO: set Stale instead\r
  79 \r
  80         unless ($check) {\r
  81             $c->log->debug('Digest authentication failed. Bad request.')\r
  82               if $c->debug;\r
  83             $c->res->status(400);             # bad request\r
  84             die $Catalyst::DETACH;\r
  85         }\r
  86 \r
  87         $c->log->debug('Checking authentication response.')\r
  88           if $c->debug;\r
  89 \r
  90         my $username = $res{username};\r
  91         my $realm    = $res{realm};\r
  92 \r
  93         my $user;\r
  94         my $store = $c->config->{authentication}{http}{store}\r
  95           || $c->default_auth_store;\r
  96         $user = $store->get_user($username) if $store;\r
  97         unless ($user) {    # no user, no authentication\r
  98             $c->log->debug('Unknown user: $user.') if $c->debug;\r
  99             return 0;\r
 100         }\r
 101 \r
 102         # everything looks good, let's check the response\r
 103 \r
 104         # calculate H(A2) as per spec\r
 105         my $ctx = Digest::MD5->new;\r
 106         $ctx->add( join( ':', $c->request->method, $res{uri} ) );\r
 107         if ( $res{qop} eq 'auth-int' ) {\r
 108             my $digest =\r
 109               Digest::MD5::md5_hex( $c->request->body );    # not sure here\r
 110             $ctx->add( ':', $digest );\r
 111         }\r
 112         my $A2_digest = $ctx->hexdigest;\r
 113 \r
 114         # the idea of the for loop:\r
 115         # if we do not want to store the plain password in our user store,\r
 116         # we can store md5_hex("$username:$realm:$password") instead\r
 117         for my $r ( 0 .. 1 ) {\r
 118 \r
 119             # calculate H(A1) as per spec\r
 120             my $A1_digest = $r ? $user->password : do {\r
 121                 $ctx = Digest::MD5->new;\r
 122                 $ctx->add( join( ':', $username, $realm, $user->password ) );\r
 123                 $ctx->hexdigest;\r
 124             };\r
 125             if ( $nonce->algorithm eq 'MD5-sess' ) {\r
 126                 $ctx = Digest::MD5->new;\r
 127                 $ctx->add( join( ':', $A1_digest, $res{nonce}, $res{cnonce} ) );\r
 128                 $A1_digest = $ctx->hexdigest;\r
 129             }\r
 130 \r
 131             my $rq_digest = Digest::MD5::md5_hex(\r
 132                 join( ':',\r
 133                     $A1_digest, $res{nonce},\r
 134                     $res{qop} ? ( $res{nc}, $res{cnonce}, $res{qop} ) : (),\r
 135                     $A2_digest )\r
 136             );\r
 137 \r
 138             $nonce->nonce_count($nonce_count);\r
 139             $c->cache->set( __PACKAGE__ . '::opaque:' . $nonce->opaque,\r
 140                 $nonce );\r
 141 \r
 142             return $c->login( $user, $user->password )\r
 143               if $rq_digest eq $res{response};\r
 144         }\r
 145     }\r
 146 \r
 147     return 0;\r
 148 }\r
 149 \r
 150 sub _check_cache {\r
 151     my $c = shift;\r
 152 \r
 153     die "A cache is needed for http digest authentication."\r
 154       unless $c->can('cache');\r
 155 }\r
 156 \r
 157 sub _is_auth_type {\r
 158     my ( $c, $type ) = @_;\r
 159 \r
 160     my $cfgtype = lc( $c->config->{authentication}{http}{type} || 'any' );\r
 161     return 1 if $cfgtype eq 'any' || $cfgtype eq lc $type;\r
 162     return 0;\r
 163 }\r
 164 \r
 165 sub authorization_required {\r
 166     my ( $c, %opts ) = @_;\r
 167 \r
 168     return 1 if $c->_is_auth_type('digest') && $c->authenticate_digest;\r
 169     return 1 if $c->_is_auth_type('basic')  && $c->authenticate_basic;\r
 170 \r
 171     $c->authorization_required_response(%opts);\r
 172 \r
 173     die $Catalyst::DETACH;\r
 174 }\r
 175 \r
 176 sub authorization_required_response {\r
 177     my ( $c, %opts ) = @_;\r
 178 \r
 179     $c->res->status(401);\r
 180 \r
 181     my ( $digest, $basic );\r
 182     $digest = $c->build_authorization_required_response( \%opts, 'Digest' )\r
 183       if $c->_is_auth_type('digest');\r
 184     $basic = $c->build_authorization_required_response( \%opts, 'Basic' )\r
 185       if $c->_is_auth_type('basic');\r
 186 \r
 187     die 'Could not build authorization required response. '\r
 188       . 'Did you configure a valid authentication http type: '\r
 189       . 'basic, digest, any'\r
 190       unless $digest || $basic;\r
 191 \r
 192     $c->res->headers->push_header( 'WWW-Authenticate' => $digest )\r
 193       if $digest;\r
 194     $c->res->headers->push_header( 'WWW-Authenticate' => $basic ) if $basic;\r
 195 }\r
 196 \r
 197 sub build_authorization_required_response {\r
 198     my ( $c, $opts, $type ) = @_;\r
 199     my @opts;\r
 200 \r
 201     if ( my $realm = $opts->{realm} ) {\r
 202         push @opts, 'realm=' . String::Escape::qprintable($realm);\r
 203     }\r
 204 \r
 205     if ( my $domain = $opts->{domain} ) {\r
 206         Catalyst::Excpetion->throw("domain must be an array reference")\r
 207           unless ref($domain) && ref($domain) eq "ARRAY";\r
 208 \r
 209         my @uris =\r
 210           $c->config->{authentication}{http}{use_uri_for}\r
 211           ? ( map { $c->uri_for($_) } @$domain )\r
 212           : ( map { URI::Escape::uri_escape($_) } @$domain );\r
 213 \r
 214         push @opts, qq{domain="@uris"};\r
 215     }\r
 216 \r
 217     if ( $type eq 'Digest' ) {\r
 218         my $package = __PACKAGE__ . '::Nonce';\r
 219         my $nonce   = $package->new;\r
 220         $nonce->algorithm( $c->config->{authentication}{http}{algorithm}\r
 221               || $nonce->algorithm );\r
 222 \r
 223         push @opts, 'qop="' . $nonce->qop . '"';\r
 224         push @opts, 'nonce="' . $nonce->nonce . '"';\r
 225         push @opts, 'opaque="' . $nonce->opaque . '"';\r
 226         push @opts, 'algorithm="' . $nonce->algorithm . '"';\r
 227 \r
 228         $c->_check_cache;\r
 229         $c->cache->set( __PACKAGE__ . '::opaque:' . $nonce->opaque, $nonce );\r
 230     }\r
 231 \r
 232     return "$type " . join( ', ', @opts );\r
 233 }\r
 234 \r
 235 package Catalyst::Plugin::Authentication::Credential::HTTP::Nonce;\r
 236 \r
 237 use strict;\r
 238 use base qw[ Class::Accessor::Fast ];\r
 239 use Data::UUID ();\r
 240 \r
 241 our $VERSION = "0.01";\r
 242 \r
 243 __PACKAGE__->mk_accessors(qw[ nonce nonce_count qop opaque algorithm ]);\r
 244 \r
 245 sub new {\r
 246     my $class = shift;\r
 247     my $self  = $class->SUPER::new(@_);\r
 248 \r
 249     $self->nonce( Data::UUID->new->create_b64 );\r
 250     $self->opaque( Data::UUID->new->create_b64 );\r
 251     $self->qop('auth,auth-int');\r
 252     $self->nonce_count('0x0');\r
 253     $self->algorithm('MD5');\r
 254 \r
 255     return $self;\r
 256 }\r
 257 \r
 258 1;\r
 259 \r
 260 __END__\r
 261 \r
 262 =pod\r
 263 \r
 264 =head1 NAME\r
 265 \r
 266 Catalyst::Plugin::Authentication::Credential::HTTP - HTTP Basic and Digest authentication\r
 267 for Catlayst.\r
 268 \r
 269 =head1 SYNOPSIS\r
 270 \r
 271     use Catalyst qw/\r
 272         Authentication\r
 273         Authentication::Store::Moose\r
 274         Authentication::Credential::HTTP\r
 275     /;\r
 276 \r
 277     __PACKAGE__->config->{authentication}{http}{type} = 'any'; # or 'digest' or 'basic'
 278     __PACKAGE__->config->{authentication}{users} = {
 279         Mufasa => { password => "Circle Of Life", },
 280     };\r
 281 \r
 282     sub foo : Local {\r
 283         my ( $self, $c ) = @_;\r
 284 \r
 285         $c->authorization_required( realm => "foo" ); # named after the status code ;-)\r
 286 \r
 287         # either user gets authenticated or 401 is sent\r
 288 \r
 289         do_stuff();\r
 290     }\r
 291 \r
 292     # with ACL plugin\r
 293     __PACKAGE__->deny_access_unless("/path", sub { $_[0]->authenticate_http });\r
 294 \r
 295     sub end : Private {\r
 296         my ( $self, $c ) = @_;\r
 297 \r
 298         $c->authorization_required_response( realm => "foo" );\r
 299         $c->error(0);\r
 300     }\r
 301 \r
 302 =head1 DESCRIPTION\r
 303 \r
 304 This moduule lets you use HTTP authentication with\r
 305 L<Catalyst::Plugin::Authentication>. Both basic and digest authentication\r
 306 are currently supported.\r
 307 \r
 308 =head1 METHODS\r
 309 \r
 310 =over 4\r
 311 \r
 312 =item authorization_required\r
 313 \r
 314 Tries to C<authenticate_http>, and if that fails calls\r
 315 C<authorization_required_response> and detaches the current action call stack.\r
 316 \r
 317 =item authenticate_http\r
 318 \r
 319 Looks inside C<< $c->request->headers >> and processes the digest and basic\r
 320 (badly named) authorization header.\r
 321 \r
 322 =item authorization_required_response\r
 323 \r
 324 Sets C<< $c->response >> to the correct status code, and adds the correct\r
 325 header to demand authentication data from the user agent.\r
 326 \r
 327 =back\r
 328 \r
 329 =head1 AUTHORS\r
 330 \r
 331 Yuval Kogman, C<nothingmuch@woobling.org>\r
 332 \r
 333 Jess Robinson\r
 334 \r
 335 Sascha Kiefer C<esskar@cpan.org>\r
 336 \r
 337 =head1 COPYRIGHT & LICENSE\r
 338 \r
 339         Copyright (c) 2005-2006 the aforementioned authors. All rights\r
 340         reserved. This program is free software; you can redistribute\r
 341         it and/or modify it under the same terms as Perl itself.\r
 342 \r
 343 =cut\r