File Coverage

blib/lib/App/MonM.pm
Criterion Covered Total %
statement 66 187 35.2
branch 0 62 0.0
condition 0 49 0.0
subroutine 22 32 68.7
pod 6 6 100.0
total 94 336 27.9


line stmt bran cond sub pod time code
1             package App::MonM; # $Id: MonM.pm 151 2022-09-16 07:45:23Z abalama $
2 1     1   50154 use warnings;
  1         8  
  1         26  
3 1     1   4 use strict;
  1         1  
  1         13  
4 1     1   467 use utf8;
  1         11  
  1         3  
5              
6             =encoding utf-8
7              
8             =head1 NAME
9              
10             App::MonM - Simple monitoring tool
11              
12             =head1 VERSION
13              
14             Version 1.09
15              
16             =head1 SYNOPSIS
17              
18             # monm checkit
19             # monm report
20             # monm show
21              
22             =head1 DESCRIPTION
23              
24             Simple monitoring tool
25              
26             =head2 FEATURES
27              
28             =over 4
29              
30             =item Checking availability of sites (http/https)
31              
32             =item Checking of database health (DBI)
33              
34             =item Checking internal and external counters using system commands and tools (command)
35              
36             =item Supports SMTP, POP3, FTP, SSH protocols, and etc.
37              
38             =item Interface for SMS sending
39              
40             =item Easy installation and configuration
41              
42             =item A small number of system dependencies
43              
44             =back
45              
46             =head2 SYSTEM REQUIREMENTS
47              
48             =over 4
49              
50             =item Perl v5.16+
51              
52             =item L
53              
54             =item L
55              
56             =item L
57              
58             =item L
59              
60             To use this module in full powerful, you must have Net-SNMP installed
61             on your system. More specifically you need the Perl modules that come with it.
62              
63             DO NOT INSTALL SNMP or Net::SNMP from CPAN!
64              
65             The SNMP module is matched to an install of net-snmp, and must be installed
66             from the net-snmp source tree.
67              
68             The Perl module C is found inside the net-snmp distribution. Go to the
69             F directory of the distribution to install it, or run
70             C<./configure --with-perl-modules> from the top directory of the net-snmp
71             distribution.
72              
73             Net-SNMP can be found at https://net-snmp.sourceforge.io/
74              
75             =back
76              
77             =head2 INSTALLATION
78              
79             # sudo cpan install App::MonM
80              
81             ...and then:
82              
83             # sudo monm configure
84              
85             =head2 CONFIGURATION
86              
87             By default configuration file located in C directory
88              
89             B each configuration option (directive) detailed describes in C file,
90             see also C file for example of MonM checkit configuration
91              
92             =head3 GENERAL DIRECTIVES
93              
94             =over 4
95              
96             =item B, B
97              
98             DaemonUser monmu
99             DaemonGroup monmu
100              
101             Defines a username and groupname for daemon working
102              
103             Default: monmu
104              
105             =item B
106              
107             Expires 1d
108              
109             Defines the lifetime of a record in the database.
110             After this time, the record from the database will be deleted automatically.
111              
112             Format for time can be in any of the following forms:
113              
114             20 -- in 20 seconds
115             180s -- in 180 seconds
116             2m -- in 2 minutes
117             12h -- in 12 hours
118             1d -- in 1 day
119             3M -- in 3 months
120             2y -- in 2 years
121              
122             Default: 1d (1 day)
123              
124             =item B
125              
126             Interval 20
127              
128             Defines worker interval. This interval determines how often
129             the cycle of checks will be started.
130              
131             Default: 20
132              
133             =item B
134              
135             LogEnable on
136              
137             Activate or deactivate the logging: on/off (yes/no)
138              
139             Default: off
140              
141             =item B
142              
143             LogFile /var/log/monm.log
144              
145             Defines path to custom log file
146              
147             Default: use syslog
148              
149             =item B
150              
151             LogIdent myProgramName
152              
153             Defines LogIdent string. We not recommended use it
154              
155             Default: none
156              
157             =item B
158              
159             LogLevel warning
160              
161             Defines log level
162              
163             Allowed levels: debug, info, notice, warning, error,
164             crit, alert, emerg, fatal, except
165              
166             Default: debug
167              
168             =item B
169              
170             Workers 3
171              
172             Defines workers number
173              
174             Default: 3
175              
176             =back
177              
178             =head3 USER AND GROUP DIRECTIVES
179              
180             =over 4
181              
182             =item B
183              
184             The "Group" section combines several users into named groups.
185             This allows you to reduce the lists of recipients of notifications
186              
187            
188             Enable on
189             User Bob, Alice
190             User Ted
191            
192              
193             Each group has a status - enabled/disabled (see Enable directive)
194              
195             =item B
196              
197             The User section allows you to define the user name and settings.
198              
199            
200             Enable on
201              
202             At Sun[off];Mon-Thu[08:30-12:30,13:30-18:00];Fri[10:00-20:30];Sat[off]
203              
204            
205             To bob@example.com
206            
207              
208            
209             To +1-424-254-5301
210             At Mon-Fri[08:30-18:30]
211            
212            
213              
214             Each user has a status - enabled/disabled (see Enable directive). User settings
215             are disabled by default. User settings contains channel sections, the settings
216             of which are taken either from globally defined channel sections or from those
217             defines within the scope of this user only
218              
219             =back
220              
221             =head3 CHANNEL DIRECTIVES
222              
223             See L
224              
225             =head3 CHECKIT DIRECTIVES
226              
227             See L
228              
229             =head2 CRONTAB
230              
231             To automatically launch the program, you can using standard scheduling tools, such as crontab
232              
233             * * * * * monm checkit >/dev/null 2>>/var/log/monm-error.log
234              
235             For daily reporting:
236              
237             0 8 * * * monm report >/dev/null 2>>/var/log/monm-error.log
238              
239             =head1 INTERNAL METHODS
240              
241             =over 4
242              
243             =item B
244              
245             The CTK method for classes extension. For internal use only!
246              
247             See L
248              
249             =item B
250              
251             my $notifier = $app->notifier;
252              
253             Returns the Notifier object
254              
255             =item B
256              
257             $app->notify();
258              
259             Sends notifications
260              
261             =item B
262              
263             return $app->raise("Red message");
264              
265             Sends message to STDERR and returns 0
266              
267             =item B
268              
269             my $store = $app->store();
270              
271             Returns store object
272              
273             =item B
274              
275             my @errors = $app->trigger();
276              
277             Runs triggers
278              
279             =back
280              
281             =head1 HISTORY
282              
283             See C file
284              
285             =head1 TO DO
286              
287             See C file
288              
289             =head1 SEE ALSO
290              
291             L, L
292              
293             =head1 AUTHOR
294              
295             Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE
296              
297             =head1 COPYRIGHT
298              
299             Copyright (C) 1998-2022 D&D Corporation. All Rights Reserved
300              
301             =head1 LICENSE
302              
303             This program is free software; you can redistribute it and/or
304             modify it under the same terms as Perl itself.
305              
306             See C file and L
307              
308             =cut
309              
310 1     1   57 use vars qw/ $VERSION /;
  1         2  
  1         45  
