File Coverage

blib/lib/Mojolicious/Plugin/SecurityHeader.pm

Criterion	Covered	Total	%
statement	72	75	96.0
branch	47	60	78.3
condition	14	24	58.3
subroutine	7	8	87.5
pod	1	6	16.6
total	141	173	81.5

package Mojolicious::Plugin::SecurityHeader;
# ABSTRACT: Mojolicious Plugin
use Mojo::Base 'Mojolicious::Plugin';

our $VERSION = '0.05';

sub register {
    my ($self, $app, $headers) = @_;

    return if !ref $headers;
    return if 'ARRAY' ne ref $headers;

    my @headers_list = qw(
        Strict-Transport-Security Public-Key-Pins Referrer-Policy
        X-Content-Type-Options X-Frame-Options X-Xss-Protection
        Content-Security-Policy
    );

    my %valid_headers;
    @valid_headers{@headers_list} = (1) x @headers_list;

    my %values = (
        'Strict-Transport-Security' => \&check_sts,
        'Referrer-Policy'           => [
             "",
             "no-referrer",
             "no-referrer-when-downgrade",
             "same-origin",
             "origin",
             "strict-origin",
             "origin-when-cross-origin",
             "strict-origin-when-cross-origin",
             "unsafe-url"
         ],
         'X-Content-Type-Options'  => ['nosniff'],
         'X-Xss-Protection'        => \&check_xp,
         'X-Frame-Options'         => \&check_fo,
         'Content-Security-Policy' => \&check_csp,
    );

    my %options = (
         'Strict-Transport-Security' => { includeSubDomains => 1, preload => 1 },
    );

    my %headers_default = (
        'Referrer-Policy'           => "",
        'Strict-Transport-Security' => "max-age=31536000",
        'X-Content-Type-Options'    => "nosniff",
        'X-Xss-Protection'          => '1; mode=block',
        'X-Frame-Options'           => 'DENY',
        'Content-Security-Policy'   => "default-src 'self'",
    );

    my %security_headers;

    my $last_header;
    my $header_value;

    HEADER:
    for my $header ( @{ $headers || [] } ) {
       if ( $valid_headers{$header} ) {
           if ( $last_header ) {
               $security_headers{$last_header} = $header_value // $headers_default{$last_header};
           }

           undef $header_value;
           $last_header = $header;
       }
       elsif ( $last_header ) {
           $header_value = $header;

           if ( $values{$last_header} ) {
               my $ref = ref $values{$last_header};

               if ( $ref eq 'CODE' ) {
                   $header_value = $values{$last_header}->($header_value // $headers_default{$last_header}, $options{$last_header});
               }
               elsif ( $ref eq 'ARRAY' ) {
                   ($header_value) = grep{ $header_value eq $_ }@{ $values{$last_header} };

                   undef $last_header if !$header_value;
               }
           }
       }
    }

    $security_headers{$last_header} = $header_value // $headers_default{$last_header} if $last_header;

    $app->hook( before_dispatch => sub {
        my $c = shift;

        for my $header_name ( keys %security_headers ) {
            $c->res->headers->header( $header_name => $security_headers{$header_name} );
        }
    });
}

sub check_csp {
    my ($value, $options) = @_;

    my $option = '';

    if ( ref $value ) {
       for my $key ( reverse sort keys %{ $value || {} } ) {
           my $tmp_value = $value->{$key};
           $option .= sprintf "%s-src %s; ", $key, $tmp_value;
       }
    }

    return $option;
}

sub check_sts {
    my ($value, $options) = @_;

    my $option = '';

    if ( ref $value ) {
        $option = $value->{opt};
        $value  = $value->{maxage};

        $option = '' if !$options->{$option};
    }

    $option = '; ' . $option if $option;

    return 'max-age=31536000' . $option if $value == -1;
    return if $value < 0;
    return if $value ne int $value;
    return 'max-age=' . $value . $option;
}

sub check_fo {
    my ($value) = @_;

    my %allowed = ('DENY' => 1, 'SAMEORIGIN' => 1);

    return 'DENY' if !defined $value;
    return $value if $allowed{$value};
    return if !ref $value;

    return if ref $value && !$value->{'ALLOW-FROM'};
    return 'ALLOW-FROM ' . $value->{'ALLOW-FROM'};
}

sub check_xp {
    my ($value, $options) = @_;

    if ( !ref $value ) {
        return        if $value ne '1' && $value ne '0';
        return $value if $value eq '0' || $value eq '1';
    }

    if ( ref $value && $value->{value} eq '1' ) {
       my $option = '';

       if ( $value->{mode} && $value->{mode} eq 'block' ) {
           $option = 'mode=block';
       }
       elsif ( $value->{report} ) {
           $option = 'report=' . $value->{report};
       }

       $value = '1; ' . $option if $option;
       return  $value;
    }

    return;
}

sub is_string {
    my ($value) = @_;

    return defined $value;
}

1;

__END__