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

   1 #!/usr/bin/perl
   2
   3 package Catalyst::Plugin::Authentication::Credential::Password;
   4
   5 use strict;
   6 use warnings;
   7
   8 use Scalar::Util        ();
   9 use Catalyst::Exception ();
  10 use Digest              ();
  11
  12 sub new {
  13     my ($class, $config, $app) = @_;
  14
  15     my $self = { %{$config} };
  16     $self->{'password_field'} ||= 'password';
  17     $self->{'password_type'}  ||= 'clear';
  18     $self->{'password_hash_type'} ||= 'SHA-1';
  19
  20     if (!grep /$$self{'password_type'}/, ('clear', 'hashed', 'salted_hash', 'crypted', 'self_check')) {
  21         Catalyst::Exception->throw(__PACKAGE__ . " used with unsupported password type: " . $self->{'password_type'});
  22     }
  23
  24     bless $self, $class;
  25 }
  26
  27 sub authenticate {
  28     my ( $self, $c, $authstore, $authinfo ) = @_;
  29
  30     my $user_obj = $authstore->find_user($authinfo, $c);
  31     if ($user_obj) {
  32         if ($self->check_password($user_obj, $authinfo)) {
  33             return $user_obj;
  34         }
  35     } else {
  36         $c->log->debug("Unable to locate user matching user info provided");
  37         return;
  38     }
  39 }
  40
  41 sub check_password {
  42     my ( $self, $user, $authinfo ) = @_;
  43
  44     if ($self->{'password_type'} eq 'self_check') {
  45         return $user->check_password($authinfo->{$self->{'password_field'}});
  46     } else {
  47         my $password = $authinfo->{$self->{'password_field'}};
  48         my $storedpassword = $user->get($self->{'password_field'});
  49
  50         if ($self->{password_type} eq 'clear') {
  51             return $password eq $storedpassword;
  52         }  elsif ($self->{'password_type'} eq 'crypted') {
  53             return $storedpassword eq crypt( $password, $storedpassword );
  54         } elsif ($self->{'password_type'} eq 'salted_hash') {
  55             require Crypt::SaltedHash;
  56             my $salt_len = $self->{'password_salt_len'} ? $self->{'password_salt_len'} : 0;
  57             return Crypt::SaltedHash->validate( $storedpassword, $password,
  58                 $salt_len );
  59         } elsif ($self->{'password_type'} eq 'hashed') {
  60
  61              my $d = Digest->new( $self->{'password_hash_type'} );
  62              $d->add( $self->{'password_pre_salt'} || '' );
  63              $d->add($password);
  64              $d->add( $self->{'password_post_salt'} || '' );
  65
  66              my $computed    = $d->clone()->digest;
  67              my $b64computed = $d->clone()->b64digest;
  68              return ( ( $computed eq $storedpassword )
  69                    || ( unpack( "H*", $computed ) eq $storedpassword )
  70                    || ( $b64computed eq $storedpassword)
  71                    || ( $b64computed.'=' eq $storedpassword) );
  72         }
  73     }
  74 }
  75
  76 ## BACKWARDS COMPATIBILITY - all subs below here are deprecated
  77 ## They are here for compatibility with older modules that use / inherit from C::P::A::Password
  78 ## login()'s existance relies rather heavily on the fact that Credential::Password
  79 ## is being used as a credential.  This may not be the case.  This is only here
  80 ## for backward compatibility.  It will go away in a future version
  81 ## login should not be used in new applications.
  82
  83 sub login {
  84     my ( $c, $user, $password, @rest ) = @_;
  85
  86     unless (
  87         defined($user)
  88             or
  89         $user = $c->request->param("login")
  90              || $c->request->param("user")
  91              || $c->request->param("username")
  92     ) {
  93         $c->log->debug(
  94             "Can't login a user without a user object or user ID param")
  95               if $c->debug;
  96         return;
  97     }
  98
  99     unless (
 100         defined($password)
 101             or
 102         $password = $c->request->param("password")
 103                  || $c->request->param("passwd")
 104                  || $c->request->param("pass")
 105     ) {
 106         $c->log->debug("Can't login a user without a password")
 107           if $c->debug;
 108         return;
 109     }
 110
 111     unless ( Scalar::Util::blessed($user)
 112         and $user->isa("Catalyst::Plugin::Authentication::User") )
 113     {
 114         if ( my $user_obj = $c->get_user( $user, $password, @rest ) ) {
 115             $user = $user_obj;
 116         }
 117         else {
 118             $c->log->debug("User '$user' doesn't exist in the default store")
 119               if $c->debug;
 120             return;
 121         }
 122     }
 123
 124     if ( $c->_check_password( $user, $password ) ) {
 125         $c->set_authenticated($user);
 126         $c->log->debug("Successfully authenticated user '$user'.")
 127           if $c->debug;
 128         return 1;
 129     }
 130     else {
 131         $c->log->debug(
 132             "Failed to authenticate user '$user'. Reason: 'Incorrect password'")
 133           if $c->debug;
 134         return;
 135     }
 136
 137 }
 138
 139 ## also deprecated.  Here for compatibility with older credentials which do not inherit from C::P::A::Password
 140 sub _check_password {
 141     my ( $c, $user, $password ) = @_;
 142
 143     if ( $user->supports(qw/password clear/) ) {
 144         return $user->password eq $password;
 145     }
 146     elsif ( $user->supports(qw/password crypted/) ) {
 147         my $crypted = $user->crypted_password;
 148         return $crypted eq crypt( $password, $crypted );
 149     }
 150     elsif ( $user->supports(qw/password hashed/) ) {
 151
 152         my $d = Digest->new( $user->hash_algorithm );
 153         $d->add( $user->password_pre_salt || '' );
 154         $d->add($password);
 155         $d->add( $user->password_post_salt || '' );
 156
 157         my $stored      = $user->hashed_password;
 158         my $computed    = $d->clone()->digest;
 159         my $b64computed = $d->clone()->b64digest;
 160
 161         return ( ( $computed eq $stored )
 162               || ( unpack( "H*", $computed ) eq $stored )
 163               || ( $b64computed eq $stored)
 164               || ( $b64computed.'=' eq $stored) );
 165     }
 166     elsif ( $user->supports(qw/password salted_hash/) ) {
 167         require Crypt::SaltedHash;
 168
 169         my $salt_len =
 170           $user->can("password_salt_len") ? $user->password_salt_len : 0;
 171
 172         return Crypt::SaltedHash->validate( $user->hashed_password, $password,
 173             $salt_len );
 174     }
 175     elsif ( $user->supports(qw/password self_check/) ) {
 176
 177         # while somewhat silly, this is to prevent code duplication
 178         return $user->check_password($password);
 179
 180     }
 181     else {
 182         Catalyst::Exception->throw(
 183                 "The user object $user does not support any "
 184               . "known password authentication mechanism." );
 185     }
 186 }
 187
 188 __PACKAGE__;
 189
 190 __END__
 191
 192 =pod
 193
 194 =head1 NAME
 195
 196 Catalyst::Plugin::Authentication::Credential::Password - Authenticate a user
 197 with a password.
 198
 199 =head1 SYNOPSIS
 200
 201     use Catalyst qw/
 202       Authentication
 203       Authentication::Store::Foo
 204       Authentication::Credential::Password
 205       /;
 206
 207     package MyApp::Controller::Auth;
 208
 209     # *** NOTE ***
 210     # if you place an action named 'login' in your application's root (as
 211     # opposed to inside a controller) the following snippet will recurse,
 212     # giving you lots of grief.
 213     # never name actions in the root controller after plugin methods - use
 214     # controllers and : Global instead.
 215
 216     sub login : Local {
 217         my ( $self, $c ) = @_;
 218
 219         $c->login( $c->req->param('username'), $c->req->param('password') );
 220     }
 221
 222 =head1 DESCRIPTION
 223
 224 This authentication credential checker takes a username (or userid) and a
 225 password, and tries various methods of comparing a password based on what
 226 the chosen store's user objects support:
 227
 228 =over 4
 229
 230 =item clear text password
 231
 232 If the user has clear a clear text password it will be compared directly.
 233
 234 =item crypted password
 235
 236 If UNIX crypt hashed passwords are supported, they will be compared using
 237 perl's builtin C<crypt> function.
 238
 239 =item hashed password
 240
 241 If the user object supports hashed passwords, they will be used in conjunction
 242 with L<Digest>.
 243
 244 =back
 245
 246 =head1 METHODS
 247
 248 =over 4
 249
 250 =item login $username, $password
 251
 252 Try to log a user in.
 253
 254 C<$username> can be a string (e.g. retrieved from a form) or an object.
 255 If the object is a L<Catalyst::Plugin::Authentication::User> it will be used
 256 as is. Otherwise C<< $c->get_user >> is used to retrieve it.
 257
 258 C<$password> is a string.
 259
 260 If C<$username> or C<$password> are not provided, the query parameters
 261 C<login>, C<user>, C<username> and C<password>, C<passwd>, C<pass> will
 262 be tried instead.
 263
 264 =back
 265
 266 =head1 RELATED USAGE
 267
 268 After the user is logged in, the user object for the current logged in user
 269 can be retrieved from the context using the C<< $c->user >> method.
 270
 271 The current user can be logged out again by calling the C<< $c->logout >>
 272 method.
 273
 274 =head1 SUPPORTING THIS PLUGIN
 275
 276 For a User class to support credential verification using this plugin, it
 277 needs to indicate what sort of password a given user supports
 278 by implementing the C<supported_features> method in one or many of the
 279 following ways:
 280
 281 =head2 Clear Text Passwords
 282
 283 Predicate:
 284
 285         $user->supported_features(qw/password clear/);
 286
 287 Expected methods:
 288
 289 =over 4
 290
 291 =item password
 292
 293 Returns the user's clear text password as a string to be compared with C<eq>.
 294
 295 =back
 296
 297 =head2 Crypted Passwords
 298
 299 Predicate:
 300
 301         $user->supported_features(qw/password crypted/);
 302
 303 Expected methods:
 304
 305 =over 4
 306
 307 =item crypted_password
 308
 309 Return's the user's crypted password as a string, with the salt as the first two chars.
 310
 311 =back
 312
 313 =head2 Hashed Passwords
 314
 315 Predicate:
 316
 317         $user->supported_features(qw/password hashed/);
 318
 319 Expected methods:
 320
 321 =over 4
 322
 323 =item hashed_password
 324
 325 Return's the hash of the user's password as B<binary>.
 326
 327 =item hash_algorithm
 328
 329 Returns a string suitable for feeding into L<Digest/new>.
 330
 331 =item password_pre_salt
 332
 333 =item password_post_salt
 334
 335 Returns a string to be hashed before/after the user's password. Typically only
 336 a pre-salt is used.
 337
 338 =back
 339
 340 =head2 Crypt::SaltedHash Passwords
 341
 342 Predicate:
 343
 344         $user->supported_features(qw/password salted_hash/);
 345
 346 Expected methods:
 347
 348 =over 4
 349
 350 =item hashed_password
 351
 352 Returns the hash of the user's password as returned from L<Crypt-SaltedHash>->generate.
 353
 354 =back
 355
 356 Optional methods:
 357
 358 =over 4
 359
 360 =item password_salt_len
 361
 362 Returns the length of salt used to generate the salted hash.
 363
 364 =back
 365
 366 =cut
 367
 368