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 login {
  13     my ( $c, $user, $password, @rest ) = @_;
  14
  15     for ( $c->request ) {
  16         unless ( $user ||= $_->param("login")
  17             || $_->param("user")
  18             || $_->param("username") )
  19         {
  20             $c->log->debug(
  21                 "Can't login a user without a user object or user ID param")
  22                   if $c->debug;
  23             return;
  24         }
  25
  26         unless ( $password ||= $_->param("password")
  27             || $_->param("passwd")
  28             || $_->param("pass") )
  29         {
  30             $c->log->debug("Can't login a user without a password")
  31               if $c->debug;
  32             return;
  33         }
  34     }
  35
  36     unless ( Scalar::Util::blessed($user)
  37         and $user->isa("Catalyst::Plugin::Authentication::User") )
  38     {
  39         if ( my $user_obj = $c->get_user( $user, $password, @rest ) ) {
  40             $user = $user_obj;
  41         }
  42         else {
  43             $c->log->debug("User '$user' doesn't exist in the default store")
  44               if $c->debug;
  45             return;
  46         }
  47     }
  48
  49     if ( $c->_check_password( $user, $password ) ) {
  50         $c->set_authenticated($user);
  51         $c->log->debug("Successfully authenticated user '$user'.")
  52           if $c->debug;
  53         return 1;
  54     }
  55     else {
  56         $c->log->debug(
  57             "Failed to authenticate user '$user'. Reason: 'Incorrect password'")
  58           if $c->debug;
  59         return;
  60     }
  61 }
  62
  63 sub _check_password {
  64     my ( $c, $user, $password ) = @_;
  65
  66     if ( $user->supports(qw/password clear/) ) {
  67         return $user->password eq $password;
  68     }
  69     elsif ( $user->supports(qw/password crypted/) ) {
  70         my $crypted = $user->crypted_password;
  71         return $crypted eq crypt( $password, $crypted );
  72     }
  73     elsif ( $user->supports(qw/password hashed/) ) {
  74
  75         my $d = Digest->new( $user->hash_algorithm );
  76         $d->add( $user->password_pre_salt || '' );
  77         $d->add($password);
  78         $d->add( $user->password_post_salt || '' );
  79
  80         my $stored      = $user->hashed_password;
  81         my $computed    = $d->clone()->digest;
  82         my $b64computed = $d->clone()->b64digest;
  83
  84         return ( ( $computed eq $stored )
  85               || ( unpack( "H*", $computed ) eq $stored )
  86               || ( $b64computed eq $stored)
  87               || ( $b64computed.'=' eq $stored) );
  88     }
  89     elsif ( $user->supports(qw/password salted_hash/) ) {
  90         require Crypt::SaltedHash;
  91
  92         my $salt_len =
  93           $user->can("password_salt_len") ? $user->password_salt_len : 0;
  94
  95         return Crypt::SaltedHash->validate( $user->hashed_password, $password,
  96             $salt_len );
  97     }
  98     elsif ( $user->supports(qw/password self_check/) ) {
  99
 100         # while somewhat silly, this is to prevent code duplication
 101         return $user->check_password($password);
 102
 103     }
 104     else {
 105         Catalyst::Exception->throw(
 106                 "The user object $user does not support any "
 107               . "known password authentication mechanism." );
 108     }
 109 }
 110
 111 __PACKAGE__;
 112
 113 __END__
 114
 115 =pod
 116
 117 =head1 NAME
 118
 119 Catalyst::Plugin::Authentication::Credential::Password - Authenticate a user
 120 with a password.
 121
 122 =head1 SYNOPSIS
 123
 124     use Catalyst qw/
 125       Authentication
 126       Authentication::Store::Foo
 127       Authentication::Credential::Password
 128       /;
 129
 130     package MyApp::Controller::Auth;
 131
 132     # *** NOTE ***
 133     # if you place an action named 'login' in your application's root (as
 134     # opposed to inside a controller) the following snippet will recurse,
 135     # giving you lots of grief.
 136     # never name actions in the root controller after plugin methods - use
 137     # controllers and : Global instead.
 138
 139     sub login : Local {
 140         my ( $self, $c ) = @_;
 141
 142         $c->login( $c->req->param('username'), $c->req->param('password') );
 143     }
 144
 145 =head1 DESCRIPTION
 146
 147 This authentication credential checker takes a username (or userid) and a
 148 password, and tries various methods of comparing a password based on what
 149 the chosen store's user objects support:
 150
 151 =over 4
 152
 153 =item clear text password
 154
 155 If the user has clear a clear text password it will be compared directly.
 156
 157 =item crypted password
 158
 159 If UNIX crypt hashed passwords are supported, they will be compared using
 160 perl's builtin C<crypt> function.
 161
 162 =item hashed password
 163
 164 If the user object supports hashed passwords, they will be used in conjunction
 165 with L<Digest>.
 166
 167 =back
 168
 169 =head1 METHODS
 170
 171 =over 4
 172
 173 =item login $username, $password
 174
 175 Try to log a user in.
 176
 177 C<$username> can be a string (e.g. retrieved from a form) or an object.
 178 If the object is a L<Catalyst::Plugin::Authentication::User> it will be used
 179 as is. Otherwise C<< $c->get_user >> is used to retrieve it.
 180
 181 C<$password> is a string.
 182
 183 If C<$username> or C<$password> are not provided, the query parameters
 184 C<login>, C<user>, C<username> and C<password>, C<passwd>, C<pass> will
 185 be tried instead.
 186
 187 =back
 188
 189 =head1 RELATED USAGE
 190
 191 After the user is logged in, the user object for the current logged in user
 192 can be retrieved from the context using the C<< $c->user >> method.
 193
 194 The current user can be logged out again by calling the C<< $c->logout >>
 195 method.
 196
 197 =head1 SUPPORTING THIS PLUGIN
 198
 199 For a User class to support credential verification using this plugin, it
 200 needs to indicate what sort of password a given user supports
 201 by implementing the C<supported_features> method in one or many of the
 202 following ways:
 203
 204 =head2 Clear Text Passwords
 205
 206 Predicate:
 207
 208         $user->supported_features(qw/password clear/);
 209
 210 Expected methods:
 211
 212 =over 4
 213
 214 =item password
 215
 216 Returns the user's clear text password as a string to be compared with C<eq>.
 217
 218 =back
 219
 220 =head2 Crypted Passwords
 221
 222 Predicate:
 223
 224         $user->supported_features(qw/password crypted/);
 225
 226 Expected methods:
 227
 228 =over 4
 229
 230 =item crypted_password
 231
 232 Return's the user's crypted password as a string, with the salt as the first two chars.
 233
 234 =back
 235
 236 =head2 Hashed Passwords
 237
 238 Predicate:
 239
 240         $user->supported_features(qw/password hashed/);
 241
 242 Expected methods:
 243
 244 =over 4
 245
 246 =item hashed_password
 247
 248 Return's the hash of the user's password as B<binary>.
 249
 250 =item hash_algorithm
 251
 252 Returns a string suitable for feeding into L<Digest/new>.
 253
 254 =item password_pre_salt
 255
 256 =item password_post_salt
 257
 258 Returns a string to be hashed before/after the user's password. Typically only
 259 a pre-salt is used.
 260
 261 =back
 262
 263 =head2 Crypt::SaltedHash Passwords
 264
 265 Predicate:
 266
 267         $user->supported_features(qw/password salted_hash/);
 268
 269 Expected methods:
 270
 271 =over 4
 272
 273 =item hashed_password
 274
 275 Returns the hash of the user's password as returned from L<Crypt-SaltedHash>->generate.
 276
 277 =back
 278
 279 Optional methods:
 280
 281 =over 4
 282
 283 =item password_salt_len
 284
 285 Returns the length of salt used to generate the salted hash.
 286
 287 =back
 288
 289 =cut
 290
 291