File Coverage

blib/lib/HTTP/CSPHeader.pm

Criterion	Covered	Total	%
statement	63	65	96.9
branch	12	20	60.0
condition			n/a
subroutine	14	14	100.0
pod	2	2	100.0
total	91	101	90.1

package HTTP::CSPHeader;

# ABSTRACT: manage dynamic content security policy headers

use v5.14;

use Moo;

use Fcntl qw/ O_NONBLOCK O_RDONLY /;
use List::Util 1.29 qw/ pairmap pairs /;
use Math::Random::ISAAC;
use Types::Standard qw/ ArrayRef is_ArrayRef Bool HashRef Str /;

# RECOMMEND PREREQ: Math::Random::ISAAC::XS
# RECOMMEND PREREQ: Type::Tiny::XS

use namespace::autoclean;

our $VERSION = 'v0.2.1';


has _base_policy => (
    is       => 'ro',
    isa      => HashRef,
    required => 1,
    init_arg => 'policy',
);

has policy => (
    is       => 'lazy',
    isa      => HashRef,
    clearer  => '_clear_policy',
    init_arg => undef,
);

sub _build_policy {
    my ($self) = @_;
    my %policy = %{ $self->_base_policy };
    if ( my @dirs = @{ $self->nonces_for } ) {
        my $nonce = "'nonce-" . $self->nonce . "'";
        for my $dir (@dirs) {
            if ( defined $policy{$dir} ) {
                $policy{$dir} .= " " . $nonce;
            }
            else {
                $policy{$dir} = $nonce;
            }
        }
        $self->_changed(1);
    }
    return \%policy;
}

has _changed => (
    is       => 'rw',
    isa      => Bool,
    lazy     => 1,
    default  => 0,
    init_arg => undef,
);


has nonces_for => (
    is      => 'lazy',
    isa     => ArrayRef [Str],
    builder => sub { return [] },
    coerce  => sub { my $val = is_ArrayRef( $_[0] ) ? $_[0] : [ $_[0] ] },
);


has nonce => (
    is       => 'lazy',
    isa      => Str,
    clearer  => '_clear_nonce',
    unit_arg => undef,
);

sub _build_nonce {
    my ($self) = @_;

    state $rng = do {
        sysopen( my $fh, '/dev/urandom', O_NONBLOCK | O_RDONLY ) or die $!;
        sysread( $fh, my $data, 16 )                             or die $!;
        close $fh;

        Math::Random::ISAAC->new( unpack( "C*", $data ) );
    };

    return sprintf( '%x', $rng->irand ^ $$ );
}


has header => (
    is       => 'lazy',
    isa      => Str,
    clearer  => '_clear_header',
    init_arg => undef,
);

sub _build_header {
    my ($self) = @_;
    my $policy = $self->policy;
    return join( "; ", pairmap { $a . " " . $b } %$policy );
}


sub reset {
    my ($self) = @_;
    return unless $self->_changed;
    $self->_clear_nonce;
    $self->_clear_policy;
    $self->_clear_header;
    $self->_changed(0);
}


sub amend {
    my ($self, @args) = @_;
    my $policy = $self->policy;

    if (@args) {

        for my $pol ( pairs @args ) {

            my ( $dir, $val ) = @$pol;

            if ( $dir =~ s/^\+// ) {    # append to directive
                if ( exists $policy->{$dir} ) {
                    $policy->{$dir} .= " " . $val;
                }
                elsif ( defined $val ) {
                    $policy->{$dir} = $val;
                }

            }
            else {
                if ( defined $val ) {
                    $policy->{$dir} = $val;
                }
                else {
                    delete $policy->{$dir};
                }
            }
        }

        $self->_clear_header;
        $self->_changed(1);
    }

    return $policy;
}

1;

__END__