File Coverage

blib/lib/Zabbix/ServerScript.pm
Criterion Covered Total %
statement 239 243 98.3
branch 92 102 90.2
condition 23 30 76.6
subroutine 39 40 97.5
pod 7 7 100.0
total 400 422 94.7


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__