311             $VERSION = '1.09';
312              
313 1     1   4 use feature qw/ say /;
  1         1  
  1         93  
314              
315 1     1   377 use Text::SimpleTable;
  1         1830  
  1         23  
316 1     1   5 use File::Spec;
  1         1  
  1         17  
317 1     1   853 use File::stat qw//;
  1         7081  
  1         22  
318 1     1   375 use Text::ParseWords qw/shellwords quotewords/;
  1         989  
  1         47  
319 1     1   758 use Text::Wrap qw/wrap/;
  1         2304  
  1         44  
320              
321 1     1   368 use CTK::Skel;
  1         171854  
  1         33  
322 1     1   7 use CTK::Util qw/ preparedir dformat execute dtf tz_diff sendmail variant_stf lf_normalize sharedstatedir /;
  1         2  
  1         64  
323 1     1   5 use CTK::ConfGenUtil;
  1         2  
  1         50  
324 1     1   6 use CTK::TFVals qw/ :ALL /;
  1         2  
  1         137  
325              
326 1     1   334 use App::MonM::Const;
  1         2  
  1         65  
327 1         90 use App::MonM::Util qw/
328             blue green red yellow cyan magenta gray
329             yep nope skip wow
330             getBit setBit
331             node2anode getCheckitByName
332             getExpireOffset getTimeOffset explain
333             slurp spurt
334             merge
335 1     1   400 /;
  1         2  
336 1     1   379 use App::MonM::Store;
  1         3  
  1         33  
337 1     1   356 use App::MonM::Checkit;
  1         3  
  1         26  
338 1     1   341 use App::MonM::QNotifier;
  1         3  
  1         28  
339 1     1   368 use App::MonM::Report;
  1         1  
  1         27  
340              
341 1     1   5 use parent qw/CTK::App/;
  1         2  
  1         6  
342              
343             use constant {
344 1         4711 TAB9 => " " x 9,
345             EXPIRES => 24*60*60, # 1 day
346             SMSSBJ => 'MONM CHECKIT REPORT',
347             DATE_FORMAT => '%YYYY-%MM-%DD %hh:%mm:%ss',
348             TABLE_HEADERS => [(
349             [32, 'NAME'],
350             [7, 'TYPE'],
351             [19, 'LAST CHECK DATE'],
352             [7, 'RESULT'],
353             )],
354              
355             # Markers
356             MARKER_OK => '[ OK ]',
357             MARKER_FAIL => '[ FAIL ]',
358             MARKER_SKIP => '[ SKIP ]',
359             MARKER_INFO => '[ INFO ]',
360 1     1   5407 };
  1         2  
