line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package HTML::FormHandlerX::Form::Login; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
47993
|
use 5.006; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
61
|
|
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
44
|
|
6
|
1
|
|
|
1
|
|
7
|
use warnings; |
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
128
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 NAME |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
HTML::FormHandlerX::Form::Login - An HTML::FormHandler login form. |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 VERSION |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
Version 0.17 |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=cut |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our $VERSION = '0.17'; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 SYNOPSIS |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
Performs login form validation, including changing passwords, forgotten passwords, and resetting passwords. |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
If you are working under Catalyst, take a look at L<CatalystX::SimpleLogin> or L<CatalystX::Controller::Auth>. |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
Registering... |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
$form = HTML::FormHandlerX::Form::Login->new( active => [ qw( email password confirm_password ) ] ); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
$form->process( params => { email => $email, |
33
|
|
|
|
|
|
|
password => $password, |
34
|
|
|
|
|
|
|
confirm_password => $confirm_password, |
35
|
|
|
|
|
|
|
} ); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
Login with either an optional C<email> B<or> C<username> parameter. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
my $form = HTML::FormHandlerX::Form::Login->new( active => [ qw( email password ) ] ); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
$form->process( params => { email => $email, password => $password } ); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
Changing a password... |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
my $form = HTML::FormHandlerX::Form::Login->new( active => [ qw( old_password password confirm_password ) ] ); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
$form->process( params => { old_password => $old_password, |
48
|
|
|
|
|
|
|
password => $password, |
49
|
|
|
|
|
|
|
confirm_password => $confirm_password, |
50
|
|
|
|
|
|
|
} ); |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
Forgot password, just validates an C<email>, or C<username>. |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
Use this to create a C<token> to send to the user to verify their email address. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
my $form = HTML::FormHandlerX::Form::Login->new( active => [ qw( email ) ] ); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
$form->process( params => { email => $email } ); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
if ( $form->validated ) |
61
|
|
|
|
|
|
|
{ |
62
|
|
|
|
|
|
|
$form->token_salt( 'SoMeThInG R4nD0M AnD PR1V4te' ); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
my $token = $form->token; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Coming back from an email link, if the form validates, you would show the password reset form (carry the token in a hidden field or cookie). |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
$form = HTML::FormHandlerX::Form::Login->new( active => [ qw( token ) ] ); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
$form->token_salt( 'SoMeThInG R4nD0M AnD PR1V4te' ); |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
$form->process( params => { token => $token } ); |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
When trying to actually reset a password... |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
$form = HTML::FormHandlerX::Form::Login->new( active => [ qw( token password confirm_password ) ] ); |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
$form->token_salt( 'SoMeThInG R4nD0M AnD PR1V4te' ); |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
$form->process( params => { token => $token, |
82
|
|
|
|
|
|
|
password => $password, |
83
|
|
|
|
|
|
|
confirm_password => $confirm_password, |
84
|
|
|
|
|
|
|
} ); |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=head1 DESCRIPTION |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
This module will validate your forms. It does not perform any actual authentication, that is still left for you. |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=head2 Register |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
You can register with either an C<email> or C<username>. |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
Using C<email> brings in validation using L<Email::Valid>. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
C<email>/C<username>, C<password> and C<confirm_password> are all required fields, so will fail validation if empty. |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
my $form = HTML::FormHandlerX::Form::Login->new( active => [ qw( email password confirm_password ) ] ); |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
$form->process( params => { email => $email, password => $password, confirm_password => $confirm_password } ); |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=head2 Login |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
You can choose between an optional C<email> and C<username> for the unique identifier. |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
Using C<email> brings in validation using L<Email::Valid>. |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
my $form = HTML::FormHandlerX::Form::Login->new( active => [ qw( email password ) ] ); |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
$form->process( params => { email => $email, password => $password } ); |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head2 Change Password |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
Instantiate the form by activating the 3 fields: C<old_password>, C<password>, and C<confirm_password>. |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
All 3 fields are required, and validation will also check the C<confirm_password> matches the C<password>. |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
my $form = HTML::FormHandlerX::Form::Login->new( active => [ qw( old_password password confirm_password ) ] ); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
$form->process( params => { old_password => $old_password, |
121
|
|
|
|
|
|
|
password => $password, |
122
|
|
|
|
|
|
|
confirm_password => $confirm_password, |
123
|
|
|
|
|
|
|
} ); |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
if ( $form->validated ) { } |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=head2 Forgot Password |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
Provide the C<email> B<or> C<username> to validate, the form will then have a C<token> for you. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
You can then send this C<token> to the user via email to verify their identity. |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
You need to supply a (private) C<token_salt> to make sure your C<token>s are not guessable. This can be anything you like. |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
Tokens expire by default after 24 hours from the date/time of issue. To change |
136
|
|
|
|
|
|
|
this, either supply an epoch timestamp of when to expire, or give a human-friendly format of how long to wait. We like things like: |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
2h - 2 hours |
139
|
|
|
|
|
|
|
3d - 3 days |
140
|
|
|
|
|
|
|
4w - 4 weeks |
141
|
|
|
|
|
|
|
5m - 5 months |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
If you specify C<add_token_field> the value of this field in the form will be included in the token. This can be useful when the token is sent back, to identify the user. |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
my $form = HTML::FormHandlerX::Form::Login->new( active => [ qw( email ) ] ); |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
$form->process( params => { email => $email } ); |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
if ( $form->validated ) |
150
|
|
|
|
|
|
|
{ |
151
|
|
|
|
|
|
|
$form->token_salt( 'SoMeThInG R4nD0M AnD PR1V4te' ); |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
$form->add_token_field( 'email' ); |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
$form->token_expires( '3h' ); |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
my $token = $form->token; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
The token is comprised of a L<Digest::SHA> hash, so can be a tad long, but has much less chance of collisions compared to an MD5. |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=head2 Reset Password - Stage 1 |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
You will usually give the token to the user in an email so they can verify they own the email address. |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
This step is for just showing the user a reset-password form. |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
The first step when the user comes back to reset their password, is to check they have not fiddled with the token. |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
You can safely skip this step, we check the token again when they/you actually try to change the password, this just lets you stop them in their tracks a little sooner. |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
Setting the C<token_salt> is required, and must obviously be the same C<salt> as used in the forgot-password call. |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
C<add_token_field> as you did during the forgot-password process. This will populate the unique identifier field for you. |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
$form = HTML::FormHandlerX::Form::Login->new( active => [ qw( token ) ] ); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
$form->token_salt( 'SoMeThInG R4nD0M AnD PR1V4te' ); |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
$form->add_token_field( 'email' ); |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
$form->process( params => { token => $token } ); |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
if ( $form->validated ) { } |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=head2 Reset Password - Stage 2 |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
You have now shown the user a form to enter a new password (and confirm it). |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
Either hidden in that form, or as a cookie, you have also stored the token. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
$form = HTML::FormHandlerX::Form::Login->new( active => [ qw( token password confirm_password ) ] ); |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
$form->token_salt( 'SoMeThInG R4nD0M AnD PR1V4te' ); |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
$form->add_token_field( 'email' ); |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
$form->process( params => { token => $token, |
199
|
|
|
|
|
|
|
password => $password, |
200
|
|
|
|
|
|
|
confirm_password => $confirm_password, |
201
|
|
|
|
|
|
|
} ); |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
if ( $form->validated ) { } |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
If you specified the C<token_field> as C<email>, you can now collect that from the form as the record to update safely. |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
$form->field( 'email' )->value; |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
And now know which user to update. |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=cut |
212
|
|
|
|
|
|
|
|
213
|
1
|
|
|
1
|
|
583
|
use HTML::FormHandler::Moose; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
extends 'HTML::FormHandler'; |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
use Digest::SHA qw( sha512_hex ); |
218
|
|
|
|
|
|
|
use Email::Valid; |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=head1 METHODS |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=head2 Attributes |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=head3 token |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
$form->token |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Returns a unique string for the C<email> or C<username> validated by the form. |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
You typically send this to the users email. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=cut |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
has token => ( is => 'rw', isa => 'Str', lazy_build => 1 ); |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=head3 token_fields |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
$form->add_token_field( 'email' ); |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
Specifies which fields to include in the token for you to identify which user it is trying to reset their password when they come back. |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
Either C<email> or C<username> is normal. |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=cut |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
has _token_fields => ( is => 'rw', |
247
|
|
|
|
|
|
|
isa => 'ArrayRef[Str]', |
248
|
|
|
|
|
|
|
default => sub { [] }, |
249
|
|
|
|
|
|
|
traits => ['Array'], |
250
|
|
|
|
|
|
|
handles => { token_fields => 'elements', |
251
|
|
|
|
|
|
|
add_token_field => 'push', |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
); |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=head3 token_salt |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
$form->token_salt |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
Your own (random string) salt used to create the reset-password token. |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=cut |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
has token_salt => ( is => 'rw', isa => 'Str', default => '' ); |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=head3 token_expires |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
$form->token_expires |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
Dictates how long the token is valid for, default is 1 day. |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
Possible formats are 2h, 3d, 6w, 1m, or an epoch timestamp. |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=cut |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
has token_expires => ( is => 'rw', isa => 'Int', default => 86400 ); # 1 day |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=head2 Fields |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=head3 token |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
$form->field('token') |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
This field is used when attempting to reset a password. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=cut |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
has_field token => ( type => 'Hidden', |
288
|
|
|
|
|
|
|
required => 1, |
289
|
|
|
|
|
|
|
messages => { required => "Missing token." }, |
290
|
|
|
|
|
|
|
wrapper_attr => { id => 'field-token', }, |
291
|
|
|
|
|
|
|
tags => { no_errors => 1 }, |
292
|
|
|
|
|
|
|
inactive => 1, |
293
|
|
|
|
|
|
|
); |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=head3 email / username / openid_identifier |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
$form->field('email') |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
$form->field('username') |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
$form->field('openid_identifier') |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
The C<openid_identifier> field used by L<Catalyst::Authentication::Credential::OpenID> for OpenID logins, C<username> field, or use the specific C<email> field for extra validation (employing Email::Valid). |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=cut |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
has_field email => ( type => 'Email', |
308
|
|
|
|
|
|
|
required => 1, |
309
|
|
|
|
|
|
|
messages => { required => 'Your email is required.' }, |
310
|
|
|
|
|
|
|
tags => { no_errors => 1 }, |
311
|
|
|
|
|
|
|
wrapper_attr => { id => 'field-email' }, |
312
|
|
|
|
|
|
|
inactive => 1, |
313
|
|
|
|
|
|
|
); |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
has_field username => ( type => 'Text', |
316
|
|
|
|
|
|
|
required => 1, |
317
|
|
|
|
|
|
|
messages => { required => 'Your username is required.' }, |
318
|
|
|
|
|
|
|
tags => { no_errors => 1 }, |
319
|
|
|
|
|
|
|
wrapper_attr => { id => 'field-username' }, |
320
|
|
|
|
|
|
|
inactive => 1, |
321
|
|
|
|
|
|
|
); |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
has_field openid_identifier => ( type => 'Text', |
324
|
|
|
|
|
|
|
required => 1, |
325
|
|
|
|
|
|
|
messages => { required => 'Your openid is required.' }, |
326
|
|
|
|
|
|
|
tags => { no_errors => 1 }, |
327
|
|
|
|
|
|
|
wrapper_attr => { id => 'field-openid-identifer' }, |
328
|
|
|
|
|
|
|
inactive => 1, |
329
|
|
|
|
|
|
|
); |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
=head3 old_password |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
$form->field('old_password') |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
Required when changing a known password. |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
C<HTML::FormHandler> has a built-in length restriction for C<password> fields of 6-characters, we drop that to 1-character, it is up to you to come with your own rules. |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
=cut |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
has_field old_password => ( type => 'Password', |
342
|
|
|
|
|
|
|
minlength => 1, |
343
|
|
|
|
|
|
|
required => 1, |
344
|
|
|
|
|
|
|
messages => { required => "Your old password is required." }, |
345
|
|
|
|
|
|
|
tags => { no_errors => 1 }, |
346
|
|
|
|
|
|
|
wrapper_attr => { id => 'field-old-password', }, |
347
|
|
|
|
|
|
|
inactive => 1, |
348
|
|
|
|
|
|
|
); |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=head3 password |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
$form->field('password') |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
Used for logging in, changing and/or resetting a password to something new. |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
C<HTML::FormHandler> has a built-in length restriction for C<password> fields of 6-characters, we drop that to 1-character, it is up to you to come with your own rules. |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
=cut |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
has_field password => ( type => 'Password', |
361
|
|
|
|
|
|
|
minlength => 1, |
362
|
|
|
|
|
|
|
required => 1, |
363
|
|
|
|
|
|
|
messages => { required => "Your password is required." }, |
364
|
|
|
|
|
|
|
tags => { no_errors => 1 }, |
365
|
|
|
|
|
|
|
wrapper_attr => { id => 'field-password', }, |
366
|
|
|
|
|
|
|
inactive => 1, |
367
|
|
|
|
|
|
|
); |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
=head3 confirm_password |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
$form->field('confirm_password') |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
Required for changing and/or resetting the password. |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=cut |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
has_field confirm_password => ( type => 'PasswordConf', |
378
|
|
|
|
|
|
|
required => 1, |
379
|
|
|
|
|
|
|
password_field => 'password', |
380
|
|
|
|
|
|
|
messages => { required => "You must confirm your password." }, |
381
|
|
|
|
|
|
|
tags => { no_errors => 1 }, |
382
|
|
|
|
|
|
|
wrapper_attr => { id => 'field-confirm-password', }, |
383
|
|
|
|
|
|
|
inactive => 1, |
384
|
|
|
|
|
|
|
); |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
=head3 remember |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
$form->field('remember') |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
Useful for a "remember me" checkbox. |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=cut |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
has_field remember => ( type => 'Checkbox', |
395
|
|
|
|
|
|
|
tags => { no_errors => 1 }, |
396
|
|
|
|
|
|
|
wrapper_attr => { id => 'field-remember', }, |
397
|
|
|
|
|
|
|
inactive => 1, |
398
|
|
|
|
|
|
|
); |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=head3 submit |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
$form->field('submit') |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
The submit button. |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=cut |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
has_field submit => ( type => 'Submit', |
409
|
|
|
|
|
|
|
value => '', |
410
|
|
|
|
|
|
|
wrapper_attr => { id => 'field-submit', }, |
411
|
|
|
|
|
|
|
); |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
=head2 Validation |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=head3 validate_token |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
The internal validation of the token when attempting to reset a password. |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
=cut |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
sub validate_token |
422
|
|
|
|
|
|
|
{ |
423
|
|
|
|
|
|
|
my ( $self, $field ) = @_; |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
my @token_parts = split( ':', $field->value ); |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
my $token = pop @token_parts; |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
if ( $token ne sha512_hex( $self->token_salt . join( '', @token_parts ) ) ) |
430
|
|
|
|
|
|
|
{ |
431
|
|
|
|
|
|
|
$field->add_error("Invalid token."); |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
my $time = pop @token_parts; |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
if ( time > $time ) |
437
|
|
|
|
|
|
|
{ |
438
|
|
|
|
|
|
|
$field->add_error("Expired token."); |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=head3 html_attributes |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
This method has been populated to ensure all fields in error have the C<error> CSS class assigned to the labels. |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
=cut |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
sub html_attributes |
449
|
|
|
|
|
|
|
{ |
450
|
|
|
|
|
|
|
my ($self, $field, $type, $attr, $result) = @_; |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
if( $type eq 'label' && $result->has_errors ) |
453
|
|
|
|
|
|
|
{ |
454
|
|
|
|
|
|
|
push @{$attr->{class}}, 'error'; |
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
after build_active => sub { |
459
|
|
|
|
|
|
|
my $self = shift; |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
if ( ( $self->field('email')->is_active || $self->field('username')->is_active ) && $self->field('password')->is_active && $self->field('confirm_password')->is_active ) |
462
|
|
|
|
|
|
|
{ |
463
|
|
|
|
|
|
|
$self->field('submit')->value('Register'); |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
elsif ( ( $self->field('password')->is_active && ! $self->field('confirm_password')->is_active ) || $self->field('openid_identifier')->is_active ) |
466
|
|
|
|
|
|
|
{ |
467
|
|
|
|
|
|
|
$self->field('submit')->value('Login'); |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
elsif ( ( $self->field('email')->is_active || $self->field('username')->is_active ) && ! $self->field('password')->is_active && ! $self->field('token')->is_active ) |
470
|
|
|
|
|
|
|
{ |
471
|
|
|
|
|
|
|
$self->field('submit')->value('Forgot Password'); |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
elsif ( $self->field('old_password')->is_active && $self->field('password')->is_active && $self->field('confirm_password')->is_active ) |
474
|
|
|
|
|
|
|
{ |
475
|
|
|
|
|
|
|
$self->field('password')->label('New Password'); |
476
|
|
|
|
|
|
|
$self->field('submit')->value('Change Password'); |
477
|
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
|
elsif ( $self->field('token')->is_active ) |
479
|
|
|
|
|
|
|
{ |
480
|
|
|
|
|
|
|
$self->field('password')->label('New Password'); |
481
|
|
|
|
|
|
|
$self->field('submit')->value('Reset Password'); |
482
|
|
|
|
|
|
|
} |
483
|
|
|
|
|
|
|
}; |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
around token_expires => sub { |
486
|
|
|
|
|
|
|
my $orig = shift; |
487
|
|
|
|
|
|
|
my $self = shift; |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
if ( my $arg = shift ) |
490
|
|
|
|
|
|
|
{ |
491
|
|
|
|
|
|
|
if ( $arg =~ /(\d+)h/i ) |
492
|
|
|
|
|
|
|
{ |
493
|
|
|
|
|
|
|
$arg = $1 * 3600; |
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
elsif ( $arg =~ /(\d+)d/i ) |
496
|
|
|
|
|
|
|
{ |
497
|
|
|
|
|
|
|
$arg = $1 * 86400; |
498
|
|
|
|
|
|
|
} |
499
|
|
|
|
|
|
|
elsif ( $arg =~ /(\d+)w/i ) |
500
|
|
|
|
|
|
|
{ |
501
|
|
|
|
|
|
|
$arg = $1 * 604800; |
502
|
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
|
elsif ( $arg =~ /(\d+)m/i ) |
504
|
|
|
|
|
|
|
{ |
505
|
|
|
|
|
|
|
$arg = $1 * 2629743; |
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
return $self->$orig( $arg ); |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
return $self->$orig; |
512
|
|
|
|
|
|
|
}; |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
sub _build_token |
515
|
|
|
|
|
|
|
{ |
516
|
|
|
|
|
|
|
my $self = shift; |
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
return '' if $self->token_salt eq ''; # no salt, no token |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
my $time = time + $self->token_expires; |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
my @field_value_list = map { $self->field( $_ )->value } $self->token_fields; |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
my $token = join( ':', @field_value_list, $time, sha512_hex( $self->token_salt . join( '', @field_value_list ) . $time ) ); |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
return $token; |
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
sub _munge_params |
530
|
|
|
|
|
|
|
{ |
531
|
|
|
|
|
|
|
my ( $self, $params ) = @_; |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
if ( exists $params->{ token } ) |
534
|
|
|
|
|
|
|
{ |
535
|
|
|
|
|
|
|
# the order is drastically important |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
my @token_parts = split( ':', $params->{ token } ); |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
foreach my $field ( $self->token_fields ) |
540
|
|
|
|
|
|
|
{ |
541
|
|
|
|
|
|
|
$self->field( $field )->inactive(0); |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
$params->{ $field } = shift @token_parts; |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
$self->next::method( $params ); |
548
|
|
|
|
|
|
|
} |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
=head1 RENDERING |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
This form does some subtle rendering tricks, renaming buttons and labels based on which fields are active. |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
=head1 TODO |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
Look at password type fields, pre-set char-length, etc. and/or import types from HTML::FormHandler directly. |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
=head1 AUTHOR |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
Rob Brown, C<< <rob at intelcompute.com> >> |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
=head1 BUGS |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
Please report any bugs or feature requests to C<bug-html-formhandlerx-form-login at rt.cpan.org>, or through |
565
|
|
|
|
|
|
|
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=HTML-FormHandlerX-Form-Login>. I will be notified, and then you will |
566
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
=head1 SUPPORT |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
perldoc HTML::FormHandlerX::Form::Login |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
You can also look for information at: |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
=over 4 |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=HTML-FormHandlerX-Form-Login> |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
L<http://annocpan.org/dist/HTML-FormHandlerX-Form-Login> |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
=item * CPAN Ratings |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/HTML-FormHandlerX-Form-Login> |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
=item * Search CPAN |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
L<http://search.cpan.org/dist/HTML-FormHandlerX-Form-Login/> |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
=back |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
gshank: Gerda Shank E<lt>gshank@cpan.orgE<gt> |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
t0m: Tomas Doran E<lt>bobtfish@bobtfish.netE<gt> |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
castaway: Jess Robinson (OpenID support) |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
Copyright 2012 Rob Brown. |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
612
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
613
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information. |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
=cut |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
1; # End of HTML::FormHandlerX::Form::Login |