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 ( $self, $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 $c->digest eq $user->hashed_password;
  43     }
  44     else {
  45         Catalyst::Exception->throw(
  46                 "The user object $user does not support any "
  47               . "known password authentication mechanism." );
  48     }
  49 }
  50
  51 __PACKAGE__;
  52
  53 __END__
  54
  55 =pod
  56
  57 =head1 NAME
  58
  59 Catalyst:::Plugin::Authentication::Credential::Password - Authenticate a user
  60 with a password.
  61
  62 =head1 SYNOPSIS
  63
  64     use Catalyst qw/
  65       Authentication
  66       Authentication::Store::Foo
  67       Authentication::Credential::Password
  68       /;
  69
  70     sub login : Local {
  71         my ( $self, $c ) = @_;
  72
  73         $c->login( $c->req->param('login'), $c->req->param('password') );
  74     }
  75
  76 =head1 DESCRIPTION
  77
  78 This authentication credential checker takes a user and a password, and tries
  79 various methods of comparing a password based on what the user supports:
  80
  81 =over 4
  82
  83 =item clear text password
  84
  85 If the user has clear a clear text password it will be compared directly.
  86
  87 =item crypted password
  88
  89 If UNIX crypt hashed passwords are supported, they will be compared using
  90 perl's builtin C<crypt> function.
  91
  92 =item hashed password
  93
  94 If the user object supports hashed passwords, they will be used in conjunction
  95 with L<Digest>.
  96
  97 =back
  98
  99 =head1 METHODS
 100
 101 =over 4
 102
 103 =item login $user, $password
 104
 105 Try to log a user in.
 106
 107 $user can be an ID or object. If it isa
 108 L<Catalyst:::Plugin::Authentication::User> it will be used as is. Otherwise
 109 C<< $c->get_user >> is used to retrieve it.
 110
 111 $password is a string.
 112
 113 =back
 114
 115 =cut
 116
 117