361              
362             eval { require App::MonM::Notifier };
363             my $NOTIFIER_LOADED = 1 unless $@;
364             $NOTIFIER_LOADED = 0 if $NOTIFIER_LOADED && (App::MonM::Notifier->VERSION * 1) < 1.04;
365              
366             sub again {
367 0     0 1   my $self = shift;
368 0           $self->SUPER::again(); # CTK::App again first!!
369              
370             # Datadir & Tempdir
371 0 0         if ($self->option("datadir")) {
    0          
372             # Prepare DataDir
373 0 0         preparedir( $self->datadir() ) or do {
374 0           $self->status(0);
375 0           $self->raise("Can't prepare directory %s", $self->datadir());
376             };
377             } elsif ($self->option("daemondir")) {
378 0           $self->datadir(File::Spec->catdir(sharedstatedir(), PREFIX));
379             } else {
380 0           $self->datadir($self->tempdir());
381             }
382             # Prepare TempDir
383 0 0         preparedir( $self->tempdir() ) or do {
384 0           $self->status(0);
385 0           $self->raise("Can't prepare directory %s", $self->tempdir());
386             };
387              
388             # Store
389 0           my $db_file = File::Spec->catfile($self->datadir, App::MonM::Store::DB_FILENAME());
390 0   0       my $store_conf = $self->config("store") || $self->config('dbi') || {file => $db_file};
391 0 0         $store_conf = {file => $db_file} unless is_hash($store_conf);
392 0           my %store_args = %$store_conf;
393 0 0 0       $store_args{file} = $db_file unless ($store_args{file} || $store_args{dsn});
394 0           my $store = App::MonM::Store->new(%store_args);
395 0           $self->{store} = $store;
396             #$self->debug(explain($store));
397              
398             # Notifier object init
399 0           my %nargs = (config => $self->configobj);
400 0 0 0       $self->{notifier} = $NOTIFIER_LOADED && lvalue($self->config("usemonotifier"))
401             ? App::MonM::Notifier->new(%nargs)
402             : App::MonM::QNotifier->new(%nargs);
403              
404             #$self->status($self->raise("Test error"));
405              
406 0           return $self; # CTK requires!
407             }
408             sub raise {
409 0     0 1   my $self = shift;
410 0           say STDERR red(@_);
411 0           $self->log_error(sprintf(shift, @_));
412 0           return 0;
413             }
414             sub store {
415 0     0 1   my $self = shift;
416 0           return $self->{store};
417             }
418             sub notifier {
419 0     0 1   my $self = shift;
420 0           return $self->{notifier};
421             }
422              
423             __PACKAGE__->register_handler(
424             handler => "info",
425             description => "Show statistic information",
426             code => sub {
427             ### CODE:
428             my ($self, $meta, @arguments) = @_;
429             my $store = $self->store;
430              
431             # General info
432             printf("Hostname : %s\n", HOSTNAME);
433             printf("MonM version : %s\n", $self->VERSION);
434             printf("Date : %s\n", _fdate());
435             printf("Data dir : %s\n", $self->datadir);
436             printf("Temp dir : %s\n", $self->tempdir);
437             printf("Config file : %s\n", $self->configfile);
438             printf("Config status : %s\n", $self->conf("loadstatus") ? green("OK") : magenta("ERROR: not loaded"));
439             $self->raise($self->configobj->error) if !$self->configobj->status and length($self->configobj->error);
440             printf("Notifier class : %s\n", ref($self->notifier) || magenta("not initialized"));
441             #$self->debug(explain($self->config)) if $self->conf("loadstatus") && $self->verbosemode;
442              
443             # DB status
444             printf("DB DSN : %s\n", $store->dsn);
445             printf("DB status : %s\n", $store->error ? red("ERROR") : green("OK"));
446             my $db_is_ok = $store->error ? 0 : 1;
447             if ($db_is_ok && $store->{file} && -e $store->{file}) {
448             my $s = File::stat::stat($store->{file})->size;
449             printf("DB file : %s\n", $store->{file});
450             printf("DB size : %s\n", sprintf("%s (%d bytes)", _fbytes($s), $s));
451             printf("DB modified : %s\n", _fdate(File::stat::stat($store->{file})->mtime || 0));
452             }
453             $self->raise($store->error) unless $db_is_ok;
454              
455             # Checkets
456             my @checkits = getCheckitByName($self->config("checkit"));
457             my $noc = scalar(@checkits);
458             printf("Checkits : %s\n", $noc ? $noc : yellow("none"));
459             if ($noc) {
460             #print explain(\@checkits);
461             my $tbl = Text::SimpleTable->new(
462             [20, 'CHECKIT NAME'], # name
463             [7, 'TYPE'], # type
464             [7, 'TARGET'], # target
465             [6, 'INTRVL'], # interval
466             [3, 'TRG'], # trigger
467             [27, 'RECIPIENTS'], # sendto
468             );
469             foreach my $ch (@checkits) {
470             my $triggers = array($ch, "trigger");
471             my $recipients = array($ch, "sendto");
472             $tbl->row( # variant_stf($v->{source} // '', $src_len),
473             variant_stf($ch->{name} // '', 20),
474             $ch->{type} // 'http',
475             $ch->{target} // 'status',
476             $ch->{interval} || 0,
477             scalar(@$triggers),
478             join(", ", @$recipients),
479             );
480             }
481             print $tbl->draw();
482             }
483              
484             # Scheduler
485             my $scheduler = App::MonM::Util::Scheduler->new;
486              
487             # Channels
488             my $channels = $self->notifier->{ch_def} || {};
489             my $chcnt = scalar(keys %$channels);
490             printf("Channels : %s\n", $chcnt ? $chcnt : yellow("none"));
491             if ($chcnt) {
492             my $tbl = Text::SimpleTable->new(
493             [20, 'CHANNEL NAME'],
494             [7, 'TYPE'],
495             [42, 'TO (FROM)'],
496             [7, 'ON/NOW'],
497             );
498             foreach my $ch_name (keys %$channels) {
499             my $ch = hash($channels, $ch_name);
500             $scheduler->add($ch_name, lvalue($ch, "at"));
501             $tbl->row(
502             $ch_name,
503             lvalue($ch, "type") || '',
504             lvalue($ch, "from")
505             ? sprintf("%s (%s)", lvalue($ch, "to") || '', lvalue($ch, "from"))
506             : lvalue($ch, "to") || '',
507             sprintf("%s/%s",
508             lvalue($ch, "enable") || lvalue($ch, "enabled") ? 'Yes' : 'No',
509             $scheduler->check($ch_name) ? "Yes" : "No",
510             ),
511             );
512             if ($self->verbosemode && $scheduler->getAtString($ch_name)) {
513             printf(" Ch=%s; At=%s\n", $ch_name, $scheduler->getAtString($ch_name));
514             }
515              
516             }
517             print $tbl->draw();
518             }
519              
520             # Users
521             my @users = $self->notifier->getUsers;
522             printf("Allowed users : %s\n", @users ? join(", ", @users) : yellow("none"));
523             if (@users) {
524             my $tbl = Text::SimpleTable->new(
525             [20, 'USERNAME'],
526             [20, 'CHANNEL (BASEDON)'],
527             [7, 'TYPE'],
528             [19, 'TO'],
529             [7, 'ON/NOW'],
530             );
531             my $old = "";
532             foreach my $u (sort {$a cmp $b} @users) {
533             # Get User node
534             my $usernode = node($self->conf("user"), $u);
535             next unless is_hash($usernode) && keys %$usernode;
536             #print App::MonM::Util::explain($usernode);
537              
538             # Get user channels
539             my $channels_usr = hash($usernode => "channel");
540             foreach my $ch_name (keys %$channels_usr) {
541             my $at = lvalue($channels_usr, $ch_name, "at") || lvalue($usernode, "at");
542             my $basedon = lvalue($channels_usr, $ch_name, "basedon") || lvalue($channels_usr, $ch_name, "baseon") || '';
543             my $ch = merge(
544             hash($self->notifier->{ch_def}, $basedon || $ch_name),
545             hash($channels_usr, $ch_name),
546             {$at ? (at => $at) : ()},
547             );
548             $scheduler->add($ch_name, lvalue($ch, "at"));
549             #print App::MonM::Util::explain($ch);
550             $tbl->row(
551             ($old eq $u) ? "" : $u,
552             $basedon ? sprintf("%s (%s)", $ch_name, $basedon): $ch_name,
553             lvalue($ch, "type") || '',
554             lvalue($ch, "to") || '',
555             sprintf("%s/%s",
556             lvalue($ch, "enable") || lvalue($ch, "enabled") ? 'Yes' : 'No',
557             $scheduler->check($ch_name) ? "Yes" : "No",
558             ),
559             );
560             if ($self->verbosemode && $scheduler->getAtString($ch_name)) {
561             printf(" Usr=%s; Ch=%s; At=%s\n", $u, $ch_name, $scheduler->getAtString($ch_name));
562             }
563             } continue {
564             $old = $u;
565             }
566             unless (%$channels_usr) {
567             $tbl->row( $u, '', '', '', '-------' );
568             }
569             }
570             print $tbl->draw();
571             }
572              
573             # Groups
574             my @groups = $self->notifier->getGroups;
575             printf("Allowed groups : %s\n", @groups ? join(", ", @groups) : yellow("none"));
576             if (@groups) {
577             my $tbl = Text::SimpleTable->new(
578             [20, 'GROUP NAME'],
579             [62, 'USERS'],
580             );
581             foreach my $g (sort {$a cmp $b} @groups) {
582             my @us = $self->notifier->getUsersByGroup($g);
583             $tbl->row(
584             $g,
585             join(", ", @us),
586             );
587             }
588             print $tbl->draw();
589             }
590              
591             #print explain([$self->notifier->getUsersByGroup("Bar")]);
592              
593             return 1;
594             });
595              
596             __PACKAGE__->register_handler(
597             handler => "configure",
598             description => "Generate configuration files",
599             code => sub {
600             ### CODE:
601             my ($self, $meta, @arguments) = @_;
602             my $store = $self->store;
603             my $dir = shift(@arguments) || $self->root;
604              
605             # Creating configuration
606             my $skel = CTK::Skel->new(
607             -name => PROJECTNAME,
608             -root => $dir,
609             -skels => {
610             config => 'App::MonM::ConfigSkel',
611             },
612             -vars => {
613             PROJECT => PROJECTNAME,
614             PROJECTNAME => PROJECTNAME,
615             PREFIX => PREFIX,
616             },
617             -debug => $self->verbosemode,
618             );
619             printf("Installing configuration to \"%s\"...\n", $dir);
620             if ($skel->build("config")) {
621             say green("Done. Configuration has been installed");
622             } else {
623             return $self->raise("Can't install configuration");
624             }
625              
626             return 1;
627             });
628              
629             __PACKAGE__->register_handler(
630             handler => "checkit",
631             description => "Checkit",
632             code => sub {
633             ### CODE:
634             my ($self, $meta, @arguments) = @_;
635             my $store = $self->store;
636             return $self->raise($store->error) if $store->error;
637              
638             # Check configuration
639             unless ($self->configobj->status) {
640             return length($self->configobj->error)
641             ? $self->raise($self->configobj->error)
642             : "Can't load configuration file";
643             }
644              
645             # Get checkits
646             my @checkits = getCheckitByName($self->config("checkit"), @arguments);
647             my $noc = scalar(@checkits);
648             unless ($noc) {
649             skip("No enabled configuration section found");
650             $self->log_info("No enabled configuration section found");
651             return 1;
652             }
653              
654             # Create Checkit object
655             my $checker = App::MonM::Checkit->new;
656              
657             # Get all records from DB
658             my %all;
659             foreach my $r ($store->getall) {
660             $all{$r->{name}} = $r;
661             }
662             return $self->raise($store->error) if $store->error;
663             # print explain(\@checkits);
664              
665             # Start
666             my $curtime = time;
667             my $status = 1;
668             my $passed = 0;
669             foreach my $checkit (sort {$a->{name} cmp $b->{name}} @checkits) {
670             my $result = 1; # Check result
671             my $name = $checkit->{name};
672             my $info = $all{$name} || {}; # from database
673             my $id = $info->{id} || 0;
674             my $old = $info->{status} || 0;
675             my $got = ($old << 1) & 15;
676             my $pub = $info->{'time'} || 0;
677             my $interval = getTimeOffset(lvalue($checkit, "interval") || 0);
678              
679             # Check interval first
680             if ($interval) {
681             if (($pub + $interval) >= $curtime) {
682             print gray MARKER_SKIP;
683             printf(" %s (%s)\n", $name, "Too little time has passed before a next check [delay $interval sec]");
684             next;
685             }
686             }
687              
688             # Check
689             $result = $checker->check($checkit);
690             if ($result) {
691             $got = setBit($got, 0); # Set first bit if result is PASSED
692             $passed++;
693             } else {
694             $status = 0; # General status
695             }
696              
697             # Show resulsts
698             print $result ? green(MARKER_OK) : red(MARKER_FAIL);
699             printf(" %s (%s >>> %s)\n", $name, $checker->source, $checker->message);
700             if ($self->verbosemode) {
701             printf "%sStatus=%s; Code=%s\n", TAB9,
702             $checker->status || 0, $checker->code // '';
703             say TAB9, $checker->note;
704             if (defined($checker->content) && length($checker->content)) {
705             $Text::Wrap::columns = SCREENWIDTH - 10;
706             say TAB9, "-----BEGIN CONTENT-----";
707             say wrap(TAB9, TAB9, lf_normalize($checker->content));
708             say TAB9, "-----END CONTENT-----";
709             }
710             }
711             if ($result && !$checker->status) {
712             wow("%s", $checker->error);
713             } elsif (!$result) {
714             nope("%s", $checker->error);
715             }
716              
717             # Save data to database
718             my %data = (
719             id => $id,
720             name => $name, # Checkit name
721             type => $checker->type, # Checkit type
722             result => $result, # Checkit result
723             source => $checker->source, # Source string
724             code => $checker->code, # Checkit code value
725             message => $checker->message, # Checkit message string
726             note => $checker->note, # Checkit note string
727             status => $got, # New status value (code of result) for store only!
728             subject => sprintf("%s: Available %s [%s]", $result ? 'OK' : 'PROBLEM', $name, HOSTNAME), # Subject
729             );
730             my $chst = $id ? $store->set(%data) : $store->add(%data);
731             unless ($chst) {
732             $self->raise($store->error) if $store->error;
733             $status = 0;
734             next;
735             }
736              
737             # Triggers and notifications
738             # GOT = [0-0-1-1] = 3 -- OK
739             # GOT = [1-1-0-0] = 12 -- PROBLEM
740             if ($got == 3 or $got == 12) {
741             my @errs;
742             push @errs, $checker->error if $checker->error; # Checkit error string
743             $data{status} = $checker->status; # Checkit status (NO RESULT!!);
744              
745             # Run triggers (FIRST)
746             push @errs, $self->trigger(%data, trigger => array($checkit, "trigger"));
747              
748             # Send message via notifier (SECOND)
749             $self->notify(%data, sendto => array($checkit, "sendto"), errors => \@errs);
750             }
751             }
752              
753             # Show Total resulsts
754             print $status ? green(MARKER_OK) : red(MARKER_FAIL);
755             printf(" Total passed %d checks of %d in %s\n", $passed, $noc, $self->tms());
756              
757             # Cleaning DB
758             my $expire = getExpireOffset(lvalue($self->config("expires"))
759             || lvalue($self->config("expire")) || EXPIRES);
760             $store->clean(period => $expire) or do {
761             return $store->error ? $self->raise($store->error) : 0;
762             };
763              
764             return $status;
765             });
766              
767             __PACKAGE__->register_handler(
768             handler => "remind",
769             description => "Retries sending notifies",
770             code => sub {
771             ### CODE:
772             my ($self, $meta, @arguments) = @_;
773             return $self->raise(($self->notifier->error)) unless $self->notifier->remind;
774             return 1;
775             });
776              
777             __PACKAGE__->register_handler(
778             handler => "report",
779             description => "Checkit report",
780             code => sub {
781             ### CODE:
782             my ($self, $meta, @arguments) = @_;
783             my $store = $self->store;
784              
785             # Init
786             my (@errors, @table);
787             my $status = 1;
788             my $tbl = Text::SimpleTable->new(@{(TABLE_HEADERS)});
789              
790             # Header
791             my @header;
792             push @header, ["Hostname", HOSTNAME];
793             push @header, ["Database DSN", $store->dsn];
794             my $db_is_ok = $store->error ? 0 : 1;
795             push @header, ["Database status", $db_is_ok ? "OK" : "ERROR"];
796             unless ($db_is_ok) {
797             push @errors, $store->dsn, $store->error, "";
798             $status = $self->raise("%s: %s", $store->dsn, $store->error);
799             }
800              
801             # Get checkits from config
802             my @checkits = getCheckitByName($self->config("checkit"));
803             my $noc = scalar(@checkits);
804             push @header, ["Number of checks", $noc ? $noc : "no checks"];
805             unless ($noc) {
806             skip("No enabled configuration section found");
807             $self->log_info("No enabled configuration section found");
808             $status = 0;
809             }
810              
811             # Get all records from DB
812             my %all;
813             if ($db_is_ok) {
814             foreach my $r ($store->getall) {
815             $all{$r->{name}} = $r;
816             }
817             if ($store->error) {
818             push @errors, $store->dsn, $store->error, "";
819             $status = $self->raise("%s: %s", $store->dsn, $store->error);
820             }
821             }
822              
823             # Checkits
824             if ($status) {
825             foreach my $checkit (sort {$a->{name} cmp $b->{name}} @checkits) {
826             my $name = $checkit->{name};
827             my $info = $all{$name} || {};
828             my $last = $info->{"time"} || 0;
829             my $v = $info->{status} || 0;
830             my $ostat = -1;
831             if (getBit($v, 0) && getBit($v, 1) && getBit($v, 2)) { # Ok
832             $ostat = 1;
833             } elsif ((getBit($v, 0) + getBit($v, 1)) == 0) { # Problem
834             $ostat = 0;
835             $status = 0;
836             }
837             $tbl->row($name, $info->{type} || 'http',
838             $last ? dtf(DATE_FORMAT, $last) : "",
839             $ostat ? $ostat > 0 ? 'PASSED' : 'UNKNOWN' : 'FAILED',
840             );
841             unless ($ostat) {
842             push @errors, sprintf("%s (%s >>> %s)", $name, $info->{source} || '', $info->{message} || ''), "";
843             }
844             #say(explain($info));
845             }
846             $tbl->hr;
847             }
848             $tbl->row('SUMMARY', "", "", $noc ? $status ? 'PASSED' : 'FAILED' : 'UNKNOWN');
849              
850             # Get SendMail config
851             my $sendmail = hash($self->config('channel'), "SendMail");
852              
853             # Get output file
854             my $outfile = $self->option("outfile");
855             if ($outfile) {
856             unless (File::Spec->file_name_is_absolute($outfile)) {
857             $outfile = File::Spec->catfile($self->datadir, $outfile);
858             }
859             }
860              
861             # Get To value
862             my $to = scalar(@arguments)
863             ? join(", ", @arguments)
864             : uv2null(value($sendmail, "to"));
865             my $send_report = 1 if $to && $to !~ /\@example.com$/;
866             $send_report = 0 if $outfile;
867             push @header, ["Send report to", $to] if $send_report;
868             push @header, ["Summary result", $status ? 'PASSED' : 'FAILED'];
869              
870             # Report generate
871             my $report = App::MonM::Report->new(name => "last checks", configfile => $self->configfile);
872             my $report_title = $status ? "checking report" : "error report";
873             $report->common(@header); # Add common information
874             $report->summary( # Add summary table
875             $status ? "All last checks successful" : "Errors occurred while checking",
876             $tbl->draw(), # Add report table
877             );
878             $report->errors(@errors); # Add list of occurred errors
879             if ($outfile) {
880             $report->abstract(sprintf("The %s for last checks on %s\n", $report_title, HOSTNAME));
881             if (my $err = spurt($outfile, $report->as_string)) {
882             nope($err);
883             $self->log_error($err);
884             } else {
885             my $msg = sprintf("The report successfully saved to file: %s", $outfile);
886             yep($msg);
887             $self->log_debug($msg);
888             }
889             return $status;
890             } elsif ($self->verbosemode) { # Draw to STDOUT
891             printf("%s BEGIN REPORT ~~~\n", "~" x (SCREENWIDTH()-17)) if IS_TTY;
892             printf("The %s for last checks on %s\n\n", $report_title, HOSTNAME);
893             print $report->as_string;
894             printf("%s END REPORT ~~~\n", "~" x (SCREENWIDTH()-15)) if IS_TTY;
895             }
896              
897             # Send report
898             if ($send_report) {
899             $report->title($report_title);
900             $report->footer($self->tms);
901              
902             # Send
903             my $ns = $self->notifier->notify(
904             to => $to,
905             subject => sprintf("%s %s (%s on %s)", PROJECTNAME, $report_title, "last checks", HOSTNAME),
906             message => $report->as_string,
907             after => sub {
908             my $this = shift;
909             my $message = shift;
910             my $sent = shift;
911              
912             if ($sent) {
913             my $msg = $this->channel->error
914             ? sprintf("Report was not sent to %s: %s", $message->recipient, $this->channel->error)
915             : sprintf("Report has been sent to %s", $message->recipient);
916             if ($this->channel->error) { skip($msg) }
917             else { yep($msg) }
918             $self->log_debug($msg);
919             } else {
920             my $err = sprintf("Report was not sent to %s: %s", $message->recipient, $this->channel->error || "unknown error");
921             nope($err);
922             $self->log_warning($err);
923             }
924              
925             1;
926             },
927             );
928             unless ($ns) {
929             my $err = sprintf("Report was not sent to %s: %s", $to, $self->notifier->error);
930             nope($err);
931             $self->log_warning($err);
932             }
933             }
934              
935             return $status;
936             });
937              
938             __PACKAGE__->register_handler(
939             handler => "show",
940             description => "Show table data",
941             code => sub {
942             ### CODE:
943             my ($self, $meta, @arguments) = @_;
944             my $store = $self->store;
945             return $self->raise($store->error) if $store->error;
946              
947             # Get all records from DB
948             my %all;
949             foreach my $r ($store->getall) {
950             $all{$r->{name}} = $r;
951             }
952             return $self->raise($store->error) if $store->error;
953              
954             # Check data
955             my $n = scalar(keys %all) || 0;
956             if ($n) {
957             printf("Number of records: %d\n", $n);
958             } else {
959             return skip("No data");
960             }
961              
962             # Show dump
963             if ($self->verbosemode) {
964             print(explain(\%all));
965             return 1;
966             }
967              
968             # Checkets
969             my @checkits = getCheckitByName($self->config("checkit"));
970             my %chckts = ();
971             foreach my $ch (@checkits) {
972             $chckts{$ch->{name}} = $ch;
973             }
974              
975             # Generate table
976             my $src_len = (SCREENWIDTH() - 88);
977             $src_len = 32 if $src_len < 32;
978             my $tbl = Text::SimpleTable->new(
979             [20, 'CHECKIT'],
980             [7, 'TYPE'],
981             [7, 'TARGET'],
982             [$src_len, 'SOURCE STRING'],
983             [19, 'LAST CHECK DATE'],
984             [6, 'INTRVL'], # interval
985             [7, 'RESULT']
986             );
987              
988             # Show table
989             my $status = 1;
990             foreach my $v (sort {$a->{name} cmp $b->{name}} values %all) {
991             my $stv = $v->{status} || 0;
992             my $ostat = -1;
993             if (getBit($stv, 0) && getBit($stv, 1) && getBit($stv, 2)) { # Ok
994             $ostat = 1;
995             } elsif ((getBit($stv, 0) + getBit($stv, 1)) == 0) { # Problem
996             $ostat = 0;
997             $status = 0;
998             }
999              
1000             $tbl->row(
1001             variant_stf($v->{name} // '', 20),
1002             $v->{type} || 'http',
1003             lvalue(\%chckts, $v->{name} // '__default', "target") // 'status',
1004             variant_stf($v->{source} // '', $src_len),
1005             $v->{"time"} ? dtf(DATE_FORMAT, $v->{"time"}) : '',
1006             lvalue(\%chckts, $v->{name} // '__default', "interval") || 0,
1007             $ostat ? $ostat > 0 ? 'PASSED' : 'UNKNOWN' : 'FAILED'
1008             );
1009              
1010             }
1011             $tbl->hr;
1012             $tbl->row('SUMMARY', "", "", "", "", "", $status ? 'PASSED' : 'FAILED');
1013             say $tbl->draw();
1014              
1015             return $status;
1016             });
1017              
1018             sub trigger {
1019 0     0 1   my $self = shift;
1020 0           my %args = @_;
1021 0   0       my $name = $args{name} || 'virtual';
1022 0   0       my $message = $args{message} // "";
1023 0   0       my $source = $args{source} // "";
1024 0           my $subject = $args{subject};
1025              
1026             # Execute triggers
1027 0   0       my $triggers = $args{trigger} || [];
1028 0           my @errs;
1029 0           foreach my $trg (@$triggers) {
1030 0 0         next unless $trg;
1031             my $cmd = dformat($trg, {
1032             SUBJECT => $subject, SUBJ => $subject, SBJ => $subject,
1033             MESSAGE => $message, MSG => $message,
1034             SOURCE => $source, SRC => $source,
1035             NAME => $name,
1036             TYPE => $args{type} // "http",
1037             CODE => $args{code} // '',
1038             STATUS => $args{status} ? 'OK' : 'ERROR',
1039             RESULT => $args{result} ? 'PASSED' : 'FAILED',
1040 0 0 0       NOTE => $args{note} // '',
    0 0        
      0        
1041             });
1042 0           my $exe_err = '';
1043 0           my $exe_out = execute($cmd, undef, \$exe_err);
1044 0 0         my $exe_stt = ($? >> 8) ? 0 : 1;
1045 0 0         if ($exe_stt) {
1046 0           my $msg = sprintf("# %s", $cmd);
1047 0           print cyan MARKER_INFO;
1048 0           say " ", $msg;
1049 0           $self->log_info($msg);
1050 0 0 0       if (defined($exe_out) && length($exe_out) && $self->verbosemode) {
      0        
1051 0           say $exe_out if IS_TTY;
1052 0           $self->log_info($exe_out);
1053             }
1054             } else {
1055 0           my $msg = sprintf("Can't execute trigger %s", $cmd);
1056 0           print red MARKER_FAIL;
1057 0           say " ", $msg;
1058 0           $self->log_error($msg);
1059 0           push @errs, $msg;
1060 0 0         if ($exe_err) {
1061 0           chomp($exe_err);
1062 0           nope($exe_err);
1063 0           $self->log_error($exe_err);
1064 0           push @errs, $exe_err;
1065             }
1066             }
1067             }
1068              
1069 0           return @errs;
1070             }
1071             sub notify {
1072 0     0 1   my $self = shift;
1073 0           my %args = @_;
1074 0   0       my $name = $args{name} || 'virtual';
1075 0   0       my $sendto = $args{sendto} || [];
1076 0           my $subject = $args{subject};
1077 0           my @errors;
1078 0           my $errs = $args{errors};
1079 0 0         push @errors, @$errs if is_array($errs);
1080             #say(explain(\%args));
1081              
1082             # Header
1083 0           my @header;
1084             push @header, (
1085             ["Checkit", $name], # Checkit name
1086             ["Type", $args{type} || 'http'], # Checkit type
1087             ["Result", $args{result} ? 'PASSED' : 'FAILED'], # Checkit result
1088             ["Source", $args{source} || "UNKNOWN"], # Source string
1089             ["Status", $args{status} ? 'OK' : 'ERROR'], # Checkit status (NO RESULT!!);
1090             ["Code", $args{code} // "UNKNOWN"], # Checkit code value
1091             ["Note", $args{note} // "No comments"], # Checkit note string
1092 0 0 0       ["Message", $args{message} // ""], # Checkit message string
    0 0        
      0        
      0        
      0        
1093             );
1094              
1095             # Report
1096 0           my $report = App::MonM::Report->new(name => $name, configfile => $self->configfile);
1097 0 0         $report->title($args{result} ? "checking report" : "error report");
1098 0           $report->common(@header); # Common information
1099 0 0         $report->summary($args{result} ? "All checks successful" : "Errors occurred while checking"); # Summary
1100 0 0         $report->errors(@errors) if @errors; # List of occurred errors
1101 0           $report->footer($self->tms);
1102              
1103             # Send
1104             my $notify_status = $self->notifier->notify(
1105             to => $sendto,
1106             subject => $subject,
1107             message => $report->as_string,
1108             before => sub {
1109 0     0     my $this = shift; # App::MonM::QNotifier object (this)
1110 0           my $message = shift; # App::MonM::Message object
1111              
1112             # Check internal errors
1113 0 0         if ($this->error) {
1114 0           nope($this->error);
1115 0           $self->log_error($this->error);
1116             }
1117              
1118 0           return 1;
1119             },
1120             after => sub {
1121 0     0     my $this = shift; # App::MonM::QNotifier object (this)
1122 0           my $message = shift; # App::MonM::Message object
1123 0           my $sent = shift; # Status of sending
1124              
1125             # Check internal errors
1126 0 0         if ($this->error) {
1127 0           nope($this->error);
1128 0           $self->log_error($this->error);
1129             }
1130              
1131             # Check sending status
1132 0 0         if ($sent) {
1133 0 0         my $msg = $this->channel->error
1134             ? sprintf("Message was not sent to %s: %s", $message->recipient, $this->channel->error)
1135             : sprintf("Message has been sent to %s", $message->recipient);
1136 0 0         if ($this->channel->error) { print red MARKER_FAIL }
  0            
1137 0           else { print cyan MARKER_INFO }
1138 0           say " ", $msg;
1139 0           $self->log_debug($msg);
1140             } else {
1141 0   0       my $err = sprintf("Message was not sent to %s: %s", $message->recipient, $this->channel->error || "unknown error");
1142 0           print red MARKER_FAIL;
1143 0           print " ";
1144 0           nope($err);
1145 0           $self->log_warning($err);
1146             }
1147              
1148 0           return 1;
1149             },
1150 0           );
1151 0 0         unless ($notify_status) {
1152 0           print red MARKER_FAIL;
1153 0           print " ";
1154 0           nope($self->notifier->error);
1155 0           $self->log_error($self->notifier->error);
1156             }
1157              
1158 0           return 1;
1159             }
1160              
1161             # Private methods
1162             sub _fbytes {
1163 0     0     my $n = int(shift);
1164 0 0         if ($n >= 1024 ** 3) {
    0          
    0          
1165 0           return sprintf "%.3g GB", $n / (1024 ** 3);
1166             } elsif ($n >= 1024 ** 2) {
1167 0           return sprintf "%.3g MB", $n / (1024.0 * 1024);
1168             } elsif ($n >= 1024) {
1169 0           return sprintf "%.3g KB", $n / 1024.0;
1170             } else {
1171 0           return "$n B";
1172             }
1173             }
1174             sub _fdate {
1175 0   0 0     my $d = shift || time;
1176 0   0       my $g = shift || 0;
1177 0 0         return "unknown" unless $d;
1178 0 0         return dtf(DATETIME_GMT_FORMAT, $d, 1) if $g;
1179 0           return dtf(DATETIME_FORMAT . " " . tz_diff(), $d);
1180             }
1181              
1182             1;
1183              
1184             __END__