File Coverage

blib/lib/Amon2/Plugin/Web/Maintenance.pm

Criterion	Covered	Total	%
statement	12	46	26.0
branch	0	28	0.0
condition	0	6	0.0
subroutine	4	9	44.4
pod	0	1	0.0
total	16	90	17.7

package Amon2::Plugin::Web::Maintenance;
use 5.008001;
use strict;
use warnings;
use Net::CIDR::Lite;

our $VERSION = "0.01";

sub init {
    my ( $class, $c, $conf ) = @_;

    return unless $c->config->{MAINTENANCE}->{enable};

    $c->add_trigger(
        BEFORE_DISPATCH => sub {
            my ($self) = @_;

            return if &_is_exception($self);

            return $self->res_maintenance
                if $self->can('res_maintenance');

            return $self->create_response(
                503,
                [   'Content-Type'   => 'text/plain',
                    'Content-Length' => 36,
                ],
                ['Service unavailable for maintenance.']
            );
        }
    );
}

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

    my $config = $self->config->{MAINTENANCE};

    if ( exists $config->{except} ) {
        if ( exists $config->{except}->{addr} ) {
            my $remote_addr = $self->request->env->{REMOTE_ADDR};
            return 1
                if &_match_addr( $remote_addr,
                $config->{except}->{addr} );
        }
        if ( exists $config->{except}->{path} ) {
            my $path = $self->request->env->{PATH_INFO};
            return 1
                if &_match_path( $path, $config->{except}->{path} );
        }
        return 0;
    }
}

sub _match_addr {
    my ( $addr, $conditions ) = @_;

    my $cidr4 = Net::CIDR::Lite->new();
    my $cidr6 = Net::CIDR::Lite->new();
    for my $condition (@$conditions) {
        if ( $condition && $condition =~ m!:! ) {
            $cidr6->add_any($condition);
        }
        else {
            $cidr4->add_any($condition);
        }
    }

    if ( $addr =~ m!:! ) {
        return $cidr6->find($addr);
    }
    else {
        return $cidr4->find($addr);
    }
    return 0;
}

sub _match_path {
    my ( $path, $conditions ) = @_;

    for my $condition (@$conditions) {
        if ( ref $condition && ref $condition eq 'Regexp' ) {
            return 1 if $path =~ m!$condition!;
        }
        elsif ( defined $condition ) {
            return 1 if $path eq $condition;
        }
    }
    return 0;
}

1;
__END__