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