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