Improved documentation
[catagits/Catalyst-Plugin-Authentication.git] / lib / Catalyst / Plugin / Authentication / Credential / Password.pm
CommitLineData
01c50dd6 1#!/usr/bin/perl\r
2\r
3package Catalyst::Plugin::Authentication::Credential::Password;\r
4\r
5use strict;\r
6use warnings;\r
7\r
8use Scalar::Util ();\r
9use Catalyst::Exception ();\r
10use Digest ();\r
11\r
12sub 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
40sub _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
93Catalyst::Plugin::Authentication::Credential::Password - Authenticate a user\r
94with 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
112This authentication credential checker takes a user and a password, and tries\r
113various 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
119If the user has clear a clear text password it will be compared directly.\r
120\r
121=item crypted password\r
122\r
123If UNIX crypt hashed passwords are supported, they will be compared using\r
124perl's builtin C<crypt> function.\r
125\r
126=item hashed password\r
127\r
128If the user object supports hashed passwords, they will be used in conjunction\r
129with 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
141Try to log a user in.\r
142\r
143C<$user> can be an ID or object. If it isa\r
144L<Catalyst::Plugin::Authentication::User> it will be used as is. Otherwise\r
145C<< $c->get_user >> is used to retrieve it.\r
146\r
147C<$password> is a string.\r
148\r
149If C<$user> or C<$password> are not provided the parameters C<login>, C<user>,\r
150C<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
158Predicate:\r
159\r
160 $user->supports(qw/password clear/);\r
161\r
162Expected methods:\r
163\r
164=over 4\r
165\r
166=item password\r
167\r
168Returns 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
174Predicate:\r
175\r
176 $user->supports(qw/password crypted/);\r
177\r
178Expected methods:\r
179\r
180=over 4\r
181\r
182=item crypted_password\r
183\r
184Return'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
190Predicate:\r
191\r
192 $user->supports(qw/password hashed/);\r
193\r
194Expected methods:\r
195\r
196=over 4\r
197\r
198=item hashed_password\r
199\r
200Return's the hash of the user's password as B<binary>.\r
201\r
202=item hash_algorithm\r
203\r
204Returns 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
210Returns a string to be hashed before/after the user's password. Typically only\r
211a pre-salt is used.\r
212\r
fe4cf44a 213=back\r
214\r
01c50dd6 215=head2 Crypt::SaltedHash Passwords\r
216\r
217Predicate:\r
218\r
219 $user->supports(qw/password salted_hash/);\r
220\r
221Expected methods:\r
222\r
223=over 4\r
224\r
225=item hashed_password\r
226\r
227Return's the hash of the user's password as returned from L<Crypt-SaltedHash>->generate.\r
228\r
229=back\r
230\r
231Optional methods:\r
232\r
233=over 4\r
234\r
235=item password_salt_len\r
236\r
237Returns the length of salt used to generate the salted hash.\r
238\r
239=back\r
240\r
241=cut\r
242\r
243\r