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