line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/bin/false |
2
|
|
|
|
|
|
|
# ABSTRACT: An OOP interface to Monit. |
3
|
|
|
|
|
|
|
# PODNAME: Monit::HTTP |
4
|
|
|
|
|
|
|
|
5
|
5
|
|
|
5
|
|
502803
|
use warnings; |
|
5
|
|
|
|
|
62
|
|
|
5
|
|
|
|
|
165
|
|
6
|
5
|
|
|
5
|
|
27
|
use strict; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
93
|
|
7
|
5
|
|
|
5
|
|
54
|
use v5.10; |
|
5
|
|
|
|
|
18
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
package Monit::HTTP; |
10
|
|
|
|
|
|
|
$Monit::HTTP::VERSION = '0.06'; |
11
|
5
|
|
|
5
|
|
3701
|
use HTTP::Tiny; |
|
5
|
|
|
|
|
234656
|
|
|
5
|
|
|
|
|
241
|
|
12
|
5
|
|
|
5
|
|
2406
|
use XML::Fast; |
|
5
|
|
|
|
|
56837
|
|
|
5
|
|
|
|
|
299
|
|
13
|
5
|
|
|
5
|
|
34
|
use Carp qw( croak ); |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
1070
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our ( |
16
|
|
|
|
|
|
|
%MONIT_ACTIONS, |
17
|
|
|
|
|
|
|
%MONIT_ACTIONS_REV, |
18
|
|
|
|
|
|
|
%MONIT_STATUS, |
19
|
|
|
|
|
|
|
%MONIT_STATUS_REV, |
20
|
|
|
|
|
|
|
%MONIT_TYPES, |
21
|
|
|
|
|
|
|
%MONIT_TYPES_REV, |
22
|
|
|
|
|
|
|
%MONIT_MONITOR, |
23
|
|
|
|
|
|
|
%MONIT_MONITOR_REV, |
24
|
|
|
|
|
|
|
); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
BEGIN { |
27
|
|
|
|
|
|
|
|
28
|
5
|
|
|
5
|
|
39
|
%MONIT_ACTIONS_REV = ( |
29
|
|
|
|
|
|
|
'stop' => 'ACTION_STOP', |
30
|
|
|
|
|
|
|
'start' => 'ACTION_START', |
31
|
|
|
|
|
|
|
'restart' => 'ACTION_RESTART', |
32
|
|
|
|
|
|
|
'monitor' => 'ACTION_MONITOR', |
33
|
|
|
|
|
|
|
'unmonitor' => 'ACTION_UNMONITOR', |
34
|
|
|
|
|
|
|
); |
35
|
5
|
|
|
|
|
54
|
%MONIT_ACTIONS = reverse %MONIT_ACTIONS_REV; |
36
|
|
|
|
|
|
|
|
37
|
5
|
|
|
|
|
23
|
%MONIT_MONITOR_REV = ( |
38
|
|
|
|
|
|
|
0 => 'off', |
39
|
|
|
|
|
|
|
1 => 'monitored', |
40
|
|
|
|
|
|
|
2 => 'initializing', |
41
|
|
|
|
|
|
|
); |
42
|
5
|
|
|
|
|
28
|
%MONIT_MONITOR = reverse %MONIT_MONITOR_REV; |
43
|
|
|
|
|
|
|
|
44
|
5
|
|
|
|
|
23
|
%MONIT_STATUS_REV = ( |
45
|
|
|
|
|
|
|
0 => 'Running', |
46
|
|
|
|
|
|
|
32 => 'Connection Failed', |
47
|
|
|
|
|
|
|
512 => 'Does not exist', |
48
|
|
|
|
|
|
|
); |
49
|
5
|
|
|
|
|
23
|
%MONIT_STATUS = reverse %MONIT_STATUS_REV; |
50
|
|
|
|
|
|
|
|
51
|
5
|
|
|
|
|
36
|
%MONIT_TYPES_REV = ( |
52
|
|
|
|
|
|
|
0 => 'TYPE_FILESYSTEM', |
53
|
|
|
|
|
|
|
1 => 'TYPE_DIRECTORY', |
54
|
|
|
|
|
|
|
2 => 'TYPE_FILE', |
55
|
|
|
|
|
|
|
3 => 'TYPE_PROCESS', |
56
|
|
|
|
|
|
|
4 => 'TYPE_HOST', |
57
|
|
|
|
|
|
|
5 => 'TYPE_SYSTEM', |
58
|
|
|
|
|
|
|
6 => 'TYPE_FIFO', |
59
|
|
|
|
|
|
|
7 => 'TYPE_STATUS', |
60
|
|
|
|
|
|
|
); |
61
|
5
|
|
|
|
|
330
|
%MONIT_TYPES = reverse %MONIT_TYPES_REV; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# This creates constants from all the above values |
66
|
|
|
|
|
|
|
# perl 5.10 has strange issues just going: |
67
|
|
|
|
|
|
|
# use constant reverse %{ MONIT_TYPES() } |
68
|
|
|
|
|
|
|
# So work around it with do {} |
69
|
5
|
|
|
5
|
|
34
|
use constant do { my %foo = reverse( %MONIT_TYPES_REV ); \%foo }; |
|
5
|
|
|
|
|
18
|
|
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
32
|
|
|
5
|
|
|
|
|
816
|
|
70
|
5
|
|
|
5
|
|
38
|
use constant do { my %foo = reverse( %MONIT_ACTIONS_REV ); \%foo }; |
|
5
|
|
|
|
|
8
|
|
|
5
|
|
|
|
|
20
|
|
|
5
|
|
|
|
|
34
|
|
|
5
|
|
|
|
|
527
|
|
71
|
|
|
|
|
|
|
|
72
|
5
|
|
|
5
|
|
923
|
use parent qw(Exporter); |
|
5
|
|
|
|
|
648
|
|
|
5
|
|
|
|
|
36
|
|
73
|
|
|
|
|
|
|
our (%EXPORT_TAGS, @EXPORT_OK); |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
%EXPORT_TAGS = ( |
76
|
|
|
|
|
|
|
constants => [qw/ |
77
|
|
|
|
|
|
|
ACTION_MONITOR |
78
|
|
|
|
|
|
|
ACTION_RESTART |
79
|
|
|
|
|
|
|
ACTION_START |
80
|
|
|
|
|
|
|
ACTION_STOP |
81
|
|
|
|
|
|
|
ACTION_UNMONITOR |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
TYPE_DIRECTORY |
84
|
|
|
|
|
|
|
TYPE_FIFO |
85
|
|
|
|
|
|
|
TYPE_FILE |
86
|
|
|
|
|
|
|
TYPE_FILESYSTEM |
87
|
|
|
|
|
|
|
TYPE_HOST |
88
|
|
|
|
|
|
|
TYPE_PROCESS |
89
|
|
|
|
|
|
|
TYPE_SYSTEM |
90
|
|
|
|
|
|
|
/], |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
hashes => [qw/ |
93
|
|
|
|
|
|
|
%MONIT_ACTIONS |
94
|
|
|
|
|
|
|
%MONIT_ACTIONS_REV |
95
|
|
|
|
|
|
|
%MONIT_STATUS |
96
|
|
|
|
|
|
|
%MONIT_STATUS_REV |
97
|
|
|
|
|
|
|
%MONIT_TYPES |
98
|
|
|
|
|
|
|
%MONIT_TYPES_REV |
99
|
|
|
|
|
|
|
%MONIT_MONITOR |
100
|
|
|
|
|
|
|
%MONIT_MONITOR_REV |
101
|
|
|
|
|
|
|
/], |
102
|
|
|
|
|
|
|
); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
@EXPORT_OK = ( |
105
|
|
|
|
|
|
|
@{$EXPORT_TAGS{constants}}, |
106
|
|
|
|
|
|
|
@{$EXPORT_TAGS{hashes}}, |
107
|
|
|
|
|
|
|
); |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
Exporter::export_ok_tags( keys %EXPORT_TAGS ); |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub new { |
113
|
3
|
|
|
3
|
1
|
2485
|
my ($class, %self) = @_; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
# OOP stuff |
116
|
3
|
|
33
|
|
|
22
|
$class = ref($class) || $class; |
117
|
3
|
|
|
|
|
9
|
my $self = \%self; |
118
|
3
|
|
|
|
|
19
|
bless $self, $class; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# set some defaults, if not already set |
121
|
3
|
|
100
|
|
|
42
|
$self->{hostname} ||= 'localhost'; |
122
|
3
|
|
50
|
|
|
20
|
$self->{port} ||= 2812; |
123
|
3
|
|
50
|
|
|
17
|
$self->{use_auth} ||= 0; |
124
|
3
|
50
|
|
|
|
10
|
if($self->{use_auth}) { |
125
|
0
|
|
0
|
|
|
0
|
$self->{username} ||= 'admin'; |
126
|
0
|
|
0
|
|
|
0
|
$self->{password} ||= 'monit'; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
3
|
|
|
|
|
33
|
$self->{ua} = HTTP::Tiny->new( agent => sprintf('Perl %s/%s',__PACKAGE__,$Monit::HTTP::VERSION) ); |
130
|
3
|
|
|
|
|
312
|
$self->_generate_url; |
131
|
|
|
|
|
|
|
|
132
|
3
|
|
|
|
|
9
|
return $self |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub _generate_url { |
136
|
|
|
|
|
|
|
|
137
|
5
|
|
|
5
|
|
20
|
my $self = shift; |
138
|
|
|
|
|
|
|
|
139
|
5
|
|
|
|
|
12
|
my $auth = ''; |
140
|
5
|
0
|
33
|
|
|
32
|
if (defined $self->{username} and defined $self->{password} and $self->{use_auth}) { |
|
|
|
33
|
|
|
|
|
141
|
|
|
|
|
|
|
$auth = sprintf('%s:%s@',$self->{username},$self->{password}) |
142
|
0
|
|
|
|
|
0
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
$self->{status_url} = sprintf('http://%s%s:%d/_status?format=xml', |
145
|
5
|
|
|
|
|
42
|
$auth, $self->{hostname}, $self->{port}); |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
sub set_hostname { |
150
|
1
|
|
|
1
|
1
|
3113
|
my ($self, $hostname) = @_; |
151
|
1
|
|
|
|
|
7
|
$self->{hostname} = $hostname; |
152
|
1
|
|
|
|
|
7
|
$self->_generate_url; |
153
|
1
|
|
|
|
|
7
|
return $hostname |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub set_port { |
158
|
1
|
|
|
1
|
1
|
2067
|
my ($self, $port) = @_; |
159
|
1
|
|
|
|
|
3
|
$self->{port} = $port; |
160
|
1
|
|
|
|
|
3
|
$self->_generate_url; |
161
|
1
|
|
|
|
|
4
|
return $port |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub set_username { |
166
|
0
|
|
|
0
|
1
|
0
|
my ($self, $username) = @_; |
167
|
0
|
|
|
|
|
0
|
$self->{username} = $username; |
168
|
0
|
|
|
|
|
0
|
$self->_generate_url; |
169
|
0
|
|
|
|
|
0
|
return $username |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
sub set_password { |
174
|
0
|
|
|
0
|
1
|
0
|
my ($self, $password ) = @_; |
175
|
0
|
|
|
|
|
0
|
$self->{password} = $password; |
176
|
0
|
|
|
|
|
0
|
$self->_generate_url; |
177
|
0
|
|
|
|
|
0
|
return $password |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
sub _fetch_info { |
182
|
7
|
|
|
7
|
|
17
|
my ($self) = @_; |
183
|
|
|
|
|
|
|
|
184
|
7
|
|
|
|
|
161
|
my $res = $self->{ua}->get( $self->{status_url} ); |
185
|
7
|
100
|
|
|
|
31987
|
if ($res->{success}) { |
186
|
3
|
|
|
|
|
9
|
$self->_set_xml($res->{content}); |
187
|
3
|
|
|
|
|
9
|
$self->{xml_hash} = xml2hash( $self->_get_xml ); |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
else { |
190
|
|
|
|
|
|
|
croak sprintf "Error while connecting to %s !\n" . |
191
|
|
|
|
|
|
|
"Status: %s\nReason: %s\nContent: %s\n", |
192
|
4
|
|
50
|
|
|
948
|
$self->{status_url}, $res->{status}, $res->{reason}, $res->{content} || 'NIL'; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
3
|
|
|
|
|
765
|
return 1 |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
sub get_services { |
200
|
5
|
|
|
5
|
1
|
7475
|
my ($self, $type) = @_; |
201
|
5
|
|
|
|
|
11
|
my @services; |
202
|
5
|
|
50
|
|
|
30
|
$type ||= '-1'; |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
croak "Don't understand this service type!\n" |
205
|
5
|
50
|
33
|
|
|
37
|
unless $type == -1 or grep {$_ == $type} keys %{MONIT_TYPES()}; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
206
|
|
|
|
|
|
|
|
207
|
5
|
|
|
|
|
21
|
$self->_fetch_info; |
208
|
|
|
|
|
|
|
|
209
|
1
|
|
|
|
|
2
|
for my $s (@{$self->{xml_hash}->{monit}->{service}}) { |
|
1
|
|
|
|
|
5
|
|
210
|
2
|
50
|
33
|
|
|
7
|
if ($type == -1 or $s->{'-type'} == $type) { |
211
|
2
|
|
|
|
|
5
|
push @services, $s->{name}; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
} |
214
|
1
|
|
|
|
|
5
|
return @services; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
sub _set_xml { |
219
|
3
|
|
|
3
|
|
8
|
my ($self, $xml) = @_; |
220
|
3
|
|
|
|
|
6
|
$self->{status_raw_content} = $xml; |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
sub _get_xml { |
225
|
4
|
|
|
4
|
|
1384
|
my ($self) = @_; |
226
|
4
|
|
|
|
|
37
|
return $self->{status_raw_content}; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
sub service_status { |
231
|
2
|
|
|
2
|
1
|
1221
|
my ($self, $service) = @_; |
232
|
2
|
|
|
|
|
5
|
my $status_href = {}; |
233
|
|
|
|
|
|
|
|
234
|
2
|
|
|
|
|
6
|
$self->_fetch_info; |
235
|
|
|
|
|
|
|
|
236
|
2
|
|
|
|
|
5
|
for my $s (@{$self->{xml_hash}->{monit}->{service}}) { |
|
2
|
|
|
|
|
7
|
|
237
|
4
|
100
|
|
|
|
12
|
if ($s->{name} eq $service) { |
238
|
|
|
|
|
|
|
|
239
|
2
|
|
|
|
|
5
|
$status_href->{host} = $self->{hostname}; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
$status_href->{'type'} = $s->{'-type'} |
242
|
2
|
50
|
|
|
|
8
|
if exists $s->{'-type'}; |
243
|
|
|
|
|
|
|
|
244
|
2
|
|
|
|
|
6
|
for my $thing (qw/ |
245
|
|
|
|
|
|
|
children |
246
|
|
|
|
|
|
|
collected_sec |
247
|
|
|
|
|
|
|
collected_usec |
248
|
|
|
|
|
|
|
euid |
249
|
|
|
|
|
|
|
gid |
250
|
|
|
|
|
|
|
group |
251
|
|
|
|
|
|
|
monitor |
252
|
|
|
|
|
|
|
monitormode |
253
|
|
|
|
|
|
|
pid |
254
|
|
|
|
|
|
|
ppid |
255
|
|
|
|
|
|
|
name |
256
|
|
|
|
|
|
|
pendingaction |
257
|
|
|
|
|
|
|
status |
258
|
|
|
|
|
|
|
status_hint |
259
|
|
|
|
|
|
|
uid |
260
|
|
|
|
|
|
|
uptime |
261
|
|
|
|
|
|
|
/) { |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
$status_href->{$thing} = $s->{$thing} |
264
|
32
|
100
|
|
|
|
67
|
if exists $s->{$thing}; |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
} # main stuff loop |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
# the 'system' (type 5) service sticks these things in to ->{system}, others are top level |
269
|
2
|
50
|
33
|
|
|
11
|
if (my $sys = $s->{system} || $s) { |
270
|
2
|
|
|
|
|
5
|
for my $thing (qw/ kilobyte kilobytetotal percent percenttotal /) { |
271
|
|
|
|
|
|
|
$status_href->{memory}->{$thing} = $sys->{memory}->{$thing} |
272
|
8
|
100
|
|
|
|
24
|
if exists $sys->{memory}->{$thing}; |
273
|
|
|
|
|
|
|
} # memory loop |
274
|
|
|
|
|
|
|
|
275
|
2
|
|
|
|
|
4
|
for my $thing (qw/ kilobyte percent /) { |
276
|
|
|
|
|
|
|
$status_href->{swap}->{$thing} = $sys->{swap}->{$thing} |
277
|
4
|
50
|
|
|
|
10
|
if exists $sys->{swap}->{$thing}; |
278
|
|
|
|
|
|
|
} # swap loop |
279
|
|
|
|
|
|
|
|
280
|
2
|
|
|
|
|
4
|
for my $thing (qw/ percent percenttotal /) { |
281
|
|
|
|
|
|
|
$status_href->{cpu}->{$thing} = $sys->{cpu}->{$thing} |
282
|
4
|
100
|
|
|
|
12
|
if exists $sys->{cpu}->{$thing}; |
283
|
|
|
|
|
|
|
} # cpu loop |
284
|
|
|
|
|
|
|
|
285
|
2
|
|
|
|
|
5
|
for my $thing (qw/ avg01 avg05 avg15 /) { |
286
|
|
|
|
|
|
|
$status_href->{load}->{$thing} = $sys->{load}->{$thing} |
287
|
6
|
100
|
|
|
|
18
|
if exists $sys->{load}->{$thing}; |
288
|
|
|
|
|
|
|
} # load loop |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
2
|
50
|
|
|
|
8
|
croak "Service $service does not exist\n" |
295
|
|
|
|
|
|
|
unless scalar keys %$status_href; |
296
|
|
|
|
|
|
|
|
297
|
2
|
|
|
|
|
8
|
return $status_href |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
sub command_run { |
303
|
0
|
|
|
0
|
1
|
|
my ($self, $service, $command) = @_; |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
croak "Don't understand this action\n" |
306
|
0
|
0
|
|
|
|
|
unless grep { $command eq $_ } keys %{MONIT_ACTIONS()}; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
|
308
|
0
|
0
|
|
|
|
|
if(not defined $service) { |
309
|
0
|
|
|
|
|
|
$self->{is_success} = 0; |
310
|
0
|
|
|
|
|
|
croak "Service not specified\n"; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
# if services does not exist throw error |
314
|
|
|
|
|
|
|
|
315
|
0
|
|
|
|
|
|
my $url = 'http://'.$self->{hostname}.':'.$self->{port}.'/'.$service; |
316
|
|
|
|
|
|
|
|
317
|
0
|
|
|
|
|
|
my $res = $self->{ua}->post_form($url, { action => $command }); |
318
|
|
|
|
|
|
|
croak $res->{status} |
319
|
0
|
0
|
|
|
|
|
unless $res->{success}; |
320
|
|
|
|
|
|
|
|
321
|
0
|
|
|
|
|
|
return 1 |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
1; # End of Monit::HTTP |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
__END__ |