lib/Catalyst/Authentication/Credential/Password.pm

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