File Coverage

blib/lib/Plack/Middleware/BlockHeaderInjection.pm

Criterion	Covered	Total	%
statement	36	36	100.0
branch	6	6	100.0
condition	1	2	50.0
subroutine	10	10	100.0
pod	1	2	50.0
total	54	56	96.4

package Plack::Middleware::BlockHeaderInjection;

# ABSTRACT: block header injections in responses

use v5.8;

use strict;
use warnings;

use parent qw( Plack::Middleware );

use Plack::Util;
use Plack::Util::Accessor qw( logger status );

our $VERSION = 'v1.0.1';


sub call {
    my ( $self, $env ) = @_;

    # cache the logger
    $self->logger($env->{'psgix.logger'} || sub { })
        unless defined $self->logger;

    $self->status(500) unless $self->status;

    my $res = $self->app->($env);

    Plack::Util::response_cb(
        $res,
        sub {
            my $res = shift;

            # Sanity check headers

            my $hdrs = $res->[1];

            my $i = 0;
            while ($i < @{$hdrs}) {
                my $val = $hdrs->[$i+1];
                if ($val =~ /[\n\r]/) {
                    my $key = $hdrs->[$i];
                    $self->log(
                        error => "possible header injection detected in ${key}" );
                    $res->[0] = $self->status;
                    Plack::Util::header_remove($hdrs, $key);
                }
                $i+=2;
            }

        }
    );

}

# Note: ideas borrowed from XSRFBlock


sub log {
    my ($self, $level, $msg) = @_;
    $self->logger->({
        level   => $level,
        message => "BlockHeaderInjection: ${msg}",
    });
}


1;

__END__