File Coverage

blib/lib/Plack/Middleware/LimitRequest.pm
Criterion Covered Total %
statement 53 53 100.0
branch 27 30 90.0
condition 3 6 50.0
subroutine 9 9 100.0
pod 2 3 66.6
total 94 101 93.0


line stmt bran cond sub pod time code
1             package Plack::Middleware::LimitRequest;
2              
3 5     5   2247 use strict;
  5         10  
  5         160  
4 5     5   22 use warnings;
  5         7  
  5         118  
5 5     5   82 use 5.008_001;
  5         12  
  5         140  
6 5     5   20 use Carp;
  5         6  
  5         330  
7 5     5   440 use parent qw(Plack::Middleware);
  5         236  
  5         31  
8 5     5   11864 use Plack::Util::Accessor qw(body fields field_size line);
  5         8  
  5         33  
9              
10             our $VERSION = '0.02';
11              
12             sub prepare_app {
13 4     4 1 119 my $self = shift;
14 4 100       12 $self->body(0) if ! defined $self->body;
15 4 100       310 $self->fields(100) if ! defined $self->fields;
16 4 100       29 $self->field_size(8190) if ! defined $self->field_size;
17 4 100       30 $self->line(8190) if ! defined $self->line;
18             }
19              
20             sub call {
21 10     10 1 9498 my($self, $env) = @_;
22              
23             # HTTP request body size limitation
24 10 100       33 if (my $body_limit = $self->body) {
25 3 100       25 if (my $content_length = $env->{CONTENT_LENGTH}) {
26 2 100       5 if ($content_length > $body_limit) {
27 1         3 return $self->handle_error(413 => 'Entity Too Large');
28             }
29             }
30             }
31              
32             # HTTP request line length limitation
33 9 50       67 if (my $line_limit = $self->line) {
34 9         41 my $total = 0;
35 9         17 for my $env_key (qw(REQUEST_METHOD REQUEST_URI SERVER_PROTOCOL)) {
36 27         38 $total += length $env->{$env_key};
37 27 100       50 if ($env_key ne 'SERVER_PROTOCOL') { # append a white space
38 18         15 ++$total;
39             }
40 27 100       53 if ($total > $line_limit) {
41 1         4 return $self->handle_error(414 => 'Request-URI Too Large');
42             }
43             }
44             }
45              
46             # HTTP request header field number and field size limitation
47 8         22 my $limit_fields = $self->fields;
48 8         40 my $limit_field_size = $self->field_size;
49              
50 8 50 33     41 if ($limit_fields or $limit_field_size) {
51 8         6 my $field_count = 1; # includes the request line
52 8         45 for my $env_key (keys %$env) {
53 174 100       340 next if $env_key !~ /^(?:HTTP_\w+|CONTENT_(?:TYPE|LENGTH))$/;
54 24         23 ++$field_count;
55 24 100 66     89 if ($limit_fields && $field_count > $limit_fields) {
56 1         3 return $self->handle_error(400 => 'Bad Request');
57             }
58 23 50       33 if ($limit_field_size) {
59 23         46 (my $field_name = $env_key) =~ s/^HTTP_//;
60             # "2" means length of separator ": "
61 23         40 my $field_size =
62             length($field_name) + 2 + length($env->{$env_key});
63 23 100       91 if ($field_size > $limit_field_size) {
64 1         4 return $self->handle_error(400 => 'Bad Request');
65             }
66             }
67             }
68             }
69              
70 6         42 return $self->app->($env);
71             }
72              
73             sub handle_error {
74 4     4 0 7 my($self, $code, $body) = @_;
75             return [
76 4         35 $code,
77             [
78             'Content-Type' => 'text/plain',
79             'Content-Length' => length $body,
80             ],
81             [ $body ],
82             ];
83             }
84              
85             1;
86             __END__