lib/Catalyst/Plugin/Authentication/Credential/Password.pm

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