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