Commit | Line | Data |
a90296d4 |
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 | |
54c8dc06 |
12 | sub new { |
13 | my ($class, $config, $app) = @_; |
14 | |
15 | my $self = { %{$config} }; |
16 | $self->{'password_field'} ||= 'password'; |
17 | $self->{'password_type'} ||= 'clear'; |
18 | $self->{'password_hash_type'} ||= 'SHA-1'; |
19 | |
20 | if (!grep /$$self{'password_type'}/, ('clear', 'hashed', 'salted_hash', 'crypted', 'self_check')) { |
21 | Catalyst::Exception->throw(__PACKAGE__ . " used with unsupported password type: " . $self->{'password_type'}); |
22 | } |
a90296d4 |
23 | |
54c8dc06 |
24 | bless $self, $class; |
25 | } |
26 | |
27 | sub authenticate { |
28 | my ( $self, $c, $authstore, $authinfo ) = @_; |
29 | |
30 | my $user_obj = $authstore->find_user($authinfo, $c); |
31 | if ($user_obj) { |
32 | if ($self->check_password($user_obj, $authinfo)) { |
33 | return $user_obj; |
a93f1197 |
34 | } |
54c8dc06 |
35 | } else { |
36 | $c->log->debug("Unable to locate user matching user info provided"); |
37 | return; |
38 | } |
39 | } |
a93f1197 |
40 | |
54c8dc06 |
41 | sub check_password { |
42 | my ( $self, $user, $authinfo ) = @_; |
43 | |
44 | if ($self->{'password_type'} eq 'self_check') { |
45 | return $user->check_password($authinfo->{$self->{'password_field'}}); |
46 | } else { |
47 | my $password = $authinfo->{$self->{'password_field'}}; |
48 | my $storedpassword = $user->get($self->{'password_field'}); |
49 | |
50 | if ($self->{password_type} eq 'clear') { |
51 | return $password eq $storedpassword; |
52 | } elsif ($self->{'password_type'} eq 'crypted') { |
53 | return $storedpassword eq crypt( $password, $storedpassword ); |
54 | } elsif ($self->{'password_type'} eq 'salted_hash') { |
55 | require Crypt::SaltedHash; |
56 | my $salt_len = $self->{'password_salt_len'} ? $self->{'password_salt_len'} : 0; |
57 | return Crypt::SaltedHash->validate( $storedpassword, $password, |
58 | $salt_len ); |
59 | } elsif ($self->{'password_type'} eq 'hashed') { |
60 | |
61 | my $d = Digest->new( $self->{'password_hash_type'} ); |
62 | $d->add( $self->{'password_pre_salt'} || '' ); |
63 | $d->add($password); |
64 | $d->add( $self->{'password_post_salt'} || '' ); |
65 | |
66 | my $computed = $d->clone()->digest; |
67 | my $b64computed = $d->clone()->b64digest; |
68 | return ( ( $computed eq $storedpassword ) |
69 | || ( unpack( "H*", $computed ) eq $storedpassword ) |
70 | || ( $b64computed eq $storedpassword) |
71 | || ( $b64computed.'=' eq $storedpassword) ); |
a93f1197 |
72 | } |
a90296d4 |
73 | } |
54c8dc06 |
74 | } |
75 | |
76 | ## BACKWARDS COMPATIBILITY - all subs below here are deprecated |
77 | ## They are here for compatibility with older modules that use / inherit from C::P::A::Password |
78 | ## login()'s existance relies rather heavily on the fact that Credential::Password |
79 | ## is being used as a credential. This may not be the case. This is only here |
80 | ## for backward compatibility. It will go away in a future version |
81 | ## login should not be used in new applications. |
a90296d4 |
82 | |
54c8dc06 |
83 | sub login { |
84 | my ( $c, $user, $password, @rest ) = @_; |
85 | |
86 | unless ( |
87 | defined($user) |
88 | or |
89 | $user = $c->request->param("login") |
90 | || $c->request->param("user") |
91 | || $c->request->param("username") |
92 | ) { |
93 | $c->log->debug( |
94 | "Can't login a user without a user object or user ID param") |
95 | if $c->debug; |
96 | return; |
97 | } |
98 | |
99 | unless ( |
100 | defined($password) |
101 | or |
102 | $password = $c->request->param("password") |
103 | || $c->request->param("passwd") |
104 | || $c->request->param("pass") |
105 | ) { |
106 | $c->log->debug("Can't login a user without a password") |
107 | if $c->debug; |
108 | return; |
109 | } |
110 | |
a93f1197 |
111 | unless ( Scalar::Util::blessed($user) |
85d1d92d |
112 | and $user->isa("Catalyst::Plugin::Authentication::User") ) |
a93f1197 |
113 | { |
2f7d8b59 |
114 | if ( my $user_obj = $c->get_user( $user, $password, @rest ) ) { |
a93f1197 |
115 | $user = $user_obj; |
116 | } |
117 | else { |
118 | $c->log->debug("User '$user' doesn't exist in the default store") |
119 | if $c->debug; |
120 | return; |
121 | } |
122 | } |
a90296d4 |
123 | |
124 | if ( $c->_check_password( $user, $password ) ) { |
125 | $c->set_authenticated($user); |
a93f1197 |
126 | $c->log->debug("Successfully authenticated user '$user'.") |
127 | if $c->debug; |
a90296d4 |
128 | return 1; |
129 | } |
130 | else { |
a93f1197 |
131 | $c->log->debug( |
85d1d92d |
132 | "Failed to authenticate user '$user'. Reason: 'Incorrect password'") |
a93f1197 |
133 | if $c->debug; |
a90296d4 |
134 | return; |
135 | } |
54c8dc06 |
136 | |
a90296d4 |
137 | } |
138 | |
54c8dc06 |
139 | ## also deprecated. Here for compatibility with older credentials which do not inherit from C::P::A::Password |
a90296d4 |
140 | sub _check_password { |
141 | my ( $c, $user, $password ) = @_; |
54c8dc06 |
142 | |
a90296d4 |
143 | if ( $user->supports(qw/password clear/) ) { |
144 | return $user->password eq $password; |
145 | } |
146 | elsif ( $user->supports(qw/password crypted/) ) { |
147 | my $crypted = $user->crypted_password; |
148 | return $crypted eq crypt( $password, $crypted ); |
149 | } |
150 | elsif ( $user->supports(qw/password hashed/) ) { |
151 | |
152 | my $d = Digest->new( $user->hash_algorithm ); |
153 | $d->add( $user->password_pre_salt || '' ); |
154 | $d->add($password); |
155 | $d->add( $user->password_post_salt || '' ); |
156 | |
fd5b31a0 |
157 | my $stored = $user->hashed_password; |
158 | my $computed = $d->clone()->digest; |
159 | my $b64computed = $d->clone()->b64digest; |
a90296d4 |
160 | |
161 | return ( ( $computed eq $stored ) |
fd5b31a0 |
162 | || ( unpack( "H*", $computed ) eq $stored ) |
163 | || ( $b64computed eq $stored) |
164 | || ( $b64computed.'=' eq $stored) ); |
a90296d4 |
165 | } |
166 | elsif ( $user->supports(qw/password salted_hash/) ) { |
167 | require Crypt::SaltedHash; |
168 | |
169 | my $salt_len = |
170 | $user->can("password_salt_len") ? $user->password_salt_len : 0; |
171 | |
172 | return Crypt::SaltedHash->validate( $user->hashed_password, $password, |
173 | $salt_len ); |
174 | } |
175 | elsif ( $user->supports(qw/password self_check/) ) { |
176 | |
177 | # while somewhat silly, this is to prevent code duplication |
178 | return $user->check_password($password); |
179 | |
180 | } |
181 | else { |
182 | Catalyst::Exception->throw( |
183 | "The user object $user does not support any " |
184 | . "known password authentication mechanism." ); |
185 | } |
186 | } |
187 | |
188 | __PACKAGE__; |
189 | |
190 | __END__ |
191 | |
192 | =pod |
193 | |
194 | =head1 NAME |
195 | |
196 | Catalyst::Plugin::Authentication::Credential::Password - Authenticate a user |
197 | with a password. |
198 | |
199 | =head1 SYNOPSIS |
200 | |
201 | use Catalyst qw/ |
202 | Authentication |
203 | Authentication::Store::Foo |
204 | Authentication::Credential::Password |
205 | /; |
206 | |
8d3ca09c |
207 | package MyApp::Controller::Auth; |
208 | |
209 | # *** NOTE *** |
210 | # if you place an action named 'login' in your application's root (as |
211 | # opposed to inside a controller) the following snippet will recurse, |
212 | # giving you lots of grief. |
213 | # never name actions in the root controller after plugin methods - use |
214 | # controllers and : Global instead. |
215 | |
a90296d4 |
216 | sub login : Local { |
217 | my ( $self, $c ) = @_; |
218 | |
219 | $c->login( $c->req->param('username'), $c->req->param('password') ); |
220 | } |
221 | |
222 | =head1 DESCRIPTION |
223 | |
9b09fd1c |
224 | This authentication credential checker takes a username (or userid) and a |
225 | password, and tries various methods of comparing a password based on what |
a90296d4 |
226 | the chosen store's user objects support: |
227 | |
228 | =over 4 |
229 | |
230 | =item clear text password |
231 | |
232 | If the user has clear a clear text password it will be compared directly. |
233 | |
234 | =item crypted password |
235 | |
236 | If UNIX crypt hashed passwords are supported, they will be compared using |
237 | perl's builtin C<crypt> function. |
238 | |
239 | =item hashed password |
240 | |
241 | If the user object supports hashed passwords, they will be used in conjunction |
242 | with L<Digest>. |
243 | |
244 | =back |
245 | |
246 | =head1 METHODS |
247 | |
248 | =over 4 |
249 | |
250 | =item login $username, $password |
251 | |
252 | Try to log a user in. |
253 | |
a2fcf979 |
254 | C<$username> can be a string (e.g. retrieved from a form) or an object. |
9b09fd1c |
255 | If the object is a L<Catalyst::Plugin::Authentication::User> it will be used |
a90296d4 |
256 | as is. Otherwise C<< $c->get_user >> is used to retrieve it. |
257 | |
258 | C<$password> is a string. |
259 | |
d1481e8f |
260 | If C<$username> or C<$password> are not provided, the query parameters |
9b09fd1c |
261 | C<login>, C<user>, C<username> and C<password>, C<passwd>, C<pass> will |
262 | be tried instead. |
263 | |
264 | =back |
265 | |
266 | =head1 RELATED USAGE |
267 | |
268 | After the user is logged in, the user object for the current logged in user |
269 | can be retrieved from the context using the C<< $c->user >> method. |
270 | |
271 | The current user can be logged out again by calling the C<< $c->logout >> |
272 | method. |
273 | |
a90296d4 |
274 | =head1 SUPPORTING THIS PLUGIN |
9b09fd1c |
275 | |
276 | For a User class to support credential verification using this plugin, it |
277 | needs to indicate what sort of password a given user supports |
278 | by implementing the C<supported_features> method in one or many of the |
279 | following ways: |
280 | |
a90296d4 |
281 | =head2 Clear Text Passwords |
282 | |
283 | Predicate: |
284 | |
285 | $user->supported_features(qw/password clear/); |
286 | |
287 | Expected methods: |
288 | |
289 | =over 4 |
290 | |
291 | =item password |
292 | |
293 | Returns the user's clear text password as a string to be compared with C<eq>. |
294 | |
295 | =back |
296 | |
297 | =head2 Crypted Passwords |
298 | |
299 | Predicate: |
300 | |
301 | $user->supported_features(qw/password crypted/); |
302 | |
303 | Expected methods: |
304 | |
305 | =over 4 |
306 | |
307 | =item crypted_password |
308 | |
309 | Return's the user's crypted password as a string, with the salt as the first two chars. |
310 | |
311 | =back |
312 | |
313 | =head2 Hashed Passwords |
314 | |
315 | Predicate: |
316 | |
317 | $user->supported_features(qw/password hashed/); |
318 | |
319 | Expected methods: |
320 | |
321 | =over 4 |
322 | |
323 | =item hashed_password |
324 | |
325 | Return's the hash of the user's password as B<binary>. |
326 | |
327 | =item hash_algorithm |
328 | |
329 | Returns a string suitable for feeding into L<Digest/new>. |
330 | |
331 | =item password_pre_salt |
332 | |
333 | =item password_post_salt |
334 | |
335 | Returns a string to be hashed before/after the user's password. Typically only |
336 | a pre-salt is used. |
337 | |
338 | =back |
339 | |
340 | =head2 Crypt::SaltedHash Passwords |
341 | |
342 | Predicate: |
343 | |
344 | $user->supported_features(qw/password salted_hash/); |
345 | |
346 | Expected methods: |
347 | |
348 | =over 4 |
349 | |
350 | =item hashed_password |
351 | |
352 | Returns the hash of the user's password as returned from L<Crypt-SaltedHash>->generate. |
353 | |
354 | =back |
355 | |
356 | Optional methods: |
357 | |
358 | =over 4 |
359 | |
360 | =item password_salt_len |
361 | |
362 | Returns the length of salt used to generate the salted hash. |
363 | |
364 | =back |
365 | |
366 | =cut |
367 | |
368 | |