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