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('username'), $c->req->param('password') );\r
 108     }\r
 109 \r
 110 =head1 DESCRIPTION\r
 111 \r
 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:\r
 115 \r
 116 =over 4\r
 117 \r
 118 =item clear text password\r
 119 \r
 120 If the user has clear a clear text password it will be compared directly.\r
 121 \r
 122 =item crypted password\r
 123 \r
 124 If UNIX crypt hashed passwords are supported, they will be compared using\r
 125 perl's builtin C<crypt> function.\r
 126 \r
 127 =item hashed password\r
 128 \r
 129 If the user object supports hashed passwords, they will be used in conjunction\r
 130 with L<Digest>.\r
 131 \r
 132 =back\r
 133 \r
 134 =head1 METHODS\r
 135 \r
 136 =over 4\r
 137 \r
 138 =item login $username, $password\r
 139 \r
 140 Try to log a user in.\r
 141 \r
 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.\r
 145 \r
 146 C<$password> is a string.\r
 147 \r
 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\r
 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\r
 170 \r
 171 Predicate:\r
 172 \r
 173         $user->supported_features(qw/password clear/);\r
 174 \r
 175 Expected methods:\r
 176 \r
 177 =over 4\r
 178 \r
 179 =item password\r
 180 \r
 181 Returns the user's clear text password as a string to be compared with C<eq>.\r
 182 \r
 183 =back\r
 184 \r
 185 =head2 Crypted Passwords\r
 186 \r
 187 Predicate:\r
 188 \r
 189         $user->supported_features(qw/password crypted/);\r
 190 \r
 191 Expected methods:\r
 192 \r
 193 =over 4\r
 194 \r
 195 =item crypted_password\r
 196 \r
 197 Return's the user's crypted password as a string, with the salt as the first two chars.\r
 198 \r
 199 =back\r
 200 \r
 201 =head2 Hashed Passwords\r
 202 \r
 203 Predicate:\r
 204 \r
 205         $user->supported_features(qw/password hashed/);\r
 206 \r
 207 Expected methods:\r
 208 \r
 209 =over 4\r
 210 \r
 211 =item hashed_password\r
 212 \r
 213 Return's the hash of the user's password as B<binary>.\r
 214 \r
 215 =item hash_algorithm\r
 216 \r
 217 Returns a string suitable for feeding into L<Digest/new>.\r
 218 \r
 219 =item password_pre_salt\r
 220 \r
 221 =item password_post_salt\r
 222 \r
 223 Returns a string to be hashed before/after the user's password. Typically only\r
 224 a pre-salt is used.\r
 225 \r
 226 =back\r
 227 \r
 228 =head2 Crypt::SaltedHash Passwords\r
 229 \r
 230 Predicate:\r
 231 \r
 232         $user->supported_features(qw/password salted_hash/);\r
 233 \r
 234 Expected methods:\r
 235 \r
 236 =over 4\r
 237 \r
 238 =item hashed_password\r
 239 \r
 240 Returns the hash of the user's password as returned from L<Crypt-SaltedHash>->generate.\r
 241 \r
 242 =back\r
 243 \r
 244 Optional methods:\r
 245 \r
 246 =over 4\r
 247 \r
 248 =item password_salt_len\r
 249 \r
 250 Returns the length of salt used to generate the salted hash.\r
 251 \r
 252 =back\r
 253 \r
 254 =cut\r
 255 \r
 256 \r