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
 280 =item password_type
 281
 282 This sets the password type.  Often passwords are stored in crypted or hashed
 283 formats.  In order for the password module to verify the plaintext password
 284 passed in, it must be told what format the password will be in when it is retreived
 285 from the user object. The supported options are:
 286
 287 =over 8
 288
 289 =item none
 290
 291 No password check is done. An attempt is made to retrieve the user based on
 292 the information provided in the $c->authenticate() call. If a user is found,
 293 authentication is considered to be successful.
 294
 295 =item clear
 296
 297 The password in user is in clear text and will be compared directly.
 298
 299 =item self_check
 300
 301 This option indicates that the password should be passed to the check_password()
 302 routine on the user object returned from the store.
 303
 304 =item crypted
 305
 306 The password in user is in UNIX crypt hashed format.
 307
 308 =item salted_hash
 309
 310 The password in user is in salted hash format, and will be validated
 311 using L<Crypt::SaltedHash>.  If this password type is selected, you should
 312 also provide the B<password_salt_len> config element to define the salt length.
 313
 314 =item hashed
 315
 316 If the user object supports hashed passwords, they will be used in conjunction
 317 with L<Digest>. The following config elements affect the hashed configuration:
 318
 319 =over 8
 320
 321 =item password_hash_type
 322
 323 The hash type used, passed directly to L<Digest/new>.
 324
 325 =item password_pre_salt
 326
 327 Any pre-salt data to be passed to L<Digest/add> before processing the password.
 328
 329 =item password_post_salt
 330
 331 Any post-salt data to be passed to L<Digest/add> after processing the password.
 332
 333 =back
 334
 335 =back
 336
 337 =back
 338
 339 =head1 USAGE
 340
 341 The Password credential module is very simple to use. Once configured as
 342 indicated above, authenticating using this module is simply a matter of
 343 calling $c->authenticate() with an authinfo hashref that includes the
 344 B<password> element. The password element should contain the password supplied
 345 by the user to be authenticated, in clear text. The other information supplied
 346 in the auth hash is ignored by the Password module, and simply passed to the
 347 auth store to be used to retrieve the user. An example call follows:
 348
 349     if ($c->authenticate({ username => $username,
 350                            password => $password} )) {
 351         # authentication successful
 352     } else {
 353         # authentication failed
 354     }
 355
 356 =head1 METHODS
 357
 358 There are no publicly exported routines in the Password module (or indeed in
 359 most credential modules.)  However, below is a description of the routines
 360 required by L<Catalyst::Plugin::Authentication> for all credential modules.
 361
 362 =head2 new( $config, $app )
 363
 364 Instantiate a new Password object using the configuration hash provided in
 365 $config. A reference to the application is provided as the second argument.
 366 Note to credential module authors: new() is called during the application's
 367 plugin setup phase, which is before the application specific controllers are
 368 loaded. The practical upshot of this is that things like $c->model(...) will
 369 not function as expected.
 370
 371 =head2 authenticate( $authinfo, $c )
 372
 373 Try to log a user in, receives a hashref containing authentication information
 374 as the first argument, and the current context as the second.
 375
 376 =head2 check_password( )
 377
 378 =head2 login( )
 379
 380 =cut