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           || Catalyst::Exception->throw("Can't determine username for login");
  20
  21              $password ||= $_->param("password")
  22           || $_->param("passwd")
  23           || $_->param("pass")
  24           || Catalyst::Exception->throw("Can't determine password for login");
  25     }
  26
  27     $user = $c->get_user($user)
  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 undef;
  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         my $d = Digest->new( $user->hash_algorithm );
  52         $d->add( $user->password_pre_salt || '' );
  53         $d->add($password);
  54         $d->add( $user->password_post_salt || '' );
  55         return $d->digest eq $user->hashed_password;
  56     }
  57     elsif ( $user->supports(qw/password self_check/) ) {
  58
  59         # while somewhat silly, this is to prevent code duplication
  60         return $user->check_password($password);
  61     }
  62     else {
  63         Catalyst::Exception->throw(
  64                 "The user object $user does not support any "
  65               . "known password authentication mechanism." );
  66     }
  67 }
  68
  69 __PACKAGE__;
  70
  71 __END__
  72
  73 =pod
  74
  75 =head1 NAME
  76
  77 Catalyst::Plugin::Authentication::Credential::Password - Authenticate a user
  78 with a password.
  79
  80 =head1 SYNOPSIS
  81
  82     use Catalyst qw/
  83       Authentication
  84       Authentication::Store::Foo
  85       Authentication::Credential::Password
  86       /;
  87
  88     sub login : Local {
  89         my ( $self, $c ) = @_;
  90
  91         $c->login( $c->req->param('login'), $c->req->param('password') );
  92     }
  93
  94 =head1 DESCRIPTION
  95
  96 This authentication credential checker takes a user and a password, and tries
  97 various methods of comparing a password based on what the user supports:
  98
  99 =over 4
 100
 101 =item clear text password
 102
 103 If the user has clear a clear text password it will be compared directly.
 104
 105 =item crypted password
 106
 107 If UNIX crypt hashed passwords are supported, they will be compared using
 108 perl's builtin C<crypt> function.
 109
 110 =item hashed password
 111
 112 If the user object supports hashed passwords, they will be used in conjunction
 113 with L<Digest>.
 114
 115 =back
 116
 117 =head1 METHODS
 118
 119 =over 4
 120
 121 =item login $user, $password
 122
 123 =item login
 124
 125 Try to log a user in.
 126
 127 C<$user> can be an ID or object. If it isa
 128 L<Catalyst::Plugin::Authentication::User> it will be used as is. Otherwise
 129 C<< $c->get_user >> is used to retrieve it.
 130
 131 C<$password> is a string.
 132
 133 If C<$user> or C<$password> are not provided the parameters C<login>, C<user>,
 134 C<username> and C<password>, C<passwd>, C<pass> will be tried instead.
 135
 136 =back
 137
 138 =head1 SUPPORTING THIS PLUGIN
 139
 140 =head2 Clear Text Passwords
 141
 142 Predicate:
 143
 144         $user->supports(qw/password clear/);
 145
 146 Expected methods:
 147
 148 =over 4
 149
 150 =item password
 151
 152 Returns the user's clear text password as a string to be compared with C<eq>.
 153
 154 =back
 155
 156 =head2 Crypted Passwords
 157
 158 Predicate:
 159
 160         $user->supports(qw/password crypted/);
 161
 162 Expected methods:
 163
 164 =over 4
 165
 166 =item crypted_password
 167
 168 Return's the user's crypted password as a string, with the salt as the first two chars.
 169
 170 =back
 171
 172 =head2 Hashed Passwords
 173
 174 Predicate:
 175
 176         $user->supports(qw/password hashed/);
 177
 178 Expected methods:
 179
 180 =over 4
 181
 182 =item hashed_passwords
 183
 184 Return's the hash of the user's password as B<binary>.
 185
 186 =item hash_algorithm
 187
 188 Returns a string suitable for feeding into L<Digest/new>.
 189
 190 =item password_pre_salt
 191
 192 =item password_post_salt
 193
 194 Returns a string to be hashed before/after the user's password. Typically only
 195 a pre-salt is used.
 196
 197 =back
 198
 199 =cut
 200
 201