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

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