Commit | Line | Data |
01c50dd6 |
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 |
2632f048 |
19 | || return;\r |
01c50dd6 |
20 | \r |
21 | $password ||= $_->param("password")\r |
22 | || $_->param("passwd")\r |
23 | || $_->param("pass")\r |
2632f048 |
24 | || return;\r |
01c50dd6 |
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 |
2632f048 |
36 | return;\r |
01c50dd6 |
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 |
3a0c523c |
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 |
01c50dd6 |
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 |
9b09fd1c |
107 | $c->login( $c->req->param('username'), $c->req->param('password') );\r |
01c50dd6 |
108 | }\r |
109 | \r |
110 | =head1 DESCRIPTION\r |
111 | \r |
9b09fd1c |
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 |
01c50dd6 |
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 |
9b09fd1c |
138 | =item login $username, $password\r |
01c50dd6 |
139 | \r |
140 | Try to log a user in.\r |
141 | \r |
a2fcf979 |
142 | C<$username> can be a string (e.g. retrieved from a form) or an object. |
9b09fd1c |
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 |
01c50dd6 |
145 | \r |
146 | C<$password> is a string.\r |
147 | \r |
d1481e8f |
148 | If C<$username> or C<$password> are not provided, the query parameters |
9b09fd1c |
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 | |
01c50dd6 |
162 | =head1 SUPPORTING THIS PLUGIN\r |
9b09fd1c |
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 | |
01c50dd6 |
169 | =head2 Clear Text Passwords\r |
170 | \r |
171 | Predicate:\r |
172 | \r |
9b09fd1c |
173 | $user->supported_features(qw/password clear/);\r |
01c50dd6 |
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 |
9b09fd1c |
189 | $user->supported_features(qw/password crypted/);\r |
01c50dd6 |
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 |
9b09fd1c |
205 | $user->supported_features(qw/password hashed/);\r |
01c50dd6 |
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 |
fe4cf44a |
226 | =back\r |
227 | \r |
01c50dd6 |
228 | =head2 Crypt::SaltedHash Passwords\r |
229 | \r |
230 | Predicate:\r |
231 | \r |
9b09fd1c |
232 | $user->supported_features(qw/password salted_hash/);\r |
01c50dd6 |
233 | \r |
234 | Expected methods:\r |
235 | \r |
236 | =over 4\r |
237 | \r |
238 | =item hashed_password\r |
239 | \r |
9b09fd1c |
240 | Returns the hash of the user's password as returned from L<Crypt-SaltedHash>->generate.\r |
01c50dd6 |
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 |