File Coverage

blib/lib/Plack/Middleware/MonocerosStatus.pm

Criterion	Covered	Total	%
statement	35	63	55.5
branch	6	26	23.0
condition	0	6	0.0
subroutine	7	10	70.0
pod	2	3	66.6
total	50	108	46.3

package Plack::Middleware::MonocerosStatus;

use strict;
use warnings;
use parent qw(Plack::Middleware);
use Plack::Util::Accessor qw(path allow);
use Net::CIDR::Lite;
use IO::Socket::UNIX;

sub prepare_app {
    my $self = shift;
    if ( $self->allow ) {
        my @ip = ref $self->allow ? @{$self->allow} : ($self->allow);
        my @ipv4;
        my @ipv6;
        for (@ip) {
            # hacky check, but actual checks are done in Net::CIDR::Lite.
            if (/:/) {
                push @ipv6, $_;
            } else {
                push @ipv4, $_;
            }
        }
        if ( @ipv4 ) {
            my $cidr4 = Net::CIDR::Lite->new();
            $cidr4->add_any($_) for @ipv4;
            $self->{__cidr4} = $cidr4;
        }
        if ( @ipv6 ) {
            my $cidr6 = Net::CIDR::Lite->new();
            $cidr6->add_any($_) for @ipv6;
            $self->{__cidr6} = $cidr6;
        }
    }
}

sub call {
    my ($self, $env) = @_;
    if( $self->path && $env->{PATH_INFO} eq $self->path ) {
        return $self->_handle_status($env);
    }
    $self->app->($env);
}

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

    if ( ! $self->allowed($env->{REMOTE_ADDR}) ) {
        return [403, ['Content-Type' => 'text/plain'], [ 'Forbidden' ]];
    }

    if ( !$env->{X_MONOCEROS_WORKER_STATS} || ! -f $env->{X_MONOCEROS_WORKER_STATS}) {
        return [500, ['Content-Type' => 'text/plain'], [ 'Monoceros stats file not found' ]];
    }

    open(my $fh, $env->{X_MONOCEROS_WORKER_STATS}) or
        return [500, ['Content-Type' => 'text/plain'], [ 'Could not open Monoceros stats: $!' ]];
    my $len = $fh->sysread(my $buf, 1024);
    if ( !$len ) {
        return [500, ['Content-Type' => 'text/plain'], [ 'Could not read stats: $!' ]];
    }
    my %stats;
    for my $str ( split /&/, $buf ) {
        my ($key,$val) = split /=/, $str, 2;
        $stats{$key} = $val;
    }
    my $msg = "Total: ".$stats{total}."\015\012";
    $msg .= "Waiting: ".$stats{waiting}."\015\012";
    $msg .= "Processing: ".$stats{processing}."\015\012";
    $msg .= "MaxWorkers: ".$stats{max_workers}."\015\012\015\012";

    return [200, ['Content-Type' => 'text/plain'], [$msg]];
}

sub allowed {
    my ( $self , $address ) = @_;
    if ( $address =~ /:/) {
        return unless $self->{__cidr6};
        return $self->{__cidr6}->find( $address );
    }
    return unless $self->{__cidr4};
    return $self->{__cidr4}->find( $address );
}


1;

__END__