File Coverage

blib/lib/Plack/Middleware/ServerStatus/Availability.pm
Criterion Covered Total %
statement 75 79 94.9
branch 25 34 73.5
condition 12 18 66.6
subroutine 16 16 100.0
pod 2 5 40.0
total 130 152 85.5


line stmt bran cond sub pod time code
1             package Plack::Middleware::ServerStatus::Availability;
2 3     3   85037 use strict;
  3         8  
  3         124  
3 3     3   19 use warnings;
  3         5  
  3         108  
4              
5 3     3   689 use parent qw(Plack::Middleware);
  3         556  
  3         15  
6 3     3   17670 use Plack::Util::Accessor qw(path file allow);
  3         6  
  3         17  
7 3     3   2670 use Plack::Request;
  3         187004  
  3         131  
8 3     3   2008 use Net::CIDR::Lite;
  3         13379  
  3         2522  
9              
10             our $VERSION = "0.02";
11              
12             sub prepare_app {
13 2     2 1 541 my ($self) = @_;
14 2 50       9 unless ($self->path->{status}) {
15 0         0 warn sprintf "[%s] 'path.status' is not provided.", __PACKAGE__;
16             }
17 2 50       186 unless ($self->path->{control}) {
18 0         0 warn sprintf "[%s] 'path.control' is not provided.", __PACKAGE__;
19             }
20 2 50       20 unless ($self->file) {
21 0         0 warn sprintf "[%s] 'file' is not provided.", __PACKAGE__;
22             }
23 2 50       23 unless ($self->allow) {
24 0         0 warn sprintf "[%s] 'allow' is not provided.", __PACKAGE__;
25             }
26              
27 2 50       19 if ($self->allow) {
28 2 100       15 my @allow = ref $self->allow ? @{$self->allow} : ($self->allow);
  1         7  
29 2         25 my $ip = { v4 => [], v6 => [] };
30 2 50       7 push @{$ip->{$_ =~ /:/ ? 'v6' : 'v4'}}, $_ for @allow;
  1         9  
31 2         8 $self->{__cidr} = {};
32 2         6 for my $v (qw(v4 v6)) {
33 4 100       6 if (@{$ip->{$v}}) {
  4         23  
34 1         12 my $cidr = Net::CIDR::Lite->new();
35 1         13 $cidr->add_any($_) for @{$ip->{$v}};
  1         7  
36 1         314 $self->{__cidr}->{$v} = $cidr;
37             }
38             }
39             }
40             };
41              
42             sub call {
43 13     13 1 70046 my ($self, $env) = @_;
44              
45 13         97 my $req = Plack::Request->new($env);
46 13         114 my $addr = $env->{REMOTE_ADDR};
47 13 50 66     56 if ($self->path->{status} and $self->path->{status} eq $req->path
      66        
      66        
48             and $req->method eq 'GET' and $self->file) {
49 5 100       249 return $self->respond(403, 'Forbidden') unless $self->allowed($addr);
50 4 100       296 if ($self->status->is_available) {
51 2         135 return $self->respond(200, 'OK');
52             } else {
53 2         121 return $self->respond(503, 'Server is up but is under maintenance');
54             }
55             }
56 8 50 66     194 if ($self->path->{control} and $self->path->{control} eq $req->path
      66        
      66        
57             and $req->method eq 'POST' and $self->file) {
58 7 100       229 return $self->respond(403, 'Forbidden') unless $self->allowed($addr);
59 4         269 my $action = $req->param('action');
60 4 100       978 if ($action eq 'up') {
    100          
61 2         9 $self->status->up;
62 2         17 return $self->respond(200, 'Done');
63             } elsif ($action eq 'down') {
64 1         4 $self->status->down;
65 1         254 return $self->respond(200, 'Done');
66             } else {
67 1         5 return $self->respond(400, 'Bad action');
68             }
69             }
70              
71 1         19 return $self->app->($env);
72             }
73              
74             sub allowed {
75 12     12 0 21 my ($self, $addr) = @_;
76 12 50       50 my $v = ( $addr =~ /:/ ? 'v6' : 'v4' );
77 12 100       60 return unless $self->{__cidr}->{$v};
78 8         45 return $self->{__cidr}->{$v}->find($addr);
79             }
80              
81             sub status {
82 7     7 0 24 my $file = $_[0]->file;
83 7         88 return Plack::Middleware::ServerStatus::Availability::Status->new($file);
84             }
85              
86             sub respond {
87 12     12 0 25 my ($self, $code, $reason) = @_;
88 12         190 return [ $code, [ 'Content-Type' => 'text/plain' ], [ "$code $reason" ] ];
89             }
90              
91             package Plack::Middleware::ServerStatus::Availability::Status;
92 3     3   1884 use Path::Class;
  3         74095  
  3         774  
93              
94             sub new {
95 7     7   13 my ($class, $file) = @_;
96 7         26 return bless { file => file($file) }, $class;
97             }
98              
99             sub is_available {
100 4     4   765 return -f $_[0]->{file};
101             }
102              
103             sub up {
104 2     2   300 my $file = $_[0]->{file};
105 2         9 $file->dir->mkpath;
106 2         204 my $fh = $file->openw;
107 2         745 printf $fh "%d\n", time;
108 2         187 close $fh;
109             }
110              
111             sub down {
112 1     1   113 $_[0]->{file}->remove;
113             }
114              
115             package Plack::Middleware::ServerStatus::Availability;
116              
117             1;
118             __END__