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__ |