File Coverage

blib/lib/Ark/Plugin/CSRFDefender.pm
Criterion Covered Total %
statement 37 37 100.0
branch 13 14 92.8
condition 3 6 50.0
subroutine 8 8 100.0
pod 2 3 66.6
total 63 68 92.6


line stmt bran cond sub pod time code
1             package Ark::Plugin::CSRFDefender;
2 4     4   1955 use strict;
  4         10  
  4         120  
3 4     4   21 use warnings;
  4         9  
  4         111  
4 4     4   20 use Ark::Plugin;
  4         9  
  4         23  
5 4     4   1942 use Data::UUID;
  4         2621  
  4         4822  
6              
7             has csrf_defender_param_name => (
8             is => 'ro',
9             isa => 'Str',
10             lazy => 1,
11             default => sub {
12             shift->class_config->{param_name} || 'csrf_token';
13             },
14             );
15              
16             has csrf_defender_session_name => (
17             is => 'ro',
18             isa => 'Str',
19             lazy => 1,
20             default => sub {
21             my $self = shift;
22             $self->class_config->{session_name} || $self->csrf_defender_param_name;
23             },
24             );
25              
26             has csrf_defender_validate_only => (
27             is => 'ro',
28             isa => 'Bool',
29             lazy => 1,
30             default => sub {
31             my $self = shift;
32             exists $self->class_config->{validate_only} ? $self->class_config->{validate_only} : undef;
33             },
34             );
35              
36             has csrf_defender_error_output => (
37             is => 'ro',
38             isa => 'Str',
39             lazy => 1,
40             default => sub {
41             shift->class_config->{error_output} || <<'...';
42             <!doctype html>
43             <html>
44             <head>
45             <title>403 Forbidden</title>
46             </head>
47             <body>
48             <h1>403 Forbidden</h1>
49             <p>
50             Session validation failed.
51             </p>
52             </body>
53             </html>
54             ...
55             }
56             );
57              
58             has csrf_defender_error_code => (
59             is => 'ro',
60             isa => 'Str',
61             lazy => 1,
62             default => sub {
63             shift->class_config->{error_code} || 403;
64             }
65             );
66              
67             has csrf_defender_error_action => (
68             is => 'ro',
69             isa => 'Str',
70             lazy => 1,
71             default => sub {
72             shift->class_config->{error_action} || '';
73             }
74             );
75              
76             has csrf_defender_filter_form => (
77             is => 'ro',
78             isa => 'Bool',
79             lazy => 1,
80             default => sub {
81             shift->class_config->{filter_form} || undef;
82             },
83             );
84              
85             my $uuid = Data::UUID->new;
86             has csrf_token => (
87             is => 'ro',
88             isa => 'Str',
89             lazy => 1,
90             default => sub {
91             my $c = shift;
92              
93             if (my $token = $c->session->get($c->csrf_defender_session_name)) {
94             return $token;
95             }
96             else {
97             my $token = $uuid->create_str;
98             $c->session->set($c->csrf_defender_session_name => $token);
99              
100             return $token;
101             }
102             },
103             predicate => '_has_csrf_token',
104             );
105              
106             sub validate_csrf_token {
107 71     71 1 222 my $c = shift;
108 71         169 my $req = $c->request;
109 71 100       155 if ($c->_is_csrf_validation_needed) {
110 48         197 my $param_token = $req->param($c->csrf_defender_param_name);
111 48         13547 my $session_token = $c->csrf_token;
112 48 100 33     294 if (!$param_token || !$session_token || ($param_token ne $session_token)) {
      66        
113 27         123 return (); # bad
114             }
115             }
116 44         164 return 1; # good
117             }
118              
119             sub forward_csrf_error {
120 12     12 0 32 my $c = shift;
121              
122 12 100       61 if ($c->csrf_defender_error_action) {
123 3         17 $c->res->code($c->csrf_defender_error_code);
124 3         26 $c->forward($c->csrf_defender_error_action);
125             }
126             else {
127 9         50 $c->res->code($c->csrf_defender_error_code);
128 9         72 $c->res->body($c->csrf_defender_error_output);
129 9         42 $c->res->header('Content-Type', 'text/html; charset=UTF-8');
130             }
131             }
132              
133             sub _is_csrf_validation_needed {
134 71     71   112 my $c = shift;
135 71         305 my $method = $c->req->method;
136 71 50       503 return () if !$method;
137              
138             return
139 71 100       296 $method eq 'POST' ? 1 :
    100          
    100          
140             $method eq 'PUT' ? 1 :
141             $method eq 'DELETE' ? 1 : ();
142             }
143              
144             sub html_filter_for_csrf {
145 14     14 1 30 my ($c, $html) = @_;
146              
147 14         68 my $reg = qr/<form\s*.*?\s*method=['"]?post['"]?\s*.*?>/i;
148 14         183 $html =~ s!($reg)!$1\n<input type="hidden" name="@{[$c->csrf_defender_param_name]}" value="@{[$c->csrf_token]}" />!isg;
  9         41  
  9         42  
149              
150 14         53 $html;
151             }
152              
153             after finalize_body => sub {
154             my $c = shift;
155              
156             return if $c->res->binary;
157             my $html = $c->res->body or return;
158             return unless $c->csrf_defender_filter_form;
159              
160             $html = $c->html_filter_for_csrf($html);
161             $c->res->body($html);
162             };
163              
164             around dispatch => sub {
165             my $orig = shift;
166             my ($c) = @_;
167              
168             # surely asign csrf_token
169             $c->csrf_token;
170             if (!$c->csrf_defender_validate_only && !$c->validate_csrf_token) {
171             $c->forward_csrf_error;
172             }
173             else {
174             $orig->(@_);
175             }
176             };
177              
178             1;
179             __END__
180              
181             =encoding utf-8
182              
183             =head1 NAME
184              
185             Ark::Plugin::CSRFDefender - CSRF Defender for Ark
186              
187             =head1 SYNOPSIS
188              
189             use Ark::Plugin::CSRFDefender;
190             # lib/MyApp.pm
191             use_plugins qw(
192             CSRFDefender
193             );
194              
195             # lib/MyApp/Controller/Root.pm
196             sub auto :Private {
197             my ($self, $c) = @_;
198              
199             if (!$c->validate_csrf_token) {
200             $self->res->code(403);
201             $self->res->body("CSRF ERROR");
202             $self->detach;
203             }
204              
205             ...;
206              
207             }
208              
209             # lib/MyApp/View/Xslate.pm
210             sub render {
211             my ($self, $template) = @_;
212             my $c = $self->context;
213              
214             my $html = $self->xslate->render($template);
215             $html = $c->html_filter_for_csrf($html);
216              
217             return $html;
218             }
219              
220             =head1 CONFIGURATIONS
221              
222             =head2 C<< filter_form >>
223              
224             =head2 C<< validate_only >>
225              
226             =head1 METHODS
227              
228             =head2 C<< $c->csrf_token -> Str >>
229              
230             =head2 C<< $c->validate_csrf_token -> Bool >>
231              
232             =head2 C<< $c->html_filter_for_csrf($html) -> Str >>
233              
234             =head1 SEE ALSO
235              
236             L<Amon2::Plugin::Web::CSRFDefender>, L<Mojolicious::Plugin::CSRFDefender>
237              
238             =cut