1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
package HTML::FormHandler::Field::RequestToken;
$HTML::FormHandler::Field::RequestToken::VERSION = '0.40068';
use HTML::FormHandler::Moose;
extends 'HTML::FormHandler::Field::Hidden';
use namespace::autoclean;
use Crypt::CBC;
use MIME::Base64 qw(decode_base64 encode_base64);
use Moose::Util::TypeConstraints qw(class_type);
use Try::Tiny;
has '+required' => ( default => 1 );
has '+default_method' => ( default => sub { \&get_token });
has 'expiration_time' => (
is => 'rw',
default => 3600
);
has 'token_prefix' => (
is => 'rw',
default => ''
);
has 'crypto_key' => (
is => 'rw',
default => 'rEpLaCeMe',
);
has 'crypto_cipher_type' => (
is => 'rw',
default => 'Blowfish',
);
has 'message' => (
is => 'rw',
default => 'Form submission failed. Please try again.'
);
has 'cipher' => (
is => 'ro',
isa => class_type('Crypt::CBC'),
lazy => 1,
builder => '_build_cipher',
);
sub _build_cipher {
my ($self) = @_;
return Crypt::CBC->new(
-key => $self->crypto_key,
-cipher => $self->crypto_cipher_type,
-salt => 1,
-header => 'salt',
);
}
sub validate {
my ($self, $value) = @_;
# If it's good, return it
unless ( $self->verify_token($value) ) {
$self->add_error();
}
}
sub verify_token {
my ($self, $token) = @_;
return undef unless($token);
my $form = $self->form;
my $value = undef;
try {
$value = $self->cipher->decrypt(decode_base64($token));
if ( my $prefix = $self->token_prefix ) {
return undef unless ($value =~ s/^\Q$prefix\E//);
}
} catch {};
return undef unless defined($value);
return undef unless ( $value =~ /^\d+$/ );
return undef if ( time() > $value );
return 1;
}
sub get_token {
my $self = shift;
my $value = $self->token_prefix . (time() + $self->expiration_time);
my $token = encode_base64($self->cipher->encrypt($value));
$token =~ s/[\s\r\n]+//g;
return $token;
}
__PACKAGE__->meta->make_immutable;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
HTML::FormHandler::Field::RequestToken - Hidden text field which contains
a unique time-stamped token
=head1 VERSION
version 0.40068
=head1 SYNOPSIS
with 'HTML::FormHandler::Field::Role::RequestToken';
...
has_field '_token' => (
type => 'RequestToken',
);
=head1 DESCRIPTION
This field is for preventing CSRF attacks. It contains
an encrypted token containing an expiration time for the form.
No data needs to be persisted in the user's session or on the
server.
=head1 ATTRIBUTES
=head2 expiration_time
Length of time (in seconds) that token will be accepted as valid from
the time it is initially generated. Defaults to C<3600>.
=head2 token_prefix
An optional string to prepend to the token value before encrypting it.
If specified, any received tokens must begin with this value to be
accepted as valid. Defaults to an empty string.
Passed on form process. C<< $c->sessionid . '|' >>
=head2 crypto_key
Key to use to encrypt/decrypt the token payload.
=head2 crypto_cipher_type
The C<Crypt::CBC> cipher to use to encrypt/decrypt the token payload.
Defaults to C<Blowfish>.
=head2 message
Error message if token is missing/invalid.
=head2 cipher
A C<Crypt::CBC> object to handle encrypting/decrypting the token payload.
If not specified, L</crypto_key> and L</crypto_cipher_type> will be
used to construct one.
=head2 verify_token
Validates whether the specified token is currently valid for this form.
=head2 get_token
Generates a new token and returns it.
=head1 AUTHOR
FormHandler Contributors - see HTML::FormHandler
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2017 by Gerda Shank.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
|
