1package HTML::FormFu::Element::RequestToken;
2
3use strict;
4
5our $VERSION = '2.04'; # VERSION
6our $AUTHORITY = 'cpan:NIGELM'; # AUTHORITY
7
8use Moose;
9use MooseX::Attribute::Chained;
10
11extends 'HTML::FormFu::Element::Text';
12
13use HTML::FormFu::Util qw( process_attrs );
14use Carp qw( croak );
15
16has expiration_time => ( is => 'rw', traits  => ['Chained'], default => 3600 );
17has session_key     => ( is => 'rw', traits  => ['Chained'], default => '__token' );
18has context         => ( is => 'rw', traits  => ['Chained'], default => 'context' );
19has limit           => ( is => 'rw', traits  => ['Chained'], default => 20 );
20has message         => ( is => 'rw', traits  => ['Chained'], default => 'Form submission failed. Please try again.' );
21
22after BUILD => sub {
23    my $self = shift;
24    $self->name('_token');
25    $self->constraints( [qw(RequestToken Required)] );
26    $self->field_type('hidden');
27};
28
29sub process_value {
30    my ( $self, $value ) = @_;
31
32    return $self->verify_token($value)
33        ? $value
34        : $self->value( $self->get_token )->value;
35}
36
37sub verify_token {
38    my ( $self, $token ) = @_;
39
40    return unless ($token);
41
42    my $form = $self->form;
43
44    croak "verify_token() can only be called if form has been submitted"
45        if !$form->submitted;
46
47    my $field_name = $self->name;
48
49    my $c = $self->form->stash->{ $self->context };
50
51    for ( @{ $c->session->{ $self->session_key } || [] } ) {
52        return 1 if ( $_->[0] eq $token );
53    }
54
55    return;
56}
57
58sub expire_token {
59    my ($self) = @_;
60
61    my $c = $self->form->stash->{ $self->context };
62
63    my @token;
64    for ( @{ $c->session->{ $self->session_key } || [] } ) {
65        push( @token, $_ ) if ( $_->[1] > time );
66    }
67
68    @token = splice( @token, -$self->limit, $self->limit ) if ( @token > $self->limit );
69
70    $c->session->{ $self->session_key } = \@token;
71}
72
73sub get_token {
74    my ($self) = @_;
75
76    my $token;
77    my $c = $self->form->stash->{ $self->context };
78    my @chars = ( 'a' .. 'z', 0 .. 9 );
79
80    $token .= $chars[ int( rand() * 36 ) ] for ( 0 .. 15 );
81
82    $c->session->{ $self->session_key } ||= [];
83
84    push @{ $c->session->{ $self->session_key } }, [ $token, time + $self->expiration_time ];
85
86    $self->expire_token;
87
88    return $token;
89}
90
911;
92
93__END__
94
95=pod
96
97=encoding UTF-8
98
99=head1 NAME
100
101HTML::FormFu::Element::RequestToken
102
103=head1 VERSION
104
105version 2.04
106
107=head1 SYNOPSIS
108
109  my $e = $form->element( { type => 'Token' } );
110
111  my $p = $form->element( { plugin => 'Token' } );
112
113=head1 DESCRIPTION
114
115This field can prevent CSRF attacks. It contains a random token. After
116submission the token is checked with the token which is stored in the session
117of the current user. See
118L<Catalyst::Controller::HTML::FormFu/"request_token_enable"> for a convenient
119way how to use it.
120
121=head1 NAME
122
123HTML::FormFu::Element::RequestToken - Hidden text field which contains a unique
124token
125
126=head1 ATTRIBUTES
127
128=head2 context
129
130Value of the stash key for the Catalyst context object (C<< $c >>). Defaults to
131C<context>.
132
133=head2 expiration_time
134
135Time to life for a token in seconds. Defaults to C<3600>.
136
137=head2 session_key
138
139Session key which is used to store the tokens. Defaults to C<__token>.
140
141=head2 limit
142
143Limit the number of tokens which are kept in the session. Defaults to 20.
144
145=head2 constraints
146
147Defaults to L<HTML::FormFu::Constraint::RequestToken> and
148L<HTML::FormFu::Constraint::Required>.
149
150=head2 message
151
152Set the error message.
153
154=head1 METHODS
155
156=head2 expire_token
157
158This method looks in the session for expired tokens and removes them.
159
160=head2 get_token
161
162Generates a new token and stores it in the stash.
163
164=head2 verify_token
165
166Checks whether a given token is already in the session. Returns C<1> if it
167exists, C<0> otherwise.
168
169=head1 SEE ALSO
170
171L<Catalyst::Controller::HTML::FormFu>, L<HTML::FormFu::Plugin::RequestToken>,
172L<HTML::FormFu::Constraint::RequestToken>
173
174L<HTML::FormFu>
175
176=head1 AUTHOR
177
178Moritz Onken, C<onken@houseofdesign.de>
179
180=head1 LICENSE
181
182This library is free software, you can redistribute it and/or modify it under
183the same terms as Perl itself.
184
185=head1 AUTHORS
186
187=over 4
188
189=item *
190
191Carl Franks <cpan@fireartist.com>
192
193=item *
194
195Nigel Metheringham <nigelm@cpan.org>
196
197=item *
198
199Dean Hamstead <dean@bytefoundry.com.au>
200
201=back
202
203=head1 COPYRIGHT AND LICENSE
204
205This software is copyright (c) 2007-2018 by Carl Franks / Nigel Metheringham / Dean Hamstead.
206
207This is free software; you can redistribute it and/or modify it under
208the same terms as the Perl 5 programming language system itself.
209
210=cut
211