├── .gitignore ├── .travis.yml ├── Changes ├── MANIFEST ├── MANIFEST.SKIP ├── Makefile.PL ├── README ├── examples ├── dump.pl └── test.pl ├── lib └── Monitoring │ ├── Livestatus.pm │ └── Livestatus │ ├── INET.pm │ └── UNIX.pm └── t ├── 01-Monitoring-Livestatus-basic_tests.t ├── 02-Monitoring-Livestatus-internals.t ├── 085-json_xs.t ├── 20-Monitoring-Livestatus-test_socket.t ├── 21-Monitoring-Livestatus-INET.t ├── 22-Monitoring-Livestatus-UNIX.t ├── 23-Monitoring-Livestatus-BigData.t ├── 30-Monitoring-Livestatus-live-test.t ├── 32-Monitoring-Livestatus-backend-test.t ├── 33-Monitoring-Livestatus-test_socket_timeout.t ├── 34-Monitoring-Livestatus-utf8_support.t ├── 35-Monitoring-Livestatus-callbacks_support.t ├── 97-Pod.t ├── 98-Pod-Coverage.t ├── 99-Perl-Critic.t └── perlcriticrc /.gitignore: -------------------------------------------------------------------------------- 1 | Makefile 2 | Makefile.old 3 | blib 4 | pm_to_blib 5 | MANIFEST.bak 6 | inc 7 | META.yml 8 | MYMETA.json 9 | MYMETA.yml 10 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: perl 2 | perl: 3 | - "5.24" 4 | env: 5 | - TEST_AUTHOR=1 6 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for Perl extension Monitoring::Livestatus. 2 | 3 | 0.86 Sun May 11 10:18:06 CEST 2025 4 | - improve timeout handling 5 | - improve utf8 handling 6 | - fix flaky test case (#9) 7 | 8 | 0.84 Tue Dec 15 16:53:44 CET 2020 9 | - add support for command response 10 | - remove alarm handler, timeouts should be handled in the calling module 11 | 12 | 0.82 Sat Nov 10 12:11:31 CET 2018 13 | - add tls support for tcp livestatus connections 14 | 15 | 0.80 Fri Jan 26 08:24:00 CET 2018 16 | - support ipv6 connections 17 | - change to Cpanel::JSON::XS 18 | 19 | 0.78 Fri Dec 23 17:09:35 CET 2016 20 | - fix spelling errors (#5) 21 | 22 | 0.76 Tue Sep 27 21:45:25 CEST 2016 23 | - fix utf-8 decoding error: missing high surrogate character in surrogate pair 24 | - fixed typo 25 | - removed MULTI class 26 | 27 | 0.74 Fri Apr 22 00:16:37 CEST 2011 28 | - fixed problem with bulk commands 29 | 30 | 0.72 Tue Apr 19 15:38:34 CEST 2011 31 | - fixed problem with inet timeout 32 | 33 | 0.70 Sat Apr 16 16:43:57 CEST 2011 34 | - fixed tests using english 35 | 36 | 0.68 Wed Mar 23 23:16:22 CET 2011 37 | - fixed typo 38 | 39 | 0.66 Tue Mar 22 23:19:23 CET 2011 40 | - added support for additonal headers 41 | 42 | 0.64 Fri Nov 5 11:02:51 CET 2010 43 | - removed useless test dependecies 44 | 45 | 0.62 Wed Nov 3 15:20:02 CET 2010 46 | - fixed tests with threads > 1.79 47 | 48 | 0.60 Wed Aug 25 15:04:22 CEST 2010 49 | - fixed package and made author tests optional 50 | 51 | 0.58 Wed Aug 11 09:30:30 CEST 2010 52 | - added callback support 53 | 54 | 0.56 Tue Aug 10 09:45:28 CEST 2010 55 | - changed parser from csv to JSON::XS 56 | 57 | 0.54 Wed Jun 23 16:43:11 CEST 2010 58 | - fixed utf8 support 59 | 60 | 0.52 Mon May 17 15:54:42 CEST 2010 61 | - fixed connection timeout 62 | 63 | 0.50 Mon May 17 12:29:20 CEST 2010 64 | - fixed test requirements 65 | 66 | 0.48 Sun May 16 15:16:12 CEST 2010 67 | - added retry option for better core restart handling 68 | - added new columns from livestatus 1.1.4 69 | 70 | 0.46 Tue Mar 16 15:19:08 CET 2010 71 | - error code have been changed in livestatus (1.1.3) 72 | - fixed threads support 73 | 74 | 0.44 Sun Feb 28 12:19:56 CET 2010 75 | - fixed bug when disabling backends and using threads 76 | 77 | 0.42 Thu Feb 25 21:32:37 CET 2010 78 | - added possibility to disable specific backends 79 | 80 | 0.41 Sat Feb 20 20:37:36 CET 2010 81 | - fixed tests on windows 82 | 83 | 0.40 Thu Feb 11 01:00:20 CET 2010 84 | - fixed timeout for inet sockets 85 | 86 | 0.38 Fri Jan 29 20:54:50 CET 2010 87 | - added limit option 88 | 89 | 0.37 Thu Jan 28 21:23:19 CET 2010 90 | - removed inc from repository 91 | 92 | 0.36 Sun Jan 24 00:14:13 CET 2010 93 | - added more backend tests 94 | - fixed problem with summing up non numbers 95 | 96 | 0.35 Mon Jan 11 15:37:51 CET 2010 97 | - added TCP_NODELAY option for inet sockets 98 | - fixed undefined values 99 | 100 | 0.34 Sun Jan 10 12:29:57 CET 2010 101 | - fixed return code with multi backend and different errors 102 | 103 | 0.32 Sat Jan 9 16:12:48 CET 2010 104 | - added deepcopy option 105 | 106 | 0.31 Thu Jan 7 08:56:48 CET 2010 107 | - added generic tests for livestatus backend 108 | - fixed problem when selecting specific backend 109 | 110 | 0.30 Wed Jan 6 16:05:33 CET 2010 111 | - renamed project to Monitoring::Livestatus 112 | 113 | 0.29 Mon Dec 28 00:11:53 CET 2009 114 | - retain order of backends when merge outut 115 | - renamed select_scalar_value to selectscalar_value 116 | - fixed sums for selectscalar_value 117 | - fixed missing META.yml 118 | 119 | 0.28 Sat Dec 19 19:19:13 CET 2009 120 | - fixed bug in column alias 121 | - added support for multiple peers 122 | - changed to Module::Install 123 | 124 | 0.26 Fri Dec 4 08:25:07 CET 2009 125 | - added peer name 126 | - added peer arg (can be socket or server) 127 | 128 | 0.24 Wed Dec 2 23:41:34 CET 2009 129 | - added support for StatsAnd: and StatsOr: queries 130 | - table alias support for selectall_hashref and selectrow_hashref 131 | - added support for Stats: ... as alias 132 | - added support for StatsAnd:... as alias 133 | - added support for StatsOr: ... as alias 134 | - added support for StatsGroupBy: (with alias) 135 | - added support column aliases for Column: header 136 | 137 | 0.22 Fri Nov 27 01:04:16 CET 2009 138 | - fixed errors on socket problems 139 | - fixed sending commands 140 | 141 | 0.20 Sun Nov 22 12:41:39 CET 2009 142 | - added keepalive support 143 | - added support for ResponseHeader: fixed16 144 | - added error handling 145 | - added pod test 146 | - added tests with real socket / server 147 | - added column aliases 148 | - added timeout option 149 | - implemented select_scalar_value() 150 | - fixed perl::critic tests 151 | 152 | 0.18 Sat Nov 14 2009 08:58:02 GMT 153 | - fixed requirements 154 | - fixed typos 155 | 156 | 0.17 Fri Nov 13 17:15:44 CET 2009 157 | - added support for tcp connections 158 | 159 | 0.16 Sun Nov 8 23:17:35 CET 2009 160 | - added support for stats querys 161 | 162 | 0.15 Sat Nov 7 21:28:33 CET 2009 163 | - fixed typos in doc 164 | - minor bugfixes 165 | 166 | 0.14 Fri Nov 6 09:39:56 CET 2009 167 | - implemented selectcol_arrayref 168 | - implemented selectrow_array 169 | - implemented selectrow_hashref 170 | 171 | 0.13 Fri Nov 6 00:03:38 CET 2009 172 | - fixed tests on solaris 173 | - implemented selectall_hashref() 174 | 175 | 0.12 Thu Nov 5 09:34:59 CET 2009 176 | - fixed tests with thread support 177 | - added more tests 178 | 179 | 0.11 Wed Nov 4 23:12:16 2009 180 | - inital working version 181 | 182 | 0.10 Tue Nov 3 17:13:16 2009 183 | - renamed to Nagios::MKLivestatus 184 | 185 | 0.01 Tue Nov 3 00:07:46 2009 186 | - original version; created by h2xs 1.23 with options 187 | -A -X -n Nagios::Livestatus 188 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | Changes 2 | examples/dump.pl 3 | examples/test.pl 4 | inc/Module/AutoInstall.pm 5 | inc/Module/Install.pm 6 | inc/Module/Install/AutoInstall.pm 7 | inc/Module/Install/Base.pm 8 | inc/Module/Install/Can.pm 9 | inc/Module/Install/Fetch.pm 10 | inc/Module/Install/Include.pm 11 | inc/Module/Install/Makefile.pm 12 | inc/Module/Install/Metadata.pm 13 | inc/Module/Install/Win32.pm 14 | inc/Module/Install/WriteAll.pm 15 | lib/Monitoring/Livestatus.pm 16 | lib/Monitoring/Livestatus/INET.pm 17 | lib/Monitoring/Livestatus/UNIX.pm 18 | Makefile.PL 19 | MANIFEST 20 | META.yml 21 | README 22 | t/01-Monitoring-Livestatus-basic_tests.t 23 | t/02-Monitoring-Livestatus-internals.t 24 | t/085-json_xs.t 25 | t/20-Monitoring-Livestatus-test_socket.t 26 | t/21-Monitoring-Livestatus-INET.t 27 | t/22-Monitoring-Livestatus-UNIX.t 28 | t/23-Monitoring-Livestatus-BigData.t 29 | t/30-Monitoring-Livestatus-live-test.t 30 | t/32-Monitoring-Livestatus-backend-test.t 31 | t/33-Monitoring-Livestatus-test_socket_timeout.t 32 | t/34-Monitoring-Livestatus-utf8_support.t 33 | t/35-Monitoring-Livestatus-callbacks_support.t 34 | t/97-Pod.t 35 | t/98-Pod-Coverage.t 36 | t/99-Perl-Critic.t 37 | t/perlcriticrc 38 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | ^\.git 2 | ^Makefile$ 3 | Makefile.old 4 | blib 5 | pm_to_blib 6 | MANIFEST.bak 7 | MANIFEST.SKIP 8 | TODO 9 | MYMETA.json 10 | MYMETA.yml 11 | .*.gz 12 | .travis.yml 13 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | # IMPORTANT: if you delete this file your app will not work as 2 | # expected. you have been warned 3 | use inc::Module::Install; 4 | 5 | name 'Monitoring-Livestatus'; 6 | all_from 'lib/Monitoring/Livestatus.pm'; 7 | perl_version '5.006'; 8 | license 'perl'; 9 | 10 | resources( 11 | 'homepage', => 'http://search.cpan.org/dist/Monitoring-Livestatus/', 12 | 'bugtracker' => 'http://github.com/sni/Monitoring-Livestatus/issues', 13 | 'repository', => 'http://github.com/sni/Monitoring-Livestatus', 14 | ); 15 | 16 | 17 | requires 'IO::Socket::UNIX'; 18 | requires 'IO::Socket::IP'; 19 | requires 'IO::Select'; 20 | requires 'Test::More' => '0.87'; 21 | requires 'utf8'; 22 | requires 'Encode'; 23 | requires 'Cpanel::JSON::XS'; 24 | 25 | # test requirements 26 | # these requirements still make it into the META.yml, so they are commented so far 27 | #feature ('authortests', 28 | # -default => 0, 29 | # 'File::Copy::Recursive' => 0, 30 | # 'Test::Pod' => 1.14, 31 | # 'Test::Perl::Critic' => 0, 32 | # 'Test::Pod::Coverage' => 0, 33 | # 'Perl::Critic::Policy::Dynamic::NoIndirect' => 0, 34 | # 'Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs' => 0, 35 | # 'Perl::Critic::Policy::ValuesAndExpressions::ProhibitAccessOfPrivateData' => 0, 36 | #); 37 | 38 | auto_install; 39 | WriteAll; 40 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | Monitoring-Livestatus 2 | ===================== 3 | 4 | Monitoring::Livestatus can be used to access the data of the check_mk 5 | Livestatus Addon for Nagios and Icinga. 6 | 7 | INSTALLATION 8 | 9 | To install this module type the following: 10 | 11 | perl Makefile.PL 12 | make 13 | make test 14 | make install 15 | 16 | DEPENDENCIES 17 | 18 | This module requires no other modules. 19 | 20 | SYNOPSIS 21 | my $ml = Monitoring::Livestatus->new( socket => '/var/lib/livestatus/livestatus.sock' ); 22 | my $hosts = $ml->selectall_arrayref("GET hosts"); 23 | 24 | AUTHOR 25 | Sven Nierlein 26 | 27 | COPYRIGHT AND LICENCE 28 | 29 | Copyright (C) 2009 by Sven Nierlein 30 | 31 | This library is free software; you can redistribute it and/or modify 32 | it under the same terms as Perl itself. 33 | -------------------------------------------------------------------------------- /examples/dump.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | =head1 NAME 4 | 5 | dump.pl - print some information from a socket 6 | 7 | =head1 SYNOPSIS 8 | 9 | ./dump.pl [ -h ] [ -v ] 10 | 11 | =head1 DESCRIPTION 12 | 13 | this script print some information from a given livestatus socket or server 14 | 15 | =head1 ARGUMENTS 16 | 17 | script has the following arguments 18 | 19 | =over 4 20 | 21 | =item help 22 | 23 | -h 24 | 25 | print help and exit 26 | 27 | =item verbose 28 | 29 | -v 30 | 31 | verbose output 32 | 33 | =item socket/server 34 | 35 | server local socket file or 36 | 37 | server remote address of livestatus 38 | 39 | =back 40 | 41 | =head1 EXAMPLE 42 | 43 | ./dump.pl /tmp/live.sock 44 | 45 | =head1 AUTHOR 46 | 47 | 2009, Sven Nierlein, 48 | 49 | =cut 50 | 51 | use warnings; 52 | use strict; 53 | use Data::Dumper; 54 | use Getopt::Long; 55 | use Pod::Usage; 56 | use lib 'lib'; 57 | use lib '../lib'; 58 | use Monitoring::Livestatus; 59 | 60 | $Data::Dumper::Sortkeys = 1; 61 | 62 | ######################################################################### 63 | # parse and check cmd line arguments 64 | my ($opt_h, $opt_v, $opt_f); 65 | Getopt::Long::Configure('no_ignore_case'); 66 | if(!GetOptions ( 67 | "h" => \$opt_h, 68 | "v" => \$opt_v, 69 | "<>" => \&add_file, 70 | )) { 71 | pod2usage( { -verbose => 1, -message => 'error in options' } ); 72 | exit 3; 73 | } 74 | 75 | if(defined $opt_h) { 76 | pod2usage( { -verbose => 1 } ); 77 | exit 3; 78 | } 79 | my $verbose = 0; 80 | if(defined $opt_v) { 81 | $verbose = 1; 82 | } 83 | 84 | if(!defined $opt_f) { 85 | pod2usage( { -verbose => 1, -message => 'socket/server is a required option' } ); 86 | exit 3; 87 | } 88 | 89 | ######################################################################### 90 | my $nl = Monitoring::Livestatus->new( peer => $opt_f, verbose => $opt_v ); 91 | 92 | ######################################################################### 93 | #my $hosts = $nl->selectall_hashref('GET hosts', 'name'); 94 | #print Dumper($hosts); 95 | 96 | ######################################################################### 97 | my $services = $nl->selectall_arrayref("GET services\nColumns: description host_name state\nLimit: 2", { Slice => {}}); 98 | print Dumper($services); 99 | 100 | ######################################################################### 101 | sub add_file { 102 | my $file = shift; 103 | $opt_f = $file; 104 | } 105 | -------------------------------------------------------------------------------- /examples/test.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | =head1 NAME 4 | 5 | test.pl - print some information from a socket 6 | 7 | =head1 SYNOPSIS 8 | 9 | ./test.pl [ -h ] [ -v ] 10 | 11 | =head1 DESCRIPTION 12 | 13 | this script print some information from a given livestatus socket or server 14 | 15 | =head1 ARGUMENTS 16 | 17 | script has the following arguments 18 | 19 | =over 4 20 | 21 | =item help 22 | 23 | -h 24 | 25 | print help and exit 26 | 27 | =item verbose 28 | 29 | -v 30 | 31 | verbose output 32 | 33 | =item socket/server 34 | 35 | server local socket file or 36 | 37 | server remote address of livestatus 38 | 39 | =back 40 | 41 | =head1 EXAMPLE 42 | 43 | ./test.pl /tmp/live.sock 44 | 45 | =head1 AUTHOR 46 | 47 | 2009, Sven Nierlein, 48 | 49 | =cut 50 | 51 | use warnings; 52 | use strict; 53 | use Data::Dumper; 54 | use Getopt::Long; 55 | use Pod::Usage; 56 | use Time::HiRes qw( gettimeofday tv_interval ); 57 | use Log::Log4perl qw(:easy); 58 | use lib 'lib'; 59 | use lib '../lib'; 60 | use Monitoring::Livestatus; 61 | 62 | $Data::Dumper::Sortkeys = 1; 63 | 64 | ######################################################################### 65 | # parse and check cmd line arguments 66 | my ($opt_h, $opt_v, @opt_f); 67 | Getopt::Long::Configure('no_ignore_case'); 68 | if(!GetOptions ( 69 | "h" => \$opt_h, 70 | "v" => \$opt_v, 71 | "<>" => \&add_file, 72 | )) { 73 | pod2usage( { -verbose => 1, -message => 'error in options' } ); 74 | exit 3; 75 | } 76 | 77 | if(defined $opt_h) { 78 | pod2usage( { -verbose => 1 } ); 79 | exit 3; 80 | } 81 | my $verbose = 0; 82 | if(defined $opt_v) { 83 | $verbose = 1; 84 | } 85 | 86 | if(scalar @opt_f == 0) { 87 | pod2usage( { -verbose => 1, -message => 'socket/server is a required option' } ); 88 | exit 3; 89 | } 90 | 91 | ######################################################################### 92 | Log::Log4perl->easy_init($DEBUG); 93 | my $nl = Monitoring::Livestatus->new( 94 | peer => \@opt_f, 95 | verbose => $opt_v, 96 | timeout => 5, 97 | keepalive => 1, 98 | logger => get_logger(), 99 | ); 100 | my $log = get_logger(); 101 | 102 | ######################################################################### 103 | my $querys = [ 104 | { 'query' => "GET hostgroups\nColumns: members\nFilter: name = flap\nFilter: name = down\nOr: 2", 105 | 'sub' => "selectall_arrayref", 106 | 'opt' => {Slice => 1 } 107 | }, 108 | # { 'query' => "GET comments", 109 | # 'sub' => "selectall_arrayref", 110 | # 'opt' => {Slice => 1 } 111 | # }, 112 | # { 'query' => "GET downtimes", 113 | # 'sub' => "selectall_arrayref", 114 | # 'opt' => {Slice => 1, Sum => 1} 115 | # }, 116 | # { 'query' => "GET log\nFilter: time > ".(time() - 600)."\nLimit: 1", 117 | # 'sub' => "selectall_arrayref", 118 | # 'opt' => {Slice => 1, AddPeer => 1} 119 | # }, 120 | # { 'query' => "GET services\nFilter: contacts >= test\nFilter: host_contacts >= test\nOr: 2\nColumns: host_name description contacts host_contacts", 121 | # 'sub' => "selectall_arrayref", 122 | # 'opt' => {Slice => 1, AddPeer => 0} 123 | # }, 124 | # { 'query' => "GET services\nFilter: host_name = test_host_00\nFilter: description = test_flap_02\nOr: 2\nColumns: host_name description contacts host_contacts", 125 | # 'sub' => "selectall_arrayref", 126 | # 'opt' => {Slice => 1, AddPeer => 0} 127 | # }, 128 | ]; 129 | for my $query (@{$querys}) { 130 | my $sub = $query->{'sub'}; 131 | my $t0 = [gettimeofday]; 132 | my $stats = $nl->$sub($query->{'query'}, $query->{'opt'}); 133 | my $elapsed = tv_interval($t0); 134 | print Dumper($stats); 135 | print "Query took ".($elapsed)." seconds\n"; 136 | } 137 | 138 | 139 | ######################################################################### 140 | sub add_file { 141 | my $file = shift; 142 | push @opt_f, $file; 143 | } 144 | -------------------------------------------------------------------------------- /lib/Monitoring/Livestatus.pm: -------------------------------------------------------------------------------- 1 | package Monitoring::Livestatus; 2 | 3 | use warnings; 4 | use strict; 5 | use Carp qw/carp confess/; 6 | use Cpanel::JSON::XS (); 7 | use Data::Dumper qw/Dumper/; 8 | use IO::Select (); 9 | use Storable qw/dclone/; 10 | 11 | use Monitoring::Livestatus::INET (); 12 | use Monitoring::Livestatus::UNIX (); 13 | 14 | our $VERSION = '0.86'; 15 | 16 | 17 | # list of allowed options 18 | my $allowed_options = { 19 | 'addpeer' => 1, 20 | 'backend' => 1, 21 | 'columns' => 1, 22 | 'deepcopy' => 1, 23 | 'header' => 1, 24 | 'limit' => 1, 25 | 'limit_start' => 1, 26 | 'limit_length' => 1, 27 | 'rename' => 1, 28 | 'slice' => 1, 29 | 'sum' => 1, 30 | 'callbacks' => 1, 31 | 'wrapped_json' => 1, 32 | 'sort' => 1, 33 | 'offset' => 1, 34 | }; 35 | 36 | =head1 NAME 37 | 38 | Monitoring::Livestatus - Perl API for check_mk livestatus to access runtime 39 | data from Nagios and Icinga 40 | 41 | =head1 SYNOPSIS 42 | 43 | use Monitoring::Livestatus; 44 | my $ml = Monitoring::Livestatus->new( 45 | socket => '/var/lib/livestatus/livestatus.sock' 46 | ); 47 | my $hosts = $ml->selectall_arrayref("GET hosts"); 48 | 49 | =head1 DESCRIPTION 50 | 51 | This module connects via socket/tcp to the livestatus addon for Naemon, Nagios, 52 | Icinga and Shinken. You first have to install and activate the livestatus addon 53 | in your monitoring installation. 54 | 55 | =head1 CONSTRUCTOR 56 | 57 | =head2 new ( [ARGS] ) 58 | 59 | Creates an C object. C takes at least the 60 | socketpath. Arguments are in key-value pairs. 61 | 62 | =over 4 63 | 64 | =item socket 65 | 66 | path to the UNIX socket of check_mk livestatus 67 | 68 | =item server 69 | 70 | server address when using a TCP connection 71 | 72 | =item peer 73 | 74 | alternative way to set socket or server, if value contains ':' server is used, 75 | else socket 76 | 77 | =item name 78 | 79 | human readable name for this connection, defaults to the the socket/server 80 | address 81 | 82 | =item verbose 83 | 84 | verbose mode 85 | 86 | =item line_separator 87 | 88 | ascii code of the line separator, defaults to 10, (newline) 89 | 90 | =item column_separator 91 | 92 | ascii code of the column separator, defaults to 0 (null byte) 93 | 94 | =item list_separator 95 | 96 | ascii code of the list separator, defaults to 44 (comma) 97 | 98 | =item host_service_separator 99 | 100 | ascii code of the host/service separator, defaults to 124 (pipe) 101 | 102 | =item keepalive 103 | 104 | enable keepalive. Default is off 105 | 106 | =item errors_are_fatal 107 | 108 | errors will die with an error message. Default: on 109 | 110 | =item warnings 111 | 112 | show warnings 113 | currently only querys without Columns: Header will result in a warning 114 | 115 | =item timeout 116 | 117 | set a general timeout. Used for connect and querys, no default 118 | 119 | =item query_timeout 120 | 121 | set a query timeout. Used for retrieving querys, Default 60sec 122 | 123 | =item connect_timeout 124 | 125 | set a connect timeout. Used for initial connections, default 5sec 126 | 127 | =back 128 | 129 | If the constructor is only passed a single argument, it is assumed to 130 | be a the C specification. Use either socker OR server. 131 | 132 | =cut 133 | 134 | sub new { 135 | my($class,@args) = @_; 136 | unshift(@args, 'peer') if scalar @args == 1; 137 | my(%options) = @args; 138 | 139 | my $self = { 140 | 'verbose' => 0, # enable verbose output 141 | 'socket' => undef, # use unix sockets 142 | 'server' => undef, # use tcp connections 143 | 'peer' => undef, # use for socket / server connections 144 | 'name' => undef, # human readable name 145 | 'line_separator' => 10, # defaults to newline 146 | 'column_separator' => 0, # defaults to null byte 147 | 'list_separator' => 44, # defaults to comma 148 | 'host_service_separator' => 124, # defaults to pipe 149 | 'keepalive' => 0, # enable keepalive? 150 | 'errors_are_fatal' => 1, # die on errors 151 | 'backend' => undef, # should be keept undef, used internally 152 | 'timeout' => undef, # timeout for tcp connections 153 | 'query_timeout' => undef, # query timeout for tcp connections 154 | 'connect_timeout' => 30, # connect timeout for tcp connections 155 | 'warnings' => 1, # show warnings, for example on querys without Column: Header 156 | 'logger' => undef, # logger object used for statistical informations and errors / warnings 157 | 'deepcopy' => undef, # copy result set to avoid errors with tied structures 158 | 'retries_on_connection_error' => 3, # retry x times to connect 159 | 'retry_interval' => 1, # retry after x seconds 160 | # tls options 161 | 'cert' => undef, 162 | 'key' => undef, 163 | 'ca_file' => undef, 164 | 'verify' => undef, 165 | 'verifycn_name' => undef, 166 | }; 167 | 168 | my %old_key = ( 169 | line_seperator => 'line_separator', 170 | column_seperator => 'column_separator', 171 | list_seperator => 'list_separator', 172 | host_service_seperator => 'host_service_separator', 173 | ); 174 | 175 | # previous versions had spelling errors in the key name 176 | for my $opt_key (keys %old_key) { 177 | if(exists $options{$opt_key}) { 178 | my $value = $options{$opt_key}; 179 | $options{ $old_key{$opt_key} } = $value; 180 | delete $options{$opt_key}; 181 | } 182 | } 183 | 184 | for my $opt_key (keys %options) { 185 | if(exists $self->{$opt_key}) { 186 | $self->{$opt_key} = $options{$opt_key}; 187 | } 188 | else { 189 | confess("unknown option: $opt_key"); 190 | } 191 | } 192 | 193 | if($self->{'verbose'} && !defined $self->{'logger'}) { 194 | confess('please specify a logger object when using verbose mode'); 195 | } 196 | 197 | # setting a general timeout? 198 | if(defined $self->{'timeout'}) { 199 | $self->{'query_timeout'} = $self->{'timeout'}; 200 | $self->{'connect_timeout'} = $self->{'timeout'}; 201 | } 202 | 203 | bless $self, $class; 204 | 205 | # set our peer(s) from the options 206 | my $peer = $self->_get_peer(); 207 | 208 | if(!defined $self->{'backend'}) { 209 | $options{'name'} = $peer->{'name'}; 210 | $options{'peer'} = $peer->{'peer'}; 211 | if($peer->{'type'} eq 'UNIX') { 212 | $self->{'CONNECTOR'} = Monitoring::Livestatus::UNIX->new(%options); 213 | } 214 | elsif($peer->{'type'} eq 'INET') { 215 | $self->{'CONNECTOR'} = Monitoring::Livestatus::INET->new(%options); 216 | } 217 | $self->{'peer'} = $peer->{'peer'}; 218 | } 219 | 220 | # set names and peer for non multi backends 221 | if(defined $self->{'CONNECTOR'}->{'name'} && !defined $self->{'name'}) { 222 | $self->{'name'} = $self->{'CONNECTOR'}->{'name'}; 223 | } 224 | if(defined $self->{'CONNECTOR'}->{'peer'} && !defined $self->{'peer'}) { 225 | $self->{'peer'} = $self->{'CONNECTOR'}->{'peer'}; 226 | } 227 | 228 | return $self; 229 | } 230 | 231 | 232 | ######################################## 233 | 234 | =head1 METHODS 235 | 236 | =head2 do 237 | 238 | do($statement) 239 | do($statement, %opts) 240 | 241 | Send a single statement without fetching the result. 242 | Always returns true. 243 | 244 | =cut 245 | 246 | sub do { 247 | my($self, $statement, $opt) = @_; 248 | $self->_send($statement, $opt); 249 | return(1); 250 | } 251 | 252 | 253 | ######################################## 254 | 255 | =head2 selectall_arrayref 256 | 257 | selectall_arrayref($statement) 258 | selectall_arrayref($statement, %opts) 259 | selectall_arrayref($statement, %opts, $limit ) 260 | 261 | Sends a query and returns an array reference of arrays 262 | 263 | my $arr_refs = $ml->selectall_arrayref("GET hosts"); 264 | 265 | to get an array of hash references do something like 266 | 267 | my $hash_refs = $ml->selectall_arrayref( 268 | "GET hosts", { Slice => {} } 269 | ); 270 | 271 | to get an array of hash references from the first 2 returned rows only 272 | 273 | my $hash_refs = $ml->selectall_arrayref( 274 | "GET hosts", { Slice => {} }, 2 275 | ); 276 | 277 | you may use limit to limit the result to this number of rows 278 | 279 | column aliases can be defined with a rename hash 280 | 281 | my $hash_refs = $ml->selectall_arrayref( 282 | "GET hosts", { 283 | Slice => {}, 284 | rename => { 285 | 'name' => 'host_name' 286 | } 287 | } 288 | ); 289 | 290 | =cut 291 | 292 | sub selectall_arrayref { 293 | my($self, $statement, $opt, $limit, $result) = @_; 294 | $limit = 0 unless defined $limit; 295 | 296 | # make opt hash keys lowercase 297 | $opt = &_lowercase_and_verify_options($self, $opt) unless $result; 298 | 299 | $self->_log_statement($statement, $opt, $limit) if !$result && $self->{'verbose'}; 300 | 301 | if(!defined $result) { 302 | $result = &_send($self, $statement, $opt); 303 | 304 | if(!defined $result) { 305 | return unless $self->{'errors_are_fatal'}; 306 | confess("got undef result for: $statement"); 307 | } 308 | } 309 | 310 | # trim result set down to excepted row count 311 | if(!$opt->{'offset'} && defined $limit && $limit >= 1) { 312 | if(scalar @{$result->{'result'}} > $limit) { 313 | @{$result->{'result'}} = @{$result->{'result'}}[0..$limit-1]; 314 | } 315 | } 316 | 317 | if($opt->{'slice'}) { 318 | my $callbacks = $opt->{'callbacks'}; 319 | # make an array of hashes, inplace to safe memory 320 | my $keys = $result->{'keys'}; 321 | # renamed columns 322 | if($opt->{'rename'}) { 323 | $keys = dclone($result->{'keys'}); 324 | my $keysize = scalar @{$keys}; 325 | for(my $x=0; $x<$keysize;$x++) { 326 | my $old = $keys->[$x]; 327 | if($opt->{'rename'}->{$old}) { 328 | $keys->[$x] = $opt->{'rename'}->{$old}; 329 | } 330 | } 331 | } 332 | $result = $result->{'result'}; 333 | my $rnum = scalar @{$result}; 334 | for(my $x=0;$x<$rnum;$x++) { 335 | # sort array into hash slices 336 | my %hash; 337 | @hash{@{$keys}} = @{$result->[$x]}; 338 | # add callbacks 339 | if($callbacks) { 340 | for my $key (keys %{$callbacks}) { 341 | $hash{$key} = $callbacks->{$key}->(\%hash); 342 | } 343 | } 344 | $result->[$x] = \%hash; 345 | } 346 | return($result); 347 | } 348 | 349 | if(exists $opt->{'callbacks'}) { 350 | for my $res (@{$result->{'result'}}) { 351 | # add callbacks 352 | if(exists $opt->{'callbacks'}) { 353 | for my $key (keys %{$opt->{'callbacks'}}) { 354 | push @{$res}, $opt->{'callbacks'}->{$key}->($res); 355 | } 356 | } 357 | } 358 | 359 | for my $key (keys %{$opt->{'callbacks'}}) { 360 | push @{$result->{'keys'}}, $key; 361 | } 362 | } 363 | return($result->{'result'}); 364 | } 365 | 366 | 367 | ######################################## 368 | 369 | =head2 selectall_hashref 370 | 371 | selectall_hashref($statement, $key_field) 372 | selectall_hashref($statement, $key_field, %opts) 373 | 374 | Sends a query and returns a hashref with the given key 375 | 376 | my $hashrefs = $ml->selectall_hashref("GET hosts", "name"); 377 | 378 | =cut 379 | 380 | sub selectall_hashref { 381 | my($self, $statement, $key_field, $opt) = @_; 382 | 383 | $opt = &_lowercase_and_verify_options($self, $opt); 384 | 385 | $opt->{'slice'} = 1; 386 | 387 | confess('key is required for selectall_hashref') if !defined $key_field; 388 | 389 | my $result = $self->selectall_arrayref($statement, $opt); 390 | 391 | my %indexed; 392 | for my $row (@{$result}) { 393 | if($key_field eq '$peername') { 394 | $indexed{$self->peer_name} = $row; 395 | } 396 | elsif(!defined $row->{$key_field}) { 397 | my %possible_keys = keys %{$row}; 398 | confess("key $key_field not found in result set, possible keys are: ".join(', ', sort keys %possible_keys)); 399 | } else { 400 | $indexed{$row->{$key_field}} = $row; 401 | } 402 | } 403 | return(\%indexed); 404 | } 405 | 406 | 407 | ######################################## 408 | 409 | =head2 selectcol_arrayref 410 | 411 | selectcol_arrayref($statement) 412 | selectcol_arrayref($statement, %opt ) 413 | 414 | Sends a query an returns an arrayref for the first columns 415 | 416 | my $array_ref = $ml->selectcol_arrayref("GET hosts\nColumns: name"); 417 | 418 | $VAR1 = [ 419 | 'localhost', 420 | 'gateway', 421 | ]; 422 | 423 | returns an empty array if nothing was found 424 | 425 | to get a different column use this 426 | 427 | my $array_ref = $ml->selectcol_arrayref( 428 | "GET hosts\nColumns: name contacts", 429 | { Columns => [2] } 430 | ); 431 | 432 | you can link 2 columns in a hash result set 433 | 434 | my %hash = @{ 435 | $ml->selectcol_arrayref( 436 | "GET hosts\nColumns: name contacts", 437 | { Columns => [1,2] } 438 | ) 439 | }; 440 | 441 | produces a hash with host the contact assosiation 442 | 443 | $VAR1 = { 444 | 'localhost' => 'user1', 445 | 'gateway' => 'user2' 446 | }; 447 | 448 | =cut 449 | 450 | sub selectcol_arrayref { 451 | my($self, $statement, $opt) = @_; 452 | 453 | # make opt hash keys lowercase 454 | $opt = &_lowercase_and_verify_options($self, $opt); 455 | 456 | # if now colums are set, use just the first one 457 | if(!defined $opt->{'columns'} || ref $opt->{'columns'} ne 'ARRAY') { 458 | @{$opt->{'columns'}} = qw{1}; 459 | } 460 | 461 | my $result = $self->selectall_arrayref($statement); 462 | 463 | my @column; 464 | for my $row (@{$result}) { 465 | for my $nr (@{$opt->{'columns'}}) { 466 | push @column, $row->[$nr-1]; 467 | } 468 | } 469 | return(\@column); 470 | } 471 | 472 | 473 | ######################################## 474 | 475 | =head2 selectrow_array 476 | 477 | selectrow_array($statement) 478 | selectrow_array($statement, %opts) 479 | 480 | Sends a query and returns an array for the first row 481 | 482 | my @array = $ml->selectrow_array("GET hosts"); 483 | 484 | returns undef if nothing was found 485 | 486 | =cut 487 | sub selectrow_array { 488 | my($self, $statement, $opt) = @_; 489 | 490 | # make opt hash keys lowercase 491 | $opt = &_lowercase_and_verify_options($self, $opt); 492 | 493 | my @result = @{$self->selectall_arrayref($statement, $opt, 1)}; 494 | return @{$result[0]} if scalar @result > 0; 495 | return; 496 | } 497 | 498 | 499 | ######################################## 500 | 501 | =head2 selectrow_arrayref 502 | 503 | selectrow_arrayref($statement) 504 | selectrow_arrayref($statement, %opts) 505 | 506 | Sends a query and returns an array reference for the first row 507 | 508 | my $arrayref = $ml->selectrow_arrayref("GET hosts"); 509 | 510 | returns undef if nothing was found 511 | 512 | =cut 513 | sub selectrow_arrayref { 514 | my($self, $statement, $opt) = @_; 515 | 516 | # make opt hash keys lowercase 517 | $opt = &_lowercase_and_verify_options($self, $opt); 518 | 519 | my $result = $self->selectall_arrayref($statement, $opt, 1); 520 | return if !defined $result; 521 | return $result->[0] if scalar @{$result} > 0; 522 | return; 523 | } 524 | 525 | 526 | ######################################## 527 | 528 | =head2 selectrow_hashref 529 | 530 | selectrow_hashref($statement) 531 | selectrow_hashref($statement, %opt) 532 | 533 | Sends a query and returns a hash reference for the first row 534 | 535 | my $hashref = $ml->selectrow_hashref("GET hosts"); 536 | 537 | returns undef if nothing was found 538 | 539 | =cut 540 | sub selectrow_hashref { 541 | my($self, $statement, $opt) = @_; 542 | 543 | # make opt hash keys lowercase 544 | $opt = &_lowercase_and_verify_options($self, $opt); 545 | $opt->{slice} = 1; 546 | 547 | my $result = $self->selectall_arrayref($statement, $opt, 1); 548 | return if !defined $result; 549 | return $result->[0] if scalar @{$result} > 0; 550 | return; 551 | } 552 | 553 | 554 | ######################################## 555 | 556 | =head2 selectscalar_value 557 | 558 | selectscalar_value($statement) 559 | selectscalar_value($statement, %opt) 560 | 561 | Sends a query and returns a single scalar 562 | 563 | my $count = $ml->selectscalar_value("GET hosts\nStats: state = 0"); 564 | 565 | returns undef if nothing was found 566 | 567 | =cut 568 | sub selectscalar_value { 569 | my($self, $statement, $opt) = @_; 570 | 571 | # make opt hash keys lowercase 572 | $opt = &_lowercase_and_verify_options($self, $opt); 573 | 574 | my $row = $self->selectrow_arrayref($statement); 575 | return if !defined $row; 576 | return $row->[0] if scalar @{$row} > 0; 577 | return; 578 | } 579 | 580 | ######################################## 581 | 582 | =head2 errors_are_fatal 583 | 584 | errors_are_fatal() 585 | errors_are_fatal($value) 586 | 587 | Enable or disable fatal errors. When enabled the module will confess on any error. 588 | 589 | returns the current setting if called without new value 590 | 591 | =cut 592 | sub errors_are_fatal { 593 | my($self, $value) = @_; 594 | my $old = $self->{'errors_are_fatal'}; 595 | 596 | $self->{'errors_are_fatal'} = $value; 597 | $self->{'CONNECTOR'}->{'errors_are_fatal'} = $value if defined $self->{'CONNECTOR'}; 598 | 599 | return $old; 600 | } 601 | 602 | ######################################## 603 | 604 | =head2 warnings 605 | 606 | warnings() 607 | warnings($value) 608 | 609 | Enable or disable warnings. When enabled the module will carp on warnings. 610 | 611 | returns the current setting if called without new value 612 | 613 | =cut 614 | sub warnings { 615 | my($self, $value) = @_; 616 | my $old = $self->{'warnings'}; 617 | 618 | $self->{'warnings'} = $value; 619 | $self->{'CONNECTOR'}->{'warnings'} = $value if defined $self->{'CONNECTOR'}; 620 | 621 | return $old; 622 | } 623 | 624 | 625 | 626 | ######################################## 627 | 628 | =head2 verbose 629 | 630 | verbose() 631 | verbose($values) 632 | 633 | Enable or disable verbose output. When enabled the module will dump out debug output 634 | 635 | returns the current setting if called without new value 636 | 637 | =cut 638 | sub verbose { 639 | my($self, $value) = @_; 640 | my $old = $self->{'verbose'}; 641 | 642 | $self->{'verbose'} = $value; 643 | $self->{'CONNECTOR'}->{'verbose'} = $value if defined $self->{'CONNECTOR'}; 644 | 645 | return $old; 646 | } 647 | 648 | 649 | ######################################## 650 | 651 | =head2 peer_addr 652 | 653 | $ml->peer_addr() 654 | 655 | returns the current peer address 656 | 657 | when using multiple backends, a list of all addresses is returned in list context 658 | 659 | =cut 660 | sub peer_addr { 661 | my($self) = @_; 662 | return ''.$self->{'peer'}; 663 | } 664 | 665 | 666 | ######################################## 667 | 668 | =head2 peer_name 669 | 670 | $ml->peer_name() 671 | $ml->peer_name($string) 672 | 673 | if new value is set, name is set to this value 674 | 675 | always returns the current peer name 676 | 677 | when using multiple backends, a list of all names is returned in list context 678 | 679 | =cut 680 | sub peer_name { 681 | my($self, $value) = @_; 682 | 683 | if(defined $value and $value ne '') { 684 | $self->{'name'} = $value; 685 | } 686 | 687 | return ''.$self->{'name'}; 688 | } 689 | 690 | 691 | ######################################## 692 | 693 | =head2 peer_key 694 | 695 | $ml->peer_key() 696 | 697 | returns a uniq key for this peer 698 | 699 | =cut 700 | sub peer_key { 701 | my($self) = @_; 702 | return $self->{'key'}; 703 | } 704 | 705 | ######################################## 706 | # INTERNAL SUBS 707 | ######################################## 708 | sub _send { 709 | my($self, $statement, $opt) = @_; 710 | 711 | confess('duplicate data') if $opt->{'data'}; 712 | 713 | delete $self->{'meta_data'}; 714 | 715 | my $header = ''; 716 | my $keys; 717 | 718 | $Monitoring::Livestatus::ErrorCode = 0; 719 | undef $Monitoring::Livestatus::ErrorMessage; 720 | 721 | return(490, $self->_get_error(490), undef) if !defined $statement; 722 | chomp($statement); 723 | 724 | my($status,$msg,$body); 725 | if($statement =~ m/^Separators:/mx) { 726 | $status = 492; 727 | $msg = $self->_get_error($status); 728 | } 729 | 730 | elsif($statement =~ m/^KeepAlive:/mx) { 731 | $status = 496; 732 | $msg = $self->_get_error($status); 733 | } 734 | 735 | elsif($statement =~ m/^ResponseHeader:/mx) { 736 | $status = 495; 737 | $msg = $self->_get_error($status); 738 | } 739 | 740 | elsif($statement =~ m/^ColumnHeaders:/mx) { 741 | $status = 494; 742 | $msg = $self->_get_error($status); 743 | } 744 | 745 | elsif($statement =~ m/^OuputFormat:/mx) { 746 | $status = 493; 747 | $msg = $self->_get_error($status); 748 | } 749 | 750 | # should be cought in mlivestatus directly 751 | elsif($statement =~ m/^Limit:\ (.*)$/mx and $1 !~ m/^\d+$/mx) { 752 | $status = 403; 753 | $msg = $self->_get_error($status); 754 | } 755 | elsif($statement =~ m/^GET\ (.*)$/mx and $1 =~ m/^\s*$/mx) { 756 | $status = 403; 757 | $msg = $self->_get_error($status); 758 | } 759 | 760 | elsif($statement =~ m/^Columns:\ (.*)$/mx and ($1 =~ m/,/mx or $1 =~ /^\s*$/mx)) { 761 | $status = 405; 762 | $msg = $self->_get_error($status); 763 | } 764 | elsif($statement !~ m/^GET\ /mx and $statement !~ m/^COMMAND\ /mx) { 765 | $status = 401; 766 | $msg = $self->_get_error($status); 767 | } 768 | 769 | else { 770 | 771 | # Add Limits header 772 | if(defined $opt->{'limit_start'}) { 773 | $statement .= "\nLimit: ".($opt->{'limit_start'} + $opt->{'limit_length'}); 774 | } 775 | 776 | # for querys with column header, no seperate columns will be returned 777 | if($statement =~ m/^Columns:\ (.*)$/mx) { 778 | ($statement,$keys) = $self->_extract_keys_from_columns_header($statement); 779 | } 780 | if($statement =~ m/^Stats:\ (.*)$/mx or $statement =~ m/^StatsGroupBy:\ (.*)$/mx) { 781 | my $has_columns = defined $keys ? join(",", @{$keys}) : undef; 782 | ($statement,$keys) = extract_keys_from_stats_statement($statement); 783 | unshift @{$keys}, $has_columns if $has_columns; 784 | } 785 | 786 | # Offset header (currently naemon only) 787 | if(defined $opt->{'offset'}) { 788 | $statement .= "\nOffset: ".$opt->{'offset'}; 789 | } 790 | 791 | # Sort header (currently naemon only) 792 | if(defined $opt->{'sort'}) { 793 | for my $sort (@{$opt->{'sort'}}) { 794 | $statement .= "\nSort: ".$sort; 795 | } 796 | } 797 | 798 | # Commands need no additional header 799 | if($statement !~ m/^COMMAND/mx) { 800 | if($opt->{'wrapped_json'}) { 801 | $header .= "OutputFormat: wrapped_json\n"; 802 | } else { 803 | $header .= "OutputFormat: json\n"; 804 | } 805 | $header .= "ResponseHeader: fixed16\n"; 806 | if($self->{'keepalive'}) { 807 | $header .= "KeepAlive: on\n"; 808 | } 809 | # remove empty lines from statement 810 | $statement =~ s/\n+/\n/gmx; 811 | } 812 | 813 | # add additional headers 814 | if(defined $opt->{'header'} and ref $opt->{'header'} eq 'HASH') { 815 | for my $key ( keys %{$opt->{'header'}}) { 816 | $header .= $key.': '.$opt->{'header'}->{$key}."\n"; 817 | } 818 | } 819 | 820 | chomp($statement); 821 | my $send = "$statement\n$header"; 822 | $self->{'logger'}->debug('> '.Dumper($send)) if $self->{'verbose'}; 823 | ($status,$msg,$body) = &_send_socket($self, $send); 824 | if($self->{'verbose'}) { 825 | #$self->{'logger'}->debug("got:"); 826 | #$self->{'logger'}->debug(Dumper(\@erg)); 827 | $self->{'logger'}->debug('status: '.Dumper($status)); 828 | $self->{'logger'}->debug('msg: '.Dumper($msg)); 829 | $self->{'logger'}->debug('< '.Dumper($body)); 830 | } 831 | } 832 | 833 | if(!$status || $status >= 300) { 834 | $body = '' if !defined $body; 835 | $status = 300 if !defined $status; 836 | chomp($body); 837 | $Monitoring::Livestatus::ErrorCode = $status; 838 | if(defined $body and $body ne '') { 839 | $Monitoring::Livestatus::ErrorMessage = $body; 840 | } else { 841 | $Monitoring::Livestatus::ErrorMessage = $msg; 842 | } 843 | $self->{'logger'}->error($status.' - '.$Monitoring::Livestatus::ErrorMessage." in query:\n".$statement) if $self->{'verbose'}; 844 | if($self->{'errors_are_fatal'}) { 845 | confess('ERROR '.$status.' - '.$Monitoring::Livestatus::ErrorMessage." in query:\n".$statement."\n"); 846 | } 847 | return; 848 | } 849 | 850 | # return a empty result set if nothing found 851 | return({ keys => [], result => []}) if !defined $body; 852 | 853 | # body is already parsed 854 | my $result; 855 | if($status == 200) { 856 | $result = $body; 857 | } else { 858 | my $json_decoder = Cpanel::JSON::XS->new->utf8->relaxed; 859 | # fix json output 860 | eval { 861 | $result = $json_decoder->decode($body); 862 | }; 863 | # fix low/high surrogate errors 864 | # missing high surrogate character in surrogate pair 865 | # surrogate pair expected 866 | if($@) { 867 | # replace u+D800 to u+DFFF (reserved utf-16 low/high surrogates) 868 | $body =~ s/\\ud[89a-f][0-9a-f]{2}/\\ufffd/gmxio; 869 | eval { 870 | $result = $json_decoder->decode($body); 871 | }; 872 | } 873 | if($@) { 874 | my $message = 'ERROR '.$@." in text: '".$body."'\" for statement: '$statement'\n"; 875 | $self->{'logger'}->error($message) if $self->{'verbose'}; 876 | if($self->{'errors_are_fatal'}) { 877 | confess($message); 878 | } 879 | return({ keys => [], result => []}); 880 | } 881 | } 882 | if(!defined $result) { 883 | my $message = "ERROR undef result for text: '".$body."'\" for statement: '$statement'\n"; 884 | $self->{'logger'}->error($message) if $self->{'verbose'}; 885 | if($self->{'errors_are_fatal'}) { 886 | confess($message); 887 | } 888 | return({ keys => [], result => []}); 889 | } 890 | 891 | # for querys with column header, no separate columns will be returned 892 | if(!defined $keys) { 893 | $self->{'logger'}->warn('got statement without Columns: header!') if $self->{'verbose'}; 894 | if($self->{'warnings'}) { 895 | carp('got statement without Columns: header! -> '.$statement); 896 | } 897 | $keys = shift @{$result}; 898 | } 899 | 900 | return(&post_processing($self, $result, $opt, $keys)); 901 | } 902 | 903 | ######################################## 904 | 905 | =head2 post_processing 906 | 907 | $ml->post_processing($result, $options, $keys) 908 | 909 | returns postprocessed result. 910 | 911 | Useful when using select based io. 912 | 913 | =cut 914 | sub post_processing { 915 | my($self, $result, $opt, $keys) = @_; 916 | 917 | my $orig_result; 918 | if($opt->{'wrapped_json'}) { 919 | $orig_result = $result; 920 | $result = delete $orig_result->{'data'}; 921 | } 922 | 923 | # add peer information? 924 | my $with_peers = 0; 925 | if(defined $opt->{'addpeer'} and $opt->{'addpeer'}) { 926 | $with_peers = 1; 927 | } 928 | 929 | if(defined $with_peers and $with_peers == 1) { 930 | my $peer_name = $self->peer_name; 931 | my $peer_addr = $self->peer_addr; 932 | my $peer_key = $self->peer_key; 933 | 934 | unshift @{$keys}, 'peer_name'; 935 | unshift @{$keys}, 'peer_addr'; 936 | unshift @{$keys}, 'peer_key'; 937 | 938 | for my $row (@{$result}) { 939 | unshift @{$row}, $peer_name; 940 | unshift @{$row}, $peer_addr; 941 | unshift @{$row}, $peer_key; 942 | } 943 | } 944 | 945 | # set some metadata 946 | $self->{'meta_data'} = { 947 | 'result_count' => scalar @{$result}, 948 | }; 949 | if($opt->{'wrapped_json'}) { 950 | $self->{'meta_data'} = $orig_result; 951 | } 952 | 953 | return({ keys => $keys, result => $result }); 954 | } 955 | 956 | ######################################## 957 | sub _open { 958 | my($self) = @_; 959 | 960 | # return the current socket in keep alive mode 961 | if($self->{'keepalive'} and defined $self->{'sock'} and $self->{'sock'}->connected) { 962 | $self->{'logger'}->debug('reusing old connection') if $self->{'verbose'}; 963 | return($self->{'sock'}); 964 | } 965 | 966 | my $sock = $self->{'CONNECTOR'}->_open(); 967 | 968 | # store socket for later retrieval 969 | if($self->{'keepalive'}) { 970 | $self->{'sock'} = $sock; 971 | } 972 | 973 | $self->{'logger'}->debug('using new connection') if $self->{'verbose'}; 974 | return($sock); 975 | } 976 | 977 | ######################################## 978 | sub _close { 979 | my($self) = @_; 980 | my $sock = delete $self->{'sock'}; 981 | return($self->{'CONNECTOR'}->_close($sock)); 982 | } 983 | 984 | ######################################## 985 | 986 | =head1 QUERY OPTIONS 987 | 988 | In addition to the normal query syntax from the livestatus addon, it is 989 | possible to set column aliases in various ways. 990 | 991 | =head2 AddPeer 992 | 993 | adds the peers name, addr and key to the result set: 994 | 995 | my $hosts = $ml->selectall_hashref( 996 | "GET hosts\nColumns: name alias state", 997 | "name", 998 | { AddPeer => 1 } 999 | ); 1000 | 1001 | =head2 Backend 1002 | 1003 | send the query only to some specific backends. 1004 | Only useful when using multiple backends. 1005 | 1006 | my $hosts = $ml->selectall_arrayref( 1007 | "GET hosts\nColumns: name alias state", 1008 | { Backends => [ 'key1', 'key4' ] } 1009 | ); 1010 | 1011 | =head2 Columns 1012 | 1013 | only return the given column indexes 1014 | 1015 | my $array_ref = $ml->selectcol_arrayref( 1016 | "GET hosts\nColumns: name contacts", 1017 | { Columns => [2] } 1018 | ); 1019 | 1020 | see L for more examples 1021 | 1022 | =head2 Deepcopy 1023 | 1024 | deep copy/clone the result set. 1025 | 1026 | Only effective when using multiple backends and threads. 1027 | This can be safely turned off if you don't change the 1028 | result set. 1029 | If you get an error like "Invalid value for shared scalar" error" this 1030 | should be turned on. 1031 | 1032 | my $array_ref = $ml->selectcol_arrayref( 1033 | "GET hosts\nColumns: name contacts", 1034 | { Deepcopy => 1 } 1035 | ); 1036 | 1037 | =head2 Limit 1038 | 1039 | Just like the Limit: option from livestatus itself. 1040 | In addition you can add a start,length limit. 1041 | 1042 | my $array_ref = $ml->selectcol_arrayref( 1043 | "GET hosts\nColumns: name contacts", 1044 | { Limit => "10,20" } 1045 | ); 1046 | 1047 | This example will return 20 rows starting at row 10. You will 1048 | get row 10-30. 1049 | 1050 | Cannot be combined with a Limit inside the query 1051 | because a Limit will be added automatically. 1052 | 1053 | Adding a limit this way will greatly increase performance and 1054 | reduce memory usage. 1055 | 1056 | This option is multibackend safe contrary to the "Limit: " part of a statement. 1057 | Sending a statement like "GET...Limit: 10" with 3 backends will result in 30 rows. 1058 | Using this options, you will receive only the first 10 rows. 1059 | 1060 | =head2 Rename 1061 | 1062 | see L for detailed explainaton 1063 | 1064 | =head2 Slice 1065 | 1066 | see L for detailed explainaton 1067 | 1068 | =head2 Sum 1069 | 1070 | The Sum option only applies when using multiple backends. 1071 | The values from all backends with be summed up to a total. 1072 | 1073 | my $stats = $ml->selectrow_hashref( 1074 | "GET hosts\nStats: state = 0\nStats: state = 1", 1075 | { Sum => 1 } 1076 | ); 1077 | 1078 | =cut 1079 | 1080 | 1081 | ######################################## 1082 | # wrapper around _send_socket_do 1083 | sub _send_socket { 1084 | my($self, $statement) = @_; 1085 | 1086 | my $retries = 0; 1087 | my($status, $msg, $recv, $sock); 1088 | 1089 | # closing a socket sends SIGPIPE to reader 1090 | # https://riptutorial.com/posix/example/17424/handle-sigpipe-generated-by-write---in-a-thread-safe-manner 1091 | local $SIG{PIPE} = 'IGNORE'; 1092 | 1093 | my $maxretries = $ENV{'LIVESTATUS_RETRIES'} // $self->{'retries_on_connection_error'}; 1094 | 1095 | # try to avoid connection errors 1096 | eval { 1097 | if($maxretries <= 0) { 1098 | ($sock, $msg, $recv) = &_send_socket_do($self, $statement); 1099 | return($sock, $msg, $recv) if $msg; 1100 | ($status, $msg, $recv) = &_read_socket_do($self, $sock, $statement); 1101 | return($status, $msg, $recv); 1102 | } 1103 | 1104 | while((!defined $status || ($status == 491 || $status == 497 || $status == 500)) && $retries < $maxretries) { 1105 | $retries++; 1106 | ($sock, $msg, $recv) = &_send_socket_do($self, $statement); 1107 | return($status, $msg, $recv) if $msg; 1108 | ($status, $msg, $recv) = &_read_socket_do($self, $sock, $statement); 1109 | $self->{'logger'}->debug('query status '.$status) if $self->{'verbose'}; 1110 | if($status == 491 or $status == 497 or $status == 500) { 1111 | $self->{'logger'}->debug('got status '.$status.' retrying in '.$self->{'retry_interval'}.' seconds') if $self->{'verbose'}; 1112 | $self->_close(); 1113 | sleep($self->{'retry_interval'}) if $retries < $maxretries; 1114 | } 1115 | } 1116 | }; 1117 | my $err = $@; 1118 | if($err) { 1119 | $self->{'logger'}->debug("try 1 failed: $err") if $self->{'verbose'}; 1120 | if($err =~ /broken\ pipe/mx) { 1121 | ($sock, $msg, $recv) = &_send_socket_do($self, $statement); 1122 | return($status, $msg, $recv) if $msg; 1123 | return(&_read_socket_do($self, $sock, $statement)); 1124 | } 1125 | _die_or_confess($err) if $self->{'errors_are_fatal'}; 1126 | } 1127 | 1128 | $status = $sock unless $status; 1129 | $msg =~ s/^$status:\s+//gmx; 1130 | _die_or_confess($status.": ".$msg) if($status >= 400 and $self->{'errors_are_fatal'}); 1131 | 1132 | return($status, $msg, $recv); 1133 | } 1134 | 1135 | ######################################## 1136 | sub _send_socket_do { 1137 | my($self, $statement) = @_; 1138 | my $sock = $self->_open() or return(491, $self->_get_error(491, $@ || $!), $@ || $!); 1139 | utf8::decode($statement); # make sure 1140 | utf8::encode($statement); # query is utf8 1141 | $sock->printflush($statement,"\n") || return($self->_socket_error($statement, 'write to socket failed'.($! ? ': '.$! : ''))); 1142 | return $sock; 1143 | } 1144 | 1145 | ######################################## 1146 | sub _read_socket_do { 1147 | my($self, $sock, $statement) = @_; 1148 | my($recv,$header); 1149 | 1150 | my $s = IO::Select->new(); 1151 | $s->add($sock); 1152 | 1153 | # COMMAND statements might return a error message 1154 | if($statement && $statement =~ m/^COMMAND/mx) { 1155 | shutdown($sock, 1); 1156 | if($s->can_read(3)) { 1157 | $recv = <$sock>; 1158 | } 1159 | if($recv) { 1160 | chomp($recv); 1161 | if($recv =~ m/^(\d+):\s*(.*)$/mx) { 1162 | return($1, $recv, undef); 1163 | } 1164 | return('400', $self->_get_error(400), $recv); 1165 | } 1166 | return('200', $self->_get_error(200), undef); 1167 | } 1168 | 1169 | my $timeout = 180; 1170 | if($statement) { 1171 | # status requests should not take longer than 20 seconds 1172 | $timeout = 20 if($statement =~ m/^GET\s+status/mx); 1173 | $timeout = 300 if($statement =~ m/^GET\s+log/mx); 1174 | } 1175 | $timeout = $self->{'query_timeout'} if $self->{'query_timeout'}; 1176 | 1177 | local $! = undef; 1178 | my @ready = $s->can_read($timeout); 1179 | if(scalar @ready == 0) { 1180 | my $err = $!; 1181 | if($err) { 1182 | return($self->_socket_error($statement, 'socket error '.$err)); 1183 | } 1184 | return($self->_socket_error($statement, 'timeout ('.$timeout.'s) while waiting for socket')); 1185 | } 1186 | 1187 | $sock->read($header, 16) || return($self->_socket_error($statement, 'reading header from socket failed'.($! ? ': '.$! : ''))); 1188 | $self->{'logger'}->debug("header: $header") if $self->{'verbose'}; 1189 | my($status, $msg, $content_length) = &_parse_header($self, $header, $sock); 1190 | return($status, $msg, undef) if !defined $content_length; 1191 | our $json_decoder; 1192 | if($json_decoder) { 1193 | $json_decoder->incr_reset; 1194 | } else { 1195 | $json_decoder = Cpanel::JSON::XS->new->utf8->relaxed; 1196 | } 1197 | if($content_length > 0) { 1198 | if($status == 200) { 1199 | my $remaining = $content_length; 1200 | my $length = 32768; 1201 | if($remaining < $length) { $length = $remaining; } 1202 | while($length > 0 && $sock->read(my $buf, $length)) { 1203 | # replace u+D800 to u+DFFF (reserved utf-16 low/high surrogates) 1204 | $buf =~ s/\\ud[89a-f][0-9a-f]{2}/\\ufffd/gmxio; 1205 | $json_decoder->incr_parse($buf); 1206 | $remaining = $remaining -$length; 1207 | if($remaining < $length) { $length = $remaining; } 1208 | } 1209 | $recv = $json_decoder->incr_parse or return($self->_socket_error($statement, 'reading remaining '.$length.' bytes from socket failed'.($! ? ': '.$! : ''))); 1210 | $json_decoder->incr_reset; 1211 | } else { 1212 | $sock->read($recv, $content_length) or return($self->_socket_error($statement, 'reading body from socket failed'.($! ? ': '.$! : ''))); 1213 | } 1214 | } 1215 | 1216 | $self->_close() unless $self->{'keepalive'}; 1217 | if($status >= 400 && $recv) { 1218 | $msg .= ' - '.$recv; 1219 | } 1220 | return($status, $msg, $recv); 1221 | } 1222 | 1223 | ######################################## 1224 | sub _socket_error { 1225 | my($self, $statement, $err) = @_; 1226 | 1227 | my $message = "\n"; 1228 | $message .= "peer ".Dumper($self->peer_name); 1229 | $message .= "statement ".Dumper($statement); 1230 | 1231 | $self->{'logger'}->error($message) if $self->{'verbose'}; 1232 | 1233 | if($self->{'retries_on_connection_error'} <= 0) { 1234 | if($self->{'errors_are_fatal'}) { 1235 | _die_or_confess($message); 1236 | } 1237 | else { 1238 | carp($message); 1239 | } 1240 | } 1241 | $self->_close(); 1242 | return(500, $self->_get_error(500).($err ? " - ".$err : ""), $message); 1243 | } 1244 | 1245 | ######################################## 1246 | sub _parse_header { 1247 | my($self, $header, $sock) = @_; 1248 | 1249 | if(!defined $header) { 1250 | return(497, $self->_get_error(497), undef); 1251 | } 1252 | 1253 | my $headerlength = length($header); 1254 | if($headerlength != 16) { 1255 | return(498, $self->_get_error(498)."\ngot: ".$header.<$sock>, undef); 1256 | } 1257 | chomp($header); 1258 | 1259 | my $status = substr($header,0,3); 1260 | my $content_length = substr($header,5); 1261 | if($content_length !~ m/^\s*(\d+)$/mx) { 1262 | return(499, $self->_get_error(499)."\ngot: ".$header.<$sock>, undef); 1263 | } else { 1264 | $content_length = $1; 1265 | } 1266 | 1267 | return($status, $self->_get_error($status), $content_length); 1268 | } 1269 | 1270 | ######################################## 1271 | 1272 | =head1 COLUMN ALIAS 1273 | 1274 | In addition to the normal query syntax from the livestatus addon, it is 1275 | possible to set column aliases in various ways. 1276 | 1277 | A valid Columns: Header could look like this: 1278 | 1279 | my $hosts = $ml->selectall_arrayref( 1280 | "GET hosts\nColumns: state as status" 1281 | ); 1282 | 1283 | Stats queries could be aliased too: 1284 | 1285 | my $stats = $ml->selectall_arrayref( 1286 | "GET hosts\nStats: state = 0 as up" 1287 | ); 1288 | 1289 | This syntax is available for: Stats, StatsAnd, StatsOr and StatsGroupBy 1290 | 1291 | 1292 | An alternative way to set column aliases is to define rename option key/value 1293 | pairs: 1294 | 1295 | my $hosts = $ml->selectall_arrayref( 1296 | "GET hosts\nColumns: name", { 1297 | rename => { 'name' => 'hostname' } 1298 | } 1299 | ); 1300 | 1301 | =cut 1302 | 1303 | ######################################## 1304 | 1305 | =head2 extract_keys_from_stats_statement 1306 | 1307 | extract_keys_from_stats_statement($statement) 1308 | 1309 | Extract column keys from statement. 1310 | 1311 | =cut 1312 | sub extract_keys_from_stats_statement { 1313 | my($statement) = @_; 1314 | 1315 | my(@header, $new_statement); 1316 | 1317 | for my $line (split/\n/mx, $statement) { 1318 | if(substr($line, 0, 5) ne 'Stats') { # faster shortcut for non-stats lines 1319 | $new_statement .= $line."\n"; 1320 | next; 1321 | } 1322 | if($line =~ m/^Stats:\ (.*)\s+as\s+(.*?)$/mxo) { 1323 | push @header, $2; 1324 | $line = 'Stats: '.$1; 1325 | } 1326 | elsif($line =~ m/^Stats:\ (.*)$/mxo) { 1327 | push @header, $1; 1328 | } 1329 | 1330 | elsif($line =~ m/^StatsAnd:\ (\d+)\s+as\s+(.*?)$/mxo) { 1331 | for(my $x = 0; $x < $1; $x++) { 1332 | pop @header; 1333 | } 1334 | $line = 'StatsAnd: '.$1; 1335 | push @header, $2; 1336 | } 1337 | elsif($line =~ m/^StatsAnd:\ (\d+)$/mxo) { 1338 | my @to_join; 1339 | for(my $x = 0; $x < $1; $x++) { 1340 | unshift @to_join, pop @header; 1341 | } 1342 | push @header, join(' && ', @to_join); 1343 | } 1344 | 1345 | elsif($line =~ m/^StatsOr:\ (\d+)\s+as\s+(.*?)$/mxo) { 1346 | for(my $x = 0; $x < $1; $x++) { 1347 | pop @header; 1348 | } 1349 | $line = 'StatsOr: '.$1; 1350 | push @header, $2; 1351 | } 1352 | elsif($line =~ m/^StatsOr:\ (\d+)$/mxo) { 1353 | my @to_join; 1354 | for(my $x = 0; $x < $1; $x++) { 1355 | unshift @to_join, pop @header; 1356 | } 1357 | push @header, join(' || ', @to_join); 1358 | } 1359 | 1360 | # StatsGroupBy header are always sent first 1361 | elsif($line =~ m/^StatsGroupBy:\ (.*)\s+as\s+(.*?)$/mxo) { 1362 | unshift @header, $2; 1363 | $line = 'StatsGroupBy: '.$1; 1364 | } 1365 | elsif($line =~ m/^StatsGroupBy:\ (.*)$/mxo) { 1366 | unshift @header, $1; 1367 | } 1368 | $new_statement .= $line."\n"; 1369 | } 1370 | 1371 | return($new_statement, \@header); 1372 | } 1373 | 1374 | ######################################## 1375 | sub _extract_keys_from_columns_header { 1376 | my($self, $statement) = @_; 1377 | 1378 | my(@header, $new_statement); 1379 | for my $line (split/\n/mx, $statement) { 1380 | if($line =~ m/^Columns:\s+(.*)$/mx) { 1381 | for my $column (split/\s+/mx, $1) { 1382 | if($column eq 'as') { 1383 | pop @header; 1384 | } else { 1385 | push @header, $column; 1386 | } 1387 | } 1388 | $line =~ s/\s+as\s+([^\s]+)/\ /gmx; 1389 | } 1390 | $new_statement .= $line."\n"; 1391 | } 1392 | 1393 | return($new_statement, \@header); 1394 | } 1395 | 1396 | ######################################## 1397 | 1398 | =head1 ERROR HANDLING 1399 | 1400 | Errorhandling can be done like this: 1401 | 1402 | use Monitoring::Livestatus; 1403 | my $ml = Monitoring::Livestatus->new( 1404 | socket => '/var/lib/livestatus/livestatus.sock' 1405 | ); 1406 | $ml->errors_are_fatal(0); 1407 | my $hosts = $ml->selectall_arrayref("GET hosts"); 1408 | if($Monitoring::Livestatus::ErrorCode) { 1409 | confess($Monitoring::Livestatus::ErrorMessage); 1410 | } 1411 | 1412 | =cut 1413 | sub _get_error { 1414 | my($self, $code, $append) = @_; 1415 | 1416 | my $codes = { 1417 | '200' => 'OK. Reponse contains the queried data.', 1418 | '201' => 'COMMANDs never return something', 1419 | '400' => 'The request contains an invalid header.', 1420 | '401' => 'The request contains an invalid header.', 1421 | '402' => 'The request is completely invalid.', 1422 | '403' => 'The request is incomplete.', 1423 | '404' => 'The target of the GET has not been found (e.g. the table).', 1424 | '405' => 'A non-existing column was being referred to', 1425 | '413' => 'Maximum response size reached', 1426 | '452' => 'internal livestatus error', 1427 | '490' => 'no query', 1428 | '491' => 'failed to connect', 1429 | '492' => 'Separators not allowed in statement. Please use the separator options in new()', 1430 | '493' => 'OuputFormat not allowed in statement. Header will be set automatically', 1431 | '494' => 'ColumnHeaders not allowed in statement. Header will be set automatically', 1432 | '495' => 'ResponseHeader not allowed in statement. Header will be set automatically', 1433 | '496' => 'Keepalive not allowed in statement. Please use the keepalive option in new()', 1434 | '497' => 'got no header', 1435 | '498' => 'header is not exactly 16byte long', 1436 | '499' => 'not a valid header (no content-length)', 1437 | '500' => 'socket error', 1438 | '502' => 'backend connection proxy error', 1439 | }; 1440 | 1441 | confess('non existant error code: '.$code) if !defined $codes->{$code}; 1442 | my $msg = $codes->{$code}; 1443 | $msg .= ' - '.$append if $append; 1444 | 1445 | return($msg); 1446 | } 1447 | 1448 | ######################################## 1449 | sub _get_peer { 1450 | my($self) = @_; 1451 | 1452 | # check if the supplied peer is a socket or a server address 1453 | if(defined $self->{'peer'}) { 1454 | if(ref $self->{'peer'} eq '') { 1455 | my $name = $self->{'name'} || ''.$self->{'peer'}; 1456 | if(index($self->{'peer'}, ':') > 0) { 1457 | return({ 'peer' => ''.$self->{'peer'}, type => 'INET', name => $name }); 1458 | } else { 1459 | return({ 'peer' => ''.$self->{'peer'}, type => 'UNIX', name => $name }); 1460 | } 1461 | } 1462 | elsif(ref $self->{'peer'} eq 'ARRAY') { 1463 | for my $peer (@{$self->{'peer'}}) { 1464 | if(ref $peer eq 'HASH') { 1465 | next if !defined $peer->{'peer'}; 1466 | $peer->{'name'} = ''.$peer->{'peer'} unless defined $peer->{'name'}; 1467 | if(!defined $peer->{'type'}) { 1468 | $peer->{'type'} = 'UNIX'; 1469 | if(index($peer->{'peer'}, ':') >= 0) { 1470 | $peer->{'type'} = 'INET'; 1471 | } 1472 | } 1473 | return $peer; 1474 | } else { 1475 | my $type = 'UNIX'; 1476 | if(index($peer, ':') >= 0) { 1477 | $type = 'INET'; 1478 | } 1479 | return({ 'peer' => ''.$peer, type => $type, name => ''.$peer }); 1480 | } 1481 | } 1482 | } 1483 | elsif(ref $self->{'peer'} eq 'HASH') { 1484 | for my $peer (keys %{$self->{'peer'}}) { 1485 | my $name = $self->{'peer'}->{$peer}; 1486 | my $type = 'UNIX'; 1487 | if(index($peer, ':') >= 0) { 1488 | $type = 'INET'; 1489 | } 1490 | return({ 'peer' => ''.$peer, type => $type, name => ''.$name }); 1491 | } 1492 | } else { 1493 | confess('type '.(ref $self->{'peer'}).' is not supported for peer option'); 1494 | } 1495 | } 1496 | if(defined $self->{'socket'}) { 1497 | my $name = $self->{'name'} || ''.$self->{'socket'}; 1498 | return({ 'peer' => ''.$self->{'socket'}, type => 'UNIX', name => $name }); 1499 | } 1500 | if(defined $self->{'server'}) { 1501 | my $name = $self->{'name'} || ''.$self->{'server'}; 1502 | return({ 'peer' => ''.$self->{'server'}, type => 'INET', name => $name }); 1503 | } 1504 | 1505 | # check if we got a peer 1506 | confess('please specify a peer'); 1507 | } 1508 | 1509 | 1510 | ######################################## 1511 | sub _lowercase_and_verify_options { 1512 | my($self, $opts) = @_; 1513 | my $return = {}; 1514 | 1515 | # make keys lowercase 1516 | %{$return} = map { lc($_) => $opts->{$_} } keys %{$opts}; 1517 | 1518 | if($self->{'warnings'}) { 1519 | for my $key (keys %{$return}) { 1520 | if(!defined $allowed_options->{$key}) { 1521 | carp("unknown option used: $key - please use only: ".join(', ', keys %{$allowed_options})); 1522 | } 1523 | } 1524 | } 1525 | 1526 | # set limits 1527 | if(defined $return->{'limit'}) { 1528 | if(index($return->{'limit'}, ',') != -1) { 1529 | my($limit_start,$limit_length) = split /,/mx, $return->{'limit'}; 1530 | $return->{'limit_start'} = $limit_start; 1531 | $return->{'limit_length'} = $limit_length; 1532 | } 1533 | else { 1534 | $return->{'limit_start'} = 0; 1535 | $return->{'limit_length'} = $return->{'limit'}; 1536 | } 1537 | delete $return->{'limit'}; 1538 | } 1539 | 1540 | return($return); 1541 | } 1542 | 1543 | ######################################## 1544 | sub _log_statement { 1545 | my($self, $statement, $opt, $limit) = @_; 1546 | my $d = Data::Dumper->new([$opt]); 1547 | $d->Indent(0); 1548 | my $optstring = $d->Dump; 1549 | $optstring =~ s/^\$VAR1\s+=\s+//mx; 1550 | $optstring =~ s/;$//mx; 1551 | 1552 | # remove empty lines from statement 1553 | $statement =~ s/\n+/\n/gmx; 1554 | 1555 | my $cleanstatement = $statement; 1556 | $cleanstatement =~ s/\n/\\n/gmx; 1557 | $self->{'logger'}->debug('selectall_arrayref("'.$cleanstatement.'", '.$optstring.', '.$limit.')'); 1558 | return 1; 1559 | } 1560 | 1561 | ######################################## 1562 | sub _die_or_confess { 1563 | my($msg) = @_; 1564 | my @lines = split/\n/mx, $msg; 1565 | if(scalar @lines > 2) { 1566 | die($msg); 1567 | } 1568 | confess($msg); 1569 | } 1570 | 1571 | ######################################## 1572 | 1573 | 1; 1574 | 1575 | =head1 SEE ALSO 1576 | 1577 | For more information about the query syntax and the livestatus plugin installation 1578 | see the Livestatus page: http://mathias-kettner.de/checkmk_livestatus.html 1579 | 1580 | =head1 AUTHOR 1581 | 1582 | Sven Nierlein, 2009-present, 1583 | 1584 | =head1 COPYRIGHT AND LICENSE 1585 | 1586 | Copyright (C) by Sven Nierlein 1587 | 1588 | This library is free software; you can redistribute it and/or modify 1589 | it under the same terms as Perl itself. 1590 | 1591 | =cut 1592 | 1593 | __END__ 1594 | -------------------------------------------------------------------------------- /lib/Monitoring/Livestatus/INET.pm: -------------------------------------------------------------------------------- 1 | package Monitoring::Livestatus::INET; 2 | use warnings; 3 | use strict; 4 | use Carp qw/confess/; 5 | use IO::Socket::IP (); 6 | use Socket qw(IPPROTO_TCP TCP_NODELAY); 7 | 8 | use parent 'Monitoring::Livestatus'; 9 | 10 | =head1 NAME 11 | 12 | Monitoring::Livestatus::INET - connector with tcp sockets 13 | 14 | =head1 SYNOPSIS 15 | 16 | use Monitoring::Livestatus; 17 | my $nl = Monitoring::Livestatus::INET->new( 'localhost:9999' ); 18 | my $hosts = $nl->selectall_arrayref("GET hosts"); 19 | 20 | =head1 CONSTRUCTOR 21 | 22 | =head2 new ( [ARGS] ) 23 | 24 | Creates an C object. C takes at least the server. 25 | Arguments are the same as in C. 26 | If the constructor is only passed a single argument, it is assumed to 27 | be a the C specification. Use either socker OR server. 28 | 29 | =cut 30 | 31 | sub new { 32 | my($class, @args) = @_; 33 | unshift(@args, "peer") if scalar @args == 1; 34 | my(%options) = @args; 35 | $options{'name'} = $options{'peer'} unless defined $options{'name'}; 36 | 37 | $options{'backend'} = $class; 38 | my $self = Monitoring::Livestatus->new(%options); 39 | bless $self, $class; 40 | confess('not a scalar') if ref $self->{'peer'} ne ''; 41 | 42 | if(($self->{'peer'}//$self->{'server'}) =~ m|^tls://|mx) { 43 | require IO::Socket::SSL; 44 | } 45 | 46 | return $self; 47 | } 48 | 49 | 50 | ######################################## 51 | 52 | =head1 METHODS 53 | 54 | =cut 55 | 56 | sub _open { 57 | my $self = shift; 58 | my $sock; 59 | 60 | my $options = { 61 | PeerAddr => $self->{'peer'}, 62 | Type => IO::Socket::IP::SOCK_STREAM, 63 | Timeout => $self->{'connect_timeout'}, 64 | }; 65 | 66 | my $tls = 0; 67 | my $peer_addr = $self->{'peer'}; 68 | if($peer_addr =~ s|tls://||mx) { 69 | #$IO::Socket::SSL::DEBUG = 2 if $ENV{'THRUK_VERBOSE'} && $ENV{'THRUK_VERBOSE'} >= 2; 70 | #$IO::Socket::SSL::DEBUG = 3 if $ENV{'THRUK_VERBOSE'} && $ENV{'THRUK_VERBOSE'} >= 3; 71 | $options->{'PeerAddr'} = $peer_addr; 72 | $options->{'SSL_cert_file'} = $self->{'cert'}; 73 | $options->{'SSL_key_file'} = $self->{'key'}; 74 | $options->{'SSL_ca_file'} = $self->{'ca_file'}; 75 | $options->{'SSL_verify_mode'} = 0 if(defined $self->{'verify'} && $self->{'verify'} == 0); 76 | $options->{'SSL_verifycn_name'} = $self->{'verifycn_name'}; 77 | $tls = 1; 78 | } 79 | 80 | eval { 81 | if($tls) { 82 | $sock = IO::Socket::SSL->new(%{$options}); 83 | } else { 84 | $sock = IO::Socket::IP->new(%{$options}); 85 | } 86 | if(!defined $sock || !$sock->connected()) { 87 | my $msg = "failed to connect to $peer_addr: ".($tls ? IO::Socket::SSL::errstr() : $!); 88 | if($self->{'errors_are_fatal'}) { 89 | confess($msg); 90 | } 91 | $Monitoring::Livestatus::ErrorCode = 500; 92 | $Monitoring::Livestatus::ErrorMessage = $msg; 93 | return; 94 | } 95 | 96 | setsockopt($sock, IPPROTO_TCP, TCP_NODELAY, 1); 97 | 98 | }; 99 | my $err = $@; 100 | 101 | if($err) { 102 | $Monitoring::Livestatus::ErrorCode = 500; 103 | $Monitoring::Livestatus::ErrorMessage = $err; 104 | return; 105 | } 106 | 107 | if(defined $self->{'query_timeout'}) { 108 | # set timeout 109 | $sock->timeout($self->{'query_timeout'}); 110 | } 111 | 112 | return($sock); 113 | } 114 | 115 | 116 | ######################################## 117 | 118 | sub _close { 119 | my $self = shift; 120 | my $sock = shift; 121 | return unless defined $sock; 122 | return close($sock); 123 | } 124 | 125 | 126 | 1; 127 | 128 | =head1 AUTHOR 129 | 130 | Sven Nierlein, 2009-present, 131 | 132 | =head1 COPYRIGHT AND LICENSE 133 | 134 | Copyright (C) by Sven Nierlein 135 | 136 | This library is free software; you can redistribute it and/or modify 137 | it under the same terms as Perl itself. 138 | 139 | =cut 140 | 141 | __END__ 142 | -------------------------------------------------------------------------------- /lib/Monitoring/Livestatus/UNIX.pm: -------------------------------------------------------------------------------- 1 | package Monitoring::Livestatus::UNIX; 2 | use warnings; 3 | use strict; 4 | use Carp qw/confess/; 5 | use IO::Socket::UNIX (); 6 | 7 | use parent 'Monitoring::Livestatus'; 8 | 9 | =head1 NAME 10 | 11 | Monitoring::Livestatus::UNIX - connector with unix sockets 12 | 13 | =head1 SYNOPSIS 14 | 15 | use Monitoring::Livestatus; 16 | my $nl = Monitoring::Livestatus::UNIX->new( '/var/lib/livestatus/livestatus.sock' ); 17 | my $hosts = $nl->selectall_arrayref("GET hosts"); 18 | 19 | =head1 CONSTRUCTOR 20 | 21 | =head2 new ( [ARGS] ) 22 | 23 | Creates an C object. C takes at least the socketpath. 24 | Arguments are the same as in C. 25 | If the constructor is only passed a single argument, it is assumed to 26 | be a the C specification. Use either socker OR server. 27 | 28 | =cut 29 | 30 | sub new { 31 | my($class,@args) = @_; 32 | unshift(@args, "peer") if scalar @args == 1; 33 | my(%options) = @args; 34 | $options{'name'} = $options{'peer'} unless defined $options{'name'}; 35 | 36 | $options{'backend'} = $class; 37 | my $self = Monitoring::Livestatus->new(%options); 38 | bless $self, $class; 39 | confess('not a scalar') if ref $self->{'peer'} ne ''; 40 | 41 | return $self; 42 | } 43 | 44 | 45 | ######################################## 46 | 47 | =head1 METHODS 48 | 49 | =cut 50 | 51 | sub _open { 52 | my $self = shift; 53 | 54 | if(!-S $self->{'peer'}) { 55 | my $msg = "failed to open socket $self->{'peer'}: $!"; 56 | if($self->{'errors_are_fatal'}) { 57 | confess($msg); 58 | } 59 | $Monitoring::Livestatus::ErrorCode = 500; 60 | $Monitoring::Livestatus::ErrorMessage = $msg; 61 | return; 62 | } 63 | my $sock; 64 | eval { 65 | $sock = IO::Socket::UNIX->new( 66 | Peer => $self->{'peer'}, 67 | Type => IO::Socket::UNIX::SOCK_STREAM, 68 | Timeout => $self->{'connect_timeout'}, 69 | ); 70 | if(!defined $sock || !$sock->connected()) { 71 | my $msg = "failed to connect to $self->{'peer'}: $!"; 72 | if($self->{'errors_are_fatal'}) { 73 | confess($msg); 74 | } 75 | $Monitoring::Livestatus::ErrorCode = 500; 76 | $Monitoring::Livestatus::ErrorMessage = $msg; 77 | return; 78 | } 79 | }; 80 | 81 | if($@) { 82 | $Monitoring::Livestatus::ErrorCode = 500; 83 | $Monitoring::Livestatus::ErrorMessage = $@; 84 | return; 85 | } 86 | 87 | if(defined $self->{'query_timeout'}) { 88 | # set timeout 89 | $sock->timeout($self->{'query_timeout'}); 90 | } 91 | 92 | return($sock); 93 | } 94 | 95 | 96 | ######################################## 97 | 98 | sub _close { 99 | my $self = shift; 100 | my $sock = shift; 101 | return unless defined $sock; 102 | return close($sock); 103 | } 104 | 105 | 106 | 1; 107 | 108 | =head1 AUTHOR 109 | 110 | Sven Nierlein, 2009-present, 111 | 112 | =head1 COPYRIGHT AND LICENSE 113 | 114 | Copyright (C) by Sven Nierlein 115 | 116 | This library is free software; you can redistribute it and/or modify 117 | it under the same terms as Perl itself. 118 | 119 | =cut 120 | 121 | __END__ 122 | -------------------------------------------------------------------------------- /t/01-Monitoring-Livestatus-basic_tests.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | ######################### 4 | 5 | use strict; 6 | use Test::More; 7 | use File::Temp; 8 | use Data::Dumper; 9 | use IO::Socket::UNIX qw( SOCK_STREAM SOMAXCONN ); 10 | use_ok('Monitoring::Livestatus'); 11 | 12 | BEGIN { 13 | if( $^O eq 'MSWin32' ) { 14 | plan skip_all => 'no sockets on windows'; 15 | } 16 | else { 17 | plan tests => 29; 18 | } 19 | } 20 | 21 | ######################### 22 | # get a temp file from File::Temp and replace it with our socket 23 | my $fh = File::Temp->new(UNLINK => 0); 24 | my $socket_path = $fh->filename; 25 | unlink($socket_path); 26 | my $listener = IO::Socket::UNIX->new( 27 | Type => SOCK_STREAM, 28 | Listen => SOMAXCONN, 29 | Local => $socket_path, 30 | ) or die("failed to open $socket_path as test socket: $!"); 31 | ######################### 32 | # create object with single arg 33 | my $ml = Monitoring::Livestatus->new( $socket_path ); 34 | isa_ok($ml, 'Monitoring::Livestatus', 'single args'); 35 | is($ml->peer_name(), $socket_path, 'get peer_name()'); 36 | is($ml->peer_addr(), $socket_path, 'get peer_addr()'); 37 | 38 | ######################### 39 | # create object with hash args 40 | my $line_separator = 10; 41 | my $column_separator = 0; 42 | $ml = Monitoring::Livestatus->new( 43 | verbose => 0, 44 | socket => $socket_path, 45 | line_separator => $line_separator, 46 | column_separator => $column_separator, 47 | ); 48 | isa_ok($ml, 'Monitoring::Livestatus', 'new hash args'); 49 | is($ml->peer_name(), $socket_path, 'get peer_name()'); 50 | is($ml->peer_addr(), $socket_path, 'get peer_addr()'); 51 | 52 | ######################### 53 | # create object with peer arg 54 | $ml = Monitoring::Livestatus->new( 55 | peer => $socket_path, 56 | ); 57 | isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg socket'); 58 | is($ml->peer_name(), $socket_path, 'get peer_name()'); 59 | is($ml->peer_addr(), $socket_path, 'get peer_addr()'); 60 | isa_ok($ml->{'CONNECTOR'}, 'Monitoring::Livestatus::UNIX', 'peer backend UNIX'); 61 | 62 | ######################### 63 | # create object with peer arg 64 | my $server = 'localhost:12345'; 65 | $ml = Monitoring::Livestatus->new( 66 | peer => $server, 67 | ); 68 | isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg server'); 69 | is($ml->peer_name(), $server, 'get peer_name()'); 70 | is($ml->peer_addr(), $server, 'get peer_addr()'); 71 | isa_ok($ml->{'CONNECTOR'}, 'Monitoring::Livestatus::INET', 'peer backend INET'); 72 | 73 | ######################### 74 | $ml = Monitoring::Livestatus->new( 75 | peer => [ $socket_path ], 76 | verbose => 0, 77 | keepalive => 1, 78 | logger => undef, 79 | ); 80 | isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg multi with keepalive'); 81 | is($ml->peer_name(), $socket_path, 'get peer_name()'); 82 | is($ml->peer_addr(), $socket_path, 'get peer_addr()'); 83 | 84 | ######################### 85 | # timeout checks 86 | $ml = Monitoring::Livestatus->new( 87 | peer => [ $socket_path ], 88 | verbose => 0, 89 | timeout => 13, 90 | logger => undef, 91 | ); 92 | isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg multi with general timeout'); 93 | is($ml->peer_name(), $socket_path, 'get peer_name()'); 94 | is($ml->peer_addr(), $socket_path, 'get peer_addr()'); 95 | is($ml->{'connect_timeout'}, 13, 'connect_timeout'); 96 | is($ml->{'query_timeout'}, 13, 'query_timeout'); 97 | 98 | $ml = Monitoring::Livestatus->new( 99 | peer => [ $socket_path ], 100 | verbose => 0, 101 | query_timeout => 14, 102 | connect_timeout => 17, 103 | logger => undef, 104 | ); 105 | isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg multi with general timeout'); 106 | is($ml->peer_name(), $socket_path, 'get peer_name()'); 107 | is($ml->peer_addr(), $socket_path, 'get peer_addr()'); 108 | is($ml->{'connect_timeout'}, 17, 'connect_timeout'); 109 | is($ml->{'query_timeout'}, 14, 'query_timeout'); 110 | 111 | 112 | ######################### 113 | # error retry 114 | $ml = Monitoring::Livestatus->new( 115 | peer => [ $socket_path ], 116 | verbose => 0, 117 | retries_on_connection_error => 3, 118 | retry_interval => 1, 119 | logger => undef, 120 | ); 121 | isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg multi with error retry'); 122 | 123 | ######################### 124 | # cleanup 125 | unlink($socket_path); 126 | -------------------------------------------------------------------------------- /t/02-Monitoring-Livestatus-internals.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | ######################### 4 | 5 | use strict; 6 | use Test::More; 7 | use File::Temp; 8 | use Data::Dumper; 9 | use IO::Socket::UNIX qw( SOCK_STREAM SOMAXCONN ); 10 | use_ok('Monitoring::Livestatus'); 11 | 12 | BEGIN { 13 | if( $^O eq 'MSWin32' ) { 14 | plan skip_all => 'no sockets on windows'; 15 | } 16 | else { 17 | plan tests => 14; 18 | } 19 | } 20 | 21 | ######################### 22 | # get a temp file from File::Temp and replace it with our socket 23 | my $fh = File::Temp->new(UNLINK => 0); 24 | my $socket_path = $fh->filename; 25 | unlink($socket_path); 26 | my $listener = IO::Socket::UNIX->new( 27 | Type => SOCK_STREAM, 28 | Listen => SOMAXCONN, 29 | Local => $socket_path, 30 | ) or die("failed to open $socket_path as test socket: $!"); 31 | 32 | ######################### 33 | # create object with single arg 34 | my $ml = Monitoring::Livestatus->new( 'localhost:12345' ); 35 | isa_ok($ml, 'Monitoring::Livestatus', 'single args server'); 36 | isa_ok($ml->{'CONNECTOR'}, 'Monitoring::Livestatus::INET', 'single args server peer'); 37 | is($ml->{'CONNECTOR'}->peer_name, 'localhost:12345', 'single args server peer name'); 38 | is($ml->{'CONNECTOR'}->peer_addr, 'localhost:12345', 'single args server peer addr'); 39 | 40 | ######################### 41 | # create object with single arg 42 | $ml = Monitoring::Livestatus->new( $socket_path ); 43 | isa_ok($ml, 'Monitoring::Livestatus', 'single args socket'); 44 | isa_ok($ml->{'CONNECTOR'}, 'Monitoring::Livestatus::UNIX', 'single args socket peer'); 45 | is($ml->{'CONNECTOR'}->peer_name, $socket_path, 'single args socket peer name'); 46 | is($ml->{'CONNECTOR'}->peer_addr, $socket_path, 'single args socket peer addr'); 47 | 48 | my $header = "404 43\n"; 49 | my($error,$error_msg) = $ml->_parse_header($header); 50 | is($error, '404', 'error code 404'); 51 | isnt($error_msg, undef, 'error code 404 message'); 52 | 53 | ######################### 54 | my $stats_query1 = "GET services 55 | Stats: state = 0 56 | Stats: state = 1 57 | Stats: state = 2 58 | Stats: state = 3 59 | Stats: state = 4 60 | Stats: host_state != 0 61 | Stats: state = 1 62 | StatsAnd: 2 63 | Stats: host_state != 0 64 | Stats: state = 2 65 | StatsAnd: 2 66 | Stats: host_state != 0 67 | Stats: state = 3 68 | StatsAnd: 2 69 | Stats: host_state != 0 70 | Stats: state = 3 71 | Stats: active_checks = 1 72 | StatsAnd: 3 73 | Stats: state = 3 74 | Stats: active_checks = 1 75 | StatsOr: 2"; 76 | my @expected_keys1 = ( 77 | 'state = 0', 78 | 'state = 1', 79 | 'state = 2', 80 | 'state = 3', 81 | 'state = 4', 82 | 'host_state != 0 && state = 1', 83 | 'host_state != 0 && state = 2', 84 | 'host_state != 0 && state = 3', 85 | 'host_state != 0 && state = 3 && active_checks = 1', 86 | 'state = 3 || active_checks = 1', 87 | ); 88 | my($statement, $got_keys1) = Monitoring::Livestatus::extract_keys_from_stats_statement($stats_query1); 89 | is_deeply($got_keys1, \@expected_keys1, 'statsAnd, statsOr query keys') 90 | or ( diag('got keys: '.Dumper($got_keys1)) ); 91 | 92 | 93 | ######################### 94 | my $stats_query2 = "GET services 95 | Stats: state = 0 as all_ok 96 | Stats: state = 1 as all_warning 97 | Stats: state = 2 as all_critical 98 | Stats: state = 3 as all_unknown 99 | Stats: state = 4 as all_pending 100 | Stats: host_state != 0 101 | Stats: state = 1 102 | StatsAnd: 2 as all_warning_on_down_hosts 103 | Stats: host_state != 0 104 | Stats: state = 2 105 | StatsAnd: 2 as all_critical_on_down_hosts 106 | Stats: host_state != 0 107 | Stats: state = 3 108 | StatsAnd: 2 as all_unknown_on_down_hosts 109 | Stats: host_state != 0 110 | Stats: state = 3 111 | Stats: active_checks_enabled = 1 112 | StatsAnd: 3 as all_unknown_active_on_down_hosts 113 | Stats: state = 3 114 | Stats: active_checks_enabled = 1 115 | StatsOr: 2 as all_active_or_unknown"; 116 | my @expected_keys2 = ( 117 | 'all_ok', 118 | 'all_warning', 119 | 'all_critical', 120 | 'all_unknown', 121 | 'all_pending', 122 | 'all_warning_on_down_hosts', 123 | 'all_critical_on_down_hosts', 124 | 'all_unknown_on_down_hosts', 125 | 'all_unknown_active_on_down_hosts', 126 | 'all_active_or_unknown', 127 | ); 128 | my($statement, $got_keys2) = Monitoring::Livestatus::extract_keys_from_stats_statement($stats_query2); 129 | is_deeply($got_keys2, \@expected_keys2, 'stats query keys2') 130 | or ( diag('got keys: '.Dumper($got_keys2)) ); 131 | 132 | 133 | ######################### 134 | my $normal_query1 = "GET services 135 | Columns: host_name as host is_flapping description as name state 136 | "; 137 | my @expected_keys3 = ( 138 | 'host', 139 | 'is_flapping', 140 | 'name', 141 | 'state', 142 | ); 143 | my @got_keys3 = @{$ml->_extract_keys_from_columns_header($normal_query1)}; 144 | is_deeply(\@got_keys3, \@expected_keys3, 'normal query keys') 145 | or ( diag('got keys: '.Dumper(\@got_keys3)) ); 146 | 147 | ######################### 148 | unlink($socket_path); 149 | -------------------------------------------------------------------------------- /t/085-json_xs.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | 5 | plan skip_all => 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.' unless $ENV{TEST_AUTHOR}; 6 | 7 | open(my $ph, '-|', 'bash -c "find ./lib ./t -type f" 2>&1') or die('find failed: '.$!); 8 | while(<$ph>) { 9 | my $line = $_; 10 | chomp($line); 11 | check_json_xs($line); 12 | } 13 | done_testing(); 14 | 15 | 16 | sub check_json_xs { 17 | my($file) = @_; 18 | ok($file, $file); 19 | my $out = `grep -n JSON::XS "$file" | grep -v Cpanel::JSON::XS`; 20 | if($out) { 21 | fail($file." uses JSON::XS instead of Cpanel::JSON::XS"); 22 | } 23 | return; 24 | } 25 | -------------------------------------------------------------------------------- /t/20-Monitoring-Livestatus-test_socket.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | ######################### 4 | 5 | use strict; 6 | use Test::More; 7 | use IO::Socket::UNIX qw( SOCK_STREAM SOMAXCONN ); 8 | use Data::Dumper; 9 | use Cpanel::JSON::XS; 10 | 11 | BEGIN { 12 | eval {require threads;}; 13 | if ( $@ ) { 14 | plan skip_all => 'need threads support for testing a real socket' 15 | } 16 | elsif( $^O eq 'MSWin32' ) { 17 | plan skip_all => 'no sockets on windows'; 18 | } 19 | else{ 20 | plan tests => 109 21 | } 22 | } 23 | 24 | use File::Temp; 25 | BEGIN { use_ok('Monitoring::Livestatus') }; 26 | 27 | ######################### 28 | # Normal Querys 29 | ######################### 30 | my $line_separator = 10; 31 | my $column_separator = 0; 32 | my $test_data = [ ["alias","name","contacts"], # table header 33 | ["alias1","host1","contact1"], # row 1 34 | ["alias2","host2","contact2"], # row 2 35 | ["alias3","host3","contact3"], # row 3 36 | ]; 37 | my $test_hostgroups = [['']]; # test one row with no data 38 | 39 | # expected results 40 | my $selectall_arrayref1 = [ [ 'alias1', 'host1', 'contact1' ], 41 | [ 'alias2', 'host2', 'contact2' ], 42 | [ 'alias3', 'host3', 'contact3' ] 43 | ]; 44 | my $selectall_arrayref2 = [ 45 | { 'contacts' => 'contact1', 'name' => 'host1', 'alias' => 'alias1' }, 46 | { 'contacts' => 'contact2', 'name' => 'host2', 'alias' => 'alias2' }, 47 | { 'contacts' => 'contact3', 'name' => 'host3', 'alias' => 'alias3' } 48 | ]; 49 | my $selectall_hashref = { 50 | 'host1' => { 'contacts' => 'contact1', 'name' => 'host1', 'alias' => 'alias1' }, 51 | 'host2' => { 'contacts' => 'contact2', 'name' => 'host2', 'alias' => 'alias2' }, 52 | 'host3' => { 'contacts' => 'contact3', 'name' => 'host3', 'alias' => 'alias3' } 53 | }; 54 | my $selectcol_arrayref1 = [ 'alias1', 'alias2', 'alias3' ]; 55 | my $selectcol_arrayref2 = [ 'alias1', 'host1', 'alias2', 'host2', 'alias3', 'host3' ]; 56 | my $selectcol_arrayref3 = [ 'alias1', 'host1', 'contact1', 'alias2', 'host2', 'contact2', 'alias3', 'host3', 'contact3' ]; 57 | my @selectrow_array = ( 'alias1', 'host1', 'contact1' ); 58 | my $selectrow_arrayref = [ 'alias1', 'host1', 'contact1' ]; 59 | my $selectrow_hashref = { 'contacts' => 'contact1', 'name' => 'host1', 'alias' => 'alias1' }; 60 | 61 | ######################### 62 | # Single Querys 63 | ######################### 64 | my $single_statement = "GET hosts\nColumns: alias\nFilter: name = host1"; 65 | my $selectscalar_value = 'alias1'; 66 | 67 | ######################### 68 | # Stats Querys 69 | ######################### 70 | my $stats_statement = "GET services\nStats: state = 0\nStats: state = 1\nStats: state = 2\nStats: state = 3"; 71 | my $stats_data = [[4297,13,9,0]]; 72 | 73 | # expected results 74 | my $stats_selectall_arrayref1 = [ [4297,13,9,0] ]; 75 | my $stats_selectall_arrayref2 = [ { 'state = 0' => '4297', 'state = 1' => '13', 'state = 2' => '9', 'state = 3' => 0 } ]; 76 | my $stats_selectcol_arrayref = [ '4297' ]; 77 | my @stats_selectrow_array = ( '4297', '13', '9', '0' ); 78 | my $stats_selectrow_arrayref = [ '4297', '13', '9', '0' ]; 79 | my $stats_selectrow_hashref = { 'state = 0' => '4297', 'state = 1' => '13', 'state = 2' => '9', 'state = 3' => 0 }; 80 | 81 | ######################### 82 | # Empty Querys 83 | ######################### 84 | my $empty_statement = "GET services\nFilter: description = empty"; 85 | 86 | # expected results 87 | my $empty_selectall_arrayref = []; 88 | my $empty_selectcol_arrayref = []; 89 | my @empty_selectrow_array; 90 | my $empty_selectrow_arrayref; 91 | my $empty_selectrow_hashref; 92 | 93 | 94 | ######################### 95 | # get a temp file from File::Temp and replace it with our socket 96 | my $fh = File::Temp->new(UNLINK => 0); 97 | my $socket_path = $fh->filename; 98 | unlink($socket_path); 99 | my $thr1 = threads->create('create_socket', 'unix'); 100 | ######################### 101 | # get a temp file from File::Temp and replace it with our socket 102 | my $server = 'localhost:32987'; 103 | my $thr2 = threads->create('create_socket', 'inet'); 104 | sleep(1); 105 | 106 | ######################### 107 | my $objects_to_test = { 108 | # create unix object with hash args 109 | 'unix_hash_args' => Monitoring::Livestatus->new( 110 | verbose => 0, 111 | socket => $socket_path, 112 | line_separator => $line_separator, 113 | column_separator => $column_separator, 114 | ), 115 | 116 | # create unix object with a single arg 117 | 'unix_single_arg' => Monitoring::Livestatus::UNIX->new( $socket_path ), 118 | 119 | # create inet object with hash args 120 | 'inet_hash_args' => Monitoring::Livestatus->new( 121 | verbose => 0, 122 | server => $server, 123 | line_separator => $line_separator, 124 | column_separator => $column_separator, 125 | ), 126 | 127 | # create inet object with a single arg 128 | 'inet_single_arg' => Monitoring::Livestatus::INET->new( $server ), 129 | 130 | }; 131 | 132 | for my $key (keys %{$objects_to_test}) { 133 | my $ml = $objects_to_test->{$key}; 134 | isa_ok($ml, 'Monitoring::Livestatus'); 135 | 136 | # we don't need warnings for testing 137 | $ml->warnings(0); 138 | 139 | ################################################## 140 | # test settings 141 | my $rt = $ml->verbose(1); 142 | is($rt, '0', 'enable verbose'); 143 | $rt = $ml->verbose(0); 144 | is($rt, '1', 'disable verbose'); 145 | 146 | $rt = $ml->errors_are_fatal(0); 147 | is($rt, '1', 'disable errors_are_fatal'); 148 | $rt = $ml->errors_are_fatal(1); 149 | is($rt, '0', 'enable errors_are_fatal'); 150 | 151 | ################################################## 152 | # do some sample querys 153 | my $statement = "GET hosts"; 154 | 155 | ######################### 156 | my $ary_ref = $ml->selectall_arrayref($statement); 157 | is_deeply($ary_ref, $selectall_arrayref1, 'selectall_arrayref($statement)') 158 | or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectall_arrayref1)); 159 | 160 | ######################### 161 | $ary_ref = $ml->selectall_arrayref($statement, { Slice => {} }); 162 | is_deeply($ary_ref, $selectall_arrayref2, 'selectall_arrayref($statement, { Slice => {} })') 163 | or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectall_arrayref2)); 164 | 165 | ######################### 166 | my $hash_ref = $ml->selectall_hashref($statement, 'name'); 167 | is_deeply($hash_ref, $selectall_hashref, 'selectall_hashref($statement, "name")') 168 | or diag("got: ".Dumper($hash_ref)."\nbut expected ".Dumper($selectall_hashref)); 169 | 170 | ######################### 171 | $ary_ref = $ml->selectcol_arrayref($statement); 172 | is_deeply($ary_ref, $selectcol_arrayref1, 'selectcol_arrayref($statement)') 173 | or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectcol_arrayref1)); 174 | 175 | ######################### 176 | $ary_ref = $ml->selectcol_arrayref($statement, { Columns=>[1,2] }); 177 | is_deeply($ary_ref, $selectcol_arrayref2, 'selectcol_arrayref($statement, { Columns=>[1,2] })') 178 | or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectcol_arrayref2)); 179 | 180 | $ary_ref = $ml->selectcol_arrayref($statement, { Columns=>[1,2,3] }); 181 | is_deeply($ary_ref, $selectcol_arrayref3, 'selectcol_arrayref($statement, { Columns=>[1,2,3] })') 182 | or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectcol_arrayref3)); 183 | 184 | ######################### 185 | my @row_ary = $ml->selectrow_array($statement); 186 | is_deeply(\@row_ary, \@selectrow_array, 'selectrow_array($statement)') 187 | or diag("got: ".Dumper(\@row_ary)."\nbut expected ".Dumper(\@selectrow_array)); 188 | 189 | ######################### 190 | $ary_ref = $ml->selectrow_arrayref($statement); 191 | is_deeply($ary_ref, $selectrow_arrayref, 'selectrow_arrayref($statement)') 192 | or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectrow_arrayref)); 193 | 194 | ######################### 195 | $hash_ref = $ml->selectrow_hashref($statement); 196 | is_deeply($hash_ref, $selectrow_hashref, 'selectrow_hashref($statement)') 197 | or diag("got: ".Dumper($hash_ref)."\nbut expected ".Dumper($selectrow_hashref)); 198 | 199 | ################################################## 200 | # stats querys 201 | ################################################## 202 | $ary_ref = $ml->selectall_arrayref($stats_statement); 203 | is_deeply($ary_ref, $stats_selectall_arrayref1, 'selectall_arrayref($stats_statement)') 204 | or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($stats_selectall_arrayref1)); 205 | 206 | $ary_ref = $ml->selectall_arrayref($stats_statement, { Slice => {} }); 207 | is_deeply($ary_ref, $stats_selectall_arrayref2, 'selectall_arrayref($stats_statement, { Slice => {} })') 208 | or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($stats_selectall_arrayref2)); 209 | 210 | $ary_ref = $ml->selectcol_arrayref($stats_statement); 211 | is_deeply($ary_ref, $stats_selectcol_arrayref, 'selectcol_arrayref($stats_statement)') 212 | or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($stats_selectcol_arrayref)); 213 | 214 | @row_ary = $ml->selectrow_array($stats_statement); 215 | is_deeply(\@row_ary, \@stats_selectrow_array, 'selectrow_arrayref($stats_statement)') 216 | or diag("got: ".Dumper(\@row_ary)."\nbut expected ".Dumper(\@stats_selectrow_array)); 217 | 218 | $ary_ref = $ml->selectrow_arrayref($stats_statement); 219 | is_deeply($ary_ref, $stats_selectrow_arrayref, 'selectrow_arrayref($stats_statement)') 220 | or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($stats_selectrow_arrayref)); 221 | 222 | $hash_ref = $ml->selectrow_hashref($stats_statement); 223 | is_deeply($hash_ref, $stats_selectrow_hashref, 'selectrow_hashref($stats_statement)') 224 | or diag("got: ".Dumper($hash_ref)."\nbut expected ".Dumper($stats_selectrow_hashref)); 225 | 226 | my $scal = $ml->selectscalar_value($single_statement); 227 | is($scal, $selectscalar_value, 'selectscalar_value($single_statement)') 228 | or diag("got: ".Dumper($scal)."\nbut expected ".Dumper($selectscalar_value)); 229 | 230 | ################################################## 231 | # empty querys 232 | ################################################## 233 | $ary_ref = $ml->selectall_arrayref($empty_statement); 234 | is_deeply($ary_ref, $empty_selectall_arrayref, 'selectall_arrayref($empty_statement)') 235 | or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($empty_selectall_arrayref)); 236 | 237 | $ary_ref = $ml->selectcol_arrayref($empty_statement); 238 | is_deeply($ary_ref, $empty_selectcol_arrayref, 'selectcol_arrayref($empty_statement)') 239 | or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($empty_selectcol_arrayref)); 240 | 241 | @row_ary = $ml->selectrow_array($empty_statement); 242 | is_deeply(\@row_ary, \@empty_selectrow_array, 'selectrow_arrayref($empty_statement)') 243 | or diag("got: ".Dumper(\@row_ary)."\nbut expected ".Dumper(\@empty_selectrow_array)); 244 | 245 | $ary_ref = $ml->selectrow_arrayref($empty_statement); 246 | is_deeply($ary_ref, $empty_selectrow_arrayref, 'selectrow_arrayref($empty_statement)') 247 | or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($empty_selectrow_arrayref)); 248 | 249 | $hash_ref = $ml->selectrow_hashref($empty_statement); 250 | is_deeply($hash_ref, $empty_selectrow_hashref, 'selectrow_hashref($empty_statement)') 251 | or diag("got: ".Dumper($hash_ref)."\nbut expected ".Dumper($empty_selectrow_hashref)); 252 | 253 | ################################################## 254 | # empty rows and columns 255 | ################################################## 256 | my $empty_hostgroups_stm = "GET hostgroups\nColumns: members"; 257 | $ary_ref = $ml->selectall_arrayref($empty_hostgroups_stm); 258 | is_deeply($ary_ref, $test_hostgroups, 'selectall_arrayref($empty_hostgroups_stm)') 259 | or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($test_hostgroups)); 260 | 261 | } 262 | 263 | ################################################## 264 | # exit threads 265 | $thr1->kill('KILL')->detach(); 266 | $thr2->kill('KILL')->detach(); 267 | exit; 268 | 269 | 270 | ######################### 271 | # SUBS 272 | ######################### 273 | # test socket server 274 | sub create_socket { 275 | my $type = shift; 276 | my $listener; 277 | 278 | $SIG{'KILL'} = sub { threads->exit(); }; 279 | 280 | if($type eq 'unix') { 281 | print "creating unix socket\n"; 282 | $listener = IO::Socket::UNIX->new( 283 | Type => SOCK_STREAM, 284 | Listen => SOMAXCONN, 285 | Local => $socket_path, 286 | ) or die("failed to open $socket_path as test socket: $!"); 287 | } 288 | elsif($type eq 'inet') { 289 | print "creating tcp socket\n"; 290 | $listener = IO::Socket::INET->new( 291 | LocalAddr => $server, 292 | Proto => 'tcp', 293 | Listen => 1, 294 | Reuse => 1, 295 | ) or die("failed to listen on $server: $!"); 296 | } else { 297 | die("unknown type"); 298 | } 299 | while( my $socket = $listener->accept() or die('cannot accept: $!') ) { 300 | my $recv = ""; 301 | while(<$socket>) { $recv .= $_; last if $_ eq "\n" } 302 | my $data; 303 | my $status = 200; 304 | if($recv =~ m/^GET .*?\s+Filter:.*?empty/m) { 305 | $data = ''; 306 | } 307 | elsif($recv =~ m/^GET hosts\s+Columns: alias/m) { 308 | my @data = @{$test_data}[1..3]; 309 | $data = encode_json(\@data)."\n"; 310 | } 311 | elsif($recv =~ m/^GET hosts\s+Columns: name/m) { 312 | $data = encode_json(\@{$test_data}[1..3])."\n"; 313 | } 314 | elsif($recv =~ m/^GET hosts/) { 315 | $data = encode_json($test_data)."\n"; 316 | } 317 | elsif($recv =~ m/^GET hostgroups/) { 318 | $data = encode_json(\@{$test_hostgroups})."\n"; 319 | } 320 | elsif($recv =~ m/^GET services/ and $recv =~ m/Stats:/m) { 321 | $data = encode_json(\@{$stats_data})."\n"; 322 | } 323 | my $content_length = sprintf("%11s", length($data)); 324 | print $socket $status." ".$content_length."\n"; 325 | print $socket $data; 326 | close($socket); 327 | } 328 | unlink($socket_path); 329 | } 330 | -------------------------------------------------------------------------------- /t/21-Monitoring-Livestatus-INET.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | ######################### 4 | 5 | use strict; 6 | use Test::More tests => 3; 7 | use IO::Socket::INET; 8 | BEGIN { use_ok('Monitoring::Livestatus::INET') }; 9 | 10 | ######################### 11 | # create a tmp listener 12 | my $server = 'localhost:9999'; 13 | my $listener = IO::Socket::INET->new( 14 | ) or die("failed to open port as test listener: $!"); 15 | ######################### 16 | # create object with single arg 17 | my $ml = Monitoring::Livestatus::INET->new( $server ); 18 | isa_ok($ml, 'Monitoring::Livestatus', 'Monitoring::Livestatus::INET->new()'); 19 | 20 | ######################### 21 | # create object with hash args 22 | my $line_separator = 10; 23 | my $column_separator = 0; 24 | $ml = Monitoring::Livestatus::INET->new( 25 | verbose => 0, 26 | server => $server, 27 | line_separator => $line_separator, 28 | column_separator => $column_separator, 29 | ); 30 | isa_ok($ml, 'Monitoring::Livestatus', 'Monitoring::Livestatus::INET->new(%args)'); 31 | -------------------------------------------------------------------------------- /t/22-Monitoring-Livestatus-UNIX.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | ######################### 4 | 5 | use strict; 6 | use Test::More tests => 3; 7 | use IO::Socket::INET; 8 | BEGIN { use_ok('Monitoring::Livestatus::UNIX') }; 9 | 10 | ######################### 11 | # create object with single arg 12 | my $socket = "/tmp/blah.socket"; 13 | my $ml = Monitoring::Livestatus::UNIX->new( $socket ); 14 | isa_ok($ml, 'Monitoring::Livestatus', 'Monitoring::Livestatus::UNIX->new()'); 15 | 16 | ######################### 17 | # create object with hash args 18 | my $line_separator = 10; 19 | my $column_separator = 0; 20 | $ml = Monitoring::Livestatus::UNIX->new( 21 | verbose => 0, 22 | socket => $socket, 23 | line_separator => $line_separator, 24 | column_separator => $column_separator, 25 | ); 26 | isa_ok($ml, 'Monitoring::Livestatus', 'Monitoring::Livestatus::UNIX->new(%args)'); 27 | -------------------------------------------------------------------------------- /t/23-Monitoring-Livestatus-BigData.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | ######################### 4 | 5 | use strict; 6 | use Test::More; 7 | 8 | if(!$ENV{TEST_AUTHOR}) { 9 | plan skip_all => 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; 10 | exit; 11 | } 12 | 13 | my $netcat; 14 | for my $path (split(/:/mx, $ENV{'PATH'})) { 15 | if(-x $path."/netcat") { 16 | $netcat = $path."/netcat"; 17 | last; 18 | } 19 | } 20 | if( $^O eq 'MSWin32' ) { 21 | plan skip_all => 'no sockets on windows'; 22 | } 23 | elsif(!$netcat) { 24 | plan skip_all => 'no netcat found in path'; 25 | } 26 | else { 27 | plan tests => 13; 28 | } 29 | 30 | use_ok('Monitoring::Livestatus'); 31 | 32 | my $testport = 60123; 33 | my $testresults = $ARGV[0] || 5; 34 | 35 | ######################### 36 | # create object with single arg 37 | my $ml = Monitoring::Livestatus->new('localhost:'.$testport); 38 | isa_ok($ml, 'Monitoring::Livestatus', 'Monitoring::Livestatus->new()'); 39 | 40 | ######################### 41 | # prepare testfile 42 | my $testfile = '/tmp/testresult.json'; 43 | open(my $fh, '>', $testfile.'.data') or die($testfile.'.data: '.$!); 44 | print $fh "["; 45 | for my $x (1..$testresults) { 46 | printf($fh '["Test Host %d","some test pluginoutput............................................",1],%s', $x, "\n"); 47 | } 48 | print $fh "]\n"; 49 | close($fh); 50 | ok(-f $testfile.".data", "testfile: ".$testfile.".data written"); 51 | 52 | my $size = -s $testfile.".data"; 53 | ok($size, "file has $size bytes"); 54 | 55 | open($fh, '>', $testfile.'.head') or die($testfile.'.head: '.$!); 56 | printf($fh "200 %12d\n", $size); 57 | close($fh); 58 | `cat $testfile.head $testfile.data > $testfile`; 59 | unlink($testfile.'.head', $testfile.'.data'); 60 | 61 | ########################################################## 62 | my $mem_start = get_memory_usage(); 63 | ok($mem_start, sprintf('memory at start: %.2f MB', $mem_start/1024)); 64 | 65 | ########################################################## 66 | # start netcat 67 | `$netcat -vvv -w 3 -l -p $testport >/dev/null 2>&1 < $testfile &`; 68 | sleep(1); 69 | ok(1, "netcat started"); 70 | 71 | ########################################################## 72 | my $result = $ml->selectall_arrayref( 73 | "GET hosts\nColumns: name plugin_output status", { 74 | Slice => {}, 75 | } 76 | ); 77 | is(ref $result, 'ARRAY', 'result is an array'); 78 | is(scalar @{$result}, $testresults, 'result has right number'); 79 | is(ref $result->[$testresults-1], 'HASH', 'result contains hashes'); 80 | is($result->[$testresults-1]->{'name'}, 'Test Host '.$testresults, 'result contains all hosts'); 81 | 82 | 83 | ########################################################## 84 | my $mem_end = get_memory_usage(); 85 | ok($mem_end, sprintf('memory at end: %.2f MB', $mem_end/1024)); 86 | my $delta = $mem_end - $mem_start; 87 | ok($delta, sprintf('memory delta: %.2f MB', $delta/1024)); 88 | ok($delta, sprintf('memory usage per entry: %d B', $delta*1024/$testresults)); 89 | 90 | ########################################################## 91 | # returns memory usage in kB 92 | sub get_memory_usage { 93 | my($pid) = @_; 94 | $pid = $$ unless defined $pid; 95 | 96 | my $rsize; 97 | open(my $ph, '-|', "ps -p $pid -o rss") or die("ps failed: $!"); 98 | while(my $line = <$ph>) { 99 | if($line =~ m/(\d+)/mx) { 100 | $rsize = sprintf("%.2f", $1); 101 | } 102 | } 103 | CORE::close($ph); 104 | return($rsize); 105 | } 106 | -------------------------------------------------------------------------------- /t/30-Monitoring-Livestatus-live-test.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | ######################### 4 | 5 | use strict; 6 | use Test::More; 7 | use Data::Dumper; 8 | 9 | if ( ! defined $ENV{TEST_SOCKET} or !defined $ENV{TEST_SERVER} ) { 10 | my $msg = 'Author test. Set $ENV{TEST_SOCKET} and $ENV{TEST_SERVER} to run'; 11 | plan( skip_all => $msg ); 12 | } else { 13 | plan( tests => 333 ); 14 | } 15 | 16 | # set an alarm 17 | my $lastquery; 18 | $SIG{ALRM} = sub { 19 | my @caller = caller; 20 | print STDERR 'last query: '.$lastquery if defined $lastquery; 21 | die "timeout reached:".Dumper(\@caller)."\n" 22 | }; 23 | alarm(120); 24 | 25 | use_ok('Monitoring::Livestatus'); 26 | use_ok('Monitoring::Livestatus::INET'); 27 | use_ok('Monitoring::Livestatus::UNIX'); 28 | 29 | ######################### 30 | my $line_separator = 10; 31 | my $column_separator = 0; 32 | my $objects_to_test = { 33 | # UNIX 34 | # create unix object with a single arg 35 | # '01 unix_single_arg' => Monitoring::Livestatus::UNIX->new( $ENV{TEST_SOCKET} ), 36 | 37 | # create unix object with hash args 38 | '02 unix_few_args' => Monitoring::Livestatus->new( 39 | #verbose => 1, 40 | socket => $ENV{TEST_SOCKET}, 41 | line_separator => $line_separator, 42 | column_separator => $column_separator, 43 | ), 44 | 45 | # create unix object with hash args 46 | '03 unix_keepalive' => Monitoring::Livestatus->new( 47 | verbose => 0, 48 | socket => $ENV{TEST_SOCKET}, 49 | keepalive => 1, 50 | ), 51 | 52 | # TCP 53 | # create inet object with a single arg 54 | '04 inet_single_arg' => Monitoring::Livestatus::INET->new( $ENV{TEST_SERVER} ), 55 | 56 | # create inet object with hash args 57 | '05 inet_few_args' => Monitoring::Livestatus->new( 58 | verbose => 0, 59 | server => $ENV{TEST_SERVER}, 60 | line_separator => $line_separator, 61 | column_separator => $column_separator, 62 | ), 63 | 64 | 65 | # create inet object with keepalive 66 | '06 inet_keepalive' => Monitoring::Livestatus->new( 67 | verbose => 0, 68 | server => $ENV{TEST_SERVER}, 69 | keepalive => 1, 70 | ), 71 | }; 72 | 73 | my $expected_keys = { 74 | 'columns' => [ 75 | 'description','name','table','type' 76 | ], 77 | 'commands' => [ 78 | 'line','name' 79 | ], 80 | 'comments' => [ 81 | '__all_from_hosts__', '__all_from_services__', 82 | 'author','comment','entry_time','entry_type','expire_time','expires', 'id','is_service','persistent', 83 | 'source','type' 84 | ], 85 | 'contacts' => [ 86 | 'address1','address2','address3','address4','address5','address6','alias', 87 | 'can_submit_commands','custom_variable_names','custom_variable_values','email','custom_variables', 88 | 'host_notification_period','host_notifications_enabled','in_host_notification_period', 89 | 'in_service_notification_period','name','modified_attributes','modified_attributes_list', 90 | 'pager','service_notification_period','service_notifications_enabled' 91 | ], 92 | 'contactgroups' => [ 'name', 'alias', 'members' ], 93 | 'downtimes' => [ 94 | '__all_from_hosts__', '__all_from_services__', 95 | 'author','comment','duration','end_time','entry_time','fixed','id','is_service','start_time', 96 | 'triggered_by','type' 97 | ], 98 | 'hostgroups' => [ 99 | 'action_url','alias','members','name','members_with_state','notes','notes_url','num_hosts','num_hosts_down', 100 | 'num_hosts_pending','num_hosts_unreach','num_hosts_up','num_services','num_services_crit', 101 | 'num_services_hard_crit','num_services_hard_ok','num_services_hard_unknown', 102 | 'num_services_hard_warn','num_services_ok','num_services_pending','num_services_unknown', 103 | 'num_services_warn','worst_host_state','worst_service_hard_state','worst_service_state' 104 | ], 105 | 'hosts' => [ 106 | 'accept_passive_checks','acknowledged','acknowledgement_type','action_url','action_url_expanded', 107 | 'active_checks_enabled','address','alias','check_command','check_command_expanded','check_flapping_recovery_notification','check_freshness','check_interval', 108 | 'check_options','check_period','check_type','checks_enabled','childs','comments','comments_with_extra_info','comments_with_info', 109 | 'contact_groups','contacts','current_attempt','current_notification_number','custom_variable_names', 110 | 'custom_variable_values','custom_variables','display_name','downtimes','downtimes_with_info','event_handler','event_handler_enabled', 111 | 'execution_time','filename','first_notification_delay','flap_detection_enabled','groups','hard_state','has_been_checked', 112 | 'high_flap_threshold','icon_image','icon_image_alt','icon_image_expanded','in_check_period', 113 | 'in_notification_period','initial_state','is_executing','is_flapping','last_check','last_hard_state', 114 | 'last_hard_state_change','last_notification','last_state','last_state_change','latency','last_time_down', 115 | 'last_time_unreachable','last_time_up','long_plugin_output','low_flap_threshold','max_check_attempts','name', 116 | 'modified_attributes','modified_attributes_list','next_check', 117 | 'next_notification','no_more_notifications','notes','notes_expanded','notes_url','notes_url_expanded','notification_interval', 118 | 'notification_period','notifications_enabled','num_services','num_services_crit','num_services_hard_crit', 119 | 'num_services_hard_ok','num_services_hard_unknown','num_services_hard_warn','num_services_ok', 120 | 'num_services_pending','num_services_unknown','num_services_warn','obsess_over_host','parents', 121 | 'pending_flex_downtime','percent_state_change','pnpgraph_present','perf_data','plugin_output', 122 | 'process_performance_data','retry_interval','scheduled_downtime_depth','services','services_with_info','services_with_state', 123 | 'state','state_type','statusmap_image','total_services','worst_service_hard_state','worst_service_state', 124 | 'x_3d','y_3d','z_3d' 125 | ], 126 | 'hostsbygroup' => [ 127 | '__all_from_hosts__', '__all_from_hostgroups__' 128 | ], 129 | 'log' => [ 130 | '__all_from_hosts__','__all_from_services__','__all_from_contacts__','__all_from_commands__', 131 | 'attempt','class','command_name','comment','contact_name','host_name','lineno','message','options', 132 | 'plugin_output','service_description','state','state_type','time','type' 133 | ], 134 | 'servicegroups' => [ 135 | 'action_url','alias','members','name','members_with_state','notes','notes_url','num_services','num_services_crit', 136 | 'num_services_hard_crit','num_services_hard_ok','num_services_hard_unknown', 137 | 'num_services_hard_warn','num_services_ok','num_services_pending','num_services_unknown', 138 | 'num_services_warn','worst_service_state' 139 | ], 140 | 'servicesbygroup' => [ 141 | '__all_from_services__', '__all_from_hosts__', '__all_from_servicegroups__' 142 | ], 143 | 'services' => [ 144 | '__all_from_hosts__', 145 | 'accept_passive_checks','acknowledged','acknowledgement_type','action_url','action_url_expanded', 146 | 'active_checks_enabled','check_command','check_command_expanded','check_freshness','check_interval','check_options','check_period', 147 | 'check_type','checks_enabled','comments','comments_with_extra_info','comments_with_info','contact_groups','contacts','current_attempt', 148 | 'current_notification_number','custom_variable_names','custom_variable_values','custom_variables', 149 | 'description','display_name','downtimes','downtimes_with_info','event_handler','event_handler_enabled', 150 | 'execution_time','first_notification_delay','flap_detection_enabled','groups', 151 | 'has_been_checked','high_flap_threshold','icon_image','icon_image_alt','icon_image_expanded','in_check_period', 152 | 'in_notification_period','initial_state','is_executing','is_flapping','last_check', 153 | 'last_hard_state','last_hard_state_change','last_notification','last_state', 154 | 'last_state_change','latency','last_time_critical','last_time_ok','last_time_unknown','last_time_warning', 155 | 'long_plugin_output','low_flap_threshold','max_check_attempts','modified_attributes','modified_attributes_list', 156 | 'next_check','next_notification','no_more_notifications','notes','notes_expanded','notes_url','notes_url_expanded', 157 | 'notification_interval','notification_period','notifications_enabled','obsess_over_service', 158 | 'percent_state_change','pnpgraph_present','perf_data','plugin_output','process_performance_data','retry_interval', 159 | 'scheduled_downtime_depth','state','state_type' 160 | ], 161 | 'servicesbyhostgroup' => [ 162 | '__all_from_services__', '__all_from_hosts__', '__all_from_hostgroups__' 163 | ], 164 | 'statehist' => [], 165 | 'status' => [ 166 | 'accept_passive_host_checks','accept_passive_service_checks','cached_log_messages', 167 | 'check_external_commands','check_host_freshness','check_service_freshness','connections', 168 | 'connections_rate','enable_event_handlers','enable_flap_detection','enable_notifications', 169 | 'execute_host_checks','execute_service_checks','external_command_buffer_max','external_command_buffer_slots','external_command_buffer_usage','external_commands','external_commands_rate','forks','forks_rate','host_checks','host_checks_rate','interval_length', 170 | 'last_command_check','last_log_rotation','livecheck_overflows','livecheck_overflows_rate','livechecks','livechecks_rate','livestatus_active_connections','livestatus_queued_connections','livestatus_threads','livestatus_version','log_messages','log_messages_rate','nagios_pid','neb_callbacks', 171 | 'neb_callbacks_rate','num_hosts','num_services','obsess_over_hosts','obsess_over_services','process_performance_data', 172 | 'program_start','program_version','requests','requests_rate','service_checks','service_checks_rate' 173 | ], 174 | 'timeperiods' => [ 'in', 'name', 'alias' ], 175 | }; 176 | 177 | my $author = 'Monitoring::Livestatus test'; 178 | for my $key (sort keys %{$objects_to_test}) { 179 | my $ml = $objects_to_test->{$key}; 180 | isa_ok($ml, 'Monitoring::Livestatus') or BAIL_OUT("no need to continue without a proper Monitoring::Livestatus object: ".$key); 181 | 182 | # don't die on errors 183 | $ml->errors_are_fatal(0); 184 | $ml->warnings(0); 185 | 186 | ######################### 187 | # set downtime for a host and service 188 | my $downtimes = $ml->selectall_arrayref("GET downtimes\nColumns: id"); 189 | my $num_downtimes = 0; 190 | $num_downtimes = scalar @{$downtimes} if defined $downtimes; 191 | my $firsthost = $ml->selectscalar_value("GET hosts\nColumns: name\nLimit: 1"); 192 | isnt($firsthost, undef, 'get test hostname') or BAIL_OUT($key.': got not test hostname'); 193 | $ml->do('COMMAND ['.time().'] SCHEDULE_HOST_DOWNTIME;'.$firsthost.';'.time().';'.(time()+300).';1;0;300;'.$author.';perl test: '.$0); 194 | my $firstservice = $ml->selectscalar_value("GET services\nColumns: description\nFilter: host_name = $firsthost\nLimit: 1"); 195 | isnt($firstservice, undef, 'get test servicename') or BAIL_OUT('got not test servicename'); 196 | $ml->do('COMMAND ['.time().'] SCHEDULE_SVC_DOWNTIME;'.$firsthost.';'.$firstservice.';'.time().';'.(time()+300).';1;0;300;'.$author.';perl test: '.$0); 197 | # sometimes it takes while till the downtime is accepted 198 | my $waited = 0; 199 | while(scalar @{$ml->selectall_arrayref("GET downtimes\nColumns: id")} < $num_downtimes + 2) { 200 | print "waiting for the downtime...\n"; 201 | sleep(1); 202 | $waited++; 203 | BAIL_OUT('waited 30 seconds for the downtime...') if $waited > 30; 204 | } 205 | ######################### 206 | 207 | ######################### 208 | # check tables 209 | my $data = $ml->selectall_hashref("GET columns\nColumns: table", 'table'); 210 | my @tables = sort keys %{$data}; 211 | my @expected_tables = sort keys %{$expected_keys}; 212 | is_deeply(\@tables, \@expected_tables, $key.' tables') or BAIL_OUT("got tables:\n".join(', ', @tables)."\nbut expected\n".join(', ', @expected_tables)); 213 | 214 | ######################### 215 | # check keys 216 | for my $type (keys %{$expected_keys}) { 217 | next if $type eq 'statehist'; 218 | my $filter = ""; 219 | $filter = "Filter: time > ".(time() - 86400)."\n" if $type eq 'log'; 220 | $filter .= "Filter: time < ".(time())."\n" if $type eq 'log'; 221 | my $expected_keys = get_expected_keys($type); 222 | my $statement = "GET $type\n".$filter."Limit: 1"; 223 | $lastquery = $statement; 224 | my $hash_ref = $ml->selectrow_hashref($statement); 225 | undef $lastquery; 226 | is(ref $hash_ref, 'HASH', $type.' keys are a hash') or BAIL_OUT($type.'keys are not in hash format, got '.Dumper($hash_ref)); 227 | my @keys = sort keys %{$hash_ref}; 228 | is_deeply(\@keys, $expected_keys, $key.' '.$type.' table columns') or BAIL_OUT("got $type keys:\n".join(', ', @keys)."\nbut expected\n".join(', ', @{$expected_keys})); 229 | } 230 | 231 | my $statement = "GET hosts\nColumns: name as hostname state\nLimit: 1"; 232 | $lastquery = $statement; 233 | my $hash_ref = $ml->selectrow_hashref($statement); 234 | undef $lastquery; 235 | isnt($hash_ref, undef, $key.' test column alias'); 236 | is($Monitoring::Livestatus::ErrorCode, 0, $key.' test column alias') or 237 | diag('got error: '.$Monitoring::Livestatus::ErrorMessage); 238 | 239 | ######################### 240 | # send a test command 241 | # commands still don't work and breaks livestatus 242 | my $rt = $ml->do('COMMAND ['.time().'] SAVE_STATE_INFORMATION'); 243 | is($rt, '1', $key.' test command'); 244 | 245 | ######################### 246 | # check for errors 247 | #$ml->{'verbose'} = 1; 248 | $statement = "GET hosts\nLimit: 1"; 249 | $lastquery = $statement; 250 | $hash_ref = $ml->selectrow_hashref($statement ); 251 | undef $lastquery; 252 | isnt($hash_ref, undef, $key.' test error 200 body'); 253 | is($Monitoring::Livestatus::ErrorCode, 0, $key.' test error 200 status') or 254 | diag('got error: '.$Monitoring::Livestatus::ErrorMessage); 255 | 256 | $statement = "BLAH hosts"; 257 | $lastquery = $statement; 258 | $hash_ref = $ml->selectrow_hashref($statement ); 259 | undef $lastquery; 260 | is($hash_ref, undef, $key.' test error 401 body'); 261 | is($Monitoring::Livestatus::ErrorCode, '401', $key.' test error 401 status') or 262 | diag('got error: '.$Monitoring::Livestatus::ErrorMessage); 263 | 264 | $statement = "GET hosts\nLimit: "; 265 | $lastquery = $statement; 266 | $hash_ref = $ml->selectrow_hashref($statement ); 267 | undef $lastquery; 268 | is($hash_ref, undef, $key.' test error 403 body'); 269 | is($Monitoring::Livestatus::ErrorCode, '403', $key.' test error 403 status') or 270 | diag('got error: '.$Monitoring::Livestatus::ErrorMessage); 271 | 272 | $statement = "GET unknowntable\nLimit: 1"; 273 | $lastquery = $statement; 274 | $hash_ref = $ml->selectrow_hashref($statement ); 275 | undef $lastquery; 276 | is($hash_ref, undef, $key.' test error 404 body'); 277 | is($Monitoring::Livestatus::ErrorCode, '404', $key.' test error 404 status') or 278 | diag('got error: '.$Monitoring::Livestatus::ErrorMessage); 279 | 280 | $statement = "GET hosts\nColumns: unknown"; 281 | $lastquery = $statement; 282 | $hash_ref = $ml->selectrow_hashref($statement ); 283 | undef $lastquery; 284 | is($hash_ref, undef, $key.' test error 405 body'); 285 | TODO: { 286 | local $TODO = 'livestatus returns wrong status'; 287 | is($Monitoring::Livestatus::ErrorCode, '405', $key.' test error 405 status') or 288 | diag('got error: '.$Monitoring::Livestatus::ErrorMessage); 289 | }; 290 | 291 | ######################### 292 | # some more broken statements 293 | $statement = "GET "; 294 | $lastquery = $statement; 295 | $hash_ref = $ml->selectrow_hashref($statement); 296 | undef $lastquery; 297 | is($hash_ref, undef, $key.' test error 403 body'); 298 | is($Monitoring::Livestatus::ErrorCode, '403', $key.' test error 403 status: GET ') or 299 | diag('got error: '.$Monitoring::Livestatus::ErrorMessage); 300 | 301 | $statement = "GET hosts\nColumns: name, name"; 302 | $lastquery = $statement; 303 | $hash_ref = $ml->selectrow_hashref($statement ); 304 | undef $lastquery; 305 | is($hash_ref, undef, $key.' test error 405 body'); 306 | is($Monitoring::Livestatus::ErrorCode, '405', $key.' test error 405 status: GET hosts\nColumns: name, name') or 307 | diag('got error: '.$Monitoring::Livestatus::ErrorMessage); 308 | 309 | $statement = "GET hosts\nColumns: "; 310 | $lastquery = $statement; 311 | $hash_ref = $ml->selectrow_hashref($statement ); 312 | undef $lastquery; 313 | is($hash_ref, undef, $key.' test error 405 body'); 314 | is($Monitoring::Livestatus::ErrorCode, '405', $key.' test error 405 status: GET hosts\nColumns: ') or 315 | diag('got error: '.$Monitoring::Livestatus::ErrorMessage); 316 | 317 | ######################### 318 | # some forbidden headers 319 | $statement = "GET hosts\nKeepAlive: on"; 320 | $lastquery = $statement; 321 | $hash_ref = $ml->selectrow_hashref($statement ); 322 | undef $lastquery; 323 | is($hash_ref, undef, $key.' test error 496 body'); 324 | is($Monitoring::Livestatus::ErrorCode, '496', $key.' test error 496 status: KeepAlive: on') or 325 | diag('got error: '.$Monitoring::Livestatus::ErrorMessage); 326 | 327 | $statement = "GET hosts\nResponseHeader: fixed16"; 328 | $lastquery = $statement; 329 | $hash_ref = $ml->selectrow_hashref($statement ); 330 | undef $lastquery; 331 | is($hash_ref, undef, $key.' test error 495 body'); 332 | is($Monitoring::Livestatus::ErrorCode, '495', $key.' test error 495 status: ResponseHeader: fixed16') or 333 | diag('got error: '.$Monitoring::Livestatus::ErrorMessage); 334 | 335 | $statement = "GET hosts\nColumnHeaders: on"; 336 | $lastquery = $statement; 337 | $hash_ref = $ml->selectrow_hashref($statement ); 338 | undef $lastquery; 339 | is($hash_ref, undef, $key.' test error 494 body'); 340 | is($Monitoring::Livestatus::ErrorCode, '494', $key.' test error 494 status: ColumnHeader: on') or 341 | diag('got error: '.$Monitoring::Livestatus::ErrorMessage); 342 | 343 | $statement = "GET hosts\nOuputFormat: json"; 344 | $lastquery = $statement; 345 | $hash_ref = $ml->selectrow_hashref($statement ); 346 | undef $lastquery; 347 | is($hash_ref, undef, $key.' test error 493 body'); 348 | is($Monitoring::Livestatus::ErrorCode, '493', $key.' test error 493 status: OutputForma: json') or 349 | diag('got error: '.$Monitoring::Livestatus::ErrorMessage); 350 | 351 | $statement = "GET hosts\nSeparators: 0 1 2 3"; 352 | $lastquery = $statement; 353 | $hash_ref = $ml->selectrow_hashref($statement ); 354 | undef $lastquery; 355 | is($hash_ref, undef, $key.' test error 492 body'); 356 | is($Monitoring::Livestatus::ErrorCode, '492', $key.' test error 492 status: Seperators: 0 1 2 3') or 357 | diag('got error: '.$Monitoring::Livestatus::ErrorMessage); 358 | 359 | 360 | ######################### 361 | # check some fancy stats queries 362 | my $stats_query = "GET services 363 | Stats: state = 0 as all_ok 364 | Stats: state = 1 as all_warning 365 | Stats: state = 2 as all_critical 366 | Stats: state = 3 as all_unknown 367 | Stats: state = 4 as all_pending 368 | Stats: host_state != 0 369 | Stats: state = 1 370 | StatsAnd: 2 as all_warning_on_down_hosts 371 | Stats: host_state != 0 372 | Stats: state = 2 373 | StatsAnd: 2 as all_critical_on_down_hosts 374 | Stats: host_state != 0 375 | Stats: state = 3 376 | StatsAnd: 2 as all_unknown_on_down_hosts 377 | Stats: host_state != 0 378 | Stats: state = 3 379 | Stats: active_checks_enabled = 1 380 | StatsAnd: 3 as all_unknown_active_on_down_hosts 381 | Stats: state = 3 382 | Stats: active_checks_enabled = 1 383 | StatsOr: 2 as all_active_or_unknown"; 384 | $lastquery = $stats_query; 385 | $hash_ref = $ml->selectrow_hashref($stats_query ); 386 | undef $lastquery; 387 | isnt($hash_ref, undef, $key.' test fancy stats query') or 388 | diag('got error: '.Dumper($hash_ref)); 389 | } 390 | 391 | 392 | 393 | # generate expected keys 394 | sub get_expected_keys { 395 | my $type = shift; 396 | my $skip = shift; 397 | my @keys = @{$expected_keys->{$type}}; 398 | 399 | my @new_keys; 400 | for my $key (@keys) { 401 | my $replaced = 0; 402 | for my $replace_with (keys %{$expected_keys}) { 403 | if($key eq '__all_from_'.$replace_with.'__') { 404 | $replaced = 1; 405 | next if $skip; 406 | my $prefix = $replace_with.'_'; 407 | if($replace_with eq "hosts") { $prefix = 'host_'; } 408 | if($replace_with eq "services") { $prefix = 'service_'; } 409 | if($replace_with eq "commands") { $prefix = 'command_'; } 410 | if($replace_with eq "contacts") { $prefix = 'contact_'; } 411 | if($replace_with eq "servicegroups") { $prefix = 'servicegroup_'; } 412 | if($replace_with eq "hostgroups") { $prefix = 'hostgroup_'; } 413 | 414 | if($type eq "log") { $prefix = 'current_'.$prefix; } 415 | 416 | if($type eq "servicesbygroup" and $replace_with eq 'services') { $prefix = ''; } 417 | if($type eq "servicesbyhostgroup" and $replace_with eq 'services') { $prefix = ''; } 418 | if($type eq "hostsbygroup" and $replace_with eq 'hosts') { $prefix = ''; } 419 | 420 | my $replace_keys = get_expected_keys($replace_with, 1); 421 | for my $key2 (@{$replace_keys}) { 422 | push @new_keys, $prefix.$key2; 423 | } 424 | } 425 | } 426 | if($replaced == 0) { 427 | push @new_keys, $key; 428 | } 429 | } 430 | 431 | # has been fixed in 1.1.1rc 432 | #if($type eq 'log') { 433 | # my %keys = map { $_ => 1 } @new_keys; 434 | # delete $keys{'current_contact_can_submit_commands'}; 435 | # delete $keys{'current_contact_host_notifications_enabled'}; 436 | # delete $keys{'current_contact_in_host_notification_period'}; 437 | # delete $keys{'current_contact_in_service_notification_period'}; 438 | # delete $keys{'current_contact_service_notifications_enabled'}; 439 | # @new_keys = keys %keys; 440 | #} 441 | 442 | my @return = sort @new_keys; 443 | return(\@return); 444 | } 445 | -------------------------------------------------------------------------------- /t/32-Monitoring-Livestatus-backend-test.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | ######################### 4 | 5 | use strict; 6 | use Carp; 7 | use Test::More; 8 | use Data::Dumper; 9 | 10 | if ( ! defined $ENV{TEST_SOCKET} or !defined $ENV{TEST_SERVER} or !defined $ENV{TEST_BACKEND} ) { 11 | my $msg = 'Author test. Set $ENV{TEST_SOCKET} and $ENV{TEST_SERVER} and $ENV{TEST_BACKEND} to run'; 12 | plan( skip_all => $msg ); 13 | } else { 14 | # we don't know yet how many tests we got 15 | plan( tests => 57070 ); 16 | } 17 | 18 | # set an alarm 19 | my $lastquery; 20 | $SIG{ALRM} = sub { 21 | my @caller = caller; 22 | $lastquery =~ s/\n+/\n/g; 23 | print STDERR 'last query: '.$lastquery."\n" if defined $lastquery; 24 | confess "timeout reached:".Dumper(\@caller)."\n" 25 | }; 26 | 27 | use_ok('Monitoring::Livestatus'); 28 | 29 | ######################### 30 | my $objects_to_test = { 31 | # UNIX 32 | '01 unix_single_arg' => Monitoring::Livestatus::UNIX->new( $ENV{TEST_SOCKET} ), 33 | 34 | # TCP 35 | '02 inet_single_arg' => Monitoring::Livestatus::INET->new( $ENV{TEST_SERVER} ), 36 | }; 37 | 38 | for my $key (sort keys %{$objects_to_test}) { 39 | my $ml = $objects_to_test->{$key}; 40 | isa_ok($ml, 'Monitoring::Livestatus') or BAIL_OUT("no need to continue without a proper Monitoring::Livestatus object: ".$key); 41 | 42 | # don't die on errors 43 | $ml->errors_are_fatal(0); 44 | $ml->warnings(0); 45 | 46 | ######################### 47 | # get tables 48 | my $data = $ml->selectall_hashref("GET columns\nColumns: table", 'table'); 49 | my @tables = sort keys %{$data}; 50 | 51 | ######################### 52 | # check keys 53 | for my $type (@tables) { 54 | next if $type eq 'statehist'; 55 | alarm(120); 56 | my $filter = ""; 57 | $filter = "Filter: time > ".(time() - 86400)."\n" if $type eq 'log'; 58 | $filter .= "Filter: time < ".(time())."\n" if $type eq 'log'; 59 | my $statement = "GET $type\n".$filter."Limit: 1"; 60 | $lastquery = $statement; 61 | my $keys = $ml->selectrow_hashref($statement ); 62 | undef $lastquery; 63 | is(ref $keys, 'HASH', $type.' keys are a hash');# or BAIL_OUT('keys are not in hash format, got '.Dumper($keys)); 64 | 65 | # status has no filter implemented 66 | next if $type eq 'status'; 67 | 68 | for my $key (keys %{$keys}) { 69 | my $value = $keys->{$key}; 70 | if(index($value, ',') > 0) { my @vals = split /,/, $value; $value = $vals[0]; } 71 | my $typefilter = "Filter: $key >= $value\n"; 72 | if($value eq '') { 73 | $typefilter = "Filter: $key =\n"; 74 | } 75 | my $statement = "GET $type\n".$filter.$typefilter."Limit: 1"; 76 | $lastquery = $statement; 77 | my $hash_ref = $ml->selectrow_hashref($statement ); 78 | undef $lastquery; 79 | is($Monitoring::Livestatus::ErrorCode, 0, "GET ".$type." Filter: ".$key." >= ".$value) or BAIL_OUT("query failed: ".$statement); 80 | #isnt($hash_ref, undef, "GET ".$type." Filter: ".$key." >= ".$value);# or BAIL_OUT("got undef for ".$statement); 81 | 82 | # send test stats query 83 | my $stats_query = [ $key.' = '.$value, 'std '.$key, 'min '.$key, 'max '.$key, 'avg '.$key, 'sum '.$key ]; 84 | for my $stats_part (@{$stats_query}) { 85 | my $statement = "GET $type\n".$filter.$typefilter."\nStats: $stats_part"; 86 | $lastquery = $statement; 87 | my $hash_ref = $ml->selectrow_hashref($statement ); 88 | undef $lastquery; 89 | is($Monitoring::Livestatus::ErrorCode, 0, "GET ".$type." Filter: ".$key." >= ".$value." Stats: $stats_part") or BAIL_OUT("query failed:\n".$statement); 90 | 91 | $statement = "GET $type\n".$filter.$typefilter."\nStats: $stats_part\nStatsGroupBy: $key"; 92 | $lastquery = $statement; 93 | $hash_ref = $ml->selectrow_hashref($statement ); 94 | undef $lastquery; 95 | is($Monitoring::Livestatus::ErrorCode, 0, "GET ".$type." Filter: ".$key." >= ".$value." Stats: $stats_part StatsGroupBy: $key") or BAIL_OUT("query failed:\n".$statement); 96 | } 97 | 98 | # wait till backend is started up again 99 | if(!defined $hash_ref and $Monitoring::Livestatus::ErrorCode > 200) { 100 | sleep(2); 101 | } 102 | } 103 | } 104 | } 105 | -------------------------------------------------------------------------------- /t/33-Monitoring-Livestatus-test_socket_timeout.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | ######################### 4 | 5 | use strict; 6 | use Test::More; 7 | use Data::Dumper; 8 | 9 | if ( !defined $ENV{TEST_SERVER} ) { 10 | my $msg = 'Author test. Set $ENV{TEST_SOCKET} and $ENV{TEST_SERVER} to run'; 11 | plan( skip_all => $msg ); 12 | } else { 13 | plan( tests => 7 ); 14 | } 15 | 16 | # set an alarm 17 | my $lastquery; 18 | $SIG{ALRM} = sub { 19 | my @caller = caller; 20 | print STDERR 'last query: '.$lastquery if defined $lastquery; 21 | die "timeout reached:".Dumper(\@caller)."\n" 22 | }; 23 | alarm(30); 24 | 25 | use_ok('Monitoring::Livestatus'); 26 | 27 | #use Log::Log4perl qw(:easy); 28 | #Log::Log4perl->easy_init($DEBUG); 29 | 30 | ######################### 31 | # Test Query 32 | ######################### 33 | my $statement = "GET hosts\nColumns: alias\nFilter: name = host1"; 34 | 35 | ######################### 36 | my $objects_to_test = { 37 | # create inet object with hash args 38 | '01 inet_hash_args' => Monitoring::Livestatus->new( 39 | verbose => 0, 40 | server => $ENV{TEST_SERVER}, 41 | keepalive => 1, 42 | timeout => 3, 43 | retries_on_connection_error => 0, 44 | # logger => get_logger(), 45 | ), 46 | 47 | # create inet object with a single arg 48 | '02 inet_single_arg' => Monitoring::Livestatus::INET->new( $ENV{TEST_SERVER} ), 49 | 50 | }; 51 | 52 | for my $key (sort keys %{$objects_to_test}) { 53 | my $ml = $objects_to_test->{$key}; 54 | isa_ok($ml, 'Monitoring::Livestatus'); 55 | 56 | # we don't need warnings for testing 57 | $ml->warnings(0); 58 | 59 | ######################### 60 | my $ary_ref = $ml->selectall_arrayref($statement); 61 | is($Monitoring::Livestatus::ErrorCode, 0, 'Query Status 0'); 62 | #is_deeply($ary_ref, $selectall_arrayref1, 'selectall_arrayref($statement)') 63 | # or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectall_arrayref1)); 64 | 65 | sleep(10); 66 | 67 | $ary_ref = $ml->selectall_arrayref($statement); 68 | is($Monitoring::Livestatus::ErrorCode, 0, 'Query Status 0'); 69 | #is_deeply($ary_ref, $selectall_arrayref1, 'selectall_arrayref($statement)') 70 | # or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectall_arrayref1)); 71 | 72 | #print Dumper($Monitoring::Livestatus::ErrorCode); 73 | #print Dumper($Monitoring::Livestatus::ErrorMessage); 74 | } 75 | -------------------------------------------------------------------------------- /t/34-Monitoring-Livestatus-utf8_support.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | ######################### 4 | 5 | use strict; 6 | use Encode; 7 | use Test::More; 8 | use Data::Dumper; 9 | 10 | if ( !defined $ENV{TEST_UTF8} ) { 11 | my $msg = 'Author test. $ENV{TEST_UTF8} to run'; 12 | plan( skip_all => $msg ); 13 | } 14 | elsif ( !defined $ENV{TEST_SERVER} ) { 15 | my $msg = 'Author test. Set $ENV{TEST_SERVER} to run'; 16 | plan( skip_all => $msg ); 17 | } else { 18 | plan( tests => 9 ); 19 | } 20 | 21 | use_ok('Monitoring::Livestatus'); 22 | 23 | #use Log::Log4perl qw(:easy); 24 | #Log::Log4perl->easy_init($DEBUG); 25 | 26 | ######################### 27 | my $objects_to_test = { 28 | # create inet object with hash args 29 | '01 inet_hash_args' => Monitoring::Livestatus->new( 30 | verbose => 0, 31 | server => $ENV{TEST_SERVER}, 32 | keepalive => 1, 33 | timeout => 3, 34 | retries_on_connection_error => 0, 35 | # logger => get_logger(), 36 | ), 37 | 38 | # create inet object with a single arg 39 | '02 inet_single_arg' => Monitoring::Livestatus::INET->new( $ENV{TEST_SERVER} ), 40 | }; 41 | 42 | my $author = 'Monitoring::Livestatus test'; 43 | for my $key (sort keys %{$objects_to_test}) { 44 | my $ml = $objects_to_test->{$key}; 45 | isa_ok($ml, 'Monitoring::Livestatus'); 46 | 47 | # we don't need warnings for testing 48 | $ml->warnings(0); 49 | 50 | ######################### 51 | my $downtimes = $ml->selectall_arrayref("GET downtimes\nColumns: id"); 52 | my $num_downtimes = 0; 53 | $num_downtimes = scalar @{$downtimes} if defined $downtimes; 54 | 55 | ######################### 56 | # get a test host 57 | my $firsthost = $ml->selectscalar_value("GET hosts\nColumns: name\nLimit: 1"); 58 | isnt($firsthost, undef, 'get test hostname') or BAIL_OUT($key.': got not test hostname'); 59 | 60 | my $expect = "aa ²&é\"'''(§è!çà)- %s ''%s'' aa ~ € bb"; 61 | #my $expect = "öäüß"; 62 | my $teststrings = [ 63 | $expect, 64 | "aa \x{c2}\x{b2}&\x{c3}\x{a9}\"'''(\x{c2}\x{a7}\x{c3}\x{a8}!\x{c3}\x{a7}\x{c3}\x{a0})- %s ''%s'' aa ~ \x{e2}\x{82}\x{ac} bb", 65 | ]; 66 | for my $string (@{$teststrings}) { 67 | $ml->do('COMMAND ['.time().'] SCHEDULE_HOST_DOWNTIME;'.$firsthost.';'.time().';'.(time()+300).';1;0;300;'.$author.';'.$string); 68 | 69 | # sometimes it takes while till the downtime is accepted 70 | my $waited = 0; 71 | while($downtimes = $ml->selectall_arrayref("GET downtimes\nColumns: id comment", { Slice => 1 }) and scalar @{$downtimes} < $num_downtimes + 1) { 72 | print "waiting for the downtime...\n"; 73 | sleep(1); 74 | $waited++; 75 | BAIL_OUT('waited 30 seconds for the downtime...') if $waited > 30; 76 | } 77 | 78 | my $last_downtime = pop @{$downtimes}; 79 | #utf8::decode($expect); 80 | is($last_downtime->{'comment'}, $expect, 'get same utf8 comment: got '.Dumper($last_downtime)); 81 | } 82 | } 83 | -------------------------------------------------------------------------------- /t/35-Monitoring-Livestatus-callbacks_support.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | ######################### 4 | 5 | use strict; 6 | use Encode; 7 | use Test::More; 8 | use Data::Dumper; 9 | 10 | if ( !defined $ENV{TEST_SERVER} ) { 11 | my $msg = 'Author test. Set $ENV{TEST_SOCKET} and $ENV{TEST_SERVER} to run'; 12 | plan( skip_all => $msg ); 13 | } else { 14 | plan( tests => 15 ); 15 | } 16 | 17 | use_ok('Monitoring::Livestatus'); 18 | 19 | #use Log::Log4perl qw(:easy); 20 | #Log::Log4perl->easy_init($DEBUG); 21 | 22 | ######################### 23 | my $objects_to_test = { 24 | # create inet object with hash args 25 | '01 inet_hash_args' => Monitoring::Livestatus->new( 26 | verbose => 0, 27 | server => $ENV{TEST_SERVER}, 28 | keepalive => 1, 29 | timeout => 3, 30 | retries_on_connection_error => 0, 31 | # logger => get_logger(), 32 | ), 33 | 34 | # create inet object with a single arg 35 | '02 inet_single_arg' => Monitoring::Livestatus::INET->new( $ENV{TEST_SERVER} ), 36 | }; 37 | 38 | for my $key (sort keys %{$objects_to_test}) { 39 | my $ml = $objects_to_test->{$key}; 40 | isa_ok($ml, 'Monitoring::Livestatus'); 41 | 42 | my $got = $ml->selectall_arrayref("GET hosts\nColumns: name alias state\nLimit: 1", { Slice => 1, callbacks => { 'c1' => sub { return $_[0]->{'alias'}; } } }); 43 | isnt($got->[0]->{'alias'}, undef, 'got a test host'); 44 | is($got->[0]->{'alias'}, $got->[0]->{'c1'}, 'callback for sliced results'); 45 | 46 | $got = $ml->selectall_arrayref("GET hosts\nColumns: name alias state\nLimit: 1", { Slice => 1, callbacks => { 'name' => sub { return $_[0]->{'alias'}; } } }); 47 | isnt($got->[0]->{'alias'}, undef, 'got a test host'); 48 | is($got->[0]->{'alias'}, $got->[0]->{'name'}, 'callback for sliced results which overwrites key'); 49 | 50 | $got = $ml->selectall_arrayref("GET hosts\nColumns: name alias state\nLimit: 1", { callbacks => { 'c1' => sub { return $_[0]->[1]; } } }); 51 | isnt($got->[0]->[1], undef, 'got a test host'); 52 | is($got->[0]->[1], $got->[0]->[3], 'callback for non sliced results'); 53 | } 54 | -------------------------------------------------------------------------------- /t/97-Pod.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | 5 | eval "use Test::Pod 1.14"; 6 | plan skip_all => 'Test::Pod 1.14 required' if $@; 7 | plan skip_all => 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.' unless $ENV{TEST_AUTHOR}; 8 | 9 | all_pod_files_ok(); 10 | -------------------------------------------------------------------------------- /t/98-Pod-Coverage.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | # $Id$ 4 | # 5 | use strict; 6 | use warnings; 7 | use File::Spec; 8 | use Test::More; 9 | 10 | if ( not $ENV{TEST_AUTHOR} ) { 11 | my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; 12 | plan( skip_all => $msg ); 13 | } 14 | 15 | eval { require Test::Pod::Coverage; }; 16 | 17 | if ( $@ ) { 18 | my $msg = 'Test::Pod::Coverage required to criticise pod'; 19 | plan( skip_all => $msg ); 20 | } 21 | 22 | eval "use Test::Pod::Coverage 1.00"; 23 | all_pod_coverage_ok(); 24 | -------------------------------------------------------------------------------- /t/99-Perl-Critic.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | # $Id$ 4 | # 5 | use strict; 6 | use warnings; 7 | use File::Spec; 8 | use Test::More; 9 | 10 | if ( not $ENV{TEST_AUTHOR} ) { 11 | my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; 12 | plan( skip_all => $msg ); 13 | } 14 | 15 | eval { require Test::Perl::Critic; }; 16 | 17 | if ( $@ ) { 18 | my $msg = 'Test::Perl::Critic required to criticise code'; 19 | plan( skip_all => $msg ); 20 | } 21 | 22 | my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' ); 23 | Test::Perl::Critic->import( -profile => $rcfile ); 24 | all_critic_ok(); 25 | -------------------------------------------------------------------------------- /t/perlcriticrc: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # This Perl::Critic configuration file sets the Policy severity levels 3 | # according to Damian Conway's own personal recommendations. Feel free to 4 | # use this as your own, or make modifications. 5 | ############################################################################## 6 | 7 | [Perl::Critic::Policy::ValuesAndExpressions::ProhibitAccessOfPrivateData] 8 | severity = 3 9 | 10 | [Perl::Critic::Policy::BuiltinFunctions::ProhibitLvalueSubstr] 11 | severity = 3 12 | 13 | [Perl::Critic::Policy::BuiltinFunctions::ProhibitReverseSortBlock] 14 | severity = 1 15 | 16 | [Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect] 17 | severity = 5 18 | 19 | [Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval] 20 | severity = 5 21 | 22 | [Perl::Critic::Policy::BuiltinFunctions::ProhibitStringySplit] 23 | severity = 2 24 | 25 | [Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalCan] 26 | severity = 4 27 | 28 | [Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalIsa] 29 | severity = 4 30 | 31 | [Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidGrep] 32 | severity = 3 33 | 34 | [Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidMap] 35 | severity = 3 36 | 37 | [Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep] 38 | severity = 4 39 | 40 | [Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap] 41 | severity = 4 42 | 43 | [Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction] 44 | severity = 5 45 | 46 | [Perl::Critic::Policy::BuiltinFunctions::RequireSimpleSortBlock] 47 | severity = 3 48 | 49 | [Perl::Critic::Policy::ClassHierarchies::ProhibitAutoloading] 50 | severity = 3 51 | 52 | [Perl::Critic::Policy::ClassHierarchies::ProhibitExplicitISA] 53 | severity = 4 54 | 55 | [Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless] 56 | severity = 5 57 | 58 | [Perl::Critic::Policy::CodeLayout::ProhibitHardTabs] 59 | severity = 3 60 | 61 | [Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins] 62 | severity = 1 63 | 64 | [Perl::Critic::Policy::CodeLayout::ProhibitQuotedWordLists] 65 | severity = 2 66 | 67 | [Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines] 68 | severity = 4 69 | 70 | [Perl::Critic::Policy::CodeLayout::RequireTidyCode] 71 | severity = 1 72 | 73 | [Perl::Critic::Policy::CodeLayout::RequireTrailingCommas] 74 | severity = 3 75 | 76 | [Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops] 77 | severity = 3 78 | 79 | [Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse] 80 | severity = 3 81 | 82 | [Perl::Critic::Policy::ControlStructures::ProhibitDeepNests] 83 | severity = 3 84 | 85 | [Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions] 86 | severity = 5 87 | 88 | [Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls] 89 | severity = 4 90 | 91 | [Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks] 92 | severity = 4 93 | 94 | [Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode] 95 | severity = 4 96 | 97 | [Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks] 98 | severity = 4 99 | 100 | [Perl::Critic::Policy::Documentation::RequirePodAtEnd] 101 | severity = 2 102 | 103 | [Perl::Critic::Policy::Documentation::RequirePodSections] 104 | severity = 2 105 | 106 | [Perl::Critic::Policy::ErrorHandling::RequireCarping] 107 | severity = 4 108 | 109 | [Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators] 110 | severity = 3 111 | 112 | [Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles] 113 | severity = 5 114 | 115 | [Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest] 116 | severity = 4 117 | 118 | [Perl::Critic::Policy::InputOutput::ProhibitOneArgSelect] 119 | severity = 4 120 | 121 | [Perl::Critic::Policy::InputOutput::ProhibitReadlineInForLoop] 122 | severity = 5 123 | 124 | [Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen] 125 | severity = 4 126 | 127 | [Perl::Critic::Policy::InputOutput::RequireBracedFileHandleWithPrint] 128 | severity = 3 129 | 130 | [Perl::Critic::Policy::Miscellanea::ProhibitFormats] 131 | severity = 3 132 | 133 | [Perl::Critic::Policy::Miscellanea::ProhibitTies] 134 | severity = 4 135 | 136 | [-Perl::Critic::Policy::Miscellanea::RequireRcsKeywords] 137 | 138 | [Perl::Critic::Policy::Modules::ProhibitAutomaticExportation] 139 | severity = 4 140 | 141 | [Perl::Critic::Policy::Modules::ProhibitEvilModules] 142 | severity = 5 143 | 144 | [Perl::Critic::Policy::Modules::ProhibitMultiplePackages] 145 | severity = 4 146 | 147 | [Perl::Critic::Policy::Modules::RequireBarewordIncludes] 148 | severity = 5 149 | 150 | [Perl::Critic::Policy::Modules::RequireEndWithOne] 151 | severity = 4 152 | 153 | [Perl::Critic::Policy::Modules::RequireExplicitPackage] 154 | severity = 4 155 | 156 | [Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage] 157 | severity = 5 158 | 159 | [Perl::Critic::Policy::Modules::RequireVersionVar] 160 | severity = 4 161 | 162 | [Perl::Critic::Policy::NamingConventions::ProhibitAmbiguousNames] 163 | severity = 3 164 | 165 | [Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs] 166 | severity = 1 167 | 168 | [Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars] 169 | severity = 1 170 | 171 | [Perl::Critic::Policy::References::ProhibitDoubleSigils] 172 | severity = 4 173 | 174 | [Perl::Critic::Policy::RegularExpressions::ProhibitCaptureWithoutTest] 175 | severity = 4 176 | 177 | [Perl::Critic::Policy::RegularExpressions::RequireExtendedFormatting] 178 | severity = 5 179 | 180 | [Perl::Critic::Policy::RegularExpressions::RequireLineBoundaryMatching] 181 | severity = 5 182 | 183 | [Perl::Critic::Policy::Subroutines::ProhibitAmpersandSigils] 184 | severity = 2 185 | 186 | [Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms] 187 | severity = 4 188 | 189 | [Perl::Critic::Policy::Subroutines::ProhibitExcessComplexity] 190 | severity = 3 191 | 192 | [Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef] 193 | severity = 5 194 | 195 | [Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes] 196 | severity = 4 197 | 198 | [Perl::Critic::Policy::Subroutines::ProtectPrivateSubs] 199 | severity = 3 200 | 201 | [Perl::Critic::Policy::Subroutines::RequireFinalReturn] 202 | severity = 5 203 | 204 | [Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict] 205 | severity = 5 206 | 207 | [Perl::Critic::Policy::TestingAndDebugging::ProhibitNoWarnings] 208 | severity = 4 209 | 210 | [Perl::Critic::Policy::TestingAndDebugging::ProhibitProlongedStrictureOverride] 211 | severity = 4 212 | 213 | [Perl::Critic::Policy::TestingAndDebugging::RequireTestLabels] 214 | severity = 3 215 | 216 | [Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict] 217 | severity = 5 218 | 219 | [Perl::Critic::Policy::TestingAndDebugging::RequireUseWarnings] 220 | severity = 4 221 | 222 | [Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma] 223 | severity = 4 224 | 225 | [Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes] 226 | severity = 2 227 | 228 | [Perl::Critic::Policy::ValuesAndExpressions::ProhibitEscapedCharacters] 229 | severity = 2 230 | 231 | [Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals] 232 | severity = 1 233 | 234 | [Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros] 235 | severity = 5 236 | 237 | [Perl::Critic::Policy::ValuesAndExpressions::ProhibitMismatchedOperators] 238 | severity = 2 239 | 240 | [Perl::Critic::Policy::ValuesAndExpressions::ProhibitMixedBooleanOperators] 241 | severity = 4 242 | 243 | [Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyQuotes] 244 | severity = 2 245 | 246 | [Perl::Critic::Policy::ValuesAndExpressions::ProhibitVersionStrings] 247 | severity = 3 248 | 249 | [Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars] 250 | severity = 1 251 | 252 | [Perl::Critic::Policy::ValuesAndExpressions::RequireNumberSeparators] 253 | severity = 2 254 | 255 | [Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator] 256 | severity = 4 257 | 258 | [Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator] 259 | severity = 4 260 | 261 | [Perl::Critic::Policy::Variables::ProhibitConditionalDeclarations] 262 | severity = 5 263 | 264 | [Perl::Critic::Policy::Variables::ProhibitLocalVars] 265 | severity = 2 266 | 267 | [Perl::Critic::Policy::Variables::ProhibitMatchVars] 268 | severity = 4 269 | 270 | [Perl::Critic::Policy::Variables::ProhibitPackageVars] 271 | severity = 3 272 | 273 | [Perl::Critic::Policy::Variables::ProhibitPunctuationVars] 274 | severity = 2 275 | 276 | [Perl::Critic::Policy::Variables::ProtectPrivateVars] 277 | severity = 3 278 | 279 | [Perl::Critic::Policy::Variables::RequireInitializationForLocalVars] 280 | severity = 5 281 | 282 | [Perl::Critic::Policy::Variables::RequireLexicalLoopIterators] 283 | severity = 5 284 | 285 | [Perl::Critic::Policy::Variables::RequireNegativeIndices] 286 | severity = 4 --------------------------------------------------------------------------------