line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Zabbix::ServerScript; |
2
|
|
|
|
|
|
|
|
3
|
19
|
|
|
19
|
|
959772
|
use strict; |
|
19
|
|
|
|
|
23
|
|
|
19
|
|
|
|
|
432
|
|
4
|
19
|
|
|
19
|
|
64
|
use warnings; |
|
19
|
|
|
|
|
18
|
|
|
19
|
|
|
|
|
374
|
|
5
|
19
|
|
|
19
|
|
56
|
use Exporter; |
|
19
|
|
|
|
|
29
|
|
|
19
|
|
|
|
|
490
|
|
6
|
19
|
|
|
19
|
|
547
|
use Data::Dumper; |
|
19
|
|
|
|
|
4521
|
|
|
19
|
|
|
|
|
573
|
|
7
|
19
|
|
|
19
|
|
7087
|
use YAML; |
|
19
|
|
|
|
|
91039
|
|
|
19
|
|
|
|
|
765
|
|
8
|
19
|
|
|
19
|
|
9918
|
use JSON; |
|
19
|
|
|
|
|
138633
|
|
|
19
|
|
|
|
|
61
|
|
9
|
19
|
|
|
19
|
|
14957
|
use Log::Log4perl; |
|
19
|
|
|
|
|
602797
|
|
|
19
|
|
|
|
|
81
|
|
10
|
19
|
|
|
19
|
|
704
|
use Log::Log4perl::Level; |
|
19
|
|
|
|
|
24
|
|
|
19
|
|
|
|
|
74
|
|
11
|
19
|
|
|
19
|
|
10469
|
use Proc::PID::File; |
|
19
|
|
|
|
|
27723
|
|
|
19
|
|
|
|
|
753
|
|
12
|
19
|
|
|
19
|
|
9135
|
use Proc::Daemon; |
|
19
|
|
|
|
|
121478
|
|
|
19
|
|
|
|
|
504
|
|
13
|
19
|
|
|
19
|
|
98
|
use File::Basename; |
|
19
|
|
|
|
|
18
|
|
|
19
|
|
|
|
|
1034
|
|
14
|
19
|
|
|
19
|
|
70
|
use Exporter; |
|
19
|
|
|
|
|
20
|
|
|
19
|
|
|
|
|
445
|
|
15
|
19
|
|
|
19
|
|
59
|
use Carp; |
|
19
|
|
|
|
|
19
|
|
|
19
|
|
|
|
|
669
|
|
16
|
19
|
|
|
19
|
|
5999
|
use Storable; |
|
19
|
|
|
|
|
23752
|
|
|
19
|
|
|
|
|
781
|
|
17
|
19
|
|
|
19
|
|
8666
|
use Term::ReadLine; |
|
19
|
|
|
|
|
37561
|
|
|
19
|
|
|
|
|
436
|
|
18
|
19
|
|
|
19
|
|
8208
|
use Term::UI; |
|
19
|
|
|
|
|
362346
|
|
|
19
|
|
|
|
|
561
|
|
19
|
19
|
|
|
19
|
|
12035
|
use Getopt::Long qw(:config bundling); |
|
19
|
|
|
|
|
125352
|
|
|
19
|
|
|
|
|
61
|
|
20
|
19
|
|
|
19
|
|
11122
|
use List::MoreUtils qw(uniq); |
|
19
|
|
|
|
|
121019
|
|
|
19
|
|
|
|
|
94
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
BEGIN { |
23
|
|
|
|
|
|
|
eval { |
24
|
19
|
|
|
|
|
3236
|
require Zabbix::ServerScript::Config; |
25
|
0
|
|
|
|
|
0
|
1; |
26
|
19
|
50
|
33
|
19
|
|
7911
|
} or eval { |
27
|
19
|
|
|
|
|
7714
|
require Zabbix::ServerScript::DefaultConfig; |
28
|
19
|
|
|
|
|
33028
|
1; |
29
|
|
|
|
|
|
|
} or die q(Either Zabbix::ServerScript::DefaultConfig or Zabbix::ServerScript::Config is required); |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
our @ISA = q(Exporter); |
33
|
|
|
|
|
|
|
our @EXPORT = qw($config $logger $zx_api create_config); |
34
|
|
|
|
|
|
|
our $VERSION = q(0.12); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
our $config = {}; |
37
|
|
|
|
|
|
|
our $logger; |
38
|
|
|
|
|
|
|
our $zx_api; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub _get_options { |
41
|
18
|
|
|
18
|
|
4645
|
my ($opt, @opt_specs) = @_; |
42
|
18
|
|
|
|
|
72
|
my $default_opt = { |
43
|
|
|
|
|
|
|
daemon => 0, |
44
|
|
|
|
|
|
|
verbose => 0, |
45
|
|
|
|
|
|
|
debug => 0, |
46
|
|
|
|
|
|
|
unique => 0, |
47
|
|
|
|
|
|
|
debug => 0, |
48
|
|
|
|
|
|
|
console => 0, |
49
|
|
|
|
|
|
|
}; |
50
|
18
|
100
|
|
|
|
89
|
$opt = { |
51
|
|
|
|
|
|
|
%$default_opt, |
52
|
|
|
|
|
|
|
(defined $opt ? %$opt : ()), |
53
|
|
|
|
|
|
|
}; |
54
|
18
|
|
|
|
|
39
|
my @default_opt_specs = qw( |
55
|
|
|
|
|
|
|
verbose|v+ |
56
|
|
|
|
|
|
|
debug |
57
|
|
|
|
|
|
|
daemon |
58
|
|
|
|
|
|
|
console |
59
|
|
|
|
|
|
|
); |
60
|
18
|
|
|
|
|
128
|
@opt_specs = uniq (@opt_specs, @default_opt_specs); |
61
|
18
|
100
|
|
|
|
66
|
GetOptions($opt, @opt_specs) or croak qq(Cannot get options); |
62
|
17
|
|
|
|
|
3263
|
return $opt; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub _set_basename { |
66
|
10
|
|
|
10
|
|
1009
|
my @caller = @_; |
67
|
10
|
|
|
|
|
444
|
$ENV{BASENAME} = basename($caller[1]); |
68
|
10
|
|
|
|
|
31
|
$ENV{BASENAME} =~ s/\.pl$//; |
69
|
10
|
|
|
|
|
23
|
$ENV{BASENAME} =~ s/[\0\/]//; |
70
|
10
|
|
|
|
|
16
|
return; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub _set_binmode { |
74
|
0
|
|
|
0
|
|
0
|
binmode(STDOUT, q(utf8:)); |
75
|
0
|
|
|
|
|
0
|
binmode(STDERR, q(utf8:)); |
76
|
0
|
|
|
|
|
0
|
return; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub _set_id { |
80
|
12
|
|
|
12
|
|
1424
|
my ($id) = @_; |
81
|
12
|
100
|
|
|
|
27
|
if (defined $id){ |
82
|
2
|
|
|
|
|
7
|
$ENV{ID} = $id; |
83
|
|
|
|
|
|
|
} else { |
84
|
10
|
|
|
|
|
32
|
$ENV{ID} = $ENV{BASENAME}; |
85
|
|
|
|
|
|
|
} |
86
|
12
|
|
|
|
|
15
|
return; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub _set_logger { |
90
|
78
|
|
|
78
|
|
629128
|
my ($opt) = @_; |
91
|
78
|
100
|
|
|
|
198
|
$opt = {} unless defined $opt; |
92
|
|
|
|
|
|
|
|
93
|
78
|
50
|
|
|
|
276
|
croak qq(Couldn't find 'log_dir' section in Zabbix::ServerScript::Config) unless defined $Zabbix::ServerScript::Config->{log_dir}; |
94
|
78
|
100
|
66
|
|
|
707
|
croak qq(Environment variables BASENAME and ID are not set) unless (defined $ENV{BASENAME} and $ENV{ID}); |
95
|
75
|
100
|
|
|
|
136
|
if (defined $opt->{log_filename}){ |
96
|
31
|
100
|
|
|
|
66
|
if ($opt->{log_filename} ne q()){ |
97
|
28
|
|
|
|
|
95
|
$ENV{LOG_FILENAME} = $opt->{log_filename}; |
98
|
|
|
|
|
|
|
} else { |
99
|
3
|
|
|
|
|
15
|
$logger->logdie(q(Cannot log to empty filename)); |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
} else { |
102
|
44
|
|
|
|
|
178
|
$ENV{LOG_FILENAME} = qq($Zabbix::ServerScript::Config->{log_dir}/$ENV{BASENAME}.log); |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
72
|
100
|
|
|
|
360
|
croak qq(Couldn't find 'log' section in Zabbix::ServerScript::Config) unless defined $Zabbix::ServerScript::Config->{log}; |
106
|
69
|
|
|
|
|
383
|
Log::Log4perl->init($Zabbix::ServerScript::Config->{log}); |
107
|
|
|
|
|
|
|
|
108
|
66
|
|
|
|
|
274837
|
my $log_category; |
109
|
66
|
100
|
|
|
|
153
|
if (defined $opt->{logger}){ |
110
|
15
|
100
|
|
|
|
30
|
if ($opt->{logger} eq q()){ |
111
|
12
|
|
|
|
|
15
|
$log_category = q(Zabbix.ServerScript.nolog); |
112
|
|
|
|
|
|
|
} else { |
113
|
3
|
|
|
|
|
3
|
$log_category = $opt->{logger}; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
} else { |
116
|
51
|
100
|
100
|
|
|
207
|
if (defined $opt->{console} && $opt->{console} == 1){ |
117
|
16
|
|
|
|
|
16
|
$log_category = q(Zabbix.ServerScript.console); |
118
|
|
|
|
|
|
|
} else { |
119
|
35
|
|
|
|
|
47
|
$log_category = q(Zabbix.ServerScript); |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
} |
122
|
66
|
|
|
|
|
159
|
$logger = Log::Log4perl::get_logger($log_category); |
123
|
66
|
|
|
|
|
1636
|
$ENV{LOG_CATEGORY} = $log_category; |
124
|
|
|
|
|
|
|
|
125
|
66
|
100
|
66
|
|
|
180
|
if (defined $opt->{verbose} && $opt->{verbose}){ |
126
|
7
|
|
|
|
|
22
|
$logger->more_logging($opt->{verbose}); |
127
|
|
|
|
|
|
|
} |
128
|
66
|
100
|
100
|
|
|
4802
|
if (defined $opt->{debug} && $opt->{debug} == 1){ |
129
|
5
|
|
|
|
|
14
|
$logger->level($DEBUG); |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
$SIG{__DIE__} = sub { |
133
|
59
|
|
|
59
|
|
15217
|
my ($message) = @_; |
134
|
59
|
100
|
100
|
|
|
445
|
if($^S and not (defined $ENV{ZBX_TESTING} and $ENV{ZBX_TESTING} == 1)) { |
|
|
|
100
|
|
|
|
|
135
|
|
|
|
|
|
|
# We're in an eval {} and don't want log |
136
|
|
|
|
|
|
|
# this message but catch it later |
137
|
36
|
|
|
|
|
290
|
return; |
138
|
|
|
|
|
|
|
} |
139
|
23
|
|
|
|
|
29
|
$Log::Log4perl::caller_depth++; |
140
|
23
|
|
|
|
|
79
|
$logger->fatal($message); |
141
|
66
|
|
|
|
|
3147
|
}; |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
$SIG{__WARN__} = sub { |
144
|
4
|
|
|
4
|
|
1533
|
my ($message) = @_; |
145
|
4
|
|
|
|
|
24
|
local $Log::Log4perl::caller_depth; |
146
|
4
|
|
|
|
|
12
|
$Log::Log4perl::caller_depth++; |
147
|
4
|
|
|
|
|
103
|
$logger->warn($message); |
148
|
66
|
|
|
|
|
250
|
}; |
149
|
66
|
|
|
|
|
154
|
return; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub _set_config { |
153
|
14
|
|
|
14
|
|
5116
|
my ($config_filename) = @_; |
154
|
|
|
|
|
|
|
|
155
|
14
|
100
|
66
|
|
|
78
|
$logger->logcroak(qq(Environment variables BASENAME and ID are not set)) unless (defined $ENV{BASENAME} and $ENV{ID}); |
156
|
|
|
|
|
|
|
|
157
|
13
|
100
|
|
|
|
49
|
if (not defined $config_filename){ |
158
|
11
|
|
|
|
|
39
|
$config_filename = qq($Zabbix::ServerScript::Config->{config_dir}/$ENV{BASENAME}.yaml); |
159
|
|
|
|
|
|
|
} |
160
|
13
|
50
|
|
|
|
28
|
if ($config_filename ne q()){ |
161
|
13
|
100
|
|
|
|
261
|
if (-f $config_filename){ |
162
|
2
|
|
|
|
|
9
|
$logger->debug(qq(Loading local config from file $config_filename)); |
163
|
2
|
50
|
|
|
|
15
|
$config = YAML::LoadFile($config_filename) or $logger->logdie(qq(Cannot load config from $config_filename)); |
164
|
|
|
|
|
|
|
} else { |
165
|
11
|
50
|
|
|
|
79
|
$logger->debug(qq(Local config $config_filename was not found.)) unless $config_filename eq q(); |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
} |
168
|
12
|
|
|
|
|
7905
|
$config->{global} = $Zabbix::ServerScript::Config; |
169
|
12
|
|
|
|
|
27
|
return; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
sub _set_api { |
173
|
17
|
|
|
17
|
|
3662
|
my ($api) = @_; |
174
|
17
|
|
|
|
|
15
|
my $api_config; |
175
|
17
|
100
|
|
|
|
42
|
if (defined $api){ |
176
|
8
|
|
|
|
|
36
|
require Zabbix::ServerScript::API; |
177
|
8
|
|
|
|
|
17
|
$zx_api = Zabbix::ServerScript::API::init($api); |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
sub _get_pid { |
182
|
8
|
|
|
8
|
|
5715
|
my ($id) = @_; |
183
|
8
|
|
|
|
|
37
|
my $name = $ENV{BASENAME}; |
184
|
8
|
100
|
|
|
|
23
|
$name .= qq(_$id) if defined $id; |
185
|
8
|
|
|
|
|
46
|
$name =~ s/[\0\/]/_/g; |
186
|
|
|
|
|
|
|
my $pid = { |
187
|
|
|
|
|
|
|
name => $name, |
188
|
|
|
|
|
|
|
dir => $Zabbix::ServerScript::Config->{pid_dir}, |
189
|
8
|
|
|
|
|
65
|
}; |
190
|
8
|
|
|
|
|
122
|
$logger->debug(qq(Using PID file $pid->{dir}/$pid->{name}.pid)); |
191
|
8
|
|
|
|
|
90
|
return $pid; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub _set_unique { |
195
|
11
|
|
|
11
|
|
2428
|
my ($unique, $id) = @_; |
196
|
11
|
100
|
66
|
|
|
238
|
if (defined $unique && $unique){ |
197
|
2
|
|
|
|
|
53
|
my $pid = _get_pid($id); |
198
|
2
|
100
|
|
|
|
107
|
if (Proc::PID::File->running($pid)){ |
199
|
1
|
|
|
|
|
1088
|
croak(qq($pid->{name} is already running)); |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub _set_daemon { |
205
|
11
|
|
|
11
|
|
3192
|
my ($daemon) = @_; |
206
|
11
|
100
|
|
|
|
287
|
return Proc::Daemon::Init() if $daemon; |
207
|
9
|
|
|
|
|
10
|
return; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
sub retrieve_cache { |
211
|
4
|
|
|
4
|
1
|
2261
|
my ($cache_filename) = @_; |
212
|
4
|
100
|
|
|
|
9
|
if (not defined $cache_filename){ |
213
|
1
|
|
|
|
|
3
|
$logger->debug(q(Cache filename is not specified, using default filename)); |
214
|
1
|
|
|
|
|
7
|
$cache_filename = qq($Zabbix::ServerScript::Config->{cache_dir}/$ENV{BASENAME}.cache) |
215
|
|
|
|
|
|
|
} |
216
|
4
|
|
|
|
|
4
|
my $cache; |
217
|
4
|
100
|
|
|
|
34
|
if (-f $cache_filename){ |
218
|
3
|
|
|
|
|
13
|
$logger->debug(qq(Loading cache from "$cache_filename")); |
219
|
|
|
|
|
|
|
eval { |
220
|
3
|
|
|
|
|
6
|
$cache = retrieve $cache_filename; |
221
|
2
|
|
|
|
|
88
|
1; |
222
|
3
|
100
|
|
|
|
16
|
} or do { |
223
|
1
|
|
|
|
|
5
|
$logger->error(qq(Cannot retrieve cache from "$cache_filename": $@)); |
224
|
|
|
|
|
|
|
}; |
225
|
|
|
|
|
|
|
} else { |
226
|
1
|
|
|
|
|
6
|
$logger->info(qq(Cache file "$cache_filename" was not found)); |
227
|
|
|
|
|
|
|
} |
228
|
4
|
|
|
|
|
284
|
return $cache; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
sub store_cache { |
232
|
3
|
|
|
3
|
1
|
2826
|
my ($cache, $cache_filename) = @_; |
233
|
3
|
100
|
|
|
|
8
|
if (not defined $cache_filename){ |
234
|
1
|
|
|
|
|
4
|
$logger->debug(q(Cache filename is not specified, using default filename)); |
235
|
1
|
|
|
|
|
7
|
$cache_filename = qq($Zabbix::ServerScript::Config->{cache_dir}/$ENV{BASENAME}.cache) |
236
|
|
|
|
|
|
|
} |
237
|
3
|
|
|
|
|
10
|
$logger->debug(qq(Storing cache to $cache_filename)); |
238
|
|
|
|
|
|
|
eval { |
239
|
3
|
|
|
|
|
7
|
store $cache, $cache_filename; |
240
|
2
|
|
|
|
|
259
|
1; |
241
|
3
|
100
|
|
|
|
14
|
} or do { |
242
|
1
|
|
|
|
|
4
|
$logger->error(qq(Cannot store cache to "$cache_filename")); |
243
|
1
|
|
|
|
|
189
|
return; |
244
|
|
|
|
|
|
|
}; |
245
|
2
|
|
|
|
|
6
|
return 1; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
sub init { |
249
|
9
|
|
|
9
|
1
|
10355
|
my ($opt, @opt_specs) = @_; |
250
|
|
|
|
|
|
|
|
251
|
9
|
|
|
|
|
41
|
$opt = _get_options($opt, @opt_specs); |
252
|
9
|
|
|
|
|
32
|
_set_basename(caller); |
253
|
9
|
|
|
|
|
33
|
_set_id($opt->{id}); |
254
|
9
|
|
|
|
|
27
|
_set_daemon($opt->{daemon}); |
255
|
9
|
|
|
|
|
20
|
_set_logger($opt); |
256
|
9
|
|
|
|
|
30
|
_set_unique($opt->{unique}, $opt->{id}); |
257
|
9
|
|
|
|
|
29
|
_set_config($opt->{config}); |
258
|
9
|
|
|
|
|
32
|
_set_api($opt->{api}); |
259
|
9
|
|
|
|
|
24
|
$logger->debug(q(Initialized Zabbix::ServerScript)); |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub return_value { |
263
|
3
|
|
|
3
|
1
|
3183
|
my ($value) = @_; |
264
|
3
|
100
|
|
|
|
19
|
if (defined $value){ |
265
|
1
|
|
|
|
|
70
|
$logger->debug(qq(Return value: $value)); |
266
|
1
|
|
|
|
|
38
|
chomp $value; |
267
|
1
|
|
|
|
|
66
|
print qq($value\n); |
268
|
1
|
|
|
|
|
182
|
exit; |
269
|
|
|
|
|
|
|
} else { |
270
|
2
|
|
|
|
|
8
|
$logger->logcroak(q(Return value is not defined)); |
271
|
|
|
|
|
|
|
} |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
sub connect_to_db { |
275
|
3
|
|
|
3
|
1
|
14417
|
my ($dbname, $user, $password, $mode) = @_; |
276
|
3
|
100
|
|
|
|
11
|
$logger->logcroak(q(dbname is not defined)) unless defined $dbname; |
277
|
2
|
|
|
|
|
2
|
my $dbh; |
278
|
2
|
|
|
|
|
9
|
$logger->debug(qq(Trying to connect to $dbname via ODBC)); |
279
|
2
|
100
|
|
|
|
15
|
$dbh = DBI->connect( |
280
|
|
|
|
|
|
|
qq(dbi:ODBC:DSN=$dbname), |
281
|
|
|
|
|
|
|
$user, |
282
|
|
|
|
|
|
|
$password, |
283
|
|
|
|
|
|
|
) or $logger->logcroak(qq(Failed to connect to $dbname: $DBI::errstr)); |
284
|
1
|
|
|
|
|
5
|
$logger->debug(qq(Connected to $dbname)); |
285
|
1
|
|
|
|
|
6
|
return $dbh; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
sub _prepare_sender_data { |
289
|
8
|
|
|
8
|
|
8
|
my ($request_data) = @_; |
290
|
8
|
100
|
|
|
|
17
|
if (ref($request_data) eq q(HASH)){ |
|
|
100
|
|
|
|
|
|
291
|
6
|
|
|
|
|
8
|
$request_data = [ $request_data ]; |
292
|
|
|
|
|
|
|
} elsif (ref($request_data) ne q(ARRAY)){ |
293
|
1
|
|
|
|
|
5
|
croak(qq(Request is neither arrayref nor hashref: ) . Dumper($request_data)); |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
$request_data = { |
296
|
7
|
|
|
|
|
14
|
request => q(sender data), |
297
|
|
|
|
|
|
|
data => $request_data, |
298
|
|
|
|
|
|
|
}; |
299
|
|
|
|
|
|
|
# encode_json throws an exception itself, if it cannot encode json. |
300
|
|
|
|
|
|
|
# This 'croak' stands here just in case encode_json implementation will be changed. |
301
|
7
|
50
|
|
|
|
65
|
my $request_json = encode_json($request_data) or croak(qq(Cannot encode to JSON: ) . Dumper($request_data)); |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
sub _proceed_sender_response { |
305
|
2
|
|
|
2
|
|
2
|
my ($response_json) = @_; |
306
|
2
|
|
|
|
|
10
|
$response_json =~ s/^.+(?={)//; |
307
|
2
|
50
|
|
|
|
20
|
my $response_data = decode_json($response_json) or croak(qq(Cannon decode JSON)); |
308
|
1
|
|
|
|
|
2
|
return $response_data; |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
sub send { |
312
|
12
|
|
|
12
|
1
|
8815
|
my ($request_data, $sender_host, $sender_port) = @_; |
313
|
12
|
100
|
|
|
|
27
|
$sender_host = q(localhost) if not defined $sender_host; |
314
|
12
|
100
|
|
|
|
20
|
$sender_port = q(10051) if not defined $sender_port; |
315
|
12
|
|
|
|
|
39
|
$logger->debug(qq(Opening sender socket to $sender_host:$sender_port)); |
316
|
12
|
|
|
|
|
2396
|
require IO::Socket::INET; |
317
|
12
|
100
|
|
|
|
31
|
my $socket = IO::Socket::INET->new( |
318
|
|
|
|
|
|
|
PeerAddr => $sender_host, |
319
|
|
|
|
|
|
|
PeerPort => $sender_port, |
320
|
|
|
|
|
|
|
Proto => q(tcp), |
321
|
|
|
|
|
|
|
Timeout => 10, |
322
|
|
|
|
|
|
|
) or croak(qq(Cannot open socket for zabbix sender to "$sender_host:$sender_port": $?)); |
323
|
|
|
|
|
|
|
|
324
|
8
|
|
|
|
|
58
|
my $request_json = _prepare_sender_data($request_data); |
325
|
6
|
|
|
|
|
7
|
my $request_length = length($request_json); |
326
|
6
|
|
|
|
|
5
|
my $response_json; |
327
|
|
|
|
|
|
|
|
328
|
6
|
|
|
|
|
19
|
$logger->debug(qq(Writing $request_length of data to sender socket: $request_json)); |
329
|
6
|
100
|
|
|
|
1034
|
$socket->write($request_json, $request_length) or croak(qq(Cannot write to socket: $!)); |
330
|
4
|
100
|
|
|
|
15
|
$socket->read($response_json, 2048) or croak(qq(Cannot read from socket: $!)); |
331
|
3
|
100
|
|
|
|
11
|
$socket->close or croak(qq(Cannot close socket: $!)); |
332
|
2
|
|
|
|
|
11
|
$logger->debug(qq(Server answered to sender: $response_json)); |
333
|
2
|
|
|
|
|
326
|
my $response_data = _proceed_sender_response($response_json); |
334
|
1
|
|
|
|
|
4
|
return $response_data; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
sub create_config { |
338
|
4
|
|
|
4
|
1
|
1003790
|
require Zabbix::ServerScript::DefaultConfig; |
339
|
|
|
|
|
|
|
|
340
|
4
|
|
|
|
|
6
|
my ($opt) = @_; |
341
|
4
|
50
|
|
|
|
28
|
$opt = { |
342
|
|
|
|
|
|
|
console => 1, |
343
|
|
|
|
|
|
|
verbose => 1, |
344
|
|
|
|
|
|
|
(defined $opt ? %$opt : ()), |
345
|
|
|
|
|
|
|
}; |
346
|
4
|
|
|
|
|
19
|
print Dumper($opt); |
347
|
4
|
|
|
|
|
407
|
init($opt); |
348
|
|
|
|
|
|
|
|
349
|
4
|
|
|
|
|
47
|
my $term = Term::ReadLine->new('Zabbix::ServerScript'); |
350
|
4
|
|
|
|
|
8407
|
(my $module_dir = dirname($INC{q(Zabbix/ServerScript/DefaultConfig.pm)})) =~ s|//|/|g; |
351
|
4
|
|
|
|
|
41
|
$module_dir = $term->get_reply( |
352
|
|
|
|
|
|
|
prompt => q(Directory to store Config.pm), |
353
|
|
|
|
|
|
|
default => $module_dir, |
354
|
|
|
|
|
|
|
); |
355
|
4
|
100
|
66
|
|
|
134
|
die(qq(Wrong directory: $module_dir)) unless (-d $module_dir and -w $module_dir); |
356
|
3
|
|
|
|
|
11
|
$logger->debug(qq(Will store Config.pm in $module_dir)); |
357
|
|
|
|
|
|
|
|
358
|
3
|
|
|
|
|
17
|
my $module_filename = qq($module_dir/Config.pm); |
359
|
3
|
100
|
|
|
|
33
|
if (-f $module_filename){ |
360
|
2
|
100
|
|
|
|
11
|
$term->ask_yn( |
361
|
|
|
|
|
|
|
prompt => qq(\n$module_filename exists.\nOverwrite?), |
362
|
|
|
|
|
|
|
default => q(n), |
363
|
|
|
|
|
|
|
) or exit 0; |
364
|
1
|
|
|
|
|
7
|
$logger->info(q(Overwrite has been requested)); |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
2
|
|
|
|
|
283
|
for my $section (qw(config_dir pid_dir log_dir)){ |
368
|
|
|
|
|
|
|
$Zabbix::ServerScript::Config->{$section} = $term->get_reply( |
369
|
|
|
|
|
|
|
prompt => $section, |
370
|
6
|
|
|
|
|
19
|
default => $Zabbix::ServerScript::Config->{$section}, |
371
|
|
|
|
|
|
|
); |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
|
374
|
2
|
50
|
|
|
|
119
|
open my $fh, q(>), $module_filename or die(qq(Cannot open file $module_filename: $!)); |
375
|
2
|
|
|
|
|
17
|
print $fh Data::Dumper->Dump([$Zabbix::ServerScript::Config], [q($Zabbix::ServerScript::Config)]); |
376
|
2
|
|
|
|
|
419
|
close $fh; |
377
|
|
|
|
|
|
|
|
378
|
2
|
50
|
|
|
|
425
|
require $module_filename or die(qq(Cannot load module: $!)); |
379
|
2
|
|
|
|
|
12
|
$logger->info(qq($module_filename has been created successfully)); |
380
|
2
|
|
|
|
|
469
|
exit 0; |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
1; |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
__END__ |