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