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

   1 #!/usr/bin/perl
   2
   3 package Catalyst::Plugin::Authentication::Credential::Password;
   4 use base qw/Class::Accessor::Fast/;
   5
   6 use strict;
   7 use warnings;
   8
   9 use Scalar::Util        ();
  10 use Catalyst::Exception ();
  11 use Digest              ();
  12
  13 BEGIN {
  14     __PACKAGE__->mk_accessors(qw/_config/);
  15 }
  16
  17 sub new {
  18     my ($class, $config, $app) = @_;
  19
  20     my $self = { _config => $config };
  21     bless $self, $class;
  22
  23     $self->_config->{'password_field'} ||= 'password';
  24     $self->_config->{'password_type'}  ||= 'clear';
  25     $self->_config->{'password_hash_type'} ||= 'SHA-1';
  26
  27     my $passwordtype = $self->_config->{'password_type'};
  28     if (!grep /$passwordtype/, ('clear', 'hashed', 'salted_hash', 'crypted', 'self_check')) {
  29         Catalyst::Exception->throw(__PACKAGE__ . " used with unsupported password type: " . $self->_config->{'password_type'});
  30     }
  31     return $self;
  32 }
  33
  34 sub authenticate {
  35     my ( $self, $c, $authstore, $authinfo ) = @_;
  36
  37     ## because passwords may be in a hashed format, we have to make sure that we remove the
  38     ## password_field before we pass it to the user routine, as some auth modules use
  39     ## all data passed to them to find a matching user...
  40     my $userfindauthinfo = {%{$authinfo}};
  41     delete($userfindauthinfo->{$self->_config->{'password_field'}});
  42
  43     my $user_obj = $authstore->find_user($userfindauthinfo, $c);
  44     if (ref($user_obj)) {
  45         if ($self->check_password($user_obj, $authinfo)) {
  46             return $user_obj;
  47         }
  48     } else {
  49         $c->log->debug("Unable to locate user matching user info provided");
  50         return;
  51     }
  52 }
  53
  54 sub check_password {
  55     my ( $self, $user, $authinfo ) = @_;
  56
  57     if ($self->_config->{'password_type'} eq 'self_check') {
  58         return $user->check_password($authinfo->{$self->_config->{'password_field'}});
  59     } else {
  60         my $password = $authinfo->{$self->_config->{'password_field'}};
  61         my $storedpassword = $user->get($self->_config->{'password_field'});
  62
  63         if ($self->_config->{password_type} eq 'clear') {
  64             return $password eq $storedpassword;
  65         }  elsif ($self->_config->{'password_type'} eq 'crypted') {
  66             return $storedpassword eq crypt( $password, $storedpassword );
  67         } elsif ($self->_config->{'password_type'} eq 'salted_hash') {
  68             require Crypt::SaltedHash;
  69             my $salt_len = $self->_config->{'password_salt_len'} ? $self->_config->{'password_salt_len'} : 0;
  70             return Crypt::SaltedHash->validate( $storedpassword, $password,
  71                 $salt_len );
  72         } elsif ($self->_config->{'password_type'} eq 'hashed') {
  73
  74              my $d = Digest->new( $self->_config->{'password_hash_type'} );
  75              $d->add( $self->_config->{'password_pre_salt'} || '' );
  76              $d->add($password);
  77              $d->add( $self->_config->{'password_post_salt'} || '' );
  78
  79              my $computed    = $d->clone()->digest;
  80              my $b64computed = $d->clone()->b64digest;
  81              return ( ( $computed eq $storedpassword )
  82                    || ( unpack( "H*", $computed ) eq $storedpassword )
  83                    || ( $b64computed eq $storedpassword)
  84                    || ( $b64computed.'=' eq $storedpassword) );
  85         }
  86     }
  87 }
  88
  89 ## BACKWARDS COMPATIBILITY - all subs below here are deprecated
  90 ## They are here for compatibility with older modules that use / inherit from C::P::A::Password
  91 ## login()'s existance relies rather heavily on the fact that only Credential::Password
  92 ## is being used as a credential.  This may not be the case.  This is only here
  93 ## for backward compatibility.  It will go away in a future version
  94 ## login should not be used in new applications.
  95
  96 sub login {
  97     my ( $c, $user, $password, @rest ) = @_;
  98
  99     unless (
 100         defined($user)
 101             or
 102         $user = $c->request->param("login")
 103              || $c->request->param("user")
 104              || $c->request->param("username")
 105     ) {
 106         $c->log->debug(
 107             "Can't login a user without a user object or user ID param")
 108               if $c->debug;
 109         return;
 110     }
 111
 112     unless (
 113         defined($password)
 114             or
 115         $password = $c->request->param("password")
 116                  || $c->request->param("passwd")
 117                  || $c->request->param("pass")
 118     ) {
 119         $c->log->debug("Can't login a user without a password")
 120           if $c->debug;
 121         return;
 122     }
 123
 124     unless ( Scalar::Util::blessed($user)
 125         and $user->isa("Catalyst::Plugin::Authentication::User") )
 126     {
 127         if ( my $user_obj = $c->get_user( $user, $password, @rest ) ) {
 128             $user = $user_obj;
 129         }
 130         else {
 131             $c->log->debug("User '$user' doesn't exist in the default store")
 132               if $c->debug;
 133             return;
 134         }
 135     }
 136
 137     if ( $c->_check_password( $user, $password ) ) {
 138         $c->set_authenticated($user);
 139         $c->log->debug("Successfully authenticated user '$user'.")
 140           if $c->debug;
 141         return 1;
 142     }
 143     else {
 144         $c->log->debug(
 145             "Failed to authenticate user '$user'. Reason: 'Incorrect password'")
 146           if $c->debug;
 147         return;
 148     }
 149
 150 }
 151
 152 ## also deprecated.  Here for compatibility with older credentials which do not inherit from C::P::A::Password
 153 sub _check_password {
 154     my ( $c, $user, $password ) = @_;
 155
 156     if ( $user->supports(qw/password clear/) ) {
 157         return $user->password eq $password;
 158     }
 159     elsif ( $user->supports(qw/password crypted/) ) {
 160         my $crypted = $user->crypted_password;
 161         return $crypted eq crypt( $password, $crypted );
 162     }
 163     elsif ( $user->supports(qw/password hashed/) ) {
 164
 165         my $d = Digest->new( $user->hash_algorithm );
 166         $d->add( $user->password_pre_salt || '' );
 167         $d->add($password);
 168         $d->add( $user->password_post_salt || '' );
 169
 170         my $stored      = $user->hashed_password;
 171         my $computed    = $d->clone()->digest;
 172         my $b64computed = $d->clone()->b64digest;
 173
 174         return ( ( $computed eq $stored )
 175               || ( unpack( "H*", $computed ) eq $stored )
 176               || ( $b64computed eq $stored)
 177               || ( $b64computed.'=' eq $stored) );
 178     }
 179     elsif ( $user->supports(qw/password salted_hash/) ) {
 180         require Crypt::SaltedHash;
 181
 182         my $salt_len =
 183           $user->can("password_salt_len") ? $user->password_salt_len : 0;
 184
 185         return Crypt::SaltedHash->validate( $user->hashed_password, $password,
 186             $salt_len );
 187     }
 188     elsif ( $user->supports(qw/password self_check/) ) {
 189
 190         # while somewhat silly, this is to prevent code duplication
 191         return $user->check_password($password);
 192
 193     }
 194     else {
 195         Catalyst::Exception->throw(
 196                 "The user object $user does not support any "
 197               . "known password authentication mechanism." );
 198     }
 199 }
 200
 201 __PACKAGE__;
 202
 203 __END__
 204
 205 =pod
 206
 207 =head1 NAME
 208
 209 Catalyst::Plugin::Authentication::Credential::Password - Authenticate a user
 210 with a password.
 211
 212 =head1 SYNOPSIS
 213
 214     use Catalyst qw/
 215       Authentication
 216       /;
 217
 218     package MyApp::Controller::Auth;
 219
 220     sub login : Local {
 221         my ( $self, $c ) = @_;
 222
 223         $c->authenticate( { username => $c->req->param('username'),
 224                             password => $c->req->param('password') });
 225     }
 226
 227 =head1 DESCRIPTION
 228
 229 This authentication credential checker takes authentication information
 230 (most often a username) and a password, and attempts to validate the password
 231 provided against the user retrieved from the store.
 232
 233 =head1 CONFIGURATION
 234
 235     # example
 236     __PACKAGE__->config->{authentication} =
 237                 {
 238                     default_realm => 'members',
 239                     realms => {
 240                         members => {
 241
 242                             credential => {
 243                                 class => 'Password',
 244                                 password_field => 'password',
 245                                 password_type => 'hashed',
 246                                 password_hash_type => 'SHA-1'
 247                             },
 248                             ...
 249
 250
 251 The password module is capable of working with several different password
 252 encryption/hashing algorithms. The one the module uses is determined by the
 253 credential configuration.
 254
 255 Those who have used L<Catalyst::Plugin::Authentication> prior to the 0.10 release
 256 should note that the password field and type information is no longer part
 257 of the store configuration and is now part of the Password credential configuration.
 258
 259 =over 4
 260
 261 =item class
 262
 263 The classname used for Credential. This is part of
 264 L<Catalyst::Plugin::Authentication> and is the method by which
 265 Catalyst::Plugin::Authentication::Credential::Password is loaded as the
 266 credential validator. For this module to be used, this must be set to
 267 'Password'.
 268
 269 =item password_field
 270
 271 The field in the user object that contains the password. This will vary
 272 depending on the storage class used, but is most likely something like
 273 'password'. In fact, this is so common that if this is left out of the config,
 274 it defaults to 'password'. This field is obtained from the user object using
 275 the get() method. Essentially: $user->get('passwordfieldname');
 276
 277 =item password_type
 278
 279 This sets the password type.  Often passwords are stored in crypted or hashed
 280 formats.  In order for the password module to verify the plaintext password
 281 passed in, it must be told what format the password will be in when it is retreived
 282 from the user object. The supported options are:
 283
 284 =over 8
 285
 286 =item clear
 287
 288 The password in user is in clear text and will be compared directly.
 289
 290 =item self_check
 291
 292 This option indicates that the password should be passed to the check_password()
 293 routine on the user object returned from the store.
 294
 295 =item crypted
 296
 297 The password in user is in UNIX crypt hashed format.
 298
 299 =item salted_hash
 300
 301 The password in user is in salted hash format, and will be validated
 302 using L<Crypt::SaltedHash>.  If this password type is selected, you should
 303 also provide the B<password_salt_len> config element to define the salt length.
 304
 305 =item hashed
 306
 307 If the user object supports hashed passwords, they will be used in conjunction
 308 with L<Digest>. The following config elements affect the hashed configuration:
 309
 310 =over 8
 311
 312 =item password_hash_type
 313
 314 The hash type used, passed directly to L<Digest/new>.
 315
 316 =item password_pre_salt
 317
 318 Any pre-salt data to be passed to L<Digest/add> before processing the password.
 319
 320 =item password_post_salt
 321
 322 Any post-salt data to be passed to L<Digest/add> after processing the password.
 323
 324 =back
 325
 326 =back
 327
 328 =back
 329
 330 =head1 USAGE
 331
 332 The Password credential module is very simple to use. Once configured as
 333 indicated above, authenticating using this module is simply a matter of
 334 calling $c->authenticate() with an authinfo hashref that includes the
 335 B<password> element. The password element should contain the password supplied
 336 by the user to be authenticated, in clear text. The other information supplied
 337 in the auth hash is ignored by the Password module, and simply passed to the
 338 auth store to be used to retrieve the user. An example call follows:
 339
 340     if ($c->authenticate({ username => $username,
 341                            password => $password} )) {
 342         # authentication successful
 343     } else {
 344         # authentication failed
 345     }
 346
 347 =head1 METHODS
 348
 349 There are no publicly exported routines in the Password module (or indeed in
 350 most credential modules.)  However, below is a description of the routines
 351 required by L<Catalyst::Plugin::Authentication> for all credential modules.
 352
 353 =over 4
 354
 355 =item new ( $config, $app )
 356
 357 Instantiate a new Password object using the configuration hash provided in
 358 $config. A reference to the application is provided as the second argument.
 359 Note to credential module authors: new() is called during the application's
 360 plugin setup phase, which is before the application specific controllers are
 361 loaded. The practical upshot of this is that things like $c->model(...) will
 362 not function as expected.
 363
 364 =item authenticate ( $authinfo, $c )
 365
 366 Try to log a user in, receives a hashref containing authentication information
 367 as the first argument, and the current context as the second.
 368
 369 =back