Commit | Line | Data |
7d0922d8 |
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 { |
b003080b |
13 | my ( $c, $user, $password ) = @_; |
712a35bf |
14 | |
15 | for ( $c->request ) { |
16 | $user ||= $_->param("login") |
97d31660 |
17 | || $_->param("user") |
18 | || $_->param("username") |
712a35bf |
19 | || Catalyst::Exception->throw("Can't determine username for login"); |
20 | |
21 | $password ||= $_->param("password") |
97d31660 |
22 | || $_->param("passwd") |
23 | || $_->param("pass") |
712a35bf |
24 | || Catalyst::Exception->throw("Can't determine password for login"); |
25 | } |
26 | |
0c4ddd06 |
27 | $user = $c->get_user($user) || return |
7d0922d8 |
28 | unless Scalar::Util::blessed($user) |
29 | and $user->isa("Catalyst:::Plugin::Authentication::User"); |
30 | |
31 | if ( $c->_check_password( $user, $password ) ) { |
32 | $c->set_authenticated($user); |
33 | return 1; |
34 | } |
35 | else { |
36 | return undef; |
37 | } |
38 | } |
39 | |
40 | sub _check_password { |
41 | my ( $c, $user, $password ) = @_; |
42 | |
43 | if ( $user->supports(qw/password clear/) ) { |
44 | return $user->password eq $password; |
45 | } |
46 | elsif ( $user->supports(qw/password crypted/) ) { |
47 | my $crypted = $user->crypted_password; |
48 | return $crypted eq crypt( $password, $crypted ); |
49 | } |
50 | elsif ( $user->supports(qw/password hashed/) ) { |
51 | my $d = Digest->new( $user->hash_algorithm ); |
52 | $d->add( $user->password_pre_salt || '' ); |
53 | $d->add($password); |
54 | $d->add( $user->password_post_salt || '' ); |
b003080b |
55 | return $d->digest eq $user->hashed_password; |
7d0922d8 |
56 | } |
6c8b6e5e |
57 | elsif ( $user->supports(qw/password self_check/) ) { |
712a35bf |
58 | |
59 | # while somewhat silly, this is to prevent code duplication |
60 | return $user->check_password($password); |
6c8b6e5e |
61 | } |
7d0922d8 |
62 | else { |
63 | Catalyst::Exception->throw( |
64 | "The user object $user does not support any " |
65 | . "known password authentication mechanism." ); |
66 | } |
67 | } |
68 | |
69 | __PACKAGE__; |
70 | |
71 | __END__ |
72 | |
73 | =pod |
74 | |
75 | =head1 NAME |
76 | |
712a35bf |
77 | Catalyst::Plugin::Authentication::Credential::Password - Authenticate a user |
7d0922d8 |
78 | with a password. |
79 | |
80 | =head1 SYNOPSIS |
81 | |
82 | use Catalyst qw/ |
83 | Authentication |
84 | Authentication::Store::Foo |
85 | Authentication::Credential::Password |
86 | /; |
87 | |
88 | sub login : Local { |
89 | my ( $self, $c ) = @_; |
90 | |
91 | $c->login( $c->req->param('login'), $c->req->param('password') ); |
92 | } |
93 | |
94 | =head1 DESCRIPTION |
95 | |
96 | This authentication credential checker takes a user and a password, and tries |
97 | various methods of comparing a password based on what the user supports: |
98 | |
99 | =over 4 |
100 | |
101 | =item clear text password |
102 | |
103 | If the user has clear a clear text password it will be compared directly. |
104 | |
105 | =item crypted password |
106 | |
107 | If UNIX crypt hashed passwords are supported, they will be compared using |
108 | perl's builtin C<crypt> function. |
109 | |
110 | =item hashed password |
111 | |
112 | If the user object supports hashed passwords, they will be used in conjunction |
113 | with L<Digest>. |
114 | |
115 | =back |
116 | |
117 | =head1 METHODS |
118 | |
119 | =over 4 |
120 | |
121 | =item login $user, $password |
122 | |
712a35bf |
123 | =item login |
124 | |
7d0922d8 |
125 | Try to log a user in. |
126 | |
712a35bf |
127 | C<$user> can be an ID or object. If it isa |
128 | L<Catalyst::Plugin::Authentication::User> it will be used as is. Otherwise |
7d0922d8 |
129 | C<< $c->get_user >> is used to retrieve it. |
130 | |
712a35bf |
131 | C<$password> is a string. |
132 | |
133 | If C<$user> or C<$password> are not provided the parameters C<login>, C<user>, |
134 | C<username> and C<password>, C<passwd>, C<pass> will be tried instead. |
7d0922d8 |
135 | |
136 | =back |
137 | |
b003080b |
138 | =head1 SUPPORTING THIS PLUGIN |
139 | |
140 | =head2 Clear Text Passwords |
141 | |
142 | Predicate: |
143 | |
144 | $user->supports(qw/password clear/); |
145 | |
146 | Expected methods: |
147 | |
148 | =over 4 |
149 | |
150 | =item password |
151 | |
152 | Returns the user's clear text password as a string to be compared with C<eq>. |
153 | |
154 | =back |
155 | |
156 | =head2 Crypted Passwords |
157 | |
158 | Predicate: |
159 | |
160 | $user->supports(qw/password crypted/); |
161 | |
162 | Expected methods: |
163 | |
164 | =over 4 |
165 | |
166 | =item crypted_password |
167 | |
168 | Return's the user's crypted password as a string, with the salt as the first two chars. |
169 | |
170 | =back |
171 | |
172 | =head2 Hashed Passwords |
173 | |
174 | Predicate: |
175 | |
176 | $user->supports(qw/password hashed/); |
177 | |
178 | Expected methods: |
179 | |
180 | =over 4 |
181 | |
182 | =item hashed_passwords |
183 | |
184 | Return's the hash of the user's password as B<binary>. |
185 | |
186 | =item hash_algorithm |
187 | |
188 | Returns a string suitable for feeding into L<Digest/new>. |
189 | |
190 | =item password_pre_salt |
191 | |
192 | =item password_post_salt |
193 | |
194 | Returns a string to be hashed before/after the user's password. Typically only |
195 | a pre-salt is used. |
196 | |
197 | =back |
198 | |
7d0922d8 |
199 | =cut |
200 | |
201 | |