root/lang/perl/Catalyst-Plugin-RequestToken/trunk/lib/Catalyst/Plugin/RequestToken.pm @ 3541

Revision 3541, 5.4 kB (checked in by tokuhirom, 6 years ago)

lang/perl/Catalyst-Plugin-RequestToken?: maybe s/FillForm/FillInForm/;

Line 
1package Catalyst::Plugin::RequestToken;
2
3use strict;
4use warnings;
5
6use NEXT;
7use Catalyst::Exception ();
8use Digest();
9use overload();
10
11our $VERSION = '0.05';
12
13sub setup {
14    my $c = shift;
15
16    $c->config->{token}->{session_name} ||= 'token';
17    $c->config->{token}->{request_name} ||= 'token';
18       
19    return $c->NEXT::setup(@_);
20}
21
22sub finalize {
23    my $c = shift;
24
25    if ( $c->{_prepare_token} ) {
26        $c->{_prepare_token} = undef;
27        my $name  = $c->config->{token}->{request_name};
28        my $token = $c->create_token;
29        my $body  = $c->response->{body};
30        $body =~ s/(<form\s*.*?>)/$1\n<input type="hidden" name="$name" value="$token">/isg;
31        $c->response->output($body);
32    }
33
34    return $c->NEXT::finalize(@_);
35}
36
37sub prepare_token {
38    my $c = shift;
39
40    $c->{_prepare_token} = 1;
41}
42
43my $counter;
44
45sub create_token {
46    my $c = shift;
47
48    my $digest = $c->_find_digest();
49    my $seed = join("", ++$counter, time, rand, $$, {}, overload::StrVal($c));
50    $digest->add( $seed );
51    my $token = $digest->hexdigest;
52    $c->log->debug("start create token : $token") if $c->debug;
53    $c->session->{$c->config->{token}->{session_name}} = $token;
54    $c->req->params->{ $c->config->{token}->{request_name} } = $token;
55    return $token;
56}
57
58sub remove_token {
59    my $c = shift;
60
61    undef $c->session->{$c->config->{token}->{session_name}};
62}
63
64sub validate_token {
65    my $c = shift;
66
67    my $session = $c->session->{$c->config->{token}->{session_name}};
68    my $request = $c->req->param($c->config->{token}->{request_name});
69
70    my $res;
71    if ($session && $request) {
72        $res = $session eq $request;
73    }
74    if ($c->isa('Catalyst::Plugin::FormValidator::Simple') && !defined($res)) {
75        $c->set_invalid_form($c->config->{token}->{request_name} => 'TOKEN');
76    }
77    return $res;
78}
79
80# following code is from Catalyst::Plugin::Session
81my $usable;
82
83sub _find_digest () {
84    unless ($usable) {
85        foreach my $alg (qw/SHA-1 SHA-256 MD5/) {
86            if ( eval { Digest->new($alg) } ) {
87                $usable = $alg;
88                last;
89            }
90        }
91        Catalyst::Exception->throw(
92                "Could not find a suitable Digest module. Please install "
93              . "Digest::SHA1, Digest::SHA, or Digest::MD5" )
94          unless $usable;
95    }
96
97    return Digest->new($usable);
98}
99
1001;
101__END__
102
103=head1 NAME
104
105Catalyst::Plugin::RequestToken - Handling transaction token for Catalyst
106
107
108=head1 SYNOPSIS
109
110in your application class:
111
112    use Catalyst qw/
113        Session
114        Session::State::Cookie
115        Session::Store::FastMmap
116        RequestToken
117        FillInForm
118    /;
119
120in your contoller class:
121   
122    sub input : Local {
123        my ( $self, $c ) = @_;
124
125        $c->stash->{template} = 'input.tt';
126        $c->forward($c->view('TT'));
127    }
128
129    sub confirm : Local {
130        my ( $self, $c ) = @_;
131
132        $c->create_token;
133        $c->stash->{template} = 'confirm.tt';
134        $c->forward($c->view('TT'));
135        $c->fillform;
136    }
137
138    sub complete : Local {
139        my ( $self, $c ) = @_;
140
141        if ($c->validate_token) {
142            $c->res->output('Complete');
143        } else {
144            $c->res->output('Invalid Token');
145        }
146        $c->remove_token;
147    }
148
149F<root/input.tt> TT template:
150
151    <html>
152    <body>
153    <form action="confirm" method="post">
154    <input type="submit" name="submit" value="confirm"/>
155    </form>
156    </body>
157    </html>
158
159F<root/confirm.tt> TT template:
160
161    <html>
162    <body>
163    <form action="complete" method="post">
164    <input type="hidden" name="token"/>
165    <input type="submit" name="submit" value="complete"/>
166    </form>
167    </body>
168    </html>
169
170or you can call prepare_token instead of a bunch of methods.
171And you don't have to write '<input type="hidden" name="token"... >' for token in your template.
172
173    sub input : Local {
174        my ( $self, $c ) = @_;
175
176        $c->stash->{template} = 'input.tt';
177        $c->prepare_token;
178    }
179
180if you loaded L<Catalyst::Plugin::FormValidator::Simple> and fail to validate token, C::P::FormValidator::Simple->set_invalid_form will call automatically in validate_token method (constraint name is 'TOKEN').
181
182    sub complete : Local {
183        my ( $self, $c ) = @_;
184
185        $c->form(
186            name => [qw/NOT_BLANK ASCII/]
187            ...
188        );
189
190        $c->validate_token;
191       
192        my $result = $c->form;
193       
194        if ( $result->has_error) {
195            $c->res->body('Error');
196        } else {
197            $c->res->body('Success');
198        }
199    }
200
201
202=head1 DESCRIPTION
203
204This plugin create, remove and validate transaction token, to be used for enforcing a single request for some transaction, for exapmle, you can prevent duplicate submits.
205
206Note:
207REQUIRES a session plugin like L<Catalyst::Plugin::Session> to store server side token.
208
209
210=head1 METHODS
211
212=over 4
213
214=item prepare_token
215
216automatically append token hidden tag to response body.
217
218=item create_token
219
220Create new token, it uses SHA-1, MD5 or SHA-256, depending on the availibility of these modules.
221
222=item remove_token
223
224Remove token from server side session.
225
226=item validate_token
227
228Validate token.
229
230=back
231
232
233=head1 SEE ALSO
234
235L<Catalyst>, L<Catalyst::Plugin::Session>, L<Catalyst::Plugin::FormValidator::Simple>
236
237
238=head1 AUTHOR
239
240Hideo Kimura C<< <<hide@hide-k.net>> >>
241
242
243=head1 LICENSE
244
245This program is free software; you can redistribute
246it and/or modify it under the same terms as Perl itself.
247
248The full text of the license can be found in the
249LICENSE file included with this module.
250
251
252
253=cut
Note: See TracBrowser for help on using the browser.