File Coverage

blib/lib/Plack/Middleware/Access.pm

Criterion	Covered	Total	%
statement	62	68	91.1
branch	26	34	76.4
condition	4	9	44.4
subroutine	13	13	100.0
pod	3	3	100.0
total	108	127	85.0

package Plack::Middleware::Access;
#ABSTRACT: Restrict access depending on remote ip or other parameters
$Plack::Middleware::Access::VERSION = '0.4';
use strict;
use warnings;

use parent qw(Plack::Middleware);

use Plack::Util::Accessor qw(rules deny_page);

use Carp qw(croak);
use Net::IP;

sub prepare_app {
    my $self = shift;

    if (!ref $self->deny_page) {
        my $msg = defined $self->deny_page ?
                          $self->deny_page : 'Forbidden';
        $self->deny_page(sub {
            [403, [ 'Content-Type'   =>'text/plain',
                    'Content-Length' => length $msg ], [ $msg ] ];
        });
    } elsif (ref $self->deny_page ne 'CODE') {
        croak "deny_page must be a CODEREF";
    }

    if (!defined($self->rules)) {
        $self->rules([]);
    } elsif( ref($self->rules) ne 'ARRAY' ) {
        croak "rules must be an ARRAYREF";
    } elsif (@{ $self->rules } % 2 != 0) {
        croak "rules must contain an even number of params";
    }

    my @rules = ();

    foreach (my $i = 0; $i < @{ $self->rules }; $i += 2) {
        my $allowing = $self->rules->[$i];
        my $rule = $self->rules->[$i + 1];

        if ($allowing !~ /^(allow|deny)$/) {
            croak "first argument of each rule must be 'allow' or 'deny'";
        }

        if (!defined($rule)) {
            croak "rule argument must be defined";
        }

        $allowing = ($allowing eq 'allow') ? 1 : 0;
        my $check = $rule;

        if ($rule eq 'all') {
            $check = sub { 1 };
        } elsif ($rule =~ /[A-Z]$/i) {
            $check = sub {
                my $host = $_[0]->{REMOTE_HOST};
                return unless defined $host; # skip rule
                return $host =~ qr/^(.*\.)?\Q${rule}\E$/;
            };
        } elsif ( ref($rule) ne 'CODE' ) {
            my $netip = Net::IP->new($rule) or
                die "not supported type of rule argument [$rule] or bad ip: " . Net::IP::Error();
            $check = sub {
                my $addr = $_[0]->{REMOTE_ADDR};
                my $ip;
                if (defined($addr) && ($ip = Net::IP->new($addr))) {
                    my $overlaps = $netip->overlaps($ip);
                    return $overlaps == $IP_B_IN_A_OVERLAP || $overlaps == $IP_IDENTICAL;
                } else {
                    return undef;
                }
            };
        }

        push @rules, [ $check => $allowing ];
    }

    $self->rules(\@rules);
}

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

    foreach my $rule (@{ $self->rules }) {
        my ($check, $allow) = @{$rule};
        my $result = $check->($env);
        if (defined $result && $result) {
            return $allow;
        }
    }

    return 1;
}

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

    return $self->allow($env)
         ? $self->app->($env) : $self->deny_page->($env);
}

1;

__END__