File Coverage

blib/lib/Plack/Middleware/BlockHeaderInjection.pm
Criterion Covered Total %
statement 47 47 100.0
branch 8 8 100.0
condition 4 6 66.6
subroutine 11 11 100.0
pod 2 3 66.6
total 72 75 96.0


line stmt bran cond sub pod time code
1             package Plack::Middleware::BlockHeaderInjection;
2              
3             # ABSTRACT: block header injections in responses
4              
5 4     4   2007064 use v5.24;
  4         18  
6 4     4   29 use warnings;
  4         17  
  4         371  
7              
8 4     4   35 use parent qw( Plack::Middleware );
  4         14  
  4         39  
9              
10 4     4   13839 use Plack::Util;
  4         10  
  4         187  
11 4     4   28 use Plack::Util::Accessor qw( logger status clean );
  4         9  
  4         40  
12              
13 4     4   926 use experimental qw( signatures );
  4         1924  
  4         38  
14              
15             our $VERSION = 'v1.3.1';
16              
17              
18 3     3 1 385 sub prepare_app($self) {
  3         152  
  3         6  
19              
20 3 100       17 $self->status(500) unless $self->status;
21 3         284 $self->clean( !!$self->clean );
22             }
23              
24 8     8 1 123733 sub call( $self, $env ) {
  8         55  
  8         16  
  8         20  
25              
26             # cache the logger
27       2     $self->logger( $env->{'psgix.logger'} || sub { } )
28 8 100 33     52 unless defined $self->logger;
29              
30 8         194 my $res = $self->app->($env);
31              
32             Plack::Util::response_cb(
33             $res,
34             sub {
35 8     8   147 my $res = shift;
36              
37             # Sanity check headers
38              
39 8         19 my $hdrs = $res->[1];
40              
41 8         18 my $i = 0;
42 8         42 while ( $i < $hdrs->@* ) {
43 13         53 my ( $key, $val ) = ( $hdrs->[$i], $hdrs->[ $i + 1 ] );
44 13 100 100     57 if ( $self->clean && $val =~ s/[\N{U+00}\n\r]+/ /gm ) {
45 1         18 Plack::Util::header_set( $hdrs, $key, $val );
46             }
47 13 100       163 if ( $val =~ /[\N{U+00}-\N{U+1f}]/ ) {
48 2         20 $self->log( error => "possible header injection detected in ${key}" );
49 2         13 $res->[0] = $self->status;
50 2         16 Plack::Util::header_remove( $hdrs, $key );
51             }
52 13         123 $i += 2;
53             }
54             }
55 8         4228 );
56              
57             }
58              
59             # Note: ideas borrowed from XSRFBlock
60              
61              
62 2     2 0 6 sub log( $self, $level, $msg ) {
  2         15  
  2         6  
  2         13  
  2         5  
63 2         16 $self->logger->(
64             {
65             level => $level,
66             message => "BlockHeaderInjection: ${msg}",
67             }
68             );
69             }
70              
71              
72             1;
73              
74             __END__