[pkg-nagios-changes] [Git][nagios-team/libmonitoring-livestatus-perl][upstream] New upstream version 0.86
Bas Couwenberg (@sebastic)
gitlab at salsa.debian.org
Sun May 11 09:36:36 BST 2025
Bas Couwenberg pushed to branch upstream at Debian Nagios Maintainer Group / libmonitoring-livestatus-perl
Commits:
f1b33805 by Bas Couwenberg at 2025-05-11T10:31:17+02:00
New upstream version 0.86
- - - - -
17 changed files:
- Changes
- META.yml
- inc/Module/AutoInstall.pm
- inc/Module/Install.pm
- inc/Module/Install/AutoInstall.pm
- inc/Module/Install/Base.pm
- inc/Module/Install/Can.pm
- inc/Module/Install/Fetch.pm
- inc/Module/Install/Include.pm
- inc/Module/Install/Makefile.pm
- inc/Module/Install/Metadata.pm
- inc/Module/Install/Win32.pm
- inc/Module/Install/WriteAll.pm
- lib/Monitoring/Livestatus.pm
- lib/Monitoring/Livestatus/INET.pm
- lib/Monitoring/Livestatus/UNIX.pm
- t/23-Monitoring-Livestatus-BigData.t
Changes:
=====================================
Changes
=====================================
@@ -1,5 +1,10 @@
Revision history for Perl extension Monitoring::Livestatus.
+0.86 Sun May 11 10:18:06 CEST 2025
+ - improve timeout handling
+ - improve utf8 handling
+ - fix flaky test case (#9)
+
0.84 Tue Dec 15 16:53:44 CET 2020
- add support for command response
- remove alarm handler, timeouts should be handled in the calling module
=====================================
META.yml
=====================================
@@ -8,7 +8,7 @@ configure_requires:
ExtUtils::MakeMaker: 6.59
distribution_type: module
dynamic_config: 1
-generated_by: 'Module::Install version 1.19'
+generated_by: 'Module::Install version 1.21'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
=====================================
inc/Module/AutoInstall.pm
=====================================
@@ -8,7 +8,7 @@ use ExtUtils::MakeMaker ();
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.19';
+ $VERSION = '1.21';
}
# special map on pre-defined feature sets
=====================================
inc/Module/Install.pm
=====================================
@@ -31,7 +31,7 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '1.19';
+ $VERSION = '1.21';
# Storage for the pseudo-singleton
$MAIN = undef;
=====================================
inc/Module/Install/AutoInstall.pm
=====================================
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.19';
+ $VERSION = '1.21';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
=====================================
inc/Module/Install/Base.pm
=====================================
@@ -4,7 +4,7 @@ package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.19';
+ $VERSION = '1.21';
}
# Suspend handler for "redefined" warnings
=====================================
inc/Module/Install/Can.pm
=====================================
@@ -8,7 +8,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.19';
+ $VERSION = '1.21';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
=====================================
inc/Module/Install/Fetch.pm
=====================================
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.19';
+ $VERSION = '1.21';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
=====================================
inc/Module/Install/Include.pm
=====================================
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.19';
+ $VERSION = '1.21';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
=====================================
inc/Module/Install/Makefile.pm
=====================================
@@ -8,7 +8,7 @@ use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.19';
+ $VERSION = '1.21';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
=====================================
inc/Module/Install/Metadata.pm
=====================================
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.19';
+ $VERSION = '1.21';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -455,12 +455,8 @@ sub author_from {
my %license_urls = (
perl => 'http://dev.perl.org/licenses/',
apache => 'http://apache.org/licenses/LICENSE-2.0',
- apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
artistic => 'http://opensource.org/licenses/artistic-license.php',
- artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
lgpl => 'http://opensource.org/licenses/lgpl-license.php',
- lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
- lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
bsd => 'http://opensource.org/licenses/bsd-license.php',
gpl => 'http://opensource.org/licenses/gpl-license.php',
gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
@@ -471,6 +467,12 @@ my %license_urls = (
unrestricted => undef,
restrictive => undef,
unknown => undef,
+
+ # these are not actually allowed in meta-spec v1.4 but are left here for compatibility:
+ apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
+ artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
+ lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
+ lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
);
sub license {
=====================================
inc/Module/Install/Win32.pm
=====================================
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.19';
+ $VERSION = '1.21';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
=====================================
inc/Module/Install/WriteAll.pm
=====================================
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.19';
+ $VERSION = '1.21';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
=====================================
lib/Monitoring/Livestatus.pm
=====================================
@@ -1,18 +1,17 @@
package Monitoring::Livestatus;
-use 5.006;
-use strict;
use warnings;
-use Data::Dumper qw/Dumper/;
+use strict;
use Carp qw/carp confess/;
use Cpanel::JSON::XS ();
-use Storable qw/dclone/;
+use Data::Dumper qw/Dumper/;
use IO::Select ();
+use Storable qw/dclone/;
use Monitoring::Livestatus::INET ();
use Monitoring::Livestatus::UNIX ();
-our $VERSION = '0.84';
+our $VERSION = '0.86';
# list of allowed options
@@ -68,7 +67,7 @@ path to the UNIX socket of check_mk livestatus
=item server
-uses this server for a TCP connection
+server address when using a TCP connection
=item peer
@@ -151,8 +150,8 @@ sub new {
'errors_are_fatal' => 1, # die on errors
'backend' => undef, # should be keept undef, used internally
'timeout' => undef, # timeout for tcp connections
- 'query_timeout' => 60, # query timeout for tcp connections
- 'connect_timeout' => 5, # connect timeout for tcp connections
+ 'query_timeout' => undef, # query timeout for tcp connections
+ 'connect_timeout' => 30, # connect timeout for tcp connections
'warnings' => 1, # show warnings, for example on querys without Column: Header
'logger' => undef, # logger object used for statistical informations and errors / warnings
'deepcopy' => undef, # copy result set to avoid errors with tied structures
@@ -163,6 +162,7 @@ sub new {
'key' => undef,
'ca_file' => undef,
'verify' => undef,
+ 'verifycn_name' => undef,
};
my %old_key = (
@@ -776,8 +776,11 @@ sub _send {
# for querys with column header, no seperate columns will be returned
if($statement =~ m/^Columns:\ (.*)$/mx) {
($statement,$keys) = $self->_extract_keys_from_columns_header($statement);
- } elsif($statement =~ m/^Stats:\ (.*)$/mx or $statement =~ m/^StatsGroupBy:\ (.*)$/mx) {
+ }
+ if($statement =~ m/^Stats:\ (.*)$/mx or $statement =~ m/^StatsGroupBy:\ (.*)$/mx) {
+ my $has_columns = defined $keys ? join(",", @{$keys}) : undef;
($statement,$keys) = extract_keys_from_stats_statement($statement);
+ unshift @{$keys}, $has_columns if $has_columns;
}
# Offset header (currently naemon only)
@@ -847,8 +850,6 @@ sub _send {
# return a empty result set if nothing found
return({ keys => [], result => []}) if !defined $body;
- my $limit_start = 0;
- if(defined $opt->{'limit_start'}) { $limit_start = $opt->{'limit_start'}; }
# body is already parsed
my $result;
if($status == 200) {
@@ -864,7 +865,7 @@ sub _send {
# surrogate pair expected
if($@) {
# replace u+D800 to u+DFFF (reserved utf-16 low/high surrogates)
- $body =~ s/\\ud[89a-f]\w{2}/\\ufffd/gmxi;
+ $body =~ s/\\ud[89a-f][0-9a-f]{2}/\\ufffd/gmxio;
eval {
$result = $json_decoder->decode($body);
};
@@ -916,7 +917,7 @@ sub post_processing {
my $orig_result;
if($opt->{'wrapped_json'}) {
$orig_result = $result;
- $result = $result->{'data'};
+ $result = delete $orig_result->{'data'};
}
# add peer information?
@@ -946,10 +947,7 @@ sub post_processing {
'result_count' => scalar @{$result},
};
if($opt->{'wrapped_json'}) {
- for my $key (keys %{$orig_result}) {
- next if $key eq 'data';
- $self->{'meta_data'}->{$key} = $orig_result->{$key};
- }
+ $self->{'meta_data'} = $orig_result;
}
return({ keys => $keys, result => $result });
@@ -1002,8 +1000,8 @@ adds the peers name, addr and key to the result set:
=head2 Backend
-send the query only to some specific backends. Only
-useful when using multiple backends.
+send the query only to some specific backends.
+Only useful when using multiple backends.
my $hosts = $ml->selectall_arrayref(
"GET hosts\nColumns: name alias state",
@@ -1092,16 +1090,18 @@ sub _send_socket {
# https://riptutorial.com/posix/example/17424/handle-sigpipe-generated-by-write---in-a-thread-safe-manner
local $SIG{PIPE} = 'IGNORE';
+ my $maxretries = $ENV{'LIVESTATUS_RETRIES'} // $self->{'retries_on_connection_error'};
+
# try to avoid connection errors
eval {
- if($self->{'retries_on_connection_error'} <= 0) {
+ if($maxretries <= 0) {
($sock, $msg, $recv) = &_send_socket_do($self, $statement);
return($sock, $msg, $recv) if $msg;
($status, $msg, $recv) = &_read_socket_do($self, $sock, $statement);
return($status, $msg, $recv);
}
- while((!defined $status || ($status == 491 || $status == 497 || $status == 500)) && $retries < $self->{'retries_on_connection_error'}) {
+ while((!defined $status || ($status == 491 || $status == 497 || $status == 500)) && $retries < $maxretries) {
$retries++;
($sock, $msg, $recv) = &_send_socket_do($self, $statement);
return($status, $msg, $recv) if $msg;
@@ -1110,23 +1110,24 @@ sub _send_socket {
if($status == 491 or $status == 497 or $status == 500) {
$self->{'logger'}->debug('got status '.$status.' retrying in '.$self->{'retry_interval'}.' seconds') if $self->{'verbose'};
$self->_close();
- sleep($self->{'retry_interval'}) if $retries < $self->{'retries_on_connection_error'};
+ sleep($self->{'retry_interval'}) if $retries < $maxretries;
}
}
};
- if($@) {
- $self->{'logger'}->debug("try 1 failed: $@") if $self->{'verbose'};
- if(defined $@ and $@ =~ /broken\ pipe/mx) {
+ my $err = $@;
+ if($err) {
+ $self->{'logger'}->debug("try 1 failed: $err") if $self->{'verbose'};
+ if($err =~ /broken\ pipe/mx) {
($sock, $msg, $recv) = &_send_socket_do($self, $statement);
return($status, $msg, $recv) if $msg;
return(&_read_socket_do($self, $sock, $statement));
}
- confess($@) if $self->{'errors_are_fatal'};
+ _die_or_confess($err) if $self->{'errors_are_fatal'};
}
$status = $sock unless $status;
$msg =~ s/^$status:\s+//gmx;
- confess($status.": ".$msg) if($status >= 400 and $self->{'errors_are_fatal'});
+ _die_or_confess($status.": ".$msg) if($status >= 400 and $self->{'errors_are_fatal'});
return($status, $msg, $recv);
}
@@ -1135,10 +1136,9 @@ sub _send_socket {
sub _send_socket_do {
my($self, $statement) = @_;
my $sock = $self->_open() or return(491, $self->_get_error(491, $@ || $!), $@ || $!);
- utf8::decode($statement);
- utf8::encode($statement);
- print $sock $statement or return($self->_socket_error($statement, $sock, 'write to socket failed: '.($@ || $!)));
- print $sock "\n";
+ utf8::decode($statement); # make sure
+ utf8::encode($statement); # query is utf8
+ $sock->printflush($statement,"\n") || return($self->_socket_error($statement, 'write to socket failed'.($! ? ': '.$! : '')));
return $sock;
}
@@ -1147,12 +1147,13 @@ sub _read_socket_do {
my($self, $sock, $statement) = @_;
my($recv,$header);
+ my $s = IO::Select->new();
+ $s->add($sock);
+
# COMMAND statements might return a error message
if($statement && $statement =~ m/^COMMAND/mx) {
shutdown($sock, 1);
- my $s = IO::Select->new();
- $s->add($sock);
- if($s->can_read(0.5)) {
+ if($s->can_read(3)) {
$recv = <$sock>;
}
if($recv) {
@@ -1165,7 +1166,25 @@ sub _read_socket_do {
return('200', $self->_get_error(200), undef);
}
- $sock->read($header, 16) or return($self->_socket_error($statement, $sock, 'reading header from socket failed, check your livestatus logfile: '.$!));
+ my $timeout = 180;
+ if($statement) {
+ # status requests should not take longer than 20 seconds
+ $timeout = 20 if($statement =~ m/^GET\s+status/mx);
+ $timeout = 300 if($statement =~ m/^GET\s+log/mx);
+ }
+ $timeout = $self->{'query_timeout'} if $self->{'query_timeout'};
+
+ local $! = undef;
+ my @ready = $s->can_read($timeout);
+ if(scalar @ready == 0) {
+ my $err = $!;
+ if($err) {
+ return($self->_socket_error($statement, 'socket error '.$err));
+ }
+ return($self->_socket_error($statement, 'timeout ('.$timeout.'s) while waiting for socket'));
+ }
+
+ $sock->read($header, 16) || return($self->_socket_error($statement, 'reading header from socket failed'.($! ? ': '.$! : '')));
$self->{'logger'}->debug("header: $header") if $self->{'verbose'};
my($status, $msg, $content_length) = &_parse_header($self, $header, $sock);
return($status, $msg, undef) if !defined $content_length;
@@ -1182,15 +1201,15 @@ sub _read_socket_do {
if($remaining < $length) { $length = $remaining; }
while($length > 0 && $sock->read(my $buf, $length)) {
# replace u+D800 to u+DFFF (reserved utf-16 low/high surrogates)
- $buf =~ s/\\ud[89a-f]\w{2}/\\ufffd/gmxio;
+ $buf =~ s/\\ud[89a-f][0-9a-f]{2}/\\ufffd/gmxio;
$json_decoder->incr_parse($buf);
$remaining = $remaining -$length;
if($remaining < $length) { $length = $remaining; }
}
- $recv = $json_decoder->incr_parse or return($self->_socket_error($statement, $sock, 'reading remaining '.$length.' bytes from socket failed: '.$!));
+ $recv = $json_decoder->incr_parse or return($self->_socket_error($statement, 'reading remaining '.$length.' bytes from socket failed'.($! ? ': '.$! : '')));
$json_decoder->incr_reset;
} else {
- $sock->read($recv, $content_length) or return($self->_socket_error($statement, $sock, 'reading body from socket failed'));
+ $sock->read($recv, $content_length) or return($self->_socket_error($statement, 'reading body from socket failed'.($! ? ': '.$! : '')));
}
}
@@ -1203,26 +1222,24 @@ sub _read_socket_do {
########################################
sub _socket_error {
- #my($self, $statement, $sock, $body)...
- my($self, $statement, undef, $body) = @_;
+ my($self, $statement, $err) = @_;
my $message = "\n";
$message .= "peer ".Dumper($self->peer_name);
$message .= "statement ".Dumper($statement);
- $message .= "message ".Dumper($body);
$self->{'logger'}->error($message) if $self->{'verbose'};
if($self->{'retries_on_connection_error'} <= 0) {
if($self->{'errors_are_fatal'}) {
- confess($message);
+ _die_or_confess($message);
}
else {
carp($message);
}
}
$self->_close();
- return(500, $self->_get_error(500), $message);
+ return(500, $self->_get_error(500).($err ? " - ".$err : ""), $message);
}
########################################
@@ -1541,6 +1558,16 @@ sub _log_statement {
return 1;
}
+########################################
+sub _die_or_confess {
+ my($msg) = @_;
+ my @lines = split/\n/mx, $msg;
+ if(scalar @lines > 2) {
+ die($msg);
+ }
+ confess($msg);
+}
+
########################################
1;
=====================================
lib/Monitoring/Livestatus/INET.pm
=====================================
@@ -1,11 +1,11 @@
package Monitoring::Livestatus::INET;
-use parent 'Monitoring::Livestatus';
-
-use strict;
use warnings;
+use strict;
+use Carp qw/confess/;
use IO::Socket::IP ();
use Socket qw(IPPROTO_TCP TCP_NODELAY);
-use Carp qw/confess/;
+
+use parent 'Monitoring::Livestatus';
=head1 NAME
@@ -66,11 +66,14 @@ sub _open {
my $tls = 0;
my $peer_addr = $self->{'peer'};
if($peer_addr =~ s|tls://||mx) {
+ #$IO::Socket::SSL::DEBUG = 2 if $ENV{'THRUK_VERBOSE'} && $ENV{'THRUK_VERBOSE'} >= 2;
+ #$IO::Socket::SSL::DEBUG = 3 if $ENV{'THRUK_VERBOSE'} && $ENV{'THRUK_VERBOSE'} >= 3;
$options->{'PeerAddr'} = $peer_addr;
$options->{'SSL_cert_file'} = $self->{'cert'};
$options->{'SSL_key_file'} = $self->{'key'};
$options->{'SSL_ca_file'} = $self->{'ca_file'};
$options->{'SSL_verify_mode'} = 0 if(defined $self->{'verify'} && $self->{'verify'} == 0);
+ $options->{'SSL_verifycn_name'} = $self->{'verifycn_name'};
$tls = 1;
}
@@ -81,7 +84,7 @@ sub _open {
$sock = IO::Socket::IP->new(%{$options});
}
if(!defined $sock || !$sock->connected()) {
- my $msg = "failed to connect to $peer_addr: $!";
+ my $msg = "failed to connect to $peer_addr: ".($tls ? IO::Socket::SSL::errstr() : $!);
if($self->{'errors_are_fatal'}) {
confess($msg);
}
@@ -93,10 +96,11 @@ sub _open {
setsockopt($sock, IPPROTO_TCP, TCP_NODELAY, 1);
};
+ my $err = $@;
- if($@) {
+ if($err) {
$Monitoring::Livestatus::ErrorCode = 500;
- $Monitoring::Livestatus::ErrorMessage = $@;
+ $Monitoring::Livestatus::ErrorMessage = $err;
return;
}
=====================================
lib/Monitoring/Livestatus/UNIX.pm
=====================================
@@ -1,10 +1,10 @@
package Monitoring::Livestatus::UNIX;
-use parent 'Monitoring::Livestatus';
-
-use strict;
use warnings;
-use IO::Socket::UNIX ();
+use strict;
use Carp qw/confess/;
+use IO::Socket::UNIX ();
+
+use parent 'Monitoring::Livestatus';
=head1 NAME
=====================================
t/23-Monitoring-Livestatus-BigData.t
=====================================
@@ -3,28 +3,31 @@
#########################
use strict;
+use Test::More;
+
+if(!$ENV{TEST_AUTHOR}) {
+ plan skip_all => 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.';
+ exit;
+}
my $netcat;
-BEGIN {
- use Test::More;
- for my $path (split(/:/mx, $ENV{'PATH'})) {
- if(-x $path."/netcat") {
- $netcat = $path."/netcat";
- last;
- }
- }
- if( $^O eq 'MSWin32' ) {
- plan skip_all => 'no sockets on windows';
- }
- elsif(!$netcat) {
- plan skip_all => 'no netcat found in path';
+for my $path (split(/:/mx, $ENV{'PATH'})) {
+ if(-x $path."/netcat") {
+ $netcat = $path."/netcat";
+ last;
}
- else {
- plan tests => 13;
- }
-};
+}
+if( $^O eq 'MSWin32' ) {
+ plan skip_all => 'no sockets on windows';
+}
+elsif(!$netcat) {
+ plan skip_all => 'no netcat found in path';
+}
+else {
+ plan tests => 13;
+}
-BEGIN { use_ok('Monitoring::Livestatus') };
+use_ok('Monitoring::Livestatus');
my $testport = 60123;
my $testresults = $ARGV[0] || 5;
View it on GitLab: https://salsa.debian.org/nagios-team/libmonitoring-livestatus-perl/-/commit/f1b338052fec386357bf6ec830a6ac37f0767dde
--
View it on GitLab: https://salsa.debian.org/nagios-team/libmonitoring-livestatus-perl/-/commit/f1b338052fec386357bf6ec830a6ac37f0767dde
You're receiving this email because of your account on salsa.debian.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://alioth-lists.debian.net/pipermail/pkg-nagios-changes/attachments/20250511/5ed446a2/attachment-0001.htm>
More information about the pkg-nagios-changes
mailing list