File Coverage

blib/lib/Plack/Middleware/BlockHeaderInjection.pm
Criterion Covered Total %
statement 45 45 100.0
branch 6 6 100.0
condition 1 3 33.3
subroutine 11 11 100.0
pod 2 3 66.6
total 65 68 95.5


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