line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Parse::Daemontools::Service; |
2
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
53637
|
use strict; |
|
3
|
|
|
|
|
8
|
|
|
3
|
|
|
|
|
113
|
|
4
|
3
|
|
|
3
|
|
19
|
use warnings; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
92
|
|
5
|
3
|
|
|
3
|
|
84
|
use 5.008_005; |
|
3
|
|
|
|
|
14
|
|
|
3
|
|
|
|
|
142
|
|
6
|
3
|
|
|
3
|
|
3163
|
use bigint; |
|
3
|
|
|
|
|
16137
|
|
|
3
|
|
|
|
|
17
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '0.03'; |
9
|
|
|
|
|
|
|
|
10
|
3
|
|
|
3
|
|
148668
|
use Carp; |
|
3
|
|
|
|
|
11
|
|
|
3
|
|
|
|
|
1031
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub new { |
13
|
6
|
|
|
6
|
1
|
11859
|
my($class, $args) = @_; |
14
|
6
|
|
100
|
|
|
27
|
$args ||= {}; |
15
|
|
|
|
|
|
|
|
16
|
6
|
|
|
|
|
34
|
my $self = bless { |
17
|
|
|
|
|
|
|
base_dir => '/service', |
18
|
|
|
|
|
|
|
%$args, |
19
|
|
|
|
|
|
|
}, $class; |
20
|
|
|
|
|
|
|
|
21
|
6
|
|
|
|
|
18
|
return $self; |
22
|
|
|
|
|
|
|
} |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub base_dir { |
25
|
5
|
|
|
5
|
1
|
18
|
my($self, $base_dir) = @_; |
26
|
5
|
50
|
|
|
|
14
|
if ($base_dir) { |
27
|
0
|
0
|
|
|
|
0
|
if (! -d $base_dir) { |
28
|
0
|
|
|
|
|
0
|
Carp::carp("No such directory: $base_dir"); |
29
|
0
|
|
|
|
|
0
|
return; |
30
|
|
|
|
|
|
|
} |
31
|
0
|
|
|
|
|
0
|
$self->{base_dir} = $base_dir; |
32
|
|
|
|
|
|
|
} |
33
|
5
|
|
|
|
|
21
|
return $self->{base_dir}; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub status { |
37
|
5
|
|
|
5
|
1
|
23
|
my($self, $service, $param) = @_; |
38
|
|
|
|
|
|
|
|
39
|
5
|
50
|
|
|
|
15
|
if (! $service) { |
40
|
0
|
|
|
|
|
0
|
Carp::carp("Missing mandatory args: service"); |
41
|
0
|
|
|
|
|
0
|
return; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
5
|
|
|
|
|
14
|
my $service_dir = join '/', $self->base_dir, $service; |
45
|
5
|
50
|
|
|
|
175
|
if (! -d $service_dir) { |
46
|
0
|
|
|
|
|
0
|
Carp::carp("No such directory: $service_dir"); |
47
|
0
|
|
|
|
|
0
|
return; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
51
|
5
|
|
|
|
|
7
|
my $normallyup = 0; |
52
|
5
|
50
|
|
|
|
98
|
$normallyup = 1 if ! -e "$service_dir/down"; |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
|
55
|
5
|
|
|
|
|
14
|
my $status_file = join '/', $service_dir, 'supervise', 'status'; |
56
|
5
|
50
|
|
|
|
125
|
if (! -f $status_file) { |
57
|
0
|
|
|
|
|
0
|
Carp::carp("No such status file: $status_file"); |
58
|
0
|
|
|
|
|
0
|
return; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
5
|
50
|
|
|
|
250
|
open my $fh, '<', $status_file or do { |
62
|
0
|
|
|
|
|
0
|
Carp::carp("Failed to open status file: $status_file: $!"); |
63
|
0
|
|
|
|
|
0
|
return; |
64
|
|
|
|
|
|
|
}; |
65
|
5
|
|
|
|
|
8
|
my $status = do { local $/; <$fh> }; |
|
5
|
|
|
|
|
19
|
|
|
5
|
|
|
|
|
123
|
|
66
|
5
|
|
|
|
|
57
|
close $fh; |
67
|
|
|
|
|
|
|
|
68
|
5
|
|
|
|
|
42
|
my($tai_h, $tai_l, $nanosec, $pid, $paused, $want) = unpack "NNLVCa", $status; |
69
|
|
|
|
|
|
|
|
70
|
5
|
100
|
|
|
|
88
|
$pid = undef if $pid == 0; |
71
|
|
|
|
|
|
|
|
72
|
5
|
|
|
|
|
639
|
my $when = ($tai_h << 32) + $tai_l; |
73
|
5
|
|
|
|
|
1726
|
my $now = tai64_now(); |
74
|
5
|
50
|
|
|
|
643
|
if ($now < $when) { |
75
|
0
|
|
|
|
|
0
|
$when = $now; |
76
|
|
|
|
|
|
|
} |
77
|
5
|
|
|
|
|
189
|
my $elapse = $now - $when; |
78
|
|
|
|
|
|
|
|
79
|
5
|
|
|
|
|
621
|
my @info; |
80
|
5
|
50
|
66
|
|
|
24
|
push @info, "normally down" if ($pid && !$normallyup); |
81
|
5
|
100
|
66
|
|
|
90
|
push @info, "normally up" if (!$pid && $normallyup); |
82
|
5
|
50
|
66
|
|
|
101
|
push @info, "paused" if ($pid && $paused); |
83
|
5
|
50
|
66
|
|
|
18
|
push @info, "want up" if (!$pid && $want eq 'u'); |
84
|
5
|
50
|
66
|
|
|
28
|
push @info, "want down" if ($pid && $want eq 'd'); |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
|
87
|
5
|
|
|
|
|
8
|
my $env = {}; |
88
|
5
|
|
|
|
|
6
|
my @env_dir; |
89
|
5
|
100
|
|
|
|
30
|
if ($param->{env_dir}) { |
90
|
3
|
100
|
|
|
|
11
|
if (ref $param->{env_dir} eq 'ARRAY') { |
91
|
2
|
|
|
|
|
4
|
@env_dir = @{ $param->{env_dir} }; |
|
2
|
|
|
|
|
5
|
|
92
|
|
|
|
|
|
|
} else { |
93
|
1
|
|
|
|
|
3
|
@env_dir = ($param->{env_dir}); |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
} else { |
96
|
2
|
|
|
|
|
8
|
@env_dir = ("$service_dir/env"); |
97
|
|
|
|
|
|
|
} |
98
|
5
|
|
|
|
|
10
|
for my $ed (@env_dir) { |
99
|
6
|
100
|
|
|
|
162
|
next unless -d $ed; |
100
|
|
|
|
|
|
|
|
101
|
5
|
50
|
|
|
|
206
|
if (opendir my $envdir, $ed) { |
102
|
5
|
|
|
|
|
62
|
while (my $k = readdir $envdir) { |
103
|
20
|
100
|
|
|
|
143
|
next if $k =~ /^\./; |
104
|
10
|
50
|
|
|
|
427
|
open my $fh, '<', "$ed/$k" or next; |
105
|
10
|
|
|
|
|
11
|
my $v = do { local $/; <$fh> }; |
|
10
|
|
|
|
|
32
|
|
|
10
|
|
|
|
|
207
|
|
106
|
10
|
|
|
|
|
92
|
close $fh; |
107
|
10
|
|
|
|
|
15
|
chomp $v; |
108
|
10
|
|
|
|
|
65
|
$env->{$k} = $v; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
} else { |
111
|
0
|
|
|
|
|
0
|
Carp::carp("Failed to open env dir: $ed: $!"); |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
5
|
|
|
|
|
17
|
my $start_at = tai642unix($when); |
116
|
5
|
50
|
33
|
|
|
772
|
$start_at = $start_at->numify if ref($start_at) && $start_at->can('numify'); |
117
|
5
|
50
|
33
|
|
|
154
|
$elapse = $elapse->numify if ref($elapse) && $elapse->can('numify'); |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
return { |
120
|
5
|
100
|
|
|
|
132
|
service => $service_dir, |
121
|
|
|
|
|
|
|
status => defined $pid ? 'up' : 'down', |
122
|
|
|
|
|
|
|
pid => $pid, |
123
|
|
|
|
|
|
|
seconds => $elapse, |
124
|
|
|
|
|
|
|
start_at => $start_at, |
125
|
|
|
|
|
|
|
info => join(", ", @info), |
126
|
|
|
|
|
|
|
env => $env, |
127
|
|
|
|
|
|
|
}; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub unix2tai64 { |
133
|
5
|
|
|
5
|
0
|
35
|
my $u = shift; |
134
|
5
|
|
|
|
|
14
|
return 4611686018427387914 + $u; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub tai642unix { |
138
|
5
|
|
|
5
|
0
|
8
|
my $t = shift; |
139
|
5
|
|
|
|
|
16
|
return $t - 4611686018427387914; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub tai64_now { |
143
|
5
|
|
|
5
|
0
|
20
|
return unix2tai64(time()); |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
1; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
__END__ |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=encoding utf-8 |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=begin html |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
<a href="https://travis-ci.org/hirose31/Parse-Daemontools-Service"><img src="https://travis-ci.org/hirose31/Parse-Daemontools-Service.png?branch=master" alt="Build Status" /></a> |
155
|
|
|
|
|
|
|
<a href="https://coveralls.io/r/hirose31/Parse-Daemontools-Service?branch=master"><img src="https://coveralls.io/repos/hirose31/Parse-Daemontools-Service/badge.png?branch=master" alt="Coverage Status" /></a> |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=end html |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=head1 NAME |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
Parse::Daemontools::Service - Retrieve status and env of service under daemontools |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=begin readme |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=head1 INSTALLATION |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
To install this module, run the following commands: |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
perl Build.PL |
170
|
|
|
|
|
|
|
./Build |
171
|
|
|
|
|
|
|
./Build test |
172
|
|
|
|
|
|
|
./Build install |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=end readme |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=head1 SYNOPSIS |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
Normally, Parse::Daemontools::Service requires root privileges because need to read /service/DAEMON/supervise/status file. |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
use Parse::Daemontools::Service; |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
my $ds = Parse::Daemontools::Service->new; |
183
|
|
|
|
|
|
|
my $status = $ds->status("qmail"); |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
my $status = $ds->status("my-daemon", |
186
|
|
|
|
|
|
|
{ |
187
|
|
|
|
|
|
|
env_dir => "/service/my-daemon/my-env-dir", |
188
|
|
|
|
|
|
|
}); |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
my $status = $ds->status("my-daemon", |
191
|
|
|
|
|
|
|
{ |
192
|
|
|
|
|
|
|
env_dir => [ |
193
|
|
|
|
|
|
|
"/service/my-daemon/env", |
194
|
|
|
|
|
|
|
"/service/my-daemon/my-env-dir", |
195
|
|
|
|
|
|
|
], |
196
|
|
|
|
|
|
|
}); |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=head1 DESCRIPTION |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
Parse::Daemontools::Service retrieves status and env of service under daemontools. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=head1 METHODS |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=over 4 |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=item B<new>({ base_dir => Str }) |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
base_dir (optional): base directory of daemontools. Default is "/service" |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=item B<status>($service_name:Str, { env_dir => Str|ArrayRef[Str] }) |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
Return status and env of $service_name as following HashRef. |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
+{ |
215
|
|
|
|
|
|
|
service => Str, # "/service/my-daemon" |
216
|
|
|
|
|
|
|
pid => Int, # PID of daemon process |
217
|
|
|
|
|
|
|
seconds => Int, # uptime of this daemon process |
218
|
|
|
|
|
|
|
start_at => Int, # UNIX time of this daemon process started at |
219
|
|
|
|
|
|
|
status => Str, # "up" | "down" |
220
|
|
|
|
|
|
|
info => Str, # "" | "normally down" | "normally up" | ... |
221
|
|
|
|
|
|
|
env => { # environment variables in envdir |
222
|
|
|
|
|
|
|
BAR => "bar", |
223
|
|
|
|
|
|
|
FOO => "foo" |
224
|
|
|
|
|
|
|
}, |
225
|
|
|
|
|
|
|
}, |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
Default env_dir is "/service/my-daemon/env". You can specify env_dir(s) by Str or ArrayRef. When you specify more than one env_dirs, same key are overridden by latter env_dir. |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=back |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=head1 AUTHOR |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
HIROSE Masaaki E<lt>hirose31@gmail.comE<gt> |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=head1 REPOSITORY |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
L<https://github.com/hirose31/Parse-Daemontools-Service> |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
git clone git://github.com/hirose31/Parse-Daemontools-Service.git |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
patches and collaborators are welcome. |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
=head1 SEE ALSO |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
svstat(1) |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=head1 COPYRIGHT |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
Copyright HIROSE Masaaki |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=head1 LICENSE |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
254
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=cut |
257
|
|
|
|
|
|
|
|