ettore.dreucci/mk_livestatus
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

initial commit

Browse Source
This commit is contained in:
Phillip Smith
2021-08-24 17:55:37 +10:00
commit 69e42aac8d
387 changed files with 69168 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

87
api/c++/Livestatus.cc Normal file
View File

@@ -0,0 +1,87 @@
// +------------------------------------------------------------------+
// | ____ _ _ __ __ _ __ |
// | / ___| |__ ___ ___| | __ | \/ | |/ / |
// | | | | '_ \ / _ \/ __| |/ / | |\/| | ' / |
// | | |___| | | | __/ (__| < | | | | . \ |
// | \____|_| |_|\___|\___|_|\_\___|_| |_|_|\_\ |
// | |
// | Copyright Mathias Kettner 2014 mk@mathias-kettner.de |
// +------------------------------------------------------------------+
//
// This file is part of Check_MK.
// The official homepage is at http://mathias-kettner.de/check_mk.
//
// check_mk is free software; you can redistribute it and/or modify it
// under the terms of the GNU General Public License as published by
// the Free Software Foundation in version 2. check_mk is distributed
// in the hope that it will be useful, but WITHOUT ANY WARRANTY; with-
// out even the implied warranty of MERCHANTABILITY or FITNESS FOR A
// PARTICULAR PURPOSE. See the GNU General Public License for more de-
// ails. You should have received a copy of the GNU General Public
// License along with GNU Make; see the file COPYING. If not, write
// to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
// Boston, MA 02110-1301 USA.
#include "Livestatus.h"
#include <fcntl.h>
#include <sys/socket.h>
#include <sys/types.h>
#include <sys/un.h>
#include <unistd.h>
void Livestatus::connectUNIX(const char *socket_path) {
_connection = socket(PF_LOCAL, SOCK_STREAM, 0);
struct sockaddr_un sockaddr;
sockaddr.sun_family = AF_UNIX;
strncpy(sockaddr.sun_path, socket_path, sizeof(sockaddr.sun_path) - 1);
sockaddr.sun_path[sizeof(sockaddr.sun_path) - 1] = '\0';
if (0 > connect(_connection, (const struct sockaddr *)&sockaddr,
sizeof(sockaddr))) {
close(_connection);
_connection = -1;
} else
_file = fdopen(_connection, "r");
}
Livestatus::~Livestatus() { disconnect(); }
void Livestatus::disconnect() {
if (isConnected()) {
if (_file)
fclose(_file);
else
close(_connection);
}
_connection = -1;
_file = 0;
}
void Livestatus::sendQuery(const char *query) {
write(_connection, query, strlen(query));
std::string separators = "Separators: 10 1 2 3\n";
write(_connection, separators.c_str(), separators.size());
shutdown(_connection, SHUT_WR);
}
std::vector<std::string> *Livestatus::nextRow() {
char line[65536];
if (0 != fgets(line, sizeof(line), _file)) {
// strip trailing linefeed
char *end = strlen(line) + line;
if (end > line && *(end - 1) == '\n') {
*(end - 1) = 0;
--end;
}
std::vector<std::string> *row = new std::vector<std::string>;
char *scan = line;
while (scan < end) {
char *zero = scan;
while (zero < end && *zero != '\001') zero++;
*zero = 0;
row->push_back(std::string(scan));
scan = zero + 1;
}
return row;
} else
return 0;
}

50
api/c++/Livestatus.h Normal file
View File

@@ -0,0 +1,50 @@
// +------------------------------------------------------------------+
// | ____ _ _ __ __ _ __ |
// | / ___| |__ ___ ___| | __ | \/ | |/ / |
// | | | | '_ \ / _ \/ __| |/ / | |\/| | ' / |
// | | |___| | | | __/ (__| < | | | | . \ |
// | \____|_| |_|\___|\___|_|\_\___|_| |_|_|\_\ |
// | |
// | Copyright Mathias Kettner 2014 mk@mathias-kettner.de |
// +------------------------------------------------------------------+
//
// This file is part of Check_MK.
// The official homepage is at http://mathias-kettner.de/check_mk.
//
// check_mk is free software; you can redistribute it and/or modify it
// under the terms of the GNU General Public License as published by
// the Free Software Foundation in version 2. check_mk is distributed
// in the hope that it will be useful, but WITHOUT ANY WARRANTY; with-
// out even the implied warranty of MERCHANTABILITY or FITNESS FOR A
// PARTICULAR PURPOSE. See the GNU General Public License for more de-
// ails. You should have received a copy of the GNU General Public
// License along with GNU Make; see the file COPYING. If not, write
// to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
// Boston, MA 02110-1301 USA.
#ifndef Livestatus_h
#define Livestatus_h
#include <stdio.h>
#include <string>
#include <vector>
// simple C++ API for accessing Livestatus from C++,
// currently supports only UNIX sockets, no TCP. But
// this is only a simple enhancement.
class Livestatus {
int _connection;
FILE *_file;
public:
Livestatus() : _connection(-1), _file(0){};
~Livestatus();
void connectUNIX(const char *socketpath);
bool isConnected() const { return _connection >= 0; };
void disconnect();
void sendQuery(const char *query);
std::vector<std::string> *nextRow();
};
#endif // Livestatus_h

42
api/c++/Makefile Normal file
View File

@@ -0,0 +1,42 @@
# +------------------------------------------------------------------+
# | ____ _ _ __ __ _ __ |
# | / ___| |__ ___ ___| | __ | \/ | |/ / |
# | | | | '_ \ / _ \/ __| |/ / | |\/| | ' / |
# | | |___| | | | __/ (__| < | | | | . \ |
# | \____|_| |_|\___|\___|_|\_\___|_| |_|_|\_\ |
# | |
# | Copyright Mathias Kettner 2014 mk@mathias-kettner.de |
# +------------------------------------------------------------------+
#
# This file is part of Check_MK.
# The official homepage is at http://mathias-kettner.de/check_mk.
#
# check_mk is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation in version 2. check_mk is distributed
# in the hope that it will be useful, but WITHOUT ANY WARRANTY; with-
# out even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE. See the GNU General Public License for more de-
# tails. You should have received a copy of the GNU General Public
# License along with GNU Make; see the file COPYING. If not, write
# to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
# Boston, MA 02110-1301 USA.
ifneq (DEBUG,)
CXXFLAGS += -g -DDEBUG
LDFLAGS += -g
endif
all: demo
demo.o: demo.cc Livestatus.h
$(CXX) $(CXXFLAGS) -c -o $@ $<
Livestatus.o: Livestatus.cc Livestatus.h
$(CXX) $(CXXFLAGS) -c -o $@ $<
demo: demo.o Livestatus.o
$(CXX) $(CXXFLAGS) $(LDFLAGS) -o $@ $^
clean:
$(RM) demo.o demo Livetatus.o

54
api/c++/demo.cc Normal file
View File

@@ -0,0 +1,54 @@
// +------------------------------------------------------------------+
// | ____ _ _ __ __ _ __ |
// | / ___| |__ ___ ___| | __ | \/ | |/ / |
// | | | | '_ \ / _ \/ __| |/ / | |\/| | ' / |
// | | |___| | | | __/ (__| < | | | | . \ |
// | \____|_| |_|\___|\___|_|\_\___|_| |_|_|\_\ |
// | |
// | Copyright Mathias Kettner 2014 mk@mathias-kettner.de |
// +------------------------------------------------------------------+
//
// This file is part of Check_MK.
// The official homepage is at http://mathias-kettner.de/check_mk.
//
// check_mk is free software; you can redistribute it and/or modify it
// under the terms of the GNU General Public License as published by
// the Free Software Foundation in version 2. check_mk is distributed
// in the hope that it will be useful, but WITHOUT ANY WARRANTY; with-
// out even the implied warranty of MERCHANTABILITY or FITNESS FOR A
// PARTICULAR PURPOSE. See the GNU General Public License for more de-
// ails. You should have received a copy of the GNU General Public
// License along with GNU Make; see the file COPYING. If not, write
// to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
// Boston, MA 02110-1301 USA.
#include <stdio.h>
#include "Livestatus.h"
const char *query =
"GET status\nColumns: livestatus_version program_version\nColumnHeaders: on\n";
int main(int argc, char **argv) {
if (argc != 2) {
fprintf(stderr, "Usage: %s SOCKETPATH\n", argv[0]);
return 1;
}
const char *socket_path = argv[1];
Livestatus live;
live.connectUNIX(socket_path);
if (live.isConnected()) {
fprintf(stderr, "Couldn't connect to socket '%s'\n", socket_path);
return 1;
}
live.sendQuery(query);
std::vector<std::string> *row;
while (0 != (row = live.nextRow())) {
printf("Line:\n");
for (size_t i = 0; i < row->size(); i++)
printf("%s\n", (*row)[i].c_str());
delete row;
}
live.disconnect();
return 0;
}

164
api/perl/Changes Normal file
View File

@@ -0,0 +1,164 @@
Revision history for Perl extension Monitoring::Livestatus.
0.74 Fri Apr 22 00:16:37 CEST 2011
- fixed problem with bulk commands
0.72 Tue Apr 19 15:38:34 CEST 2011
- fixed problem with inet timeout
0.70 Sat Apr 16 16:43:57 CEST 2011
- fixed tests using english
0.68 Wed Mar 23 23:16:22 CET 2011
- fixed typo
0.66 Tue Mar 22 23:19:23 CET 2011
- added support for additonal headers
0.64 Fri Nov 5 11:02:51 CET 2010
- removed useless test dependecies
0.62 Wed Nov 3 15:20:02 CET 2010
- fixed tests with threads > 1.79
0.60 Wed Aug 25 15:04:22 CEST 2010
- fixed package and made author tests optional
0.58 Wed Aug 11 09:30:30 CEST 2010
- added callback support
0.56 Tue Aug 10 09:45:28 CEST 2010
- changed parser from csv to JSON::XS
0.54 Wed Jun 23 16:43:11 CEST 2010
- fixed utf8 support
0.52 Mon May 17 15:54:42 CEST 2010
- fixed connection timeout
0.50 Mon May 17 12:29:20 CEST 2010
- fixed test requirements
0.48 Sun May 16 15:16:12 CEST 2010
- added retry option for better core restart handling
- added new columns from livestatus 1.1.4
0.46 Tue Mar 16 15:19:08 CET 2010
- error code have been changed in livestatus (1.1.3)
- fixed threads support
0.44 Sun Feb 28 12:19:56 CET 2010
- fixed bug when disabling backends and using threads
0.42 Thu Feb 25 21:32:37 CET 2010
- added possibility to disable specific backends
0.41 Sat Feb 20 20:37:36 CET 2010
- fixed tests on windows
0.40 Thu Feb 11 01:00:20 CET 2010
- fixed timeout for inet sockets
0.38 Fri Jan 29 20:54:50 CET 2010
- added limit option
0.37 Thu Jan 28 21:23:19 CET 2010
- removed inc from repository
0.36 Sun Jan 24 00:14:13 CET 2010
- added more backend tests
- fixed problem with summing up non numbers
0.35 Mon Jan 11 15:37:51 CET 2010
- added TCP_NODELAY option for inet sockets
- fixed undefined values
0.34 Sun Jan 10 12:29:57 CET 2010
- fixed return code with multi backend and different errors
0.32 Sat Jan 9 16:12:48 CET 2010
- added deepcopy option
0.31 Thu Jan 7 08:56:48 CET 2010
- added generic tests for livestatus backend
- fixed problem when selecting specific backend
0.30 Wed Jan 6 16:05:33 CET 2010
- renamed project to Monitoring::Livestatus
0.29 Mon Dec 28 00:11:53 CET 2009
- retain order of backends when merge outut
- renamed select_scalar_value to selectscalar_value
- fixed sums for selectscalar_value
- fixed missing META.yml
0.28 Sat Dec 19 19:19:13 CET 2009
- fixed bug in column alias
- added support for multiple peers
- changed to Module::Install
0.26 Fri Dec 4 08:25:07 CET 2009
- added peer name
- added peer arg (can be socket or server)
0.24 Wed Dec 2 23:41:34 CET 2009
- added support for StatsAnd: and StatsOr: queries
- table alias support for selectall_hashref and selectrow_hashref
- added support for Stats: ... as alias
- added support for StatsAnd:... as alias
- added support for StatsOr: ... as alias
- added support for StatsGroupBy: (with alias)
- added support column aliases for Column: header
0.22 Fri Nov 27 01:04:16 CET 2009
- fixed errors on socket problems
- fixed sending commands
0.20 Sun Nov 22 12:41:39 CET 2009
- added keepalive support
- added support for ResponseHeader: fixed16
- added error handling
- added pod test
- added tests with real socket / server
- added column aliases
- added timeout option
- implemented select_scalar_value()
- fixed perl::critic tests
0.18 Sat Nov 14 2009 08:58:02 GMT
- fixed requirements
- fixed typos
0.17 Fri Nov 13 17:15:44 CET 2009
- added support for tcp connections
0.16 Sun Nov 8 23:17:35 CET 2009
- added support for stats querys
0.15 Sat Nov 7 21:28:33 CET 2009
- fixed typos in doc
- minor bugfixes
0.14 Fri Nov 6 09:39:56 CET 2009
- implemented selectcol_arrayref
- implemented selectrow_array
- implemented selectrow_hashref
0.13 Fri Nov 6 00:03:38 CET 2009
- fixed tests on solaris
- implemented selectall_hashref()
0.12 Thu Nov 5 09:34:59 CET 2009
- fixed tests with thread support
- added more tests
0.11 Wed Nov 4 23:12:16 2009
- inital working version
0.10 Tue Nov 3 17:13:16 2009
- renamed to Nagios::MKLivestatus
0.01 Tue Nov 3 00:07:46 2009
- original version; created by h2xs 1.23 with options
-A -X -n Nagios::Livestatus

38
api/perl/MANIFEST Normal file
View File

@@ -0,0 +1,38 @@
Changes
examples/dump.pl
examples/test.pl
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/MULTI.pm
lib/Monitoring/Livestatus/UNIX.pm
Makefile.PL
MANIFEST This list of files
META.yml
README
t/01-Monitoring-Livestatus-basic_tests.t
t/02-Monitoring-Livestatus-internals.t
t/03-Monitoring-Livestatus-MULTI-internals.t
t/20-Monitoring-Livestatus-test_socket.t
t/21-Monitoring-Livestatus-INET.t
t/22-Monitoring-Livestatus-UNIX.t
t/30-Monitoring-Livestatus-live-test.t
t/31-Monitoring-Livestatus-MULTI-live-test.t
t/32-Monitoring-Livestatus-backend-test.t
t/33-Monitoring-Livestatus-test_socket_timeout.t
t/34-Monitoring-Livestatus-utf8_support.t
t/35-Monitoring-Livestatus-callbacks_support.t
t/97-Pod.t
t/98-Pod-Coverage.t
t/99-Perl-Critic.t
t/perlcriticrc

37
api/perl/META.yml Normal file
View File

@@ -0,0 +1,37 @@
---
abstract: 'Perl API for check_mk livestatus to access runtime'
author:
- 'Sven Nierlein, <nierlein@cpan.org>'
build_requires:
ExtUtils::MakeMaker: 6.42
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
generated_by: 'Module::Install version 1.00'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: Monitoring-Livestatus
no_index:
directory:
- examples
- inc
- t
requires:
Digest::MD5: 0
Encode: 0
IO::Socket::INET: 0
IO::Socket::UNIX: 0
JSON::XS: 0
Scalar::Util: 0
Test::More: 0.87
Thread::Queue: 2.11
perl: 5.6.0
utf8: 0
resources:
bugtracker: http://github.com/sni/Monitoring-Livestatus/issues
homepage: http://search.cpan.org/dist/Monitoring-Livestatus/
license: http://dev.perl.org/licenses/
repository: http://github.com/sni/Monitoring-Livestatus
version: 0.74

41
api/perl/Makefile.PL Normal file
View File

@@ -0,0 +1,41 @@
# IMPORTANT: if you delete this file your app will not work as
# expected. you have been warned
use inc::Module::Install;
name 'Monitoring-Livestatus';
all_from 'lib/Monitoring/Livestatus.pm';
perl_version '5.006';
license 'perl';
resources(
'homepage', => 'http://search.cpan.org/dist/Monitoring-Livestatus/',
'bugtracker' => 'http://github.com/sni/Monitoring-Livestatus/issues',
'repository', => 'http://github.com/sni/Monitoring-Livestatus',
);
requires 'IO::Socket::UNIX';
requires 'IO::Socket::INET';
requires 'Digest::MD5';
requires 'Scalar::Util';
requires 'Test::More' => '0.87';
requires 'Thread::Queue' => '2.11';
requires 'utf8';
requires 'Encode';
requires 'JSON::XS';
# test requirements
# these requirements still make it into the META.yml, so they are commented so far
#feature ('authortests',
# -default => 0,
# 'File::Copy::Recursive' => 0,
# 'Test::Pod' => 1.14,
# 'Test::Perl::Critic' => 0,
# 'Test::Pod::Coverage' => 0,
# 'Perl::Critic::Policy::Dynamic::NoIndirect' => 0,
# 'Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs' => 0,
# 'Perl::Critic::Policy::ValuesAndExpressions::ProhibitAccessOfPrivateData' => 0,
#);
auto_install;
WriteAll;

32
api/perl/README Normal file
View File

@@ -0,0 +1,32 @@
Monitoring-Livestatus
=====================
Monitoring::Livestatus can be used to access the data of the check_mk
Livestatus Addon for Nagios and Icinga.
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
make install
DEPENDENCIES
This module requires no other modules.
SYNOPSIS
my $ml = Monitoring::Livestatus->new( socket => '/var/lib/livestatus/livestatus.sock' );
my $hosts = $ml->selectall_arrayref("GET hosts");
AUTHOR
Sven Nierlein <nierlein@cpan.org>
COPYRIGHT AND LICENCE
Copyright (C) 2009 by Sven Nierlein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

104
api/perl/examples/dump.pl Executable file
View File

@@ -0,0 +1,104 @@
#!/usr/bin/env perl
=head1 NAME
dump.pl - print some information from a socket
=head1 SYNOPSIS
./dump.pl [ -h ] [ -v ] <socket|server>
=head1 DESCRIPTION
this script print some information from a given livestatus socket or server
=head1 ARGUMENTS
script has the following arguments
=over 4
=item help
-h
print help and exit
=item verbose
-v
verbose output
=item socket/server
server local socket file or
server remote address of livestatus
=back
=head1 EXAMPLE
./dump.pl /tmp/live.sock
=head1 AUTHOR
2009, Sven Nierlein, <nierlein@cpan.org>
=cut
use warnings;
use strict;
use Data::Dumper;
use Getopt::Long;
use Pod::Usage;
use lib 'lib';
use lib '../lib';
use Monitoring::Livestatus;
$Data::Dumper::Sortkeys = 1;
#########################################################################
# parse and check cmd line arguments
my ($opt_h, $opt_v, $opt_f);
Getopt::Long::Configure('no_ignore_case');
if(!GetOptions (
"h" => \$opt_h,
"v" => \$opt_v,
"<>" => \&add_file,
)) {
pod2usage( { -verbose => 1, -message => 'error in options' } );
exit 3;
}
if(defined $opt_h) {
pod2usage( { -verbose => 1 } );
exit 3;
}
my $verbose = 0;
if(defined $opt_v) {
$verbose = 1;
}
if(!defined $opt_f) {
pod2usage( { -verbose => 1, -message => 'socket/server is a required option' } );
exit 3;
}
#########################################################################
my $nl = Monitoring::Livestatus->new( peer => $opt_f, verbose => $opt_v );
#########################################################################
#my $hosts = $nl->selectall_hashref('GET hosts', 'name');
#print Dumper($hosts);
#########################################################################
my $services = $nl->selectall_arrayref("GET services\nColumns: description host_name state\nLimit: 2", { Slice => {}});
print Dumper($services);
#########################################################################
sub add_file {
my $file = shift;
$opt_f = $file;
}

143
api/perl/examples/test.pl Executable file
View File

@@ -0,0 +1,143 @@
#!/usr/bin/env perl
=head1 NAME
test.pl - print some information from a socket
=head1 SYNOPSIS
./test.pl [ -h ] [ -v ] <socket|server>
=head1 DESCRIPTION
this script print some information from a given livestatus socket or server
=head1 ARGUMENTS
script has the following arguments
=over 4
=item help
-h
print help and exit
=item verbose
-v
verbose output
=item socket/server
server local socket file or
server remote address of livestatus
=back
=head1 EXAMPLE
./test.pl /tmp/live.sock
=head1 AUTHOR
2009, Sven Nierlein, <nierlein@cpan.org>
=cut
use warnings;
use strict;
use Data::Dumper;
use Getopt::Long;
use Pod::Usage;
use Time::HiRes qw( gettimeofday tv_interval );
use Log::Log4perl qw(:easy);
use lib 'lib';
use lib '../lib';
use Monitoring::Livestatus;
$Data::Dumper::Sortkeys = 1;
#########################################################################
# parse and check cmd line arguments
my ($opt_h, $opt_v, @opt_f);
Getopt::Long::Configure('no_ignore_case');
if(!GetOptions (
"h" => \$opt_h,
"v" => \$opt_v,
"<>" => \&add_file,
)) {
pod2usage( { -verbose => 1, -message => 'error in options' } );
exit 3;
}
if(defined $opt_h) {
pod2usage( { -verbose => 1 } );
exit 3;
}
my $verbose = 0;
if(defined $opt_v) {
$verbose = 1;
}
if(scalar @opt_f == 0) {
pod2usage( { -verbose => 1, -message => 'socket/server is a required option' } );
exit 3;
}
#########################################################################
Log::Log4perl->easy_init($DEBUG);
my $nl = Monitoring::Livestatus->new(
peer => \@opt_f,
verbose => $opt_v,
timeout => 5,
keepalive => 1,
logger => get_logger(),
);
my $log = get_logger();
#########################################################################
my $querys = [
{ 'query' => "GET hostgroups\nColumns: members\nFilter: name = flap\nFilter: name = down\nOr: 2",
'sub' => "selectall_arrayref",
'opt' => {Slice => 1 }
},
# { 'query' => "GET comments",
# 'sub' => "selectall_arrayref",
# 'opt' => {Slice => 1 }
# },
# { 'query' => "GET downtimes",
# 'sub' => "selectall_arrayref",
# 'opt' => {Slice => 1, Sum => 1}
# },
# { 'query' => "GET log\nFilter: time > ".(time() - 600)."\nLimit: 1",
# 'sub' => "selectall_arrayref",
# 'opt' => {Slice => 1, AddPeer => 1}
# },
# { 'query' => "GET services\nFilter: contacts >= test\nFilter: host_contacts >= test\nOr: 2\nColumns: host_name description contacts host_contacts",
# 'sub' => "selectall_arrayref",
# 'opt' => {Slice => 1, AddPeer => 0}
# },
# { 'query' => "GET services\nFilter: host_name = test_host_00\nFilter: description = test_flap_02\nOr: 2\nColumns: host_name description contacts host_contacts",
# 'sub' => "selectall_arrayref",
# 'opt' => {Slice => 1, AddPeer => 0}
# },
];
for my $query (@{$querys}) {
my $sub = $query->{'sub'};
my $t0 = [gettimeofday];
my $stats = $nl->$sub($query->{'query'}, $query->{'opt'});
my $elapsed = tv_interval($t0);
print Dumper($stats);
print "Query took ".($elapsed)." seconds\n";
}
#########################################################################
sub add_file {
my $file = shift;
push @opt_f, $file;
}

820
api/perl/inc/Module/AutoInstall.pm Normal file
View File

@@ -0,0 +1,820 @@
#line 1
package Module::AutoInstall;
use strict;
use Cwd ();
use ExtUtils::MakeMaker ();
use vars qw{$VERSION};
BEGIN {
$VERSION = '1.03';
}
# special map on pre-defined feature sets
my %FeatureMap = (
'' => 'Core Features', # XXX: deprecated
'-core' => 'Core Features',
);
# various lexical flags
my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
my (
$Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps
);
my ( $PostambleActions, $PostambleUsed );
# See if it's a testing or non-interactive session
_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
_init();
sub _accept_default {
$AcceptDefault = shift;
}
sub missing_modules {
return @Missing;
}
sub do_install {
__PACKAGE__->install(
[
$Config
? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
: ()
],
@Missing,
);
}
# initialize various flags, and/or perform install
sub _init {
foreach my $arg (
@ARGV,
split(
/[\s\t]+/,
$ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''
)
)
{
if ( $arg =~ /^--config=(.*)$/ ) {
$Config = [ split( ',', $1 ) ];
}
elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
__PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
exit 0;
}
elsif ( $arg =~ /^--default(?:deps)?$/ ) {
$AcceptDefault = 1;
}
elsif ( $arg =~ /^--check(?:deps)?$/ ) {
$CheckOnly = 1;
}
elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
$SkipInstall = 1;
}
elsif ( $arg =~ /^--test(?:only)?$/ ) {
$TestOnly = 1;
}
elsif ( $arg =~ /^--all(?:deps)?$/ ) {
$AllDeps = 1;
}
}
}
# overrides MakeMaker's prompt() to automatically accept the default choice
sub _prompt {
goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
my ( $prompt, $default ) = @_;
my $y = ( $default =~ /^[Yy]/ );
print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
print "$default\n";
return $default;
}
# the workhorse
sub import {
my $class = shift;
my @args = @_ or return;
my $core_all;
print "*** $class version " . $class->VERSION . "\n";
print "*** Checking for Perl dependencies...\n";
my $cwd = Cwd::cwd();
$Config = [];
my $maxlen = length(
(
sort { length($b) <=> length($a) }
grep { /^[^\-]/ }
map {
ref($_)
? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
: ''
}
map { +{@args}->{$_} }
grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
)[0]
);
# We want to know if we're under CPAN early to avoid prompting, but
# if we aren't going to try and install anything anyway then skip the
# check entirely since we don't want to have to load (and configure)
# an old CPAN just for a cosmetic message
$UnderCPAN = _check_lock(1) unless $SkipInstall;
while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
my ( @required, @tests, @skiptests );
my $default = 1;
my $conflict = 0;
if ( $feature =~ m/^-(\w+)$/ ) {
my $option = lc($1);
# check for a newer version of myself
_update_to( $modules, @_ ) and return if $option eq 'version';
# sets CPAN configuration options
$Config = $modules if $option eq 'config';
# promote every features to core status
$core_all = ( $modules =~ /^all$/i ) and next
if $option eq 'core';
next unless $option eq 'core';
}
print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n";
$modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
unshift @$modules, -default => &{ shift(@$modules) }
if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability
while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
if ( $mod =~ m/^-(\w+)$/ ) {
my $option = lc($1);
$default = $arg if ( $option eq 'default' );
$conflict = $arg if ( $option eq 'conflict' );
@tests = @{$arg} if ( $option eq 'tests' );
@skiptests = @{$arg} if ( $option eq 'skiptests' );
next;
}
printf( "- %-${maxlen}s ...", $mod );
if ( $arg and $arg =~ /^\D/ ) {
unshift @$modules, $arg;
$arg = 0;
}
# XXX: check for conflicts and uninstalls(!) them.
my $cur = _load($mod);
if (_version_cmp ($cur, $arg) >= 0)
{
print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
push @Existing, $mod => $arg;
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
if (not defined $cur) # indeed missing
{
print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
}
else
{
# no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
print "too old. ($cur < $arg)\n";
}
push @required, $mod => $arg;
}
}
next unless @required;
my $mandatory = ( $feature eq '-core' or $core_all );
if (
!$SkipInstall
and (
$CheckOnly
or ($mandatory and $UnderCPAN)
or $AllDeps
or _prompt(
qq{==> Auto-install the }
. ( @required / 2 )
. ( $mandatory ? ' mandatory' : ' optional' )
. qq{ module(s) from CPAN?},
$default ? 'y' : 'n',
) =~ /^[Yy]/
)
)
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
elsif ( !$SkipInstall
and $default
and $mandatory
and
_prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
=~ /^[Nn]/ )
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
$DisabledTests{$_} = 1 for map { glob($_) } @tests;
}
}
if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
require Config;
print
"*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n";
# make an educated guess of whether we'll need root permission.
print " (You may need to do that as the 'root' user.)\n"
if eval '$>';
}
print "*** $class configuration finished.\n";
chdir $cwd;
# import to main::
no strict 'refs';
*{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
return (@Existing, @Missing);
}
sub _running_under {
my $thing = shift;
print <<"END_MESSAGE";
*** Since we're running under ${thing}, I'll just let it take care
of the dependency's installation later.
END_MESSAGE
return 1;
}
# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
# if we are, then we simply let it taking care of our dependencies
sub _check_lock {
return unless @Missing or @_;
my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
}
require CPAN;
if ($CPAN::VERSION > '1.89') {
if ($cpan_env) {
return _running_under('CPAN');
}
return; # CPAN.pm new enough, don't need to check further
}
# last ditch attempt, this -will- configure CPAN, very sorry
_load_cpan(1); # force initialize even though it's already loaded
# Find the CPAN lock-file
my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
return unless -f $lock;
# Check the lock
local *LOCK;
return unless open(LOCK, $lock);
if (
( $^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid() )
and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore'
) {
print <<'END_MESSAGE';
*** Since we're running under CPAN, I'll just let it take care
of the dependency's installation later.
END_MESSAGE
return 1;
}
close LOCK;
return;
}
sub install {
my $class = shift;
my $i; # used below to strip leading '-' from config keys
my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
my ( @modules, @installed );
while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
# grep out those already installed
if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
push @installed, $pkg;
}
else {
push @modules, $pkg, $ver;
}
}
return @installed unless @modules; # nothing to do
return @installed if _check_lock(); # defer to the CPAN shell
print "*** Installing dependencies...\n";
return unless _connected_to('cpan.org');
my %args = @config;
my %failed;
local *FAILED;
if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
while (<FAILED>) { chomp; $failed{$_}++ }
close FAILED;
my @newmod;
while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
push @newmod, ( $k => $v ) unless $failed{$k};
}
@modules = @newmod;
}
if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) {
_install_cpanplus( \@modules, \@config );
} else {
_install_cpan( \@modules, \@config );
}
print "*** $class installation finished.\n";
# see if we have successfully installed them
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
push @installed, $pkg;
}
elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
print FAILED "$pkg\n";
}
}
close FAILED if $args{do_once};
return @installed;
}
sub _install_cpanplus {
my @modules = @{ +shift };
my @config = _cpanplus_config( @{ +shift } );
my $installed = 0;
require CPANPLUS::Backend;
my $cp = CPANPLUS::Backend->new;
my $conf = $cp->configure_object;
return unless $conf->can('conf') # 0.05x+ with "sudo" support
or _can_write($conf->_get_build('base')); # 0.04x
# if we're root, set UNINST=1 to avoid trouble unless user asked for it.
my $makeflags = $conf->get_conf('makeflags') || '';
if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
# 0.03+ uses a hashref here
$makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
} else {
# 0.02 and below uses a scalar
$makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
}
$conf->set_conf( makeflags => $makeflags );
$conf->set_conf( prereqs => 1 );
while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
$conf->set_conf( $key, $val );
}
my $modtree = $cp->module_tree;
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
print "*** Installing $pkg...\n";
MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
my $success;
my $obj = $modtree->{$pkg};
if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
my $pathname = $pkg;
$pathname =~ s/::/\\W/;
foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
delete $INC{$inc};
}
my $rv = $cp->install( modules => [ $obj->{module} ] );
if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
print "*** $pkg successfully installed.\n";
$success = 1;
} else {
print "*** $pkg installation cancelled.\n";
$success = 0;
}
$installed += $success;
} else {
print << ".";
*** Could not find a version $ver or above for $pkg; skipping.
.
}
MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
}
return $installed;
}
sub _cpanplus_config {
my @config = ();
while ( @_ ) {
my ($key, $value) = (shift(), shift());
if ( $key eq 'prerequisites_policy' ) {
if ( $value eq 'follow' ) {
$value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
} elsif ( $value eq 'ask' ) {
$value = CPANPLUS::Internals::Constants::PREREQ_ASK();
} elsif ( $value eq 'ignore' ) {
$value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
} else {
die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
}
} else {
die "*** Cannot convert option $key to CPANPLUS version.\n";
}
}
return @config;
}
sub _install_cpan {
my @modules = @{ +shift };
my @config = @{ +shift };
my $installed = 0;
my %args;
_load_cpan();
require Config;
if (CPAN->VERSION < 1.80) {
# no "sudo" support, probe for writableness
return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
and _can_write( $Config::Config{sitelib} );
}
# if we're root, set UNINST=1 to avoid trouble unless user asked for it.
my $makeflags = $CPAN::Config->{make_install_arg} || '';
$CPAN::Config->{make_install_arg} =
join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
# don't show start-up info
$CPAN::Config->{inhibit_startup_message} = 1;
# set additional options
while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
( $args{$opt} = $arg, next )
if $opt =~ /^force$/; # pseudo-option
$CPAN::Config->{$opt} = $arg;
}
local $CPAN::Config->{prerequisites_policy} = 'follow';
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
print "*** Installing $pkg...\n";
my $obj = CPAN::Shell->expand( Module => $pkg );
my $success = 0;
if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
my $pathname = $pkg;
$pathname =~ s/::/\\W/;
foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
delete $INC{$inc};
}
my $rv = $args{force} ? CPAN::Shell->force( install => $pkg )
: CPAN::Shell->install($pkg);
$rv ||= eval {
$CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
->{install}
if $CPAN::META;
};
if ( $rv eq 'YES' ) {
print "*** $pkg successfully installed.\n";
$success = 1;
}
else {
print "*** $pkg installation failed.\n";
$success = 0;
}
$installed += $success;
}
else {
print << ".";
*** Could not find a version $ver or above for $pkg; skipping.
.
}
MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
}
return $installed;
}
sub _has_cpanplus {
return (
$HasCPANPLUS = (
$INC{'CPANPLUS/Config.pm'}
or _load('CPANPLUS::Shell::Default')
)
);
}
# make guesses on whether we're under the CPAN installation directory
sub _under_cpan {
require Cwd;
require File::Spec;
my $cwd = File::Spec->canonpath( Cwd::cwd() );
my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
return ( index( $cwd, $cpan ) > -1 );
}
sub _update_to {
my $class = __PACKAGE__;
my $ver = shift;
return
if _version_cmp( _load($class), $ver ) >= 0; # no need to upgrade
if (
_prompt( "==> A newer version of $class ($ver) is required. Install?",
'y' ) =~ /^[Nn]/
)
{
die "*** Please install $class $ver manually.\n";
}
print << ".";
*** Trying to fetch it from CPAN...
.
# install ourselves
_load($class) and return $class->import(@_)
if $class->install( [], $class, $ver );
print << '.'; exit 1;
*** Cannot bootstrap myself. :-( Installation terminated.
.
}
# check if we're connected to some host, using inet_aton
sub _connected_to {
my $site = shift;
return (
( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
qq(
*** Your host cannot resolve the domain name '$site', which
probably means the Internet connections are unavailable.
==> Should we try to install the required module(s) anyway?), 'n'
) =~ /^[Yy]/
);
}
# check if a directory is writable; may create it on demand
sub _can_write {
my $path = shift;
mkdir( $path, 0755 ) unless -e $path;
return 1 if -w $path;
print << ".";
*** You are not allowed to write to the directory '$path';
the installation may fail due to insufficient permissions.
.
if (
eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
qq(
==> Should we try to re-execute the autoinstall process with 'sudo'?),
((-t STDIN) ? 'y' : 'n')
) =~ /^[Yy]/
)
{
# try to bootstrap ourselves from sudo
print << ".";
*** Trying to re-execute the autoinstall process with 'sudo'...
.
my $missing = join( ',', @Missing );
my $config = join( ',',
UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
if $Config;
return
unless system( 'sudo', $^X, $0, "--config=$config",
"--installdeps=$missing" );
print << ".";
*** The 'sudo' command exited with error! Resuming...
.
}
return _prompt(
qq(
==> Should we try to install the required module(s) anyway?), 'n'
) =~ /^[Yy]/;
}
# load a module and return the version it reports
sub _load {
my $mod = pop; # class/instance doesn't matter
my $file = $mod;
$file =~ s|::|/|g;
$file .= '.pm';
local $@;
return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
}
# Load CPAN.pm and it's configuration
sub _load_cpan {
return if $CPAN::VERSION and $CPAN::Config and not @_;
require CPAN;
# CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to
# CPAN::HandleConfig->load. CPAN reports that the redirection
# is deprecated in a warning printed at the user.
# CPAN-1.81 expects CPAN::HandleConfig->load, does not have
# $CPAN::HandleConfig::VERSION but cannot handle
# CPAN::Config->load
# Which "versions expect CPAN::Config->load?
if ( $CPAN::HandleConfig::VERSION
|| CPAN::HandleConfig->can('load')
) {
# Newer versions of CPAN have a HandleConfig module
CPAN::HandleConfig->load;
} else {
# Older versions had the load method in Config directly
CPAN::Config->load;
}
}
# compare two versions, either use Sort::Versions or plain comparison
# return values same as <=>
sub _version_cmp {
my ( $cur, $min ) = @_;
return -1 unless defined $cur; # if 0 keep comparing
return 1 unless $min;
$cur =~ s/\s+$//;
# check for version numbers that are not in decimal format
if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
if ( ( $version::VERSION or defined( _load('version') )) and
version->can('new')
) {
# use version.pm if it is installed.
return version->new($cur) <=> version->new($min);
}
elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
{
# use Sort::Versions as the sorting algorithm for a.b.c versions
return Sort::Versions::versioncmp( $cur, $min );
}
warn "Cannot reliably compare non-decimal formatted versions.\n"
. "Please install version.pm or Sort::Versions.\n";
}
# plain comparison
local $^W = 0; # shuts off 'not numeric' bugs
return $cur <=> $min;
}
# nothing; this usage is deprecated.
sub main::PREREQ_PM { return {}; }
sub _make_args {
my %args = @_;
$args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
if $UnderCPAN or $TestOnly;
if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
require ExtUtils::Manifest;
my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
$args{EXE_FILES} =
[ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
}
$args{test}{TESTS} ||= 't/*.t';
$args{test}{TESTS} = join( ' ',
grep { !exists( $DisabledTests{$_} ) }
map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
my $missing = join( ',', @Missing );
my $config =
join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
if $Config;
$PostambleActions = (
($missing and not $UnderCPAN)
? "\$(PERL) $0 --config=$config --installdeps=$missing"
: "\$(NOECHO) \$(NOOP)"
);
return %args;
}
# a wrapper to ExtUtils::MakeMaker::WriteMakefile
sub Write {
require Carp;
Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
if ($CheckOnly) {
print << ".";
*** Makefile not written in check-only mode.
.
return;
}
my %args = _make_args(@_);
no strict 'refs';
$PostambleUsed = 0;
local *MY::postamble = \&postamble unless defined &MY::postamble;
ExtUtils::MakeMaker::WriteMakefile(%args);
print << "." unless $PostambleUsed;
*** WARNING: Makefile written with customized MY::postamble() without
including contents from Module::AutoInstall::postamble() --
auto installation features disabled. Please contact the author.
.
return 1;
}
sub postamble {
$PostambleUsed = 1;
return <<"END_MAKE";
config :: installdeps
\t\$(NOECHO) \$(NOOP)
checkdeps ::
\t\$(PERL) $0 --checkdeps
installdeps ::
\t$PostambleActions
END_MAKE
}
1;
__END__
#line 1071

470
api/perl/inc/Module/Install.pm Normal file
View File

@@ -0,0 +1,470 @@
#line 1
package Module::Install;
# For any maintainers:
# The load order for Module::Install is a bit magic.
# It goes something like this...
#
# IF ( host has Module::Install installed, creating author mode ) {
# 1. Makefile.PL calls "use inc::Module::Install"
# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
# 3. The installed version of inc::Module::Install loads
# 4. inc::Module::Install calls "require Module::Install"
# 5. The ./inc/ version of Module::Install loads
# } ELSE {
# 1. Makefile.PL calls "use inc::Module::Install"
# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
# 3. The ./inc/ version of Module::Install loads
# }
use 5.005;
use strict 'vars';
use Cwd ();
use File::Find ();
use File::Path ();
use vars qw{$VERSION $MAIN};
BEGIN {
# All Module::Install core packages now require synchronised versions.
# This will be used to ensure we don't accidentally load old or
# different versions of modules.
# 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.00';
# Storage for the pseudo-singleton
$MAIN = undef;
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
sub import {
my $class = shift;
my $self = $class->new(@_);
my $who = $self->_caller;
#-------------------------------------------------------------
# all of the following checks should be included in import(),
# to allow "eval 'require Module::Install; 1' to test
# installation of Module::Install. (RT #51267)
#-------------------------------------------------------------
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
use inc::${\__PACKAGE__};
not:
use ${\__PACKAGE__};
END_DIE
# This reportedly fixes a rare Win32 UTC file time issue, but
# as this is a non-cross-platform XS module not in the core,
# we shouldn't really depend on it. See RT #24194 for detail.
# (Also, this module only supports Perl 5.6 and above).
eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
# If the script that is loading Module::Install is from the future,
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
if ( -f $0 ) {
my $s = (stat($0))[9];
# If the modification time is only slightly in the future,
# sleep briefly to remove the problem.
my $a = $s - time;
if ( $a > 0 and $a < 5 ) { sleep 5 }
# Too far in the future, throw an error.
my $t = time;
if ( $s > $t ) { die <<"END_DIE" }
Your installer $0 has a modification time in the future ($s > $t).
This is known to create infinite loops in make.
Please correct this, then run $0 again.
END_DIE
}
# Build.PL was formerly supported, but no longer is due to excessive
# difficulty in implementing every single feature twice.
if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
Module::Install no longer supports Build.PL.
It was impossible to maintain duel backends, and has been deprecated.
Please remove all Build.PL files and only use the Makefile.PL installer.
END_DIE
#-------------------------------------------------------------
# To save some more typing in Module::Install installers, every...
# use inc::Module::Install
# ...also acts as an implicit use strict.
$^H |= strict::bits(qw(refs subs vars));
#-------------------------------------------------------------
unless ( -f $self->{file} ) {
foreach my $key (keys %INC) {
delete $INC{$key} if $key =~ /Module\/Install/;
}
local $^W;
require "$self->{path}/$self->{dispatch}.pm";
File::Path::mkpath("$self->{prefix}/$self->{author}");
$self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
$self->{admin}->init;
@_ = ($class, _self => $self);
goto &{"$self->{name}::import"};
}
local $^W;
*{"${who}::AUTOLOAD"} = $self->autoload;
$self->preload;
# Unregister loader and worker packages so subdirs can use them again
delete $INC{'inc/Module/Install.pm'};
delete $INC{'Module/Install.pm'};
# Save to the singleton
$MAIN = $self;
return 1;
}
sub autoload {
my $self = shift;
my $who = $self->_caller;
my $cwd = Cwd::cwd();
my $sym = "${who}::AUTOLOAD";
$sym->{$cwd} = sub {
my $pwd = Cwd::cwd();
if ( my $code = $sym->{$pwd} ) {
# Delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
unless ($$sym =~ s/([^:]+)$//) {
# XXX: it looks like we can't retrieve the missing function
# via $$sym (usually $main::AUTOLOAD) in this case.
# I'm still wondering if we should slurp Makefile.PL to
# get some context or not ...
my ($package, $file, $line) = caller;
die <<"EOT";
Unknown function is found at $file line $line.
Execution of $file aborted due to runtime errors.
If you're a contributor to a project, you may need to install
some Module::Install extensions from CPAN (or other repository).
If you're a user of a module, please contact the author.
EOT
}
my $method = $1;
if ( uc($method) eq $method ) {
# Do nothing
return;
} elsif ( $method =~ /^_/ and $self->can($method) ) {
# Dispatch to the root M:I class
return $self->$method(@_);
}
# Dispatch to the appropriate plugin
unshift @_, ( $self, $1 );
goto &{$self->can('call')};
};
}
sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
);
}
my @exts = @{$self->{extensions}};
unless ( @exts ) {
@exts = $self->{admin}->load_all_extensions;
}
my %seen;
foreach my $obj ( @exts ) {
while (my ($method, $glob) = each %{ref($obj) . '::'}) {
next unless $obj->can($method);
next if $method =~ /^_/;
next if $method eq uc($method);
$seen{$method}++;
}
}
my $who = $self->_caller;
foreach my $name ( sort keys %seen ) {
local $^W;
*{"${who}::$name"} = sub {
${"${who}::AUTOLOAD"} = "${who}::$name";
goto &{"${who}::AUTOLOAD"};
};
}
}
sub new {
my ($class, %args) = @_;
delete $INC{'FindBin.pm'};
{
# to suppress the redefine warning
local $SIG{__WARN__} = sub {};
require FindBin;
}
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
delete $args{prefix};
}
return $args{_self} if $args{_self};
$args{dispatch} ||= 'Admin';
$args{prefix} ||= 'inc';
$args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
$args{bundle} ||= 'inc/BUNDLES';
$args{base} ||= $base_path;
$class =~ s/^\Q$args{prefix}\E:://;
$args{name} ||= $class;
$args{version} ||= $class->VERSION;
unless ( $args{path} ) {
$args{path} = $args{name};
$args{path} =~ s!::!/!g;
}
$args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
$args{wrote} = 0;
bless( \%args, $class );
}
sub call {
my ($self, $method) = @_;
my $obj = $self->load($method) or return;
splice(@_, 0, 2, $obj);
goto &{$obj->can($method)};
}
sub load {
my ($self, $method) = @_;
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
) unless $self->{extensions};
foreach my $obj (@{$self->{extensions}}) {
return $obj if $obj->can($method);
}
my $admin = $self->{admin} or die <<"END_DIE";
The '$method' method does not exist in the '$self->{prefix}' path!
Please remove the '$self->{prefix}' directory and run $0 again to load it.
END_DIE
my $obj = $admin->load($method, 1);
push @{$self->{extensions}}, $obj;
$obj;
}
sub load_extensions {
my ($self, $path, $top) = @_;
my $should_reload = 0;
unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
$should_reload = 1;
}
foreach my $rv ( $self->find_extensions($path) ) {
my ($file, $pkg) = @{$rv};
next if $self->{pathnames}{$pkg};
local $@;
my $new = eval { local $^W; require $file; $pkg->can('new') };
unless ( $new ) {
warn $@ if $@;
next;
}
$self->{pathnames}{$pkg} =
$should_reload ? delete $INC{$file} : $INC{$file};
push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
}
$self->{extensions} ||= [];
}
sub find_extensions {
my ($self, $path) = @_;
my @found;
File::Find::find( sub {
my $file = $File::Find::name;
return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
my $subpath = $1;
return if lc($subpath) eq lc($self->{dispatch});
$file = "$self->{path}/$subpath.pm";
my $pkg = "$self->{name}::$subpath";
$pkg =~ s!/!::!g;
# If we have a mixed-case package name, assume case has been preserved
# correctly. Otherwise, root through the file to locate the case-preserved
# version of the package name.
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
my $content = Module::Install::_read($subpath . '.pm');
my $in_pod = 0;
foreach ( split //, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
next if /^\s*#/; # and comments
if ( m/^\s*package\s+($pkg)\s*;/i ) {
$pkg = $1;
last;
}
}
}
push @found, [ $file, $pkg ];
}, $path ) if -d $path;
@found;
}
#####################################################################
# Common Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
local *FH;
open( FH, '<', $_[0] ) or die "open($_[0]): $!";
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $string;
}
END_NEW
sub _read {
local *FH;
open( FH, "< $_[0]" ) or die "open($_[0]): $!";
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $string;
}
END_OLD
sub _readperl {
my $string = Module::Install::_read($_[0]);
$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
$string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
$string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
return $string;
}
sub _readpod {
my $string = Module::Install::_read($_[0]);
$string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
return $string if $_[0] =~ /\.pod\z/;
$string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
$string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
$string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
$string =~ s/^\n+//s;
return $string;
}
# Done in evals to avoid confusing Perl::MinimumVersion
eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
local *FH;
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
END_NEW
sub _write {
local *FH;
open( FH, "> $_[0]" ) or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
END_OLD
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version ($) {
my $s = shift || 0;
my $d =()= $s =~ /(\.)/g;
if ( $d >= 2 ) {
# Normalise multipart versions
$s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
}
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map {
$_ . '0' x (3 - length $_)
} $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
sub _cmp ($$) {
_version($_[0]) <=> _version($_[1]);
}
# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
(
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 - 2010 Adam Kennedy.

82
api/perl/inc/Module/Install/AutoInstall.pm Normal file
View File

@@ -0,0 +1,82 @@
#line 1
package Module::Install::AutoInstall;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub AutoInstall { $_[0] }
sub run {
my $self = shift;
$self->auto_install_now(@_);
}
sub write {
my $self = shift;
$self->auto_install(@_);
}
sub auto_install {
my $self = shift;
return if $self->{done}++;
# Flatten array of arrays into a single array
my @core = map @$_, map @$_, grep ref,
$self->build_requires, $self->requires;
my @config = @_;
# We'll need Module::AutoInstall
$self->include('Module::AutoInstall');
require Module::AutoInstall;
my @features_require = Module::AutoInstall->import(
(@config ? (-config => \@config) : ()),
(@core ? (-core => \@core) : ()),
$self->features,
);
my %seen;
my @requires = map @$_, map @$_, grep ref, $self->requires;
while (my ($mod, $ver) = splice(@requires, 0, 2)) {
$seen{$mod}{$ver}++;
}
my @build_requires = map @$_, map @$_, grep ref, $self->build_requires;
while (my ($mod, $ver) = splice(@build_requires, 0, 2)) {
$seen{$mod}{$ver}++;
}
my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires;
while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) {
$seen{$mod}{$ver}++;
}
my @deduped;
while (my ($mod, $ver) = splice(@features_require, 0, 2)) {
push @deduped, $mod => $ver unless $seen{$mod}{$ver}++;
}
$self->requires(@deduped);
$self->makemaker_args( Module::AutoInstall::_make_args() );
my $class = ref($self);
$self->postamble(
"# --- $class section:\n" .
Module::AutoInstall::postamble()
);
}
sub auto_install_now {
my $self = shift;
$self->auto_install(@_);
Module::AutoInstall::do_install();
}
1;

83
api/perl/inc/Module/Install/Base.pm Normal file
View File

@@ -0,0 +1,83 @@
#line 1
package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
$VERSION = '1.00';
}
# Suspend handler for "redefined" warnings
BEGIN {
my $w = $SIG{__WARN__};
$SIG{__WARN__} = sub { $w };
}
#line 42
sub new {
my $class = shift;
unless ( defined &{"${class}::call"} ) {
*{"${class}::call"} = sub { shift->_top->call(@_) };
}
unless ( defined &{"${class}::load"} ) {
*{"${class}::load"} = sub { shift->_top->load(@_) };
}
bless { @_ }, $class;
}
#line 61
sub AUTOLOAD {
local $@;
my $func = eval { shift->_top->autoload } or return;
goto &$func;
}
#line 75
sub _top {
$_[0]->{_top};
}
#line 90
sub admin {
$_[0]->_top->{admin}
or
Module::Install::Base::FakeAdmin->new;
}
#line 106
sub is_admin {
! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
}
sub DESTROY {}
package Module::Install::Base::FakeAdmin;
use vars qw{$VERSION};
BEGIN {
$VERSION = $Module::Install::Base::VERSION;
}
my $fake;
sub new {
$fake ||= bless(\@_, $_[0]);
}
sub AUTOLOAD {}
sub DESTROY {}
# Restore warning handler
BEGIN {
$SIG{__WARN__} = $SIG{__WARN__}->();
}
1;
#line 159

81
api/perl/inc/Module/Install/Can.pm Normal file
View File

@@ -0,0 +1,81 @@
#line 1
package Module::Install::Can;
use strict;
use Config ();
use File::Spec ();
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
# check if we can load some module
### Upgrade this to not have to load the module if possible
sub can_use {
my ($self, $mod, $ver) = @_;
$mod =~ s{::|\\}{/}g;
$mod .= '.pm' unless $mod =~ /\.pm$/i;
my $pkg = $mod;
$pkg =~ s{/}{::}g;
$pkg =~ s{\.pm$}{}i;
local $@;
eval { require $mod; $pkg->VERSION($ver || 0); 1 };
}
# check if we can run some command
sub can_run {
my ($self, $cmd) = @_;
my $_cmd = $cmd;
return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
next if $dir eq '';
my $abs = File::Spec->catfile($dir, $_[1]);
return $abs if (-x $abs or $abs = MM->maybe_command($abs));
}
return;
}
# can we locate a (the) C compiler
sub can_cc {
my $self = shift;
my @chunks = split(/ /, $Config::Config{cc}) or return;
# $Config{cc} may contain args; try to find out the program part
while (@chunks) {
return $self->can_run("@chunks") || (pop(@chunks), next);
}
return;
}
# Fix Cygwin bug on maybe_command();
if ( $^O eq 'cygwin' ) {
require ExtUtils::MM_Cygwin;
require ExtUtils::MM_Win32;
if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
*ExtUtils::MM_Cygwin::maybe_command = sub {
my ($self, $file) = @_;
if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
ExtUtils::MM_Win32->maybe_command($file);
} else {
ExtUtils::MM_Unix->maybe_command($file);
}
}
}
}
1;
__END__
#line 156

93
api/perl/inc/Module/Install/Fetch.pm Normal file
View File

@@ -0,0 +1,93 @@
#line 1
package Module::Install::Fetch;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub get_file {
my ($self, %args) = @_;
my ($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
$args{url} = $args{ftp_url}
or (warn("LWP support unavailable!\n"), return);
($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
}
$|++;
print "Fetching '$file' from $host... ";
unless (eval { require Socket; Socket::inet_aton($host) }) {
warn "'$host' resolve failed!\n";
return;
}
return unless $scheme eq 'ftp' or $scheme eq 'http';
require Cwd;
my $dir = Cwd::getcwd();
chdir $args{local_dir} or return if exists $args{local_dir};
if (eval { require LWP::Simple; 1 }) {
LWP::Simple::mirror($args{url}, $file);
}
elsif (eval { require Net::FTP; 1 }) { eval {
# use Net::FTP to get past firewall
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
$ftp->login("anonymous", 'anonymous@example.com');
$ftp->cwd($path);
$ftp->binary;
$ftp->get($file) or (warn("$!\n"), return);
$ftp->quit;
} }
elsif (my $ftp = $self->can_run('ftp')) { eval {
# no Net::FTP, fallback to ftp.exe
require FileHandle;
my $fh = FileHandle->new;
local $SIG{CHLD} = 'IGNORE';
unless ($fh->open("|$ftp -n")) {
warn "Couldn't open ftp: $!\n";
chdir $dir; return;
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
}
unless (-f $file) {
warn "Fetching failed: $@\n";
chdir $dir; return;
}
return if exists $args{size} and -s $file != $args{size};
system($args{run}) if exists $args{run};
unlink($file) if $args{remove};
print(((!exists $args{check_for} or -e $args{check_for})
? "done!" : "failed! ($!)"), "\n");
chdir $dir; return !$?;
}
1;

34
api/perl/inc/Module/Install/Include.pm Normal file
View File

@@ -0,0 +1,34 @@
#line 1
package Module::Install::Include;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub include {
shift()->admin->include(@_);
}
sub include_deps {
shift()->admin->include_deps(@_);
}
sub auto_include {
shift()->admin->auto_include(@_);
}
sub auto_include_deps {
shift()->admin->auto_include_deps(@_);
}
sub auto_include_dependent_dists {
shift()->admin->auto_include_dependent_dists(@_);
}
1;

415
api/perl/inc/Module/Install/Makefile.pm Normal file
View File

@@ -0,0 +1,415 @@
#line 1
package Module::Install::Makefile;
use strict 'vars';
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
sub Makefile { $_[0] }
my %seen = ();
sub prompt {
shift;
# Infinite loop protection
my @c = caller();
if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
}
# In automated testing or non-interactive session, always use defaults
if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
local $ENV{PERL_MM_USE_DEFAULT} = 1;
goto &ExtUtils::MakeMaker::prompt;
} else {
goto &ExtUtils::MakeMaker::prompt;
}
}
# Store a cleaned up version of the MakeMaker version,
# since we need to behave differently in a variety of
# ways based on the MM version.
my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
# If we are passed a param, do a "newer than" comparison.
# Otherwise, just return the MakeMaker version.
sub makemaker {
( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
}
# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
# as we only need to know here whether the attribute is an array
# or a hash or something else (which may or may not be appendable).
my %makemaker_argtype = (
C => 'ARRAY',
CONFIG => 'ARRAY',
# CONFIGURE => 'CODE', # ignore
DIR => 'ARRAY',
DL_FUNCS => 'HASH',
DL_VARS => 'ARRAY',
EXCLUDE_EXT => 'ARRAY',
EXE_FILES => 'ARRAY',
FUNCLIST => 'ARRAY',
H => 'ARRAY',
IMPORTS => 'HASH',
INCLUDE_EXT => 'ARRAY',
LIBS => 'ARRAY', # ignore ''
MAN1PODS => 'HASH',
MAN3PODS => 'HASH',
META_ADD => 'HASH',
META_MERGE => 'HASH',
PL_FILES => 'HASH',
PM => 'HASH',
PMLIBDIRS => 'ARRAY',
PMLIBPARENTDIRS => 'ARRAY',
PREREQ_PM => 'HASH',
CONFIGURE_REQUIRES => 'HASH',
SKIP => 'ARRAY',
TYPEMAPS => 'ARRAY',
XS => 'HASH',
# VERSION => ['version',''], # ignore
# _KEEP_AFTER_FLUSH => '',
clean => 'HASH',
depend => 'HASH',
dist => 'HASH',
dynamic_lib=> 'HASH',
linkext => 'HASH',
macro => 'HASH',
postamble => 'HASH',
realclean => 'HASH',
test => 'HASH',
tool_autosplit => 'HASH',
# special cases where you can use makemaker_append
CCFLAGS => 'APPENDABLE',
DEFINE => 'APPENDABLE',
INC => 'APPENDABLE',
LDDLFLAGS => 'APPENDABLE',
LDFROM => 'APPENDABLE',
);
sub makemaker_args {
my ($self, %new_args) = @_;
my $args = ( $self->{makemaker_args} ||= {} );
foreach my $key (keys %new_args) {
if ($makemaker_argtype{$key}) {
if ($makemaker_argtype{$key} eq 'ARRAY') {
$args->{$key} = [] unless defined $args->{$key};
unless (ref $args->{$key} eq 'ARRAY') {
$args->{$key} = [$args->{$key}]
}
push @{$args->{$key}},
ref $new_args{$key} eq 'ARRAY'
? @{$new_args{$key}}
: $new_args{$key};
}
elsif ($makemaker_argtype{$key} eq 'HASH') {
$args->{$key} = {} unless defined $args->{$key};
foreach my $skey (keys %{ $new_args{$key} }) {
$args->{$key}{$skey} = $new_args{$key}{$skey};
}
}
elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
$self->makemaker_append($key => $new_args{$key});
}
}
else {
if (defined $args->{$key}) {
warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
}
$args->{$key} = $new_args{$key};
}
}
return $args;
}
# For mm args that take multiple space-seperated args,
# append an argument to the current list.
sub makemaker_append {
my $self = shift;
my $name = shift;
my $args = $self->makemaker_args;
$args->{$name} = defined $args->{$name}
? join( ' ', $args->{$name}, @_ )
: join( ' ', @_ );
}
sub build_subdirs {
my $self = shift;
my $subdirs = $self->makemaker_args->{DIR} ||= [];
for my $subdir (@_) {
push @$subdirs, $subdir;
}
}
sub clean_files {
my $self = shift;
my $clean = $self->makemaker_args->{clean} ||= {};
%$clean = (
%$clean,
FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
);
}
sub realclean_files {
my $self = shift;
my $realclean = $self->makemaker_args->{realclean} ||= {};
%$realclean = (
%$realclean,
FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
);
}
sub libs {
my $self = shift;
my $libs = ref $_[0] ? shift : [ shift ];
$self->makemaker_args( LIBS => $libs );
}
sub inc {
my $self = shift;
$self->makemaker_args( INC => shift );
}
sub _wanted_t {
}
sub tests_recursive {
my $self = shift;
my $dir = shift || 't';
unless ( -d $dir ) {
die "tests_recursive dir '$dir' does not exist";
}
my %tests = map { $_ => 1 } split / /, ($self->tests || '');
require File::Find;
File::Find::find(
sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
$dir
);
$self->tests( join ' ', sort keys %tests );
}
sub write {
my $self = shift;
die "&Makefile->write() takes no arguments\n" if @_;
# Check the current Perl version
my $perl_version = $self->perl_version;
if ( $perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
}
# Make sure we have a new enough MakeMaker
require ExtUtils::MakeMaker;
if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
# MakeMaker can complain about module versions that include
# an underscore, even though its own version may contain one!
# Hence the funny regexp to get rid of it. See RT #35800
# for details.
my $v = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/;
$self->build_requires( 'ExtUtils::MakeMaker' => $v );
$self->configure_requires( 'ExtUtils::MakeMaker' => $v );
} else {
# Allow legacy-compatibility with 5.005 by depending on the
# most recent EU:MM that supported 5.005.
$self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
$self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
}
# Generate the MakeMaker params
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name;
$args->{NAME} =~ s/-/::/g;
$args->{VERSION} = $self->version or die <<'EOT';
ERROR: Can't determine distribution version. Please specify it
explicitly via 'version' in Makefile.PL, or set a valid $VERSION
in a module, and provide its file path via 'version_from' (or
'all_from' if you prefer) in Makefile.PL.
EOT
$DB::single = 1;
if ( $self->tests ) {
my @tests = split ' ', $self->tests;
my %seen;
$args->{test} = {
TESTS => (join ' ', grep {!$seen{$_}++} @tests),
};
} elsif ( $Module::Install::ExtraTests::use_extratests ) {
# Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
# So, just ignore our xt tests here.
} elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
$args->{test} = {
TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
};
}
if ( $] >= 5.005 ) {
$args->{ABSTRACT} = $self->abstract;
$args->{AUTHOR} = join ', ', @{$self->author || []};
}
if ( $self->makemaker(6.10) ) {
$args->{NO_META} = 1;
#$args->{NO_MYMETA} = 1;
}
if ( $self->makemaker(6.17) and $self->sign ) {
$args->{SIGN} = 1;
}
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
if ( $self->makemaker(6.31) and $self->license ) {
$args->{LICENSE} = $self->license;
}
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
map { @$_ } # flatten [module => version]
map { @$_ }
grep $_,
($self->requires)
);
# Remove any reference to perl, PREREQ_PM doesn't support it
delete $args->{PREREQ_PM}->{perl};
# Merge both kinds of requires into BUILD_REQUIRES
my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
%$build_prereq = ( %$build_prereq,
map { @$_ } # flatten [module => version]
map { @$_ }
grep $_,
($self->configure_requires, $self->build_requires)
);
# Remove any reference to perl, BUILD_REQUIRES doesn't support it
delete $args->{BUILD_REQUIRES}->{perl};
# Delete bundled dists from prereq_pm, add it to Makefile DIR
my $subdirs = ($args->{DIR} || []);
if ($self->bundles) {
my %processed;
foreach my $bundle (@{ $self->bundles }) {
my ($mod_name, $dist_dir) = @$bundle;
delete $prereq->{$mod_name};
$dist_dir = File::Basename::basename($dist_dir); # dir for building this module
if (not exists $processed{$dist_dir}) {
if (-d $dist_dir) {
# List as sub-directory to be processed by make
push @$subdirs, $dist_dir;
}
# Else do nothing: the module is already present on the system
$processed{$dist_dir} = undef;
}
}
}
unless ( $self->makemaker('6.55_03') ) {
%$prereq = (%$prereq,%$build_prereq);
delete $args->{BUILD_REQUIRES};
}
if ( my $perl_version = $self->perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
if ( $self->makemaker(6.48) ) {
$args->{MIN_PERL_VERSION} = $perl_version;
}
}
if ($self->installdirs) {
warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
$args->{INSTALLDIRS} = $self->installdirs;
}
my %args = map {
( $_ => $args->{$_} ) } grep {defined($args->{$_} )
} keys %$args;
my $user_preop = delete $args{dist}->{PREOP};
if ( my $preop = $self->admin->preop($user_preop) ) {
foreach my $key ( keys %$preop ) {
$args{dist}->{$key} = $preop->{$key};
}
}
my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
$self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
}
sub fix_up_makefile {
my $self = shift;
my $makefile_name = shift;
my $top_class = ref($self->_top) || '';
my $top_version = $self->_top->VERSION || '';
my $preamble = $self->preamble
? "# Preamble by $top_class $top_version\n"
. $self->preamble
: '';
my $postamble = "# Postamble by $top_class $top_version\n"
. ($self->postamble || '');
local *MAKEFILE;
open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
eval { flock MAKEFILE, LOCK_EX };
my $makefile = do { local $/; <MAKEFILE> };
$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
$makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
$makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
$makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
$makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
# Module::Install will never be used to build the Core Perl
# Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
# PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
$makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
#$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
# Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
$makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
# XXX - This is currently unused; not sure if it breaks other MM-users
# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
seek MAKEFILE, 0, SEEK_SET;
truncate MAKEFILE, 0;
print MAKEFILE "$preamble$makefile$postamble" or die $!;
close MAKEFILE or die $!;
1;
}
sub preamble {
my ($self, $text) = @_;
$self->{preamble} = $text . $self->{preamble} if defined $text;
$self->{preamble};
}
sub postamble {
my ($self, $text) = @_;
$self->{postamble} ||= $self->admin->postamble;
$self->{postamble} .= $text if defined $text;
$self->{postamble}
}
1;
__END__
#line 541

715
api/perl/inc/Module/Install/Metadata.pm Normal file
View File

@@ -0,0 +1,715 @@
#line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
my @boolean_keys = qw{
sign
};
my @scalar_keys = qw{
name
module_name
abstract
version
distribution_type
tests
installdirs
};
my @tuple_keys = qw{
configure_requires
build_requires
requires
recommends
bundles
resources
};
my @resource_keys = qw{
homepage
bugtracker
repository
};
my @array_keys = qw{
keywords
author
};
*authors = \&author;
sub Meta { shift }
sub Meta_BooleanKeys { @boolean_keys }
sub Meta_ScalarKeys { @scalar_keys }
sub Meta_TupleKeys { @tuple_keys }
sub Meta_ResourceKeys { @resource_keys }
sub Meta_ArrayKeys { @array_keys }
foreach my $key ( @boolean_keys ) {
*$key = sub {
my $self = shift;
if ( defined wantarray and not @_ ) {
return $self->{values}->{$key};
}
$self->{values}->{$key} = ( @_ ? $_[0] : 1 );
return $self;
};
}
foreach my $key ( @scalar_keys ) {
*$key = sub {
my $self = shift;
return $self->{values}->{$key} if defined wantarray and !@_;
$self->{values}->{$key} = shift;
return $self;
};
}
foreach my $key ( @array_keys ) {
*$key = sub {
my $self = shift;
return $self->{values}->{$key} if defined wantarray and !@_;
$self->{values}->{$key} ||= [];
push @{$self->{values}->{$key}}, @_;
return $self;
};
}
foreach my $key ( @resource_keys ) {
*$key = sub {
my $self = shift;
unless ( @_ ) {
return () unless $self->{values}->{resources};
return map { $_->[1] }
grep { $_->[0] eq $key }
@{ $self->{values}->{resources} };
}
return $self->{values}->{resources}->{$key} unless @_;
my $uri = shift or die(
"Did not provide a value to $key()"
);
$self->resources( $key => $uri );
return 1;
};
}
foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
*$key = sub {
my $self = shift;
return $self->{values}->{$key} unless @_;
my @added;
while ( @_ ) {
my $module = shift or last;
my $version = shift || 0;
push @added, [ $module, $version ];
}
push @{ $self->{values}->{$key} }, @added;
return map {@$_} @added;
};
}
# Resource handling
my %lc_resource = map { $_ => 1 } qw{
homepage
license
bugtracker
repository
};
sub resources {
my $self = shift;
while ( @_ ) {
my $name = shift or last;
my $value = shift or next;
if ( $name eq lc $name and ! $lc_resource{$name} ) {
die("Unsupported reserved lowercase resource '$name'");
}
$self->{values}->{resources} ||= [];
push @{ $self->{values}->{resources} }, [ $name, $value ];
}
$self->{values}->{resources};
}
# Aliases for build_requires that will have alternative
# meanings in some future version of META.yml.
sub test_requires { shift->build_requires(@_) }
sub install_requires { shift->build_requires(@_) }
# Aliases for installdirs options
sub install_as_core { $_[0]->installdirs('perl') }
sub install_as_cpan { $_[0]->installdirs('site') }
sub install_as_site { $_[0]->installdirs('site') }
sub install_as_vendor { $_[0]->installdirs('vendor') }
sub dynamic_config {
my $self = shift;
unless ( @_ ) {
warn "You MUST provide an explicit true/false value to dynamic_config\n";
return $self;
}
$self->{values}->{dynamic_config} = $_[0] ? 1 : 0;
return 1;
}
sub perl_version {
my $self = shift;
return $self->{values}->{perl_version} unless @_;
my $version = shift or die(
"Did not provide a value to perl_version()"
);
# Normalize the version
$version = $self->_perl_version($version);
# We don't support the reall old versions
unless ( $version >= 5.005 ) {
die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
}
$self->{values}->{perl_version} = $version;
}
sub all_from {
my ( $self, $file ) = @_;
unless ( defined($file) ) {
my $name = $self->name or die(
"all_from called with no args without setting name() first"
);
$file = join('/', 'lib', split(/-/, $name)) . '.pm';
$file =~ s{.*/}{} unless -e $file;
unless ( -e $file ) {
die("all_from cannot find $file from $name");
}
}
unless ( -f $file ) {
die("The path '$file' does not exist, or is not a file");
}
$self->{values}{all_from} = $file;
# Some methods pull from POD instead of code.
# If there is a matching .pod, use that instead
my $pod = $file;
$pod =~ s/\.pm$/.pod/i;
$pod = $file unless -e $pod;
# Pull the different values
$self->name_from($file) unless $self->name;
$self->version_from($file) unless $self->version;
$self->perl_version_from($file) unless $self->perl_version;
$self->author_from($pod) unless @{$self->author || []};
$self->license_from($pod) unless $self->license;
$self->abstract_from($pod) unless $self->abstract;
return 1;
}
sub provides {
my $self = shift;
my $provides = ( $self->{values}->{provides} ||= {} );
%$provides = (%$provides, @_) if @_;
return $provides;
}
sub auto_provides {
my $self = shift;
return $self unless $self->is_admin;
unless (-e 'MANIFEST') {
warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
return $self;
}
# Avoid spurious warnings as we are not checking manifest here.
local $SIG{__WARN__} = sub {1};
require ExtUtils::Manifest;
local *ExtUtils::Manifest::manicheck = sub { return };
require Module::Build;
my $build = Module::Build->new(
dist_name => $self->name,
dist_version => $self->version,
license => $self->license,
);
$self->provides( %{ $build->find_dist_packages || {} } );
}
sub feature {
my $self = shift;
my $name = shift;
my $features = ( $self->{values}->{features} ||= [] );
my $mods;
if ( @_ == 1 and ref( $_[0] ) ) {
# The user used ->feature like ->features by passing in the second
# argument as a reference. Accomodate for that.
$mods = $_[0];
} else {
$mods = \@_;
}
my $count = 0;
push @$features, (
$name => [
map {
ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
} @$mods
]
);
return @$features;
}
sub features {
my $self = shift;
while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
$self->feature( $name, @$mods );
}
return $self->{values}->{features}
? @{ $self->{values}->{features} }
: ();
}
sub no_index {
my $self = shift;
my $type = shift;
push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
return $self->{values}->{no_index};
}
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
} else {
$self->can($key)->($self, $value);
}
}
return $self;
}
sub write {
my $self = shift;
return $self unless $self->is_admin;
$self->admin->write_meta;
return $self;
}
sub version_from {
require ExtUtils::MM_Unix;
my ( $self, $file ) = @_;
$self->version( ExtUtils::MM_Unix->parse_version($file) );
# for version integrity check
$self->makemaker_args( VERSION_FROM => $file );
}
sub abstract_from {
require ExtUtils::MM_Unix;
my ( $self, $file ) = @_;
$self->abstract(
bless(
{ DISTNAME => $self->name },
'ExtUtils::MM_Unix'
)->parse_abstract($file)
);
}
# Add both distribution and module name
sub name_from {
my ($self, $file) = @_;
if (
Module::Install::_read($file) =~ m/
^ \s*
package \s*
([\w:]+)
\s* ;
/ixms
) {
my ($name, $module_name) = ($1, $1);
$name =~ s{::}{-}g;
$self->name($name);
unless ( $self->module_name ) {
$self->module_name($module_name);
}
} else {
die("Cannot determine name from $file\n");
}
}
sub _extract_perl_version {
if (
$_[0] =~ m/
^\s*
(?:use|require) \s*
v?
([\d_\.]+)
\s* ;
/ixms
) {
my $perl_version = $1;
$perl_version =~ s{_}{}g;
return $perl_version;
} else {
return;
}
}
sub perl_version_from {
my $self = shift;
my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
if ($perl_version) {
$self->perl_version($perl_version);
} else {
warn "Cannot determine perl version info from $_[0]\n";
return;
}
}
sub author_from {
my $self = shift;
my $content = Module::Install::_read($_[0]);
if ($content =~ m/
=head \d \s+ (?:authors?)\b \s*
([^\n]*)
|
=head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
.*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
([^\n]*)
/ixms) {
my $author = $1 || $2;
# XXX: ugly but should work anyway...
if (eval "require Pod::Escapes; 1") {
# Pod::Escapes has a mapping table.
# It's in core of perl >= 5.9.3, and should be installed
# as one of the Pod::Simple's prereqs, which is a prereq
# of Pod::Text 3.x (see also below).
$author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
{
defined $2
? chr($2)
: defined $Pod::Escapes::Name2character_number{$1}
? chr($Pod::Escapes::Name2character_number{$1})
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
# Pod::Text < 3.0 has yet another mapping table,
# though the table name of 2.x and 1.x are different.
# (1.x is in core of Perl < 5.6, 2.x is in core of
# Perl < 5.9.3)
my $mapping = ($Pod::Text::VERSION < 2)
? \%Pod::Text::HTML_Escapes
: \%Pod::Text::ESCAPES;
$author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
{
defined $2
? chr($2)
: defined $mapping->{$1}
? $mapping->{$1}
: do {
warn "Unknown escape: E<$1>";
"E<$1>";
};
}gex;
}
else {
$author =~ s{E<lt>}{<}g;
$author =~ s{E<gt>}{>}g;
}
$self->author($author);
} else {
warn "Cannot determine author info from $_[0]\n";
}
}
#Stolen from M::B
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',
gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
mit => 'http://opensource.org/licenses/mit-license.php',
mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
open_source => undef,
unrestricted => undef,
restrictive => undef,
unknown => undef,
);
sub license {
my $self = shift;
return $self->{values}->{license} unless @_;
my $license = shift or die(
'Did not provide a value to license()'
);
$license = __extract_license($license) || lc $license;
$self->{values}->{license} = $license;
# Automatically fill in license URLs
if ( $license_urls{$license} ) {
$self->resources( license => $license_urls{$license} );
}
return 1;
}
sub _extract_license {
my $pod = shift;
my $matched;
return __extract_license(
($matched) = $pod =~ m/
(=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
(=head \d.*|=cut.*|)\z
/xms
) || __extract_license(
($matched) = $pod =~ m/
(=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
(=head \d.*|=cut.*|)\z
/xms
);
}
sub __extract_license {
my $license_text = shift or return;
my @phrases = (
'(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
'(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
'Artistic and GPL' => 'perl', 1,
'GNU general public license' => 'gpl', 1,
'GNU public license' => 'gpl', 1,
'GNU lesser general public license' => 'lgpl', 1,
'GNU lesser public license' => 'lgpl', 1,
'GNU library general public license' => 'lgpl', 1,
'GNU library public license' => 'lgpl', 1,
'GNU Free Documentation license' => 'unrestricted', 1,
'GNU Affero General Public License' => 'open_source', 1,
'(?:Free)?BSD license' => 'bsd', 1,
'Artistic license' => 'artistic', 1,
'Apache (?:Software )?license' => 'apache', 1,
'GPL' => 'gpl', 1,
'LGPL' => 'lgpl', 1,
'BSD' => 'bsd', 1,
'Artistic' => 'artistic', 1,
'MIT' => 'mit', 1,
'Mozilla Public License' => 'mozilla', 1,
'Q Public License' => 'open_source', 1,
'OpenSSL License' => 'unrestricted', 1,
'SSLeay License' => 'unrestricted', 1,
'zlib License' => 'open_source', 1,
'proprietary' => 'proprietary', 0,
);
while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
$pattern =~ s#\s+#\\s+#gs;
if ( $license_text =~ /\b$pattern\b/i ) {
return $license;
}
}
return '';
}
sub license_from {
my $self = shift;
if (my $license=_extract_license(Module::Install::_read($_[0]))) {
$self->license($license);
} else {
warn "Cannot determine license info from $_[0]\n";
return 'unknown';
}
}
sub _extract_bugtracker {
my @links = $_[0] =~ m#L<(
\Qhttp://rt.cpan.org/\E[^>]+|
\Qhttp://github.com/\E[\w_]+/[\w_]+/issues|
\Qhttp://code.google.com/p/\E[\w_\-]+/issues/list
)>#gx;
my %links;
@links{@links}=();
@links=keys %links;
return @links;
}
sub bugtracker_from {
my $self = shift;
my $content = Module::Install::_read($_[0]);
my @links = _extract_bugtracker($content);
unless ( @links ) {
warn "Cannot determine bugtracker info from $_[0]\n";
return 0;
}
if ( @links > 1 ) {
warn "Found more than one bugtracker link in $_[0]\n";
return 0;
}
# Set the bugtracker
bugtracker( $links[0] );
return 1;
}
sub requires_from {
my $self = shift;
my $content = Module::Install::_readperl($_[0]);
my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
while ( @requires ) {
my $module = shift @requires;
my $version = shift @requires;
$self->requires( $module => $version );
}
}
sub test_requires_from {
my $self = shift;
my $content = Module::Install::_readperl($_[0]);
my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
while ( @requires ) {
my $module = shift @requires;
my $version = shift @requires;
$self->test_requires( $module => $version );
}
}
# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
# numbers (eg, 5.006001 or 5.008009).
# Also, convert double-part versions (eg, 5.8)
sub _perl_version {
my $v = $_[-1];
$v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
$v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
$v =~ s/(\.\d\d\d)000$/$1/;
$v =~ s/_.+$//;
if ( ref($v) ) {
# Numify
$v = $v + 0;
}
return $v;
}
sub add_metadata {
my $self = shift;
my %hash = @_;
for my $key (keys %hash) {
warn "add_metadata: $key is not prefixed with 'x_'.\n" .
"Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
$self->{values}->{$key} = $hash{$key};
}
}
######################################################################
# MYMETA Support
sub WriteMyMeta {
die "WriteMyMeta has been deprecated";
}
sub write_mymeta_yaml {
my $self = shift;
# We need YAML::Tiny to write the MYMETA.yml file
unless ( eval { require YAML::Tiny; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.yml\n";
YAML::Tiny::DumpFile('MYMETA.yml', $meta);
}
sub write_mymeta_json {
my $self = shift;
# We need JSON to write the MYMETA.json file
unless ( eval { require JSON; 1; } ) {
return 1;
}
# Generate the data
my $meta = $self->_write_mymeta_data or return 1;
# Save as the MYMETA.yml file
print "Writing MYMETA.json\n";
Module::Install::_write(
'MYMETA.json',
JSON->new->pretty(1)->canonical->encode($meta),
);
}
sub _write_mymeta_data {
my $self = shift;
# If there's no existing META.yml there is nothing we can do
return undef unless -f 'META.yml';
# We need Parse::CPAN::Meta to load the file
unless ( eval { require Parse::CPAN::Meta; 1; } ) {
return undef;
}
# Merge the perl version into the dependencies
my $val = $self->Meta->{values};
my $perl = delete $val->{perl_version};
if ( $perl ) {
$val->{requires} ||= [];
my $requires = $val->{requires};
# Canonize to three-dot version after Perl 5.6
if ( $perl >= 5.006 ) {
$perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
}
unshift @$requires, [ perl => $perl ];
}
# Load the advisory META.yml file
my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
my $meta = $yaml[0];
# Overwrite the non-configure dependency hashs
delete $meta->{requires};
delete $meta->{build_requires};
delete $meta->{recommends};
if ( exists $val->{requires} ) {
$meta->{requires} = { map { @$_ } @{ $val->{requires} } };
}
if ( exists $val->{build_requires} ) {
$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
}
return $meta;
}
1;

64
api/perl/inc/Module/Install/Win32.pm Normal file
View File

@@ -0,0 +1,64 @@
#line 1
package Module::Install::Win32;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
# determine if the user needs nmake, and download it if needed
sub check_nmake {
my $self = shift;
$self->load('can_run');
$self->load('get_file');
require Config;
return unless (
$^O eq 'MSWin32' and
$Config::Config{make} and
$Config::Config{make} =~ /^nmake\b/i and
! $self->can_run('nmake')
);
print "The required 'nmake' executable not found, fetching it...\n";
require File::Basename;
my $rv = $self->get_file(
url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
local_dir => File::Basename::dirname($^X),
size => 51928,
run => 'Nmake15.exe /o > nul',
check_for => 'Nmake.exe',
remove => 1,
);
die <<'END_MESSAGE' unless $rv;
-------------------------------------------------------------------------------
Since you are using Microsoft Windows, you will need the 'nmake' utility
before installation. It's available at:
http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
or
ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
Please download the file manually, save it to a directory in %PATH% (e.g.
C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
that directory, and run "Nmake15.exe" from there; that will create the
'nmake.exe' file needed by this module.
You may then resume the installation process described in README.
-------------------------------------------------------------------------------
END_MESSAGE
}
1;

63
api/perl/inc/Module/Install/WriteAll.pm Normal file
View File

@@ -0,0 +1,63 @@
#line 1
package Module::Install::WriteAll;
use strict;
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '1.00';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
sub WriteAll {
my $self = shift;
my %args = (
meta => 1,
sign => 0,
inline => 0,
check_nmake => 1,
@_,
);
$self->sign(1) if $args{sign};
$self->admin->WriteAll(%args) if $self->is_admin;
$self->check_nmake if $args{check_nmake};
unless ( $self->makemaker_args->{PL_FILES} ) {
# XXX: This still may be a bit over-defensive...
unless ($self->makemaker(6.25)) {
$self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
}
}
# Until ExtUtils::MakeMaker support MYMETA.yml, make sure
# we clean it up properly ourself.
$self->realclean_files('MYMETA.yml');
if ( $args{inline} ) {
$self->Inline->write;
} else {
$self->Makefile->write;
}
# The Makefile write process adds a couple of dependencies,
# so write the META.yml files after the Makefile.
if ( $args{meta} ) {
$self->Meta->write;
}
# Experimental support for MYMETA
if ( $ENV{X_MYMETA} ) {
if ( $ENV{X_MYMETA} eq 'JSON' ) {
$self->Meta->write_mymeta_json;
} else {
$self->Meta->write_mymeta_yaml;
}
}
return 1;
}
1;

1564
api/perl/lib/Monitoring/Livestatus.pm Normal file
View File

File diff suppressed because it is too large Load Diff

121
api/perl/lib/Monitoring/Livestatus/INET.pm Normal file
View File

@@ -0,0 +1,121 @@
package Monitoring::Livestatus::INET;
use 5.000000;
use strict;
use warnings;
use IO::Socket::INET;
use Socket qw(IPPROTO_TCP TCP_NODELAY);
use Carp;
use base "Monitoring::Livestatus";
=head1 NAME
Monitoring::Livestatus::INET - connector with tcp sockets
=head1 SYNOPSIS
use Monitoring::Livestatus;
my $nl = Monitoring::Livestatus::INET->new( 'localhost:9999' );
my $hosts = $nl->selectall_arrayref("GET hosts");
=head1 CONSTRUCTOR
=head2 new ( [ARGS] )
Creates an C<Monitoring::Livestatus::INET> object. C<new> takes at least the server.
Arguments are the same as in C<Monitoring::Livestatus>.
If the constructor is only passed a single argument, it is assumed to
be a the C<server> specification. Use either socker OR server.
=cut
sub new {
my $class = shift;
unshift(@_, "peer") if scalar @_ == 1;
my(%options) = @_;
$options{'name'} = $options{'peer'} unless defined $options{'name'};
$options{'backend'} = $class;
my $self = Monitoring::Livestatus->new(%options);
bless $self, $class;
confess('not a scalar') if ref $self->{'peer'} ne '';
return $self;
}
########################################
=head1 METHODS
=cut
sub _open {
my $self = shift;
my $sock;
eval {
local $SIG{'ALRM'} = sub { die("connection timeout"); };
alarm($self->{'connect_timeout'});
$sock = IO::Socket::INET->new(
PeerAddr => $self->{'peer'},
Type => SOCK_STREAM,
Timeout => $self->{'connect_timeout'},
);
if(!defined $sock or !$sock->connected()) {
my $msg = "failed to connect to $self->{'peer'} :$!";
if($self->{'errors_are_fatal'}) {
croak($msg);
}
$Monitoring::Livestatus::ErrorCode = 500;
$Monitoring::Livestatus::ErrorMessage = $msg;
alarm(0);
return;
}
if(defined $self->{'query_timeout'}) {
# set timeout
$sock->timeout($self->{'query_timeout'});
}
setsockopt($sock, IPPROTO_TCP, TCP_NODELAY, 1);
};
alarm(0);
if($@) {
$Monitoring::Livestatus::ErrorCode = 500;
$Monitoring::Livestatus::ErrorMessage = $@;
return;
}
return($sock);
}
########################################
sub _close {
my $self = shift;
my $sock = shift;
return unless defined $sock;
return close($sock);
}
1;
=head1 AUTHOR
Sven Nierlein, E<lt>nierlein@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2009 by Sven Nierlein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
__END__

922
api/perl/lib/Monitoring/Livestatus/MULTI.pm Normal file
View File

@@ -0,0 +1,922 @@
package Monitoring::Livestatus::MULTI;
use 5.000000;
use strict;
use warnings;
use Carp;
use Data::Dumper;
use Config;
use Time::HiRes qw/gettimeofday tv_interval/;
use Scalar::Util qw/looks_like_number/;
use Monitoring::Livestatus;
use base "Monitoring::Livestatus";
=head1 NAME
Monitoring::Livestatus::MULTI - connector with multiple peers
=head1 SYNOPSIS
use Monitoring::Livestatus;
my $nl = Monitoring::Livestatus::MULTI->new( qw{nagioshost1:9999 nagioshost2:9999 /var/spool/nagios/live.socket} );
my $hosts = $nl->selectall_arrayref("GET hosts");
=head1 CONSTRUCTOR
=head2 new ( [ARGS] )
Creates an C<Monitoring::Livestatus::MULTI> object. C<new> takes at least the server.
Arguments are the same as in L<Monitoring::Livestatus>.
=cut
sub new {
my $class = shift;
unshift(@_, "peer") if scalar @_ == 1;
my(%options) = @_;
$options{'backend'} = $class;
my $self = Monitoring::Livestatus->new(%options);
bless $self, $class;
if(!defined $self->{'peers'}) {
$self->{'peer'} = $self->_get_peers();
# set our peer(s) from the options
my %peer_options;
my $peers;
for my $opt_key (keys %options) {
$peer_options{$opt_key} = $options{$opt_key};
}
$peer_options{'errors_are_fatal'} = 0;
for my $peer (@{$self->{'peer'}}) {
$peer_options{'name'} = $peer->{'name'};
$peer_options{'peer'} = $peer->{'peer'};
delete $peer_options{'socket'};
delete $peer_options{'server'};
if($peer->{'type'} eq 'UNIX') {
push @{$peers}, new Monitoring::Livestatus::UNIX(%peer_options);
}
elsif($peer->{'type'} eq 'INET') {
push @{$peers}, new Monitoring::Livestatus::INET(%peer_options);
}
}
$self->{'peers'} = $peers;
delete $self->{'socket'};
delete $self->{'server'};
}
if(!defined $self->{'peers'}) {
croak('please specify at least one peer, socket or server');
}
# dont use threads with only one peer
if(scalar @{$self->{'peers'}} == 1) { $self->{'use_threads'} = 0; }
# check for threads support
if(!defined $self->{'use_threads'}) {
$self->{'use_threads'} = 0;
if($Config{useithreads}) {
$self->{'use_threads'} = 1;
}
}
if($self->{'use_threads'}) {
eval {
require threads;
require Thread::Queue;
};
if($@) {
$self->{'use_threads'} = 0;
$self->{'logger'}->debug('error initializing threads: '.$@) if defined $self->{'logger'};
} else {
$self->_start_worker;
}
}
# initialize peer keys
$self->{'peer_by_key'} = {};
$self->{'peer_by_addr'} = {};
for my $peer (@{$self->{'peers'}}) {
$self->{'peer_by_key'}->{$peer->peer_key} = $peer;
$self->{'peer_by_addr'}->{$peer->peer_addr} = $peer;
}
$self->{'name'} = 'multiple connector' unless defined $self->{'name'};
$self->{'logger'}->debug('initialized Monitoring::Livestatus::MULTI '.($self->{'use_threads'} ? 'with' : 'without' ).' threads') if $self->{'verbose'};
return $self;
}
########################################
=head1 METHODS
=head2 do
See L<Monitoring::Livestatus> for more information.
=cut
sub do {
my $self = shift;
my $opts = $self->_lowercase_and_verify_options($_[1]);
my $t0 = [gettimeofday];
$self->_do_on_peers("do", $opts->{'backends'}, @_);
my $elapsed = tv_interval ( $t0 );
$self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for do('.$_[0].') in total') if $self->{'verbose'};
return 1;
}
########################################
=head2 selectall_arrayref
See L<Monitoring::Livestatus> for more information.
=cut
sub selectall_arrayref {
my $self = shift;
my $opts = $self->_lowercase_and_verify_options($_[1]);
my $t0 = [gettimeofday];
$self->_log_statement($_[0], $opts, 0) if $self->{'verbose'};
my $return = $self->_merge_answer($self->_do_on_peers("selectall_arrayref", $opts->{'backends'}, @_));
my $elapsed = tv_interval ( $t0 );
if($self->{'verbose'}) {
my $total_results = 0;
$total_results = scalar @{$return} if defined $return;
$self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for selectall_arrayref() in total, results: '.$total_results);
}
return $return;
}
########################################
=head2 selectall_hashref
See L<Monitoring::Livestatus> for more information.
=cut
sub selectall_hashref {
my $self = shift;
my $opts = $self->_lowercase_and_verify_options($_[2]);
my $t0 = [gettimeofday];
my $return = $self->_merge_answer($self->_do_on_peers("selectall_hashref", $opts->{'backends'}, @_));
my $elapsed = tv_interval ( $t0 );
$self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for selectall_hashref() in total') if $self->{'verbose'};
return $return;
}
########################################
=head2 selectcol_arrayref
See L<Monitoring::Livestatus> for more information.
=cut
sub selectcol_arrayref {
my $self = shift;
my $opts = $self->_lowercase_and_verify_options($_[1]);
my $t0 = [gettimeofday];
my $return = $self->_merge_answer($self->_do_on_peers("selectcol_arrayref", $opts->{'backends'}, @_));
my $elapsed = tv_interval ( $t0 );
$self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for selectcol_arrayref() in total') if $self->{'verbose'};
return $return;
}
########################################
=head2 selectrow_array
See L<Monitoring::Livestatus> for more information.
=cut
sub selectrow_array {
my $self = shift;
my $statement = $_[0];
my $opts = $self->_lowercase_and_verify_options($_[1]);
my $t0 = [gettimeofday];
my @return;
if((defined $opts->{'sum'} and $opts->{'sum'} == 1) or (!defined $opts->{'sum'} and $statement =~ m/^Stats:/mx)) {
@return = @{$self->_sum_answer($self->_do_on_peers("selectrow_arrayref", $opts->{'backends'}, @_))};
} else {
if($self->{'warnings'}) {
carp("selectrow_arrayref without Stats on multi backend will not work as expected!");
}
my $rows = $self->_merge_answer($self->_do_on_peers("selectrow_arrayref", $opts->{'backends'}, @_));
@return = @{$rows} if defined $rows;
}
my $elapsed = tv_interval ( $t0 );
$self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for selectrow_array() in total') if $self->{'verbose'};
return @return;
}
########################################
=head2 selectrow_arrayref
See L<Monitoring::Livestatus> for more information.
=cut
sub selectrow_arrayref {
my $self = shift;
my $statement = $_[0];
my $opts = $self->_lowercase_and_verify_options($_[1]);
my $t0 = [gettimeofday];
my $return;
if((defined $opts->{'sum'} and $opts->{'sum'} == 1) or (!defined $opts->{'sum'} and $statement =~ m/^Stats:/mx)) {
$return = $self->_sum_answer($self->_do_on_peers("selectrow_arrayref", $opts->{'backends'}, @_));
} else {
if($self->{'warnings'}) {
carp("selectrow_arrayref without Stats on multi backend will not work as expected!");
}
my $rows = $self->_merge_answer($self->_do_on_peers("selectrow_arrayref", $opts->{'backends'}, @_));
$return = $rows->[0] if defined $rows->[0];
}
my $elapsed = tv_interval ( $t0 );
$self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for selectrow_arrayref() in total') if $self->{'verbose'};
return $return;
}
########################################
=head2 selectrow_hashref
See L<Monitoring::Livestatus> for more information.
=cut
sub selectrow_hashref {
my $self = shift;
my $statement = $_[0];
my $opts = $self->_lowercase_and_verify_options($_[1]);
my $t0 = [gettimeofday];
my $return;
if((defined $opts->{'sum'} and $opts->{'sum'} == 1) or (!defined $opts->{'sum'} and $statement =~ m/^Stats:/mx)) {
$return = $self->_sum_answer($self->_do_on_peers("selectrow_hashref", $opts->{'backends'}, @_));
} else {
if($self->{'warnings'}) {
carp("selectrow_hashref without Stats on multi backend will not work as expected!");
}
$return = $self->_merge_answer($self->_do_on_peers("selectrow_hashref", $opts->{'backends'}, @_));
}
my $elapsed = tv_interval ( $t0 );
$self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for selectrow_hashref() in total') if $self->{'verbose'};
return $return;
}
########################################
=head2 selectscalar_value
See L<Monitoring::Livestatus> for more information.
=cut
sub selectscalar_value {
my $self = shift;
my $statement = $_[0];
my $opts = $self->_lowercase_and_verify_options($_[1]);
my $t0 = [gettimeofday];
my $return;
if((defined $opts->{'sum'} and $opts->{'sum'} == 1) or (!defined $opts->{'sum'} and $statement =~ m/^Stats:/mx)) {
return $self->_sum_answer($self->_do_on_peers("selectscalar_value", $opts->{'backends'}, @_));
} else {
if($self->{'warnings'}) {
carp("selectscalar_value without Stats on multi backend will not work as expected!");
}
my $rows = $self->_merge_answer($self->_do_on_peers("selectscalar_value", $opts->{'backends'}, @_));
$return = $rows->[0] if defined $rows->[0];
}
my $elapsed = tv_interval ( $t0 );
$self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for selectscalar_value() in total') if $self->{'verbose'};
return $return;
}
########################################
=head2 errors_are_fatal
See L<Monitoring::Livestatus> for more information.
=cut
sub errors_are_fatal {
my $self = shift;
my $value = shift;
return $self->_change_setting('errors_are_fatal', $value);
}
########################################
=head2 warnings
See L<Monitoring::Livestatus> for more information.
=cut
sub warnings {
my $self = shift;
my $value = shift;
return $self->_change_setting('warnings', $value);
}
########################################
=head2 verbose
See L<Monitoring::Livestatus> for more information.
=cut
sub verbose {
my $self = shift;
my $value = shift;
return $self->_change_setting('verbose', $value);
}
########################################
=head2 peer_addr
See L<Monitoring::Livestatus> for more information.
=cut
sub peer_addr {
my $self = shift;
my @addrs;
for my $peer (@{$self->{'peers'}}) {
push @addrs, $peer->peer_addr;
}
return wantarray ? @addrs : undef;
}
########################################
=head2 peer_name
See L<Monitoring::Livestatus> for more information.
=cut
sub peer_name {
my $self = shift;
my @names;
for my $peer (@{$self->{'peers'}}) {
push @names, $peer->peer_name;
}
return wantarray ? @names : $self->{'name'};
}
########################################
=head2 peer_key
See L<Monitoring::Livestatus> for more information.
=cut
sub peer_key {
my $self = shift;
my @keys;
for my $peer (@{$self->{'peers'}}) {
push @keys, $peer->peer_key;
}
return wantarray ? @keys : $self->{'key'};
}
########################################
=head2 disable
$ml->disable()
disables this connection, returns the last state.
=cut
sub disable {
my $self = shift;
my $peer_key = shift;
if(!defined $peer_key) {
for my $peer (@{$self->{'peers'}}) {
$peer->disable();
}
return 1;
} else {
my $peer = $self->_get_peer_by_key($peer_key);
my $prev = $peer->{'disabled'};
$peer->{'disabled'} = 1;
return $prev;
}
}
########################################
=head2 enable
$ml->enable()
enables this connection, returns the last state.
=cut
sub enable {
my $self = shift;
my $peer_key = shift;
if(!defined $peer_key) {
for my $peer (@{$self->{'peers'}}) {
$peer->enable();
}
return 1;
} else {
my $peer = $self->_get_peer_by_key($peer_key);
my $prev = $peer->{'disabled'};
$peer->{'disabled'} = 0;
return $prev;
}
}
########################################
# INTERNAL SUBS
########################################
sub _change_setting {
my $self = shift;
my $key = shift;
my $value = shift;
my $old = $self->{$key};
# set new value
if(defined $value) {
$self->{$key} = $value;
for my $peer (@{$self->{'peers'}}) {
$peer->{$key} = $value;
}
# restart workers
if($self->{'use_threads'}) {
_stop_worker();
$self->_start_worker();
}
}
return $old;
}
########################################
sub _start_worker {
my $self = shift;
# create job transports
$self->{'WorkQueue'} = Thread::Queue->new;
$self->{'WorkResults'} = Thread::Queue->new;
# set signal handler before thread is started
# otherwise they would be killed when started
# and stopped immediately after start
$SIG{'USR1'} = sub { threads->exit(); };
# start worker threads
our %threads;
my $threadcount = scalar @{$self->{'peers'}};
for(my $x = 0; $x < $threadcount; $x++) {
$self->{'threads'}->[$x] = threads->new(\&_worker_thread, $self->{'peers'}, $self->{'WorkQueue'}, $self->{'WorkResults'}, $self->{'logger'});
}
# restore sig handler as it was only for the threads
$SIG{'USR1'} = 'DEFAULT';
return;
}
########################################
sub _stop_worker {
# try to kill our threads safely
eval {
for my $thr (threads->list()) {
$thr->kill('USR1')->detach();
}
};
return;
}
########################################
sub _worker_thread {
local $SIG{'USR1'} = sub { threads->exit(); };
my $peers = shift;
my $workQueue = shift;
my $workResults = shift;
my $logger = shift;
while (my $job = $workQueue->dequeue) {
my $erg;
eval {
$erg = _do_wrapper($peers->[$job->{'peer'}], $job->{'sub'}, $logger, @{$job->{'opts'}});
};
if($@) {
warn("Error in Thread ".$job->{'peer'}." :".$@);
$job->{'logger'}->error("Error in Thread ".$job->{'peer'}." :".$@) if defined $job->{'logger'};
};
$workResults->enqueue({ peer => $job->{'peer'}, result => $erg });
}
return;
}
########################################
sub _do_wrapper {
my $peer = shift;
my $sub = shift;
my $logger = shift;
my @opts = @_;
my $t0 = [gettimeofday];
my $data = $peer->$sub(@opts);
my $elapsed = tv_interval ( $t0 );
$logger->debug(sprintf('%.4f', $elapsed).' sec for fetching data on '.$peer->peer_name.' ('.$peer->peer_addr.')') if defined $logger;
$Monitoring::Livestatus::ErrorCode = 0 unless defined $Monitoring::Livestatus::ErrorCode;
$Monitoring::Livestatus::ErrorMessage = '' unless defined $Monitoring::Livestatus::ErrorMessage;
my $return = {
'msg' => $Monitoring::Livestatus::ErrorMessage,
'code' => $Monitoring::Livestatus::ErrorCode,
'data' => $data,
};
return $return;
}
########################################
sub _do_on_peers {
my $self = shift;
my $sub = shift;
my $backends = shift;
my @opts = @_;
my $statement = $opts[0];
my $use_threads = $self->{'use_threads'};
my $t0 = [gettimeofday];
my $return;
my %codes;
my %messages;
my $query_options;
if($sub eq 'selectall_hashref') {
$query_options = $self->_lowercase_and_verify_options($opts[2]);
} else {
$query_options = $self->_lowercase_and_verify_options($opts[1]);
}
# which peers affected?
my @peers;
if(defined $backends) {
my @backends;
if(ref $backends eq '') {
push @backends, $backends;
}
elsif(ref $backends eq 'ARRAY') {
@backends = @{$backends};
} else {
croak("unsupported type for backend: ".ref($backends));
}
for my $key (@backends) {
my $backend = $self->_get_peer_by_key($key);
push @peers, $backend unless $backend->{'disabled'};
}
} else {
# use all backends
@peers = @{$self->{'peers'}};
}
# its faster without threads for only one peer
if(scalar @peers <= 1) { $use_threads = 0; }
# if we have limits set, we cannot use threads
if(defined $query_options->{'limit_start'}) { $use_threads = 0; }
if($use_threads) {
# use the threaded variant
$self->{'logger'}->debug('using threads') if $self->{'verbose'};
my $peers_to_use;
for my $peer (@peers) {
if($peer->{'disabled'}) {
# dont send any query
}
elsif($peer->marked_bad) {
warn($peer->peer_name.' ('.$peer->peer_key.') is marked bad') if $self->{'verbose'};
}
else {
$peers_to_use->{$peer->peer_key} = 1;
}
}
my $x = 0;
for my $peer (@{$self->{'peers'}}) {
if(defined $peers_to_use->{$peer->peer_key}) {
my $job = {
'peer' => $x,
'sub' => $sub,
'opts' => \@opts,
};
$self->{'WorkQueue'}->enqueue($job);
}
$x++;
}
for(my $x = 0; $x < scalar keys %{$peers_to_use}; $x++) {
my $result = $self->{'WorkResults'}->dequeue;
my $peer = $self->{'peers'}->[$result->{'peer'}];
if(defined $result->{'result'}) {
push @{$codes{$result->{'result'}->{'code'}}}, { 'peer' => $peer->peer_key, 'msg' => $result->{'result'}->{'msg'} };
$return->{$peer->peer_key} = $result->{'result'}->{'data'};
} else {
warn("undefined result for: $statement");
}
}
} else {
$self->{'logger'}->debug('not using threads') if $self->{'verbose'};
for my $peer (@peers) {
if($peer->{'disabled'}) {
# dont send any query
}
elsif($peer->marked_bad) {
warn($peer->peer_name.' ('.$peer->peer_key.') is marked bad') if $self->{'verbose'};
} else {
my $erg = _do_wrapper($peer, $sub, $self->{'logger'}, @opts);
$return->{$peer->peer_key} = $erg->{'data'};
push @{$codes{$erg->{'code'}}}, { 'peer' => $peer, 'msg' => $erg->{'msg'} };
# compute limits
if(defined $query_options->{'limit_length'} and $peer->{'meta_data'}->{'result_count'}) {
last;
}
# set a new start if we had rows already
if(defined $query_options->{'limit_start'}) {
$query_options->{'limit_start'} = $query_options->{'limit_start'} - $peer->{'meta_data'}->{'row_count'};
}
}
}
}
# check if we different result stati
undef $Monitoring::Livestatus::ErrorMessage;
$Monitoring::Livestatus::ErrorCode = 0;
my @codes = sort keys %codes;
if(scalar @codes > 1) {
# got different results for our backends
if($self->{'verbose'}) {
$self->{'logger'}->warn("got different result stati: ".Dumper(\%codes));
}
} else {
# got same result codes for all backend
}
my $failed = 0;
my $code = $codes[0];
if(defined $code and $code >= 300) {
$failed = 1;
}
if($failed) {
my $msg = $codes{$code}->[0]->{'msg'};
$self->{'logger'}->debug("same: $code -> $msg") if $self->{'verbose'};
$Monitoring::Livestatus::ErrorMessage = $msg;
$Monitoring::Livestatus::ErrorCode = $code;
if($self->{'errors_are_fatal'}) {
croak("ERROR ".$code." - ".$Monitoring::Livestatus::ErrorMessage." in query:\n'".$statement."'\n");
}
return;
}
my $elapsed = tv_interval ( $t0 );
$self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for fetching all data') if $self->{'verbose'};
# deep copy result?
if($use_threads
and (
(defined $query_options->{'deepcopy'} and $query_options->{'deepcopy'} == 1)
or
(defined $self->{'deepcopy'} and $self->{'deepcopy'} == 1)
)
) {
# result has to be cloned to avoid "Invalid value for shared scalar" error
$return = $self->_clone($return, $self->{'logger'});
}
return($return);
}
########################################
sub _merge_answer {
my $self = shift;
my $data = shift;
my $return;
my $t0 = [gettimeofday];
# iterate over original peers to retain order
for my $peer (@{$self->{'peers'}}) {
my $key = $peer->peer_key;
next if !defined $data->{$key};
if(ref $data->{$key} eq 'ARRAY') {
$return = [] unless defined $return;
$return = [ @{$return}, @{$data->{$key}} ];
} elsif(ref $data->{$key} eq 'HASH') {
$return = {} unless defined $return;
$return = { %{$return}, %{$data->{$key}} };
} else {
push @{$return}, $data->{$key};
}
}
my $elapsed = tv_interval ( $t0 );
$self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for merging data') if $self->{'verbose'};
return($return);
}
########################################
sub _sum_answer {
my $self = shift;
my $data = shift;
my $return;
my $t0 = [gettimeofday];
for my $peername (keys %{$data}) {
if(ref $data->{$peername} eq 'HASH') {
for my $key (keys %{$data->{$peername}}) {
if(!defined $return->{$key}) {
$return->{$key} = $data->{$peername}->{$key};
} elsif(looks_like_number($data->{$peername}->{$key})) {
$return->{$key} += $data->{$peername}->{$key};
}
}
}
elsif(ref $data->{$peername} eq 'ARRAY') {
my $x = 0;
for my $val (@{$data->{$peername}}) {
if(!defined $return->[$x]) {
$return->[$x] = $data->{$peername}->[$x];
} else {
$return->[$x] += $data->{$peername}->[$x];
}
$x++;
}
} elsif(defined $data->{$peername}) {
$return = 0 unless defined $return;
next unless defined $data->{$peername};
$return += $data->{$peername};
}
}
my $elapsed = tv_interval ( $t0 );
$self->{'logger'}->debug(sprintf('%.4f', $elapsed).' sec for summarizing data') if $self->{'verbose'};
return $return;
}
########################################
sub _clone {
my $self = shift;
my $data = shift;
my $logger = shift;
my $t0 = [gettimeofday];
my $return;
if(ref $data eq '') {
$return = $data;
}
elsif(ref $data eq 'ARRAY') {
$return = [];
for my $dat (@{$data}) {
push @{$return}, $self->_clone($dat);
}
}
elsif(ref $data eq 'HASH') {
$return = {};
for my $key (keys %{$data}) {
$return->{$key} = $self->_clone($data->{$key});
}
}
else {
croak("cant clone: ".(ref $data));
}
my $elapsed = tv_interval ( $t0 );
$logger->debug(sprintf('%.4f', $elapsed).' sec for cloning data') if defined $logger;
return $return;
}
########################################
sub _get_peer_by_key {
my $self = shift;
my $key = shift;
return unless defined $key;
return unless defined $self->{'peer_by_key'}->{$key};
return $self->{'peer_by_key'}->{$key};
}
########################################
sub _get_peer_by_addr {
my $self = shift;
my $addr = shift;
return unless defined $addr;
return unless defined $self->{'peer_by_addr'}->{$addr};
return $self->{'peer_by_addr'}->{$addr};
}
########################################
END {
# try to kill our threads safely
_stop_worker();
}
########################################
1;
=head1 AUTHOR
Sven Nierlein, E<lt>nierlein@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2009 by Sven Nierlein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
__END__

112
api/perl/lib/Monitoring/Livestatus/UNIX.pm Normal file
View File

@@ -0,0 +1,112 @@
package Monitoring::Livestatus::UNIX;
use 5.000000;
use strict;
use warnings;
use IO::Socket::UNIX;
use Carp;
use base "Monitoring::Livestatus";
=head1 NAME
Monitoring::Livestatus::UNIX - connector with unix sockets
=head1 SYNOPSIS
use Monitoring::Livestatus;
my $nl = Monitoring::Livestatus::UNIX->new( '/var/lib/livestatus/livestatus.sock' );
my $hosts = $nl->selectall_arrayref("GET hosts");
=head1 CONSTRUCTOR
=head2 new ( [ARGS] )
Creates an C<Monitoring::Livestatus::UNIX> object. C<new> takes at least the socketpath.
Arguments are the same as in C<Monitoring::Livestatus>.
If the constructor is only passed a single argument, it is assumed to
be a the C<socket> specification. Use either socker OR server.
=cut
sub new {
my $class = shift;
unshift(@_, "peer") if scalar @_ == 1;
my(%options) = @_;
$options{'name'} = $options{'peer'} unless defined $options{'name'};
$options{'backend'} = $class;
my $self = Monitoring::Livestatus->new(%options);
bless $self, $class;
confess('not a scalar') if ref $self->{'peer'} ne '';
return $self;
}
########################################
=head1 METHODS
=cut
sub _open {
my $self = shift;
if(!-S $self->{'peer'}) {
my $msg = "failed to open socket $self->{'peer'}: $!";
if($self->{'errors_are_fatal'}) {
croak($msg);
}
$Monitoring::Livestatus::ErrorCode = 500;
$Monitoring::Livestatus::ErrorMessage = $msg;
return;
}
my $sock = IO::Socket::UNIX->new(
Peer => $self->{'peer'},
Type => SOCK_STREAM,
);
if(!defined $sock or !$sock->connected()) {
my $msg = "failed to connect to $self->{'peer'} :$!";
if($self->{'errors_are_fatal'}) {
croak($msg);
}
$Monitoring::Livestatus::ErrorCode = 500;
$Monitoring::Livestatus::ErrorMessage = $msg;
return;
}
if(defined $self->{'query_timeout'}) {
# set timeout
$sock->timeout($self->{'query_timeout'});
}
return($sock);
}
########################################
sub _close {
my $self = shift;
my $sock = shift;
return unless defined $sock;
return close($sock);
}
1;
=head1 AUTHOR
Sven Nierlein, E<lt>nierlein@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2009 by Sven Nierlein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
__END__

149
api/perl/t/01-Monitoring-Livestatus-basic_tests.t Normal file
View File

@@ -0,0 +1,149 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More;
use File::Temp;
use Data::Dumper;
use IO::Socket::UNIX qw( SOCK_STREAM SOMAXCONN );
use_ok('Monitoring::Livestatus');
BEGIN {
if( $^O eq 'MSWin32' ) {
plan skip_all => 'no sockets on windows';
}
else {
plan tests => 35;
}
}
#########################
# get a temp file from File::Temp and replace it with our socket
my $fh = File::Temp->new(UNLINK => 0);
my $socket_path = $fh->filename;
unlink($socket_path);
my $listener = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Listen => SOMAXCONN,
Local => $socket_path,
) or die("failed to open $socket_path as test socket: $!");
#########################
# create object with single arg
my $ml = Monitoring::Livestatus->new( $socket_path );
isa_ok($ml, 'Monitoring::Livestatus', 'single args');
is($ml->peer_name(), $socket_path, 'get peer_name()');
is($ml->peer_addr(), $socket_path, 'get peer_addr()');
#########################
# create object with hash args
my $line_seperator = 10;
my $column_seperator = 0;
$ml = Monitoring::Livestatus->new(
verbose => 0,
socket => $socket_path,
line_seperator => $line_seperator,
column_seperator => $column_seperator,
);
isa_ok($ml, 'Monitoring::Livestatus', 'new hash args');
is($ml->peer_name(), $socket_path, 'get peer_name()');
is($ml->peer_addr(), $socket_path, 'get peer_addr()');
#########################
# create object with peer arg
$ml = Monitoring::Livestatus->new(
peer => $socket_path,
);
isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg socket');
is($ml->peer_name(), $socket_path, 'get peer_name()');
is($ml->peer_addr(), $socket_path, 'get peer_addr()');
isa_ok($ml->{'CONNECTOR'}, 'Monitoring::Livestatus::UNIX', 'peer backend UNIX');
#########################
# create object with peer arg
my $server = 'localhost:12345';
$ml = Monitoring::Livestatus->new(
peer => $server,
);
isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg server');
is($ml->peer_name(), $server, 'get peer_name()');
is($ml->peer_addr(), $server, 'get peer_addr()');
isa_ok($ml->{'CONNECTOR'}, 'Monitoring::Livestatus::INET', 'peer backend INET');
#########################
# create multi object with peers
$ml = Monitoring::Livestatus->new(
peer => [ $server, $socket_path ],
);
isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg multi');
my @names = $ml->peer_name();
my @addrs = $ml->peer_addr();
my $name = $ml->peer_name();
my $expect = [ $server, $socket_path ];
is_deeply(\@names, $expect, 'list context get peer_name()') or diag("got peer names: ".Dumper(\@names)."but expected: ".Dumper($expect));
is($name, 'multiple connector', 'scalar context get peer_name()') or diag("got peer name: ".Dumper($name)."but expected: ".Dumper('multiple connector'));
is_deeply(\@addrs, $expect, 'list context get peer_addr()') or diag("got peer addrs: ".Dumper(\@addrs)."but expected: ".Dumper($expect));
#########################
# create multi object with peers and name
$ml = Monitoring::Livestatus->new(
peer => [ $server, $socket_path ],
name => 'test multi',
);
isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg multi with name');
$name = $ml->peer_name();
is($name, 'test multi', 'peer_name()');
#########################
$ml = Monitoring::Livestatus->new(
peer => [ $socket_path ],
verbose => 0,
keepalive => 1,
logger => undef,
);
isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg multi with keepalive');
is($ml->peer_name(), $socket_path, 'get peer_name()');
is($ml->peer_addr(), $socket_path, 'get peer_addr()');
#########################
# timeout checks
$ml = Monitoring::Livestatus->new(
peer => [ $socket_path ],
verbose => 0,
timeout => 13,
logger => undef,
);
isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg multi with general timeout');
is($ml->peer_name(), $socket_path, 'get peer_name()');
is($ml->peer_addr(), $socket_path, 'get peer_addr()');
is($ml->{'connect_timeout'}, 13, 'connect_timeout');
is($ml->{'query_timeout'}, 13, 'query_timeout');
$ml = Monitoring::Livestatus->new(
peer => [ $socket_path ],
verbose => 0,
query_timeout => 14,
connect_timeout => 17,
logger => undef,
);
isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg multi with general timeout');
is($ml->peer_name(), $socket_path, 'get peer_name()');
is($ml->peer_addr(), $socket_path, 'get peer_addr()');
is($ml->{'connect_timeout'}, 17, 'connect_timeout');
is($ml->{'query_timeout'}, 14, 'query_timeout');
#########################
# error retry
$ml = Monitoring::Livestatus->new(
peer => [ $socket_path ],
verbose => 0,
retries_on_connection_error => 3,
retry_interval => 1,
logger => undef,
);
isa_ok($ml, 'Monitoring::Livestatus', 'peer hash arg multi with error retry');
#########################
# cleanup
unlink($socket_path);

148
api/perl/t/02-Monitoring-Livestatus-internals.t Normal file
View File

@@ -0,0 +1,148 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More;
use File::Temp;
use Data::Dumper;
use IO::Socket::UNIX qw( SOCK_STREAM SOMAXCONN );
use_ok('Monitoring::Livestatus');
BEGIN {
if( $^O eq 'MSWin32' ) {
plan skip_all => 'no sockets on windows';
}
else {
plan tests => 14;
}
}
#########################
# get a temp file from File::Temp and replace it with our socket
my $fh = File::Temp->new(UNLINK => 0);
my $socket_path = $fh->filename;
unlink($socket_path);
my $listener = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Listen => SOMAXCONN,
Local => $socket_path,
) or die("failed to open $socket_path as test socket: $!");
#########################
# create object with single arg
my $ml = Monitoring::Livestatus->new( 'localhost:12345' );
isa_ok($ml, 'Monitoring::Livestatus', 'single args server');
isa_ok($ml->{'CONNECTOR'}, 'Monitoring::Livestatus::INET', 'single args server peer');
is($ml->{'CONNECTOR'}->peer_name, 'localhost:12345', 'single args server peer name');
is($ml->{'CONNECTOR'}->peer_addr, 'localhost:12345', 'single args server peer addr');
#########################
# create object with single arg
$ml = Monitoring::Livestatus->new( $socket_path );
isa_ok($ml, 'Monitoring::Livestatus', 'single args socket');
isa_ok($ml->{'CONNECTOR'}, 'Monitoring::Livestatus::UNIX', 'single args socket peer');
is($ml->{'CONNECTOR'}->peer_name, $socket_path, 'single args socket peer name');
is($ml->{'CONNECTOR'}->peer_addr, $socket_path, 'single args socket peer addr');
my $header = "404 43\n";
my($error,$error_msg) = $ml->_parse_header($header);
is($error, '404', 'error code 404');
isnt($error_msg, undef, 'error code 404 message');
#########################
my $stats_query1 = "GET services
Stats: state = 0
Stats: state = 1
Stats: state = 2
Stats: state = 3
Stats: state = 4
Stats: host_state != 0
Stats: state = 1
StatsAnd: 2
Stats: host_state != 0
Stats: state = 2
StatsAnd: 2
Stats: host_state != 0
Stats: state = 3
StatsAnd: 2
Stats: host_state != 0
Stats: state = 3
Stats: active_checks = 1
StatsAnd: 3
Stats: state = 3
Stats: active_checks = 1
StatsOr: 2";
my @expected_keys1 = (
'state = 0',
'state = 1',
'state = 2',
'state = 3',
'state = 4',
'host_state != 0 && state = 1',
'host_state != 0 && state = 2',
'host_state != 0 && state = 3',
'host_state != 0 && state = 3 && active_checks = 1',
'state = 3 || active_checks = 1',
);
my @got_keys1 = @{$ml->_extract_keys_from_stats_statement($stats_query1)};
is_deeply(\@got_keys1, \@expected_keys1, 'statsAnd, statsOr query keys')
or ( diag('got keys: '.Dumper(\@got_keys1)) );
#########################
my $stats_query2 = "GET services
Stats: state = 0 as all_ok
Stats: state = 1 as all_warning
Stats: state = 2 as all_critical
Stats: state = 3 as all_unknown
Stats: state = 4 as all_pending
Stats: host_state != 0
Stats: state = 1
StatsAnd: 2 as all_warning_on_down_hosts
Stats: host_state != 0
Stats: state = 2
StatsAnd: 2 as all_critical_on_down_hosts
Stats: host_state != 0
Stats: state = 3
StatsAnd: 2 as all_unknown_on_down_hosts
Stats: host_state != 0
Stats: state = 3
Stats: active_checks_enabled = 1
StatsAnd: 3 as all_unknown_active_on_down_hosts
Stats: state = 3
Stats: active_checks_enabled = 1
StatsOr: 2 as all_active_or_unknown";
my @expected_keys2 = (
'all_ok',
'all_warning',
'all_critical',
'all_unknown',
'all_pending',
'all_warning_on_down_hosts',
'all_critical_on_down_hosts',
'all_unknown_on_down_hosts',
'all_unknown_active_on_down_hosts',
'all_active_or_unknown',
);
my @got_keys2 = @{$ml->_extract_keys_from_stats_statement($stats_query2)};
is_deeply(\@got_keys2, \@expected_keys2, 'stats query keys2')
or ( diag('got keys: '.Dumper(\@got_keys2)) );
#########################
my $normal_query1 = "GET services
Columns: host_name as host is_flapping description as name state
";
my @expected_keys3 = (
'host',
'is_flapping',
'name',
'state',
);
my @got_keys3 = @{$ml->_extract_keys_from_columns_header($normal_query1)};
is_deeply(\@got_keys3, \@expected_keys3, 'normal query keys')
or ( diag('got keys: '.Dumper(\@got_keys3)) );
#########################
unlink($socket_path);

215
api/perl/t/03-Monitoring-Livestatus-MULTI-internals.t Normal file
View File

@@ -0,0 +1,215 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More;
use Data::Dumper;
use File::Temp;
use IO::Socket::UNIX qw( SOCK_STREAM SOMAXCONN );
use_ok('Monitoring::Livestatus::MULTI');
BEGIN {
if( $^O eq 'MSWin32' ) {
plan skip_all => 'no sockets on windows';
}
else {
plan tests => 57;
}
}
#########################
# create 2 test sockets
# get a temp file from File::Temp and replace it with our socket
my $fh = File::Temp->new(UNLINK => 0);
my $socket_path1 = $fh->filename;
unlink($socket_path1);
my $listener1 = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Listen => SOMAXCONN,
Local => $socket_path1,
) or die("failed to open $socket_path1 as test socket: $!");
$fh = File::Temp->new(UNLINK => 0);
my $socket_path2 = $fh->filename;
unlink($socket_path2);
my $listener2 = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Listen => SOMAXCONN,
Local => $socket_path2,
) or die("failed to open $socket_path2 as test socket: $!");
#########################
# test the _merge_answer
my $mergetests = [
{ # simple test for sliced selectall_arrayref
in => { '820e03551b95b42ec037c87aed9b8f4a' => [ { 'description' => 'test_flap_07', 'host_name' => 'test_host_000', 'state' => '0' }, { 'description' => 'test_flap_11', 'host_name' => 'test_host_000', 'state' => '0' } ],
'35bbb11a888f66131d429efd058fb141' => [ { 'description' => 'test_ok_00', 'host_name' => 'test_host_000', 'state' => '0' }, { 'description' => 'test_ok_01', 'host_name' => 'test_host_000', 'state' => '0' } ],
'70ea8fa14abb984761bdd45ef27685b0' => [ { 'description' => 'test_critical_00', 'host_name' => 'test_host_000', 'state' => '2' }, { 'description' => 'test_critical_19', 'host_name' => 'test_host_000', 'state' => '2' } ]
},
exp => [
{ 'description' => 'test_flap_07', 'host_name' => 'test_host_000', 'state' => '0' },
{ 'description' => 'test_flap_11', 'host_name' => 'test_host_000', 'state' => '0' },
{ 'description' => 'test_ok_00', 'host_name' => 'test_host_000', 'state' => '0' },
{ 'description' => 'test_ok_01', 'host_name' => 'test_host_000', 'state' => '0' },
{ 'description' => 'test_critical_00', 'host_name' => 'test_host_000', 'state' => '2' },
{ 'description' => 'test_critical_19', 'host_name' => 'test_host_000', 'state' => '2' },
]
},
];
#########################
# test object creation
my $ml = Monitoring::Livestatus::MULTI->new( [ $socket_path1, $socket_path2 ] );
isa_ok($ml, 'Monitoring::Livestatus', 'single args sockets');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::UNIX', 'single args sockets peer');
}
$ml = Monitoring::Livestatus::MULTI->new( [$socket_path1] );
isa_ok($ml, 'Monitoring::Livestatus', 'single array args socket');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::UNIX', 'single array args socket peer');
is($peer->peer_addr, $socket_path1, 'single arrays args socket peer addr');
is($peer->peer_name, $socket_path1, 'single arrays args socket peer name');
}
$ml = Monitoring::Livestatus::MULTI->new( 'localhost:5001' );
isa_ok($ml, 'Monitoring::Livestatus', 'single args server');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::INET', 'single args server peer');
like($peer->peer_addr, qr/^localhost/, 'single args servers peer addr');
like($peer->peer_name, qr/^localhost/, 'single args servers peer name');
}
$ml = Monitoring::Livestatus::MULTI->new( ['localhost:5001'] );
isa_ok($ml, 'Monitoring::Livestatus', 'single array args server');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::INET', 'single arrays args server peer');
like($peer->peer_addr, qr/^localhost/, 'single arrays args servers peer addr');
like($peer->peer_name, qr/^localhost/, 'single arrays args servers peer name');
}
$ml = Monitoring::Livestatus::MULTI->new( [ 'localhost:5001', 'localhost:5002' ] );
isa_ok($ml, 'Monitoring::Livestatus', 'single args servers');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::INET', 'single args servers peer');
like($peer->peer_addr, qr/^localhost/, 'single args servers peer addr');
like($peer->peer_name, qr/^localhost/, 'single args servers peer name');
}
$ml = Monitoring::Livestatus::MULTI->new( peer => [ 'localhost:5001', 'localhost:5002' ] );
isa_ok($ml, 'Monitoring::Livestatus', 'hash args servers');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::INET', 'hash args servers peer');
like($peer->peer_addr, qr/^localhost/, 'hash args servers peer addr');
like($peer->peer_name, qr/^localhost/, 'hash args servers peer name');
}
$ml = Monitoring::Livestatus::MULTI->new( peer => [ $socket_path1, $socket_path2 ] );
isa_ok($ml, 'Monitoring::Livestatus', 'hash args sockets');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::UNIX', 'hash args sockets peer');
}
$ml = Monitoring::Livestatus::MULTI->new( peer => { $socket_path1 => 'Location 1', $socket_path2 => 'Location2' } );
isa_ok($ml, 'Monitoring::Livestatus', 'hash args hashed sockets');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::UNIX', 'hash args hashed sockets peer');
like($peer->peer_name, qr/^Location/, 'hash args hashed sockets peer name');
}
$ml = Monitoring::Livestatus::MULTI->new( peer => { 'localhost:5001' => 'Location 1', 'localhost:5002' => 'Location2' } );
isa_ok($ml, 'Monitoring::Livestatus', 'hash args hashed servers');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::INET', 'hash args hashed servers peer');
like($peer->peer_addr, qr/^localhost/, 'hash args hashed servers peer addr');
like($peer->peer_name, qr/^Location/, 'hash args hashed servers peer name');
}
$ml = Monitoring::Livestatus::MULTI->new( $socket_path1 );
isa_ok($ml, 'Monitoring::Livestatus', 'single args socket');
for my $peer (@{$ml->{'peers'}}) {
isa_ok($peer, 'Monitoring::Livestatus::UNIX', 'single args socket peer');
}
#########################
# test internal subs
$ml = Monitoring::Livestatus::MULTI->new('peer' => ['192.168.123.2:9996', '192.168.123.2:9997', '192.168.123.2:9998' ] );
my $x = 0;
for my $test (@{$mergetests}) {
my $got = $ml->_merge_answer($test->{'in'});
is_deeply($got, $test->{'exp'}, '_merge_answer test '.$x)
or diag("got: ".Dumper($got)."\nbut expected ".Dumper($test->{'exp'}));
$x++;
}
#########################
# test the _sum_answer
my $sumtests = [
{ # hashes
in => { '192.168.123.2:9996' => { 'ok' => '12', 'warning' => '8' },
'192.168.123.2:9997' => { 'ok' => '17', 'warning' => '7' },
'192.168.123.2:9998' => { 'ok' => '13', 'warning' => '2' }
},
exp => { 'ok' => '42', 'warning' => '17' }
},
{ # hashes, undefs
in => { '192.168.123.2:9996' => { 'ok' => '12', 'warning' => '8' },
'192.168.123.2:9997' => undef,
'192.168.123.2:9998' => { 'ok' => '13', 'warning' => '2' }
},
exp => { 'ok' => '25', 'warning' => '10' }
},
{ # hashes, undefs
in => { '192.168.123.2:9996' => { 'ok' => '12', 'warning' => '8' },
'192.168.123.2:9997' => {},
'192.168.123.2:9998' => { 'ok' => '13', 'warning' => '2' }
},
exp => { 'ok' => '25', 'warning' => '10' }
},
{ # arrays
in => { '192.168.123.2:9996' => [ '3302', '235' ],
'192.168.123.2:9997' => [ '3324', '236' ],
'192.168.123.2:9998' => [ '3274', '236' ]
},
exp => [ 9900, 707 ]
},
{ # undefs / scalars
in => { 'e69322abf0352888e598da3e2514df4a' => undef,
'f42530d7e8c2b52732ba427b1e5e0a8e' => '1'
},
exp => 1,
},
{ # arrays, undefs
in => { '192.168.123.2:9996' => [ '2', '5' ],
'192.168.123.2:9997' => [ ],
'192.168.123.2:9998' => [ '4', '6' ]
},
exp => [ 6, 11 ]
},
{ # arrays, undefs
in => { '192.168.123.2:9996' => [ '2', '5' ],
'192.168.123.2:9997' => undef,
'192.168.123.2:9998' => [ '4', '6' ]
},
exp => [ 6, 11 ]
},
];
$x = 1;
for my $test (@{$sumtests}) {
my $got = $ml->_sum_answer($test->{'in'});
is_deeply($got, $test->{'exp'}, '_sum_answer test '.$x)
or diag("got: ".Dumper($got)."\nbut expected ".Dumper($test->{'exp'}));
$x++;
}
#########################
# clone test
my $clone = $ml->_clone($mergetests);
is_deeply($clone, $mergetests, 'merge test clone');
$clone = $ml->_clone($sumtests);
is_deeply($clone, $sumtests, 'sum test clone');

329
api/perl/t/20-Monitoring-Livestatus-test_socket.t Normal file
View File

@@ -0,0 +1,329 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More;
use IO::Socket::UNIX qw( SOCK_STREAM SOMAXCONN );
use Data::Dumper;
use JSON::XS;
BEGIN {
eval {require threads;};
if ( $@ ) {
plan skip_all => 'need threads support for testing a real socket'
}
elsif( $^O eq 'MSWin32' ) {
plan skip_all => 'no sockets on windows';
}
else{
plan tests => 109
}
}
use File::Temp;
BEGIN { use_ok('Monitoring::Livestatus') };
#########################
# Normal Querys
#########################
my $line_seperator = 10;
my $column_seperator = 0;
my $test_data = [ ["alias","name","contacts"], # table header
["alias1","host1","contact1"], # row 1
["alias2","host2","contact2"], # row 2
["alias3","host3","contact3"], # row 3
];
my $test_hostgroups = [['']]; # test one row with no data
# expected results
my $selectall_arrayref1 = [ [ 'alias1', 'host1', 'contact1' ],
[ 'alias2', 'host2', 'contact2' ],
[ 'alias3', 'host3', 'contact3' ]
];
my $selectall_arrayref2 = [
{ 'contacts' => 'contact1', 'name' => 'host1', 'alias' => 'alias1' },
{ 'contacts' => 'contact2', 'name' => 'host2', 'alias' => 'alias2' },
{ 'contacts' => 'contact3', 'name' => 'host3', 'alias' => 'alias3' }
];
my $selectall_hashref = {
'host1' => { 'contacts' => 'contact1', 'name' => 'host1', 'alias' => 'alias1' },
'host2' => { 'contacts' => 'contact2', 'name' => 'host2', 'alias' => 'alias2' },
'host3' => { 'contacts' => 'contact3', 'name' => 'host3', 'alias' => 'alias3' }
};
my $selectcol_arrayref1 = [ 'alias1', 'alias2', 'alias3' ];
my $selectcol_arrayref2 = [ 'alias1', 'host1', 'alias2', 'host2', 'alias3', 'host3' ];
my $selectcol_arrayref3 = [ 'alias1', 'host1', 'contact1', 'alias2', 'host2', 'contact2', 'alias3', 'host3', 'contact3' ];
my @selectrow_array = ( 'alias1', 'host1', 'contact1' );
my $selectrow_arrayref = [ 'alias1', 'host1', 'contact1' ];
my $selectrow_hashref = { 'contacts' => 'contact1', 'name' => 'host1', 'alias' => 'alias1' };
#########################
# Single Querys
#########################
my $single_statement = "GET hosts\nColumns: alias\nFilter: name = host1";
my $selectscalar_value = 'alias1';
#########################
# Stats Querys
#########################
my $stats_statement = "GET services\nStats: state = 0\nStats: state = 1\nStats: state = 2\nStats: state = 3";
my $stats_data = [[4297,13,9,0]];
# expected results
my $stats_selectall_arrayref1 = [ [4297,13,9,0] ];
my $stats_selectall_arrayref2 = [ { 'state = 0' => '4297', 'state = 1' => '13', 'state = 2' => '9', 'state = 3' => 0 } ];
my $stats_selectcol_arrayref = [ '4297' ];
my @stats_selectrow_array = ( '4297', '13', '9', '0' );
my $stats_selectrow_arrayref = [ '4297', '13', '9', '0' ];
my $stats_selectrow_hashref = { 'state = 0' => '4297', 'state = 1' => '13', 'state = 2' => '9', 'state = 3' => 0 };
#########################
# Empty Querys
#########################
my $empty_statement = "GET services\nFilter: description = empty";
# expected results
my $empty_selectall_arrayref = [];
my $empty_selectcol_arrayref = [];
my @empty_selectrow_array;
my $empty_selectrow_arrayref;
my $empty_selectrow_hashref;
#########################
# get a temp file from File::Temp and replace it with our socket
my $fh = File::Temp->new(UNLINK => 0);
my $socket_path = $fh->filename;
unlink($socket_path);
my $thr1 = threads->create('create_socket', 'unix');
#########################
# get a temp file from File::Temp and replace it with our socket
my $server = 'localhost:32987';
my $thr2 = threads->create('create_socket', 'inet');
sleep(1);
#########################
my $objects_to_test = {
# create unix object with hash args
'unix_hash_args' => Monitoring::Livestatus->new(
verbose => 0,
socket => $socket_path,
line_seperator => $line_seperator,
column_seperator => $column_seperator,
),
# create unix object with a single arg
'unix_single_arg' => Monitoring::Livestatus::UNIX->new( $socket_path ),
# create inet object with hash args
'inet_hash_args' => Monitoring::Livestatus->new(
verbose => 0,
server => $server,
line_seperator => $line_seperator,
column_seperator => $column_seperator,
),
# create inet object with a single arg
'inet_single_arg' => Monitoring::Livestatus::INET->new( $server ),
};
for my $key (keys %{$objects_to_test}) {
my $ml = $objects_to_test->{$key};
isa_ok($ml, 'Monitoring::Livestatus');
# we dont need warnings for testing
$ml->warnings(0);
##################################################
# test settings
my $rt = $ml->verbose(1);
is($rt, '0', 'enable verbose');
$rt = $ml->verbose(0);
is($rt, '1', 'disable verbose');
$rt = $ml->errors_are_fatal(0);
is($rt, '1', 'disable errors_are_fatal');
$rt = $ml->errors_are_fatal(1);
is($rt, '0', 'enable errors_are_fatal');
##################################################
# do some sample querys
my $statement = "GET hosts";
#########################
my $ary_ref = $ml->selectall_arrayref($statement);
is_deeply($ary_ref, $selectall_arrayref1, 'selectall_arrayref($statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectall_arrayref1));
#########################
$ary_ref = $ml->selectall_arrayref($statement, { Slice => {} });
is_deeply($ary_ref, $selectall_arrayref2, 'selectall_arrayref($statement, { Slice => {} })')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectall_arrayref2));
#########################
my $hash_ref = $ml->selectall_hashref($statement, 'name');
is_deeply($hash_ref, $selectall_hashref, 'selectall_hashref($statement, "name")')
or diag("got: ".Dumper($hash_ref)."\nbut expected ".Dumper($selectall_hashref));
#########################
$ary_ref = $ml->selectcol_arrayref($statement);
is_deeply($ary_ref, $selectcol_arrayref1, 'selectcol_arrayref($statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectcol_arrayref1));
#########################
$ary_ref = $ml->selectcol_arrayref($statement, { Columns=>[1,2] });
is_deeply($ary_ref, $selectcol_arrayref2, 'selectcol_arrayref($statement, { Columns=>[1,2] })')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectcol_arrayref2));
$ary_ref = $ml->selectcol_arrayref($statement, { Columns=>[1,2,3] });
is_deeply($ary_ref, $selectcol_arrayref3, 'selectcol_arrayref($statement, { Columns=>[1,2,3] })')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectcol_arrayref3));
#########################
my @row_ary = $ml->selectrow_array($statement);
is_deeply(\@row_ary, \@selectrow_array, 'selectrow_array($statement)')
or diag("got: ".Dumper(\@row_ary)."\nbut expected ".Dumper(\@selectrow_array));
#########################
$ary_ref = $ml->selectrow_arrayref($statement);
is_deeply($ary_ref, $selectrow_arrayref, 'selectrow_arrayref($statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectrow_arrayref));
#########################
$hash_ref = $ml->selectrow_hashref($statement);
is_deeply($hash_ref, $selectrow_hashref, 'selectrow_hashref($statement)')
or diag("got: ".Dumper($hash_ref)."\nbut expected ".Dumper($selectrow_hashref));
##################################################
# stats querys
##################################################
$ary_ref = $ml->selectall_arrayref($stats_statement);
is_deeply($ary_ref, $stats_selectall_arrayref1, 'selectall_arrayref($stats_statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($stats_selectall_arrayref1));
$ary_ref = $ml->selectall_arrayref($stats_statement, { Slice => {} });
is_deeply($ary_ref, $stats_selectall_arrayref2, 'selectall_arrayref($stats_statement, { Slice => {} })')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($stats_selectall_arrayref2));
$ary_ref = $ml->selectcol_arrayref($stats_statement);
is_deeply($ary_ref, $stats_selectcol_arrayref, 'selectcol_arrayref($stats_statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($stats_selectcol_arrayref));
@row_ary = $ml->selectrow_array($stats_statement);
is_deeply(\@row_ary, \@stats_selectrow_array, 'selectrow_arrayref($stats_statement)')
or diag("got: ".Dumper(\@row_ary)."\nbut expected ".Dumper(\@stats_selectrow_array));
$ary_ref = $ml->selectrow_arrayref($stats_statement);
is_deeply($ary_ref, $stats_selectrow_arrayref, 'selectrow_arrayref($stats_statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($stats_selectrow_arrayref));
$hash_ref = $ml->selectrow_hashref($stats_statement);
is_deeply($hash_ref, $stats_selectrow_hashref, 'selectrow_hashref($stats_statement)')
or diag("got: ".Dumper($hash_ref)."\nbut expected ".Dumper($stats_selectrow_hashref));
my $scal = $ml->selectscalar_value($single_statement);
is($scal, $selectscalar_value, 'selectscalar_value($single_statement)')
or diag("got: ".Dumper($scal)."\nbut expected ".Dumper($selectscalar_value));
##################################################
# empty querys
##################################################
$ary_ref = $ml->selectall_arrayref($empty_statement);
is_deeply($ary_ref, $empty_selectall_arrayref, 'selectall_arrayref($empty_statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($empty_selectall_arrayref));
$ary_ref = $ml->selectcol_arrayref($empty_statement);
is_deeply($ary_ref, $empty_selectcol_arrayref, 'selectcol_arrayref($empty_statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($empty_selectcol_arrayref));
@row_ary = $ml->selectrow_array($empty_statement);
is_deeply(\@row_ary, \@empty_selectrow_array, 'selectrow_arrayref($empty_statement)')
or diag("got: ".Dumper(\@row_ary)."\nbut expected ".Dumper(\@empty_selectrow_array));
$ary_ref = $ml->selectrow_arrayref($empty_statement);
is_deeply($ary_ref, $empty_selectrow_arrayref, 'selectrow_arrayref($empty_statement)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($empty_selectrow_arrayref));
$hash_ref = $ml->selectrow_hashref($empty_statement);
is_deeply($hash_ref, $empty_selectrow_hashref, 'selectrow_hashref($empty_statement)')
or diag("got: ".Dumper($hash_ref)."\nbut expected ".Dumper($empty_selectrow_hashref));
##################################################
# empty rows and columns
##################################################
my $empty_hostgroups_stm = "GET hostgroups\nColumns: members";
$ary_ref = $ml->selectall_arrayref($empty_hostgroups_stm);
is_deeply($ary_ref, $test_hostgroups, 'selectall_arrayref($empty_hostgroups_stm)')
or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($test_hostgroups));
}
##################################################
# exit threads
$thr1->kill('KILL')->detach();
$thr2->kill('KILL')->detach();
exit;
#########################
# SUBS
#########################
# test socket server
sub create_socket {
my $type = shift;
my $listener;
$SIG{'KILL'} = sub { threads->exit(); };
if($type eq 'unix') {
print "creating unix socket\n";
$listener = IO::Socket::UNIX->new(
Type => SOCK_STREAM,
Listen => SOMAXCONN,
Local => $socket_path,
) or die("failed to open $socket_path as test socket: $!");
}
elsif($type eq 'inet') {
print "creating tcp socket\n";
$listener = IO::Socket::INET->new(
LocalAddr => $server,
Proto => 'tcp',
Listen => 1,
Reuse => 1,
) or die("failed to listen on $server: $!");
} else {
die("unknown type");
}
while( my $socket = $listener->accept() or die('cannot accept: $!') ) {
my $recv = "";
while(<$socket>) { $recv .= $_; last if $_ eq "\n" }
my $data;
my $status = 200;
if($recv =~ m/^GET .*?\s+Filter:.*?empty/m) {
$data = '';
}
elsif($recv =~ m/^GET hosts\s+Columns: alias/m) {
my @data = @{$test_data}[1..3];
$data = encode_json(\@data)."\n";
}
elsif($recv =~ m/^GET hosts\s+Columns: name/m) {
$data = encode_json(\@{$test_data}[1..3])."\n";
}
elsif($recv =~ m/^GET hosts/) {
$data = encode_json($test_data)."\n";
}
elsif($recv =~ m/^GET hostgroups/) {
$data = encode_json(\@{$test_hostgroups})."\n";
}
elsif($recv =~ m/^GET services/ and $recv =~ m/Stats:/m) {
$data = encode_json(\@{$stats_data})."\n";
}
my $content_length = sprintf("%11s", length($data));
print $socket $status." ".$content_length."\n";
print $socket $data;
close($socket);
}
unlink($socket_path);
}

30
api/perl/t/21-Monitoring-Livestatus-INET.t Normal file
View File

@@ -0,0 +1,30 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More tests => 3;
use IO::Socket::INET;
BEGIN { use_ok('Monitoring::Livestatus::INET') };
#########################
# create a tmp listener
my $server = 'localhost:9999';
my $listener = IO::Socket::INET->new(
) or die("failed to open port as test listener: $!");
#########################
# create object with single arg
my $ml = Monitoring::Livestatus::INET->new( $server );
isa_ok($ml, 'Monitoring::Livestatus', 'Monitoring::Livestatus::INET->new()');
#########################
# create object with hash args
my $line_seperator = 10;
my $column_seperator = 0;
$ml = Monitoring::Livestatus::INET->new(
verbose => 0,
server => $server,
line_seperator => $line_seperator,
column_seperator => $column_seperator,
);
isa_ok($ml, 'Monitoring::Livestatus', 'Monitoring::Livestatus::INET->new(%args)');

26
api/perl/t/22-Monitoring-Livestatus-UNIX.t Normal file
View File

@@ -0,0 +1,26 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More tests => 3;
use IO::Socket::INET;
BEGIN { use_ok('Monitoring::Livestatus::UNIX') };
#########################
# create object with single arg
my $socket = "/tmp/blah.socket";
my $ml = Monitoring::Livestatus::UNIX->new( $socket );
isa_ok($ml, 'Monitoring::Livestatus', 'Monitoring::Livestatus::UNIX->new()');
#########################
# create object with hash args
my $line_seperator = 10;
my $column_seperator = 0;
$ml = Monitoring::Livestatus::UNIX->new(
verbose => 0,
socket => $socket,
line_seperator => $line_seperator,
column_seperator => $column_seperator,
);
isa_ok($ml, 'Monitoring::Livestatus', 'Monitoring::Livestatus::UNIX->new(%args)');

472
api/perl/t/30-Monitoring-Livestatus-live-test.t Normal file
View File

@@ -0,0 +1,472 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More;
use Data::Dumper;
if ( ! defined $ENV{TEST_SOCKET} or !defined $ENV{TEST_SERVER} ) {
my $msg = 'Author test. Set $ENV{TEST_SOCKET} and $ENV{TEST_SERVER} to run';
plan( skip_all => $msg );
} else {
plan( tests => 727 );
}
# set an alarm
my $lastquery;
$SIG{ALRM} = sub {
my @caller = caller;
print STDERR 'last query: '.$lastquery if defined $lastquery;
die "timeout reached:".Dumper(\@caller)."\n"
};
alarm(120);
use_ok('Monitoring::Livestatus');
#########################
my $line_seperator = 10;
my $column_seperator = 0;
my $objects_to_test = {
# UNIX
# create unix object with a single arg
# '01 unix_single_arg' => Monitoring::Livestatus::UNIX->new( $ENV{TEST_SOCKET} ),
# create unix object with hash args
'02 unix_few_args' => Monitoring::Livestatus->new(
#verbose => 1,
socket => $ENV{TEST_SOCKET},
line_seperator => $line_seperator,
column_seperator => $column_seperator,
),
# create unix object with hash args
'03 unix_keepalive' => Monitoring::Livestatus->new(
verbose => 0,
socket => $ENV{TEST_SOCKET},
keepalive => 1,
),
# TCP
# create inet object with a single arg
'04 inet_single_arg' => Monitoring::Livestatus::INET->new( $ENV{TEST_SERVER} ),
# create inet object with hash args
'05 inet_few_args' => Monitoring::Livestatus->new(
verbose => 0,
server => $ENV{TEST_SERVER},
line_seperator => $line_seperator,
column_seperator => $column_seperator,
),
# create inet object with keepalive
'06 inet_keepalive' => Monitoring::Livestatus->new(
verbose => 0,
server => $ENV{TEST_SERVER},
keepalive => 1,
),
# create multi single args
'07 multi_keepalive' => Monitoring::Livestatus->new( [ $ENV{TEST_SERVER}, $ENV{TEST_SOCKET} ] ),
# create multi object with keepalive
'08 multi_keepalive_hash_args' => Monitoring::Livestatus->new(
verbose => 0,
peer => [ $ENV{TEST_SERVER}, $ENV{TEST_SOCKET} ],
keepalive => 1,
),
# create multi object without keepalive
'09 multi_no_keepalive' => Monitoring::Livestatus->new(
peer => [ $ENV{TEST_SERVER}, $ENV{TEST_SOCKET} ],
keepalive => 0,
),
# create multi object without threads
'10 multi_no_threads' => Monitoring::Livestatus->new(
peer => [ $ENV{TEST_SERVER}, $ENV{TEST_SOCKET} ],
use_threads => 0,
),
# create multi object with only one peer
'11 multi_one_peer' => Monitoring::Livestatus::MULTI->new(
peer => $ENV{TEST_SERVER},
),
# create multi object without threads
'12 multi_two_peers' => Monitoring::Livestatus::MULTI->new(
peer => [ $ENV{TEST_SERVER}, $ENV{TEST_SOCKET} ],
),
};
my $expected_keys = {
'columns' => [
'description','name','table','type'
],
'commands' => [
'line','name'
],
'comments' => [
'__all_from_hosts__', '__all_from_services__',
'author','comment','entry_time','entry_type','expire_time','expires', 'id','persistent',
'source','type'
],
'contacts' => [
'address1','address2','address3','address4','address5','address6','alias',
'can_submit_commands','custom_variable_names','custom_variable_values','email',
'host_notification_period','host_notifications_enabled','in_host_notification_period',
'in_service_notification_period','name','modified_attributes','modified_attributes_list',
'pager','service_notification_period','service_notifications_enabled'
],
'contactgroups' => [ 'name', 'alias', 'members' ],
'downtimes' => [
'__all_from_hosts__', '__all_from_services__',
'author','comment','duration','end_time','entry_time','fixed','id','start_time',
'triggered_by','type'
],
'hostgroups' => [
'action_url','alias','members','name','members_with_state','notes','notes_url','num_hosts','num_hosts_down',
'num_hosts_pending','num_hosts_unreach','num_hosts_up','num_services','num_services_crit',
'num_services_hard_crit','num_services_hard_ok','num_services_hard_unknown',
'num_services_hard_warn','num_services_ok','num_services_pending','num_services_unknown',
'num_services_warn','worst_host_state','worst_service_hard_state','worst_service_state'
],
'hosts' => [
'accept_passive_checks','acknowledged','acknowledgement_type','action_url','action_url_expanded',
'active_checks_enabled','address','alias','check_command','check_freshness','check_interval',
'check_options','check_period','check_type','checks_enabled','childs','comments','comments_with_info',
'contacts','current_attempt','current_notification_number','custom_variable_names',
'custom_variable_values','display_name','downtimes','downtimes_with_info','event_handler_enabled',
'execution_time','first_notification_delay','flap_detection_enabled','groups','hard_state','has_been_checked',
'high_flap_threshold','icon_image','icon_image_alt','icon_image_expanded','in_check_period',
'in_notification_period','initial_state','is_executing','is_flapping','last_check','last_hard_state',
'last_hard_state_change','last_notification','last_state','last_state_change','latency','last_time_down',
'last_time_unreachable','last_time_up','long_plugin_output','low_flap_threshold','max_check_attempts','name',
'modified_attributes','modified_attributes_list','next_check',
'next_notification','notes','notes_expanded','notes_url','notes_url_expanded','notification_interval',
'notification_period','notifications_enabled','num_services','num_services_crit','num_services_hard_crit',
'num_services_hard_ok','num_services_hard_unknown','num_services_hard_warn','num_services_ok',
'num_services_pending','num_services_unknown','num_services_warn','obsess_over_host','parents',
'pending_flex_downtime','percent_state_change','perf_data','plugin_output',
'process_performance_data','retry_interval','scheduled_downtime_depth','services','services_with_state',
'state','state_type','statusmap_image','total_services','worst_service_hard_state','worst_service_state',
'x_3d','y_3d','z_3d'
],
'hostsbygroup' => [
'__all_from_hosts__', '__all_from_hostgroups__'
],
'log' => [
'__all_from_hosts__','__all_from_services__','__all_from_contacts__','__all_from_commands__',
'attempt','class','command_name','comment','contact_name','host_name','lineno','message','options',
'plugin_output','service_description','state','state_type','time','type'
],
'servicegroups' => [
'action_url','alias','members','name','members_with_state','notes','notes_url','num_services','num_services_crit',
'num_services_hard_crit','num_services_hard_ok','num_services_hard_unknown',
'num_services_hard_warn','num_services_ok','num_services_pending','num_services_unknown',
'num_services_warn','worst_service_state'
],
'servicesbygroup' => [
'__all_from_services__', '__all_from_hosts__', '__all_from_servicegroups__'
],
'services' => [
'__all_from_hosts__',
'accept_passive_checks','acknowledged','acknowledgement_type','action_url','action_url_expanded',
'active_checks_enabled','check_command','check_interval','check_options','check_period',
'check_type','checks_enabled','comments','comments_with_info','contacts','current_attempt',
'current_notification_number','custom_variable_names','custom_variable_values',
'description','display_name','downtimes','downtimes_with_info','event_handler','event_handler_enabled',
'execution_time','first_notification_delay','flap_detection_enabled','groups',
'has_been_checked','high_flap_threshold','icon_image','icon_image_alt','icon_image_expanded','in_check_period',
'in_notification_period','initial_state','is_executing','is_flapping','last_check',
'last_hard_state','last_hard_state_change','last_notification','last_state',
'last_state_change','latency','last_time_critical','last_time_ok','last_time_unknown','last_time_warning',
'long_plugin_output','low_flap_threshold','max_check_attempts','modified_attributes','modified_attributes_list',
'next_check','next_notification','notes','notes_expanded','notes_url','notes_url_expanded',
'notification_interval','notification_period','notifications_enabled','obsess_over_service',
'percent_state_change','perf_data','plugin_output','process_performance_data','retry_interval',
'scheduled_downtime_depth','state','state_type'
],
'servicesbyhostgroup' => [
'__all_from_services__', '__all_from_hosts__', '__all_from_hostgroups__'
],
'status' => [
'accept_passive_host_checks','accept_passive_service_checks','cached_log_messages',
'check_external_commands','check_host_freshness','check_service_freshness','connections',
'connections_rate','enable_event_handlers','enable_flap_detection','enable_notifications',
'execute_host_checks','execute_service_checks','forks','forks_rate','host_checks','host_checks_rate','interval_length',
'last_command_check','last_log_rotation','livestatus_version','log_messages','log_messages_rate','nagios_pid','neb_callbacks',
'neb_callbacks_rate','obsess_over_hosts','obsess_over_services','process_performance_data',
'program_start','program_version','requests','requests_rate','service_checks','service_checks_rate'
],
'timeperiods' => [ 'in', 'name', 'alias' ],
};
my $author = 'Monitoring::Livestatus test';
for my $key (sort keys %{$objects_to_test}) {
my $ml = $objects_to_test->{$key};
isa_ok($ml, 'Monitoring::Livestatus') or BAIL_OUT("no need to continue without a proper Monitoring::Livestatus object: ".$key);
# dont die on errors
$ml->errors_are_fatal(0);
$ml->warnings(0);
#########################
# set downtime for a host and service
my $downtimes = $ml->selectall_arrayref("GET downtimes\nColumns: id");
my $num_downtimes = 0;
$num_downtimes = scalar @{$downtimes} if defined $downtimes;
my $firsthost = $ml->selectscalar_value("GET hosts\nColumns: name\nLimit: 1");
isnt($firsthost, undef, 'get test hostname') or BAIL_OUT($key.': got not test hostname');
$ml->do('COMMAND ['.time().'] SCHEDULE_HOST_DOWNTIME;'.$firsthost.';'.time().';'.(time()+300).';1;0;300;'.$author.';perl test: '.$0);
my $firstservice = $ml->selectscalar_value("GET services\nColumns: description\nFilter: host_name = $firsthost\nLimit: 1");
isnt($firstservice, undef, 'get test servicename') or BAIL_OUT('got not test servicename');
$ml->do('COMMAND ['.time().'] SCHEDULE_SVC_DOWNTIME;'.$firsthost.';'.$firstservice.';'.time().';'.(time()+300).';1;0;300;'.$author.';perl test: '.$0);
# sometimes it takes while till the downtime is accepted
my $waited = 0;
while(scalar @{$ml->selectall_arrayref("GET downtimes\nColumns: id")} < $num_downtimes + 2) {
print "waiting for the downtime...\n";
sleep(1);
$waited++;
BAIL_OUT('waited 30 seconds for the downtime...') if $waited > 30;
}
#########################
#########################
# check tables
my $data = $ml->selectall_hashref("GET columns\nColumns: table", 'table');
my @tables = sort keys %{$data};
my @expected_tables = sort keys %{$expected_keys};
is_deeply(\@tables, \@expected_tables, $key.' tables') or BAIL_OUT("got tables:\n".join(', ', @tables)."\nbut expected\n".join(', ', @expected_tables));
#########################
# check keys
for my $type (keys %{$expected_keys}) {
my $filter = "";
$filter = "Filter: time > ".(time() - 86400)."\n" if $type eq 'log';
$filter .= "Filter: time < ".(time())."\n" if $type eq 'log';
my $expected_keys = get_expected_keys($type);
my $statement = "GET $type\n".$filter."Limit: 1";
$lastquery = $statement;
my $hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is(ref $hash_ref, 'HASH', $type.' keys are a hash') or BAIL_OUT($type.'keys are not in hash format, got '.Dumper($hash_ref));
my @keys = sort keys %{$hash_ref};
is_deeply(\@keys, $expected_keys, $key.' '.$type.' table columns') or BAIL_OUT("got $type keys:\n".join(', ', @keys)."\nbut expected\n".join(', ', @{$expected_keys}));
}
my $statement = "GET hosts\nColumns: name as hostname state\nLimit: 1";
$lastquery = $statement;
my $hash_ref = $ml->selectrow_hashref($statement);
undef $lastquery;
isnt($hash_ref, undef, $key.' test column alias');
is($Monitoring::Livestatus::ErrorCode, 0, $key.' test column alias') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
#########################
# send a test command
# commands still dont work and breaks livestatus
my $rt = $ml->do('COMMAND ['.time().'] SAVE_STATE_INFORMATION');
is($rt, '1', $key.' test command');
#########################
# check for errors
#$ml->{'verbose'} = 1;
$statement = "GET hosts\nLimit: 1";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
isnt($hash_ref, undef, $key.' test error 200 body');
is($Monitoring::Livestatus::ErrorCode, 0, $key.' test error 200 status') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "BLAH hosts";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 401 body');
is($Monitoring::Livestatus::ErrorCode, '401', $key.' test error 401 status') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET hosts\nLimit: ";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 403 body');
is($Monitoring::Livestatus::ErrorCode, '403', $key.' test error 403 status') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET unknowntable\nLimit: 1";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 404 body');
is($Monitoring::Livestatus::ErrorCode, '404', $key.' test error 404 status') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET hosts\nColumns: unknown";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 405 body');
TODO: {
local $TODO = 'livestatus returns wrong status';
is($Monitoring::Livestatus::ErrorCode, '405', $key.' test error 405 status') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
};
#########################
# some more broken statements
$statement = "GET ";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement);
undef $lastquery;
is($hash_ref, undef, $key.' test error 403 body');
is($Monitoring::Livestatus::ErrorCode, '403', $key.' test error 403 status: GET ') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET hosts\nColumns: name, name";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 405 body');
is($Monitoring::Livestatus::ErrorCode, '405', $key.' test error 405 status: GET hosts\nColumns: name, name') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET hosts\nColumns: ";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 405 body');
is($Monitoring::Livestatus::ErrorCode, '405', $key.' test error 405 status: GET hosts\nColumns: ') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
#########################
# some forbidden headers
$statement = "GET hosts\nKeepAlive: on";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 496 body');
is($Monitoring::Livestatus::ErrorCode, '496', $key.' test error 496 status: KeepAlive: on') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET hosts\nResponseHeader: fixed16";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 495 body');
is($Monitoring::Livestatus::ErrorCode, '495', $key.' test error 495 status: ResponseHeader: fixed16') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET hosts\nColumnHeaders: on";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 494 body');
is($Monitoring::Livestatus::ErrorCode, '494', $key.' test error 494 status: ColumnHeader: on') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET hosts\nOuputFormat: json";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 493 body');
is($Monitoring::Livestatus::ErrorCode, '493', $key.' test error 493 status: OutputForma: json') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
$statement = "GET hosts\nSeparators: 0 1 2 3";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($hash_ref, undef, $key.' test error 492 body');
is($Monitoring::Livestatus::ErrorCode, '492', $key.' test error 492 status: Seperators: 0 1 2 3') or
diag('got error: '.$Monitoring::Livestatus::ErrorMessage);
#########################
# check some fancy stats queries
my $stats_query = "GET services
Stats: state = 0 as all_ok
Stats: state = 1 as all_warning
Stats: state = 2 as all_critical
Stats: state = 3 as all_unknown
Stats: state = 4 as all_pending
Stats: host_state != 0
Stats: state = 1
StatsAnd: 2 as all_warning_on_down_hosts
Stats: host_state != 0
Stats: state = 2
StatsAnd: 2 as all_critical_on_down_hosts
Stats: host_state != 0
Stats: state = 3
StatsAnd: 2 as all_unknown_on_down_hosts
Stats: host_state != 0
Stats: state = 3
Stats: active_checks_enabled = 1
StatsAnd: 3 as all_unknown_active_on_down_hosts
Stats: state = 3
Stats: active_checks_enabled = 1
StatsOr: 2 as all_active_or_unknown";
$lastquery = $stats_query;
$hash_ref = $ml->selectrow_hashref($stats_query );
undef $lastquery;
isnt($hash_ref, undef, $key.' test fancy stats query') or
diag('got error: '.Dumper($hash_ref));
}
# generate expected keys
sub get_expected_keys {
my $type = shift;
my $skip = shift;
my @keys = @{$expected_keys->{$type}};
my @new_keys;
for my $key (@keys) {
my $replaced = 0;
for my $replace_with (keys %{$expected_keys}) {
if($key eq '__all_from_'.$replace_with.'__') {
$replaced = 1;
next if $skip;
my $prefix = $replace_with.'_';
if($replace_with eq "hosts") { $prefix = 'host_'; }
if($replace_with eq "services") { $prefix = 'service_'; }
if($replace_with eq "commands") { $prefix = 'command_'; }
if($replace_with eq "contacts") { $prefix = 'contact_'; }
if($replace_with eq "servicegroups") { $prefix = 'servicegroup_'; }
if($replace_with eq "hostgroups") { $prefix = 'hostgroup_'; }
if($type eq "log") { $prefix = 'current_'.$prefix; }
if($type eq "servicesbygroup" and $replace_with eq 'services') { $prefix = ''; }
if($type eq "servicesbyhostgroup" and $replace_with eq 'services') { $prefix = ''; }
if($type eq "hostsbygroup" and $replace_with eq 'hosts') { $prefix = ''; }
my $replace_keys = get_expected_keys($replace_with, 1);
for my $key2 (@{$replace_keys}) {
push @new_keys, $prefix.$key2;
}
}
}
if($replaced == 0) {
push @new_keys, $key;
}
}
# has been fixed in 1.1.1rc
#if($type eq 'log') {
# my %keys = map { $_ => 1 } @new_keys;
# delete $keys{'current_contact_can_submit_commands'};
# delete $keys{'current_contact_host_notifications_enabled'};
# delete $keys{'current_contact_in_host_notification_period'};
# delete $keys{'current_contact_in_service_notification_period'};
# delete $keys{'current_contact_service_notifications_enabled'};
# @new_keys = keys %keys;
#}
my @return = sort @new_keys;
return(\@return);
}

95
api/perl/t/31-Monitoring-Livestatus-MULTI-live-test.t Normal file
View File

@@ -0,0 +1,95 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More;
use Data::Dumper;
if ( ! defined $ENV{TEST_SOCKET} or !defined $ENV{TEST_SERVER} ) {
my $msg = 'Author test. Set $ENV{TEST_SOCKET} and $ENV{TEST_SERVER} to run';
plan( skip_all => $msg );
} else {
plan( tests => 22 );
}
use_ok('Monitoring::Livestatus::MULTI');
#########################
# create new test object
my $objects_to_test = {
'multi_one' => Monitoring::Livestatus::MULTI->new( peer => [ $ENV{TEST_SERVER} ], warnings => 0 ),
'multi_two' => Monitoring::Livestatus::MULTI->new( peer => [ $ENV{TEST_SERVER}, $ENV{TEST_SOCKET} ], warnings => 0 ),
'multi_three' => Monitoring::Livestatus::MULTI->new(
'verbose' => '0',
'warnings' => '0',
'timeout' => '10',
'peer' => [
{ 'name' => 'Mon 1', 'peer' => $ENV{TEST_SERVER} },
{ 'name' => 'Mon 2', 'peer' => $ENV{TEST_SOCKET} },
],
'keepalive' => '1'
),
};
# dont die on errors
#$ml->errors_are_fatal(0);
for my $key (keys %{$objects_to_test}) {
my $ml = $objects_to_test->{$key};
isa_ok($ml, 'Monitoring::Livestatus::MULTI') or BAIL_OUT("no need to continue without a proper Monitoring::Livestatus::MULTI object");
#########################
# DATA INTEGRITY
#########################
my $statement = "GET hosts\nColumns: state name alias\nLimit: 1";
my $data1 = $ml->selectall_arrayref($statement, {Slice => 1});
my $data2 = $ml->selectall_arrayref($statement, {Slice => 1, AddPeer => 1});
for my $data (@{$data2}) {
delete $data->{'peer_name'};
delete $data->{'peer_addr'};
delete $data->{'peer_key'};
}
is_deeply($data1, $data2, "data integrity with peers added and Column");
$statement = "GET hosts\nLimit: 1";
$data1 = $ml->selectall_arrayref($statement, {Slice => 1, Deepcopy => 1});
$data2 = $ml->selectall_arrayref($statement, {Slice => 1, AddPeer => 1, Deepcopy => 1});
for my $data (@{$data2}) {
delete $data->{'peer_name'};
delete $data->{'peer_addr'};
delete $data->{'peer_key'};
}
is_deeply($data1, $data2, "data integrity with peers added without Columns");
#########################
# try to change result set to scalar
for my $data (@{$data1}) { $data->{'peer_name'} = 1; }
for my $data (@{$data2}) { $data->{'peer_name'} = 1; }
is_deeply($data1, $data2, "data integrity with changed result set");
#########################
# try to change result set to hash
for my $data (@{$data1}) { $data->{'peer_name'} = {}; }
for my $data (@{$data2}) { $data->{'peer_name'} = {}; }
is_deeply($data1, $data2, "data integrity with changed result set");
#########################
# BACKENDS
#########################
my @backends = $ml->peer_key();
$data1 = $ml->selectall_arrayref($statement, {Slice => 1});
$data2 = $ml->selectall_arrayref($statement, {Slice => 1, Backend => \@backends });
is_deeply($data1, $data2, "data integrity with backends");
#########################
# BUGS
#########################
#########################
# Bug: Can't use string ("flap") as an ARRAY ref while "strict refs" in use at Monitoring/Livestatus/MULTI.pm line 206.
$statement = "GET servicegroups\nColumns: name alias\nFilter: name = flap\nLimit: 1";
$data1 = $ml->selectrow_array($statement);
isnt($data1, undef, "bug check: Can't use string (\"group\")...");
}

106
api/perl/t/32-Monitoring-Livestatus-backend-test.t Normal file
View File

@@ -0,0 +1,106 @@
#!/usr/bin/env perl
#########################
use strict;
use Carp;
use Test::More;
use Data::Dumper;
if ( ! defined $ENV{TEST_SOCKET} or !defined $ENV{TEST_SERVER} or !defined $ENV{TEST_BACKEND} ) {
my $msg = 'Author test. Set $ENV{TEST_SOCKET} and $ENV{TEST_SERVER} and $ENV{TEST_BACKEND} to run';
plan( skip_all => $msg );
} else {
# we dont know yet how many tests we got
plan( tests => 55237 );
}
# set an alarm
my $lastquery;
$SIG{ALRM} = sub {
my @caller = caller;
$lastquery =~ s/\n+/\n/g;
print STDERR 'last query: '.$lastquery."\n" if defined $lastquery;
confess "timeout reached:".Dumper(\@caller)."\n"
};
use_ok('Monitoring::Livestatus');
#########################
my $objects_to_test = {
# UNIX
'01 unix_single_arg' => Monitoring::Livestatus::UNIX->new( $ENV{TEST_SOCKET} ),
# TCP
'02 inet_single_arg' => Monitoring::Livestatus::INET->new( $ENV{TEST_SERVER} ),
# MULTI
'03 multi_keepalive' => Monitoring::Livestatus->new( [ $ENV{TEST_SERVER}, $ENV{TEST_SOCKET} ] ),
};
for my $key (sort keys %{$objects_to_test}) {
my $ml = $objects_to_test->{$key};
isa_ok($ml, 'Monitoring::Livestatus') or BAIL_OUT("no need to continue without a proper Monitoring::Livestatus object: ".$key);
# dont die on errors
$ml->errors_are_fatal(0);
$ml->warnings(0);
#########################
# get tables
my $data = $ml->selectall_hashref("GET columns\nColumns: table", 'table');
my @tables = sort keys %{$data};
#########################
# check keys
for my $type (@tables) {
alarm(120);
my $filter = "";
$filter = "Filter: time > ".(time() - 86400)."\n" if $type eq 'log';
$filter .= "Filter: time < ".(time())."\n" if $type eq 'log';
my $statement = "GET $type\n".$filter."Limit: 1";
$lastquery = $statement;
my $keys = $ml->selectrow_hashref($statement );
undef $lastquery;
is(ref $keys, 'HASH', $type.' keys are a hash');# or BAIL_OUT('keys are not in hash format, got '.Dumper($keys));
# status has no filter implemented
next if $type eq 'status';
for my $key (keys %{$keys}) {
my $value = $keys->{$key};
if(index($value, ',') > 0) { my @vals = split /,/, $value; $value = $vals[0]; }
my $typefilter = "Filter: $key >= $value\n";
if($value eq '') {
$typefilter = "Filter: $key =\n";
}
my $statement = "GET $type\n".$filter.$typefilter."Limit: 1";
$lastquery = $statement;
my $hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($Monitoring::Livestatus::ErrorCode, 0, "GET ".$type." Filter: ".$key." >= ".$value) or BAIL_OUT("query failed: ".$statement);
#isnt($hash_ref, undef, "GET ".$type." Filter: ".$key." >= ".$value);# or BAIL_OUT("got undef for ".$statement);
# send test stats query
my $stats_query = [ $key.' = '.$value, 'std '.$key, 'min '.$key, 'max '.$key, 'avg '.$key, 'sum '.$key ];
for my $stats_part (@{$stats_query}) {
my $statement = "GET $type\n".$filter.$typefilter."\nStats: $stats_part";
$lastquery = $statement;
my $hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($Monitoring::Livestatus::ErrorCode, 0, "GET ".$type." Filter: ".$key." >= ".$value." Stats: $stats_part") or BAIL_OUT("query failed:\n".$statement);
$statement = "GET $type\n".$filter.$typefilter."\nStats: $stats_part\nStatsGroupBy: $key";
$lastquery = $statement;
$hash_ref = $ml->selectrow_hashref($statement );
undef $lastquery;
is($Monitoring::Livestatus::ErrorCode, 0, "GET ".$type." Filter: ".$key." >= ".$value." Stats: $stats_part StatsGroupBy: $key") or BAIL_OUT("query failed:\n".$statement);
}
# wait till backend is started up again
if(!defined $hash_ref and $Monitoring::Livestatus::ErrorCode > 200) {
sleep(2);
}
}
}
}

74
api/perl/t/33-Monitoring-Livestatus-test_socket_timeout.t Normal file
View File

@@ -0,0 +1,74 @@
#!/usr/bin/env perl
#########################
use strict;
use Test::More;
use Data::Dumper;
if ( !defined $ENV{TEST_SERVER} ) {
my $msg = 'Author test. Set $ENV{TEST_SOCKET} and $ENV{TEST_SERVER} to run';
plan( skip_all => $msg );
} else {
plan( tests => 7 );
}
# set an alarm
my $lastquery;
$SIG{ALRM} = sub {
my @caller = caller;
print STDERR 'last query: '.$lastquery if defined $lastquery;
die "timeout reached:".Dumper(\@caller)."\n"
};
alarm(30);
use_ok('Monitoring::Livestatus');
#use Log::Log4perl qw(:easy);
#Log::Log4perl->easy_init($DEBUG);
#########################
# Test Query
#########################
my $statement = "GET hosts\nColumns: alias\nFilter: name = host1";
#########################
my $objects_to_test = {
# create inet object with hash args
'01 inet_hash_args' => Monitoring::Livestatus->new(
verbose => 0,
server => $ENV{TEST_SERVER},
keepalive => 1,
timeout => 3,
retries_on_connection_error => 0,
# logger => get_logger(),
),
# create inet object with a single arg
'02 inet_single_arg' => Monitoring::Livestatus::INET->new( $ENV{TEST_SERVER} ),
};
for my $key (sort keys %{$objects_to_test}) {
my $ml = $objects_to_test->{$key};
isa_ok($ml, 'Monitoring::Livestatus');
# we dont need warnings for testing
$ml->warnings(0);
#########################
my $ary_ref = $ml->selectall_arrayref($statement);
is($Monitoring::Livestatus::ErrorCode, 0, 'Query Status 0');
#is_deeply($ary_ref, $selectall_arrayref1, 'selectall_arrayref($statement)')
# or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectall_arrayref1));
sleep(10);
$ary_ref = $ml->selectall_arrayref($statement);
is($Monitoring::Livestatus::ErrorCode, 0, 'Query Status 0');
#is_deeply($ary_ref, $selectall_arrayref1, 'selectall_arrayref($statement)')
# or diag("got: ".Dumper($ary_ref)."\nbut expected ".Dumper($selectall_arrayref1));
#print Dumper($Monitoring::Livestatus::ErrorCode);
#print Dumper($Monitoring::Livestatus::ErrorMessage);
}

78
api/perl/t/34-Monitoring-Livestatus-utf8_support.t Normal file
View File

@@ -0,0 +1,78 @@
#!/usr/bin/env perl
#########################
use strict;
use Encode;
use Test::More;
use Data::Dumper;
if ( !defined $ENV{TEST_SERVER} ) {
my $msg = 'Author test. Set $ENV{TEST_SOCKET} and $ENV{TEST_SERVER} to run';
plan( skip_all => $msg );
} else {
plan( tests => 9 );
}
use_ok('Monitoring::Livestatus');
#use Log::Log4perl qw(:easy);
#Log::Log4perl->easy_init($DEBUG);
#########################
my $objects_to_test = {
# create inet object with hash args
'01 inet_hash_args' => Monitoring::Livestatus->new(
verbose => 0,
server => $ENV{TEST_SERVER},
keepalive => 1,
timeout => 3,
retries_on_connection_error => 0,
# logger => get_logger(),
),
# create inet object with a single arg
'02 inet_single_arg' => Monitoring::Livestatus::INET->new( $ENV{TEST_SERVER} ),
};
my $author = 'Monitoring::Livestatus test';
for my $key (sort keys %{$objects_to_test}) {
my $ml = $objects_to_test->{$key};
isa_ok($ml, 'Monitoring::Livestatus');
# we dont need warnings for testing
$ml->warnings(0);
#########################
my $downtimes = $ml->selectall_arrayref("GET downtimes\nColumns: id");
my $num_downtimes = 0;
$num_downtimes = scalar @{$downtimes} if defined $downtimes;
#########################
# get a test host
my $firsthost = $ml->selectscalar_value("GET hosts\nColumns: name\nLimit: 1");
isnt($firsthost, undef, 'get test hostname') or BAIL_OUT($key.': got not test hostname');
my $expect = "aa ²&é\"'''(§è!çà)- %s ''%s'' aa ~ € bb";
#my $expect = "öäüß";
my $teststrings = [
$expect,
"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",
];
for my $string (@{$teststrings}) {
$ml->do('COMMAND ['.time().'] SCHEDULE_HOST_DOWNTIME;'.$firsthost.';'.time().';'.(time()+300).';1;0;300;'.$author.';'.$string);
# sometimes it takes while till the downtime is accepted
my $waited = 0;
while($downtimes = $ml->selectall_arrayref("GET downtimes\nColumns: id comment", { Slice => 1 }) and scalar @{$downtimes} < $num_downtimes + 1) {
print "waiting for the downtime...\n";
sleep(1);
$waited++;
BAIL_OUT('waited 30 seconds for the downtime...') if $waited > 30;
}
my $last_downtime = pop @{$downtimes};
#utf8::decode($expect);
is($last_downtime->{'comment'}, $expect, 'get same utf8 comment: got '.Dumper($last_downtime));
}
}

53
api/perl/t/35-Monitoring-Livestatus-callbacks_support.t Normal file
View File

@@ -0,0 +1,53 @@
#!/usr/bin/env perl
#########################
use strict;
use Encode;
use Test::More;
use Data::Dumper;
if ( !defined $ENV{TEST_SERVER} ) {
my $msg = 'Author test. Set $ENV{TEST_SOCKET} and $ENV{TEST_SERVER} to run';
plan( skip_all => $msg );
} else {
plan( tests => 15 );
}
use_ok('Monitoring::Livestatus');
#use Log::Log4perl qw(:easy);
#Log::Log4perl->easy_init($DEBUG);
#########################
my $objects_to_test = {
# create inet object with hash args
'01 inet_hash_args' => Monitoring::Livestatus->new(
verbose => 0,
server => $ENV{TEST_SERVER},
keepalive => 1,
timeout => 3,
retries_on_connection_error => 0,
# logger => get_logger(),
),
# create inet object with a single arg
'02 inet_single_arg' => Monitoring::Livestatus::INET->new( $ENV{TEST_SERVER} ),
};
for my $key (sort keys %{$objects_to_test}) {
my $ml = $objects_to_test->{$key};
isa_ok($ml, 'Monitoring::Livestatus');
my $got = $ml->selectall_arrayref("GET hosts\nColumns: name alias state\nLimit: 1", { Slice => 1, callbacks => { 'c1' => sub { return $_[0]->{'alias'}; } } });
isnt($got->[0]->{'alias'}, undef, 'got a test host');
is($got->[0]->{'alias'}, $got->[0]->{'c1'}, 'callback for sliced results');
$got = $ml->selectall_arrayref("GET hosts\nColumns: name alias state\nLimit: 1", { Slice => 1, callbacks => { 'name' => sub { return $_[0]->{'alias'}; } } });
isnt($got->[0]->{'alias'}, undef, 'got a test host');
is($got->[0]->{'alias'}, $got->[0]->{'name'}, 'callback for sliced results which overwrites key');
$got = $ml->selectall_arrayref("GET hosts\nColumns: name alias state\nLimit: 1", { callbacks => { 'c1' => sub { return $_[0]->[1]; } } });
isnt($got->[0]->[1], undef, 'got a test host');
is($got->[0]->[1], $got->[0]->[3], 'callback for non sliced results');
}

9
api/perl/t/97-Pod.t Normal file
View File

@@ -0,0 +1,9 @@
use strict;
use warnings;
use Test::More;
eval "use Test::Pod 1.14";
plan skip_all => 'Test::Pod 1.14 required' if $@;
plan skip_all => 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.' unless $ENV{TEST_AUTHOR};
all_pod_files_ok();

23
api/perl/t/98-Pod-Coverage.t Normal file
View File

@@ -0,0 +1,23 @@
#!/usr/bin/env perl
#
# $Id$
#
use strict;
use warnings;
use File::Spec;
use Test::More;
if ( not $ENV{TEST_AUTHOR} ) {
my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.';
plan( skip_all => $msg );
}
eval { require Test::Pod::Coverage; };
if ( $@ ) {
my $msg = 'Test::Pod::Coverage required to criticise pod';
plan( skip_all => $msg );
}
eval "use Test::Pod::Coverage 1.00";
all_pod_coverage_ok();

24
api/perl/t/99-Perl-Critic.t Normal file
View File

@@ -0,0 +1,24 @@
#!/usr/bin/env perl
#
# $Id$
#
use strict;
use warnings;
use File::Spec;
use Test::More;
if ( not $ENV{TEST_AUTHOR} ) {
my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.';
plan( skip_all => $msg );
}
eval { require Test::Perl::Critic; };
if ( $@ ) {
my $msg = 'Test::Perl::Critic required to criticise code';
plan( skip_all => $msg );
}
my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' );
Test::Perl::Critic->import( -profile => $rcfile );
all_critic_ok();

286
api/perl/t/perlcriticrc Normal file
View File

@@ -0,0 +1,286 @@
##############################################################################
# This Perl::Critic configuration file sets the Policy severity levels
# according to Damian Conway's own personal recommendations. Feel free to
# use this as your own, or make modifications.
##############################################################################
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitAccessOfPrivateData]
severity = 3
[Perl::Critic::Policy::BuiltinFunctions::ProhibitLvalueSubstr]
severity = 3
[Perl::Critic::Policy::BuiltinFunctions::ProhibitReverseSortBlock]
severity = 1
[Perl::Critic::Policy::BuiltinFunctions::ProhibitSleepViaSelect]
severity = 5
[Perl::Critic::Policy::BuiltinFunctions::ProhibitStringyEval]
severity = 5
[Perl::Critic::Policy::BuiltinFunctions::ProhibitStringySplit]
severity = 2
[Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalCan]
severity = 4
[Perl::Critic::Policy::BuiltinFunctions::ProhibitUniversalIsa]
severity = 4
[Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidGrep]
severity = 3
[Perl::Critic::Policy::BuiltinFunctions::ProhibitVoidMap]
severity = 3
[Perl::Critic::Policy::BuiltinFunctions::RequireBlockGrep]
severity = 4
[Perl::Critic::Policy::BuiltinFunctions::RequireBlockMap]
severity = 4
[Perl::Critic::Policy::BuiltinFunctions::RequireGlobFunction]
severity = 5
[Perl::Critic::Policy::BuiltinFunctions::RequireSimpleSortBlock]
severity = 3
[Perl::Critic::Policy::ClassHierarchies::ProhibitAutoloading]
severity = 3
[Perl::Critic::Policy::ClassHierarchies::ProhibitExplicitISA]
severity = 4
[Perl::Critic::Policy::ClassHierarchies::ProhibitOneArgBless]
severity = 5
[Perl::Critic::Policy::CodeLayout::ProhibitHardTabs]
severity = 3
[Perl::Critic::Policy::CodeLayout::ProhibitParensWithBuiltins]
severity = 1
[Perl::Critic::Policy::CodeLayout::ProhibitQuotedWordLists]
severity = 2
[Perl::Critic::Policy::CodeLayout::RequireConsistentNewlines]
severity = 4
[Perl::Critic::Policy::CodeLayout::RequireTidyCode]
severity = 1
[Perl::Critic::Policy::CodeLayout::RequireTrailingCommas]
severity = 3
[Perl::Critic::Policy::ControlStructures::ProhibitCStyleForLoops]
severity = 3
[Perl::Critic::Policy::ControlStructures::ProhibitCascadingIfElse]
severity = 3
[Perl::Critic::Policy::ControlStructures::ProhibitDeepNests]
severity = 3
[Perl::Critic::Policy::ControlStructures::ProhibitMutatingListFunctions]
severity = 5
[Perl::Critic::Policy::ControlStructures::ProhibitPostfixControls]
severity = 4
[Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks]
severity = 4
[Perl::Critic::Policy::ControlStructures::ProhibitUnreachableCode]
severity = 4
[Perl::Critic::Policy::ControlStructures::ProhibitUntilBlocks]
severity = 4
[Perl::Critic::Policy::Documentation::RequirePodAtEnd]
severity = 2
[Perl::Critic::Policy::Documentation::RequirePodSections]
severity = 2
[Perl::Critic::Policy::ErrorHandling::RequireCarping]
severity = 4
[Perl::Critic::Policy::InputOutput::ProhibitBacktickOperators]
severity = 3
[Perl::Critic::Policy::InputOutput::ProhibitBarewordFileHandles]
severity = 5
[Perl::Critic::Policy::InputOutput::ProhibitInteractiveTest]
severity = 4
[Perl::Critic::Policy::InputOutput::ProhibitOneArgSelect]
severity = 4
[Perl::Critic::Policy::InputOutput::ProhibitReadlineInForLoop]
severity = 5
[Perl::Critic::Policy::InputOutput::ProhibitTwoArgOpen]
severity = 4
[Perl::Critic::Policy::InputOutput::RequireBracedFileHandleWithPrint]
severity = 3
[Perl::Critic::Policy::Miscellanea::ProhibitFormats]
severity = 3
[Perl::Critic::Policy::Miscellanea::ProhibitTies]
severity = 4
[-Perl::Critic::Policy::Miscellanea::RequireRcsKeywords]
[Perl::Critic::Policy::Modules::ProhibitAutomaticExportation]
severity = 4
[Perl::Critic::Policy::Modules::ProhibitEvilModules]
severity = 5
[Perl::Critic::Policy::Modules::ProhibitMultiplePackages]
severity = 4
[Perl::Critic::Policy::Modules::RequireBarewordIncludes]
severity = 5
[Perl::Critic::Policy::Modules::RequireEndWithOne]
severity = 4
[Perl::Critic::Policy::Modules::RequireExplicitPackage]
severity = 4
[Perl::Critic::Policy::Modules::RequireFilenameMatchesPackage]
severity = 5
[Perl::Critic::Policy::Modules::RequireVersionVar]
severity = 4
[Perl::Critic::Policy::NamingConventions::ProhibitAmbiguousNames]
severity = 3
[Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseSubs]
severity = 1
[Perl::Critic::Policy::NamingConventions::ProhibitMixedCaseVars]
severity = 1
[Perl::Critic::Policy::References::ProhibitDoubleSigils]
severity = 4
[Perl::Critic::Policy::RegularExpressions::ProhibitCaptureWithoutTest]
severity = 4
[Perl::Critic::Policy::RegularExpressions::RequireExtendedFormatting]
severity = 5
[Perl::Critic::Policy::RegularExpressions::RequireLineBoundaryMatching]
severity = 5
[Perl::Critic::Policy::Subroutines::ProhibitAmpersandSigils]
severity = 2
[Perl::Critic::Policy::Subroutines::ProhibitBuiltinHomonyms]
severity = 4
[Perl::Critic::Policy::Subroutines::ProhibitExcessComplexity]
severity = 3
[Perl::Critic::Policy::Subroutines::ProhibitExplicitReturnUndef]
severity = 5
[Perl::Critic::Policy::Subroutines::ProhibitSubroutinePrototypes]
severity = 4
[Perl::Critic::Policy::Subroutines::ProtectPrivateSubs]
severity = 3
[Perl::Critic::Policy::Subroutines::RequireFinalReturn]
severity = 5
[Perl::Critic::Policy::TestingAndDebugging::ProhibitNoStrict]
severity = 5
[Perl::Critic::Policy::TestingAndDebugging::ProhibitNoWarnings]
severity = 4
[Perl::Critic::Policy::TestingAndDebugging::ProhibitProlongedStrictureOverride]
severity = 4
[Perl::Critic::Policy::TestingAndDebugging::RequireTestLabels]
severity = 3
[Perl::Critic::Policy::TestingAndDebugging::RequireUseStrict]
severity = 5
[Perl::Critic::Policy::TestingAndDebugging::RequireUseWarnings]
severity = 4
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitConstantPragma]
severity = 4
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyQuotes]
severity = 2
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitEscapedCharacters]
severity = 2
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitInterpolationOfLiterals]
severity = 1
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitLeadingZeros]
severity = 5
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitMismatchedOperators]
severity = 2
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitMixedBooleanOperators]
severity = 4
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitNoisyQuotes]
severity = 2
[Perl::Critic::Policy::ValuesAndExpressions::ProhibitVersionStrings]
severity = 3
[Perl::Critic::Policy::ValuesAndExpressions::RequireInterpolationOfMetachars]
severity = 1
[Perl::Critic::Policy::ValuesAndExpressions::RequireNumberSeparators]
severity = 2
[Perl::Critic::Policy::ValuesAndExpressions::RequireQuotedHeredocTerminator]
severity = 4
[Perl::Critic::Policy::ValuesAndExpressions::RequireUpperCaseHeredocTerminator]
severity = 4
[Perl::Critic::Policy::Variables::ProhibitConditionalDeclarations]
severity = 5
[Perl::Critic::Policy::Variables::ProhibitLocalVars]
severity = 2
[Perl::Critic::Policy::Variables::ProhibitMatchVars]
severity = 4
[Perl::Critic::Policy::Variables::ProhibitPackageVars]
severity = 3
[Perl::Critic::Policy::Variables::ProhibitPunctuationVars]
severity = 2
[Perl::Critic::Policy::Variables::ProtectPrivateVars]
severity = 3
[Perl::Critic::Policy::Variables::RequireInitializationForLocalVars]
severity = 5
[Perl::Critic::Policy::Variables::RequireLexicalLoopIterators]
severity = 5
[Perl::Critic::Policy::Variables::RequireNegativeIndices]
severity = 4

23
api/python/README Normal file
View File

@@ -0,0 +1,23 @@
This directory contains a very efficient API to MK Livestatus
for Python. It is directly taken from the Multisite GUI and
has the following features:
* It supports keep alive
* It returns typed values
* It support transparent multi-site access
* It supports persistent connection caching
* It supports parallelized queries (though still single-threaded)
* It supports detection of dead sites (via "status_host")
Please look at the two examples:
example.py: Example for a single site
example_multisite.py: Example querying several sites
Both example are written to be run within an OMD instance
and need no further configuration.
If you are not using OMD, you need to modify the examples
and enter the correct path to you livestatus socket.
Or even better: give OMD a try --> omdistro.org. This will
make you live *really* easier!

72
api/python/example.py Executable file
View File

@@ -0,0 +1,72 @@
#!/usr/bin/python
# -*- encoding: utf-8; py-indent-offset: 4 -*-
# +------------------------------------------------------------------+
# | ____ _ _ __ __ _ __ |
# | / ___| |__ ___ ___| | __ | \/ | |/ / |
# | | | | '_ \ / _ \/ __| |/ / | |\/| | ' / |
# | | |___| | | | __/ (__| < | | | | . \ |
# | \____|_| |_|\___|\___|_|\_\___|_| |_|_|\_\ |
# | |
# | Copyright Mathias Kettner 2014 mk@mathias-kettner.de |
# +------------------------------------------------------------------+
#
# This file is part of Check_MK.
# The official homepage is at http://mathias-kettner.de/check_mk.
#
# check_mk is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation in version 2. check_mk is distributed
# in the hope that it will be useful, but WITHOUT ANY WARRANTY; with-
# out even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE. See the GNU General Public License for more de-
# tails. You should have received a copy of the GNU General Public
# License along with GNU Make; see the file COPYING. If not, write
# to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
# Boston, MA 02110-1301 USA.
import os, sys
import livestatus
try:
omd_root = os.getenv("OMD_ROOT")
socket_path = "unix:" + omd_root + "/tmp/run/live"
except:
sys.stderr.write("This example is indented to run in an OMD site\n")
sys.stderr.write("Please change socket_path in this example, if you are\n")
sys.stderr.write("not using OMD.\n")
sys.exit(1)
try:
# Make a single connection for each query
print "\nPerformance:"
for key, value in livestatus.SingleSiteConnection(socket_path).query_row_assoc("GET status").items():
print "%-30s: %s" % (key, value)
print "\nHosts:"
hosts = livestatus.SingleSiteConnection(socket_path).query_table("GET hosts\nColumns: name alias address")
for name, alias, address in hosts:
print "%-16s %-16s %s" % (name, address, alias)
# Do several queries in one connection
conn = livestatus.SingleSiteConnection(socket_path)
num_up = conn.query_value("GET hosts\nStats: hard_state = 0")
print "\nHosts up: %d" % num_up
stats = conn.query_row(
"GET services\n"
"Stats: state = 0\n"
"Stats: state = 1\n"
"Stats: state = 2\n"
"Stats: state = 3\n")
print "Service stats: %d/%d/%d/%d" % tuple(stats)
print "List of commands: %s" % \
", ".join(conn.query_column("GET commands\nColumns: name"))
print "Query error:"
conn.query_value("GET hosts\nColumns: hirni")
except Exception, e: # livestatus.MKLivestatusException, e:
print "Livestatus error: %s" % str(e)

94
api/python/example_multisite.py Executable file
View File

@@ -0,0 +1,94 @@
#!/usr/bin/python
# -*- encoding: utf-8; py-indent-offset: 4 -*-
# +------------------------------------------------------------------+
# | ____ _ _ __ __ _ __ |
# | / ___| |__ ___ ___| | __ | \/ | |/ / |
# | | | | '_ \ / _ \/ __| |/ / | |\/| | ' / |
# | | |___| | | | __/ (__| < | | | | . \ |
# | \____|_| |_|\___|\___|_|\_\___|_| |_|_|\_\ |
# | |
# | Copyright Mathias Kettner 2014 mk@mathias-kettner.de |
# +------------------------------------------------------------------+
#
# This file is part of Check_MK.
# The official homepage is at http://mathias-kettner.de/check_mk.
#
# check_mk is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation in version 2. check_mk is distributed
# in the hope that it will be useful, but WITHOUT ANY WARRANTY; with-
# out even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE. See the GNU General Public License for more de-
# tails. You should have received a copy of the GNU General Public
# License along with GNU Make; see the file COPYING. If not, write
# to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
# Boston, MA 02110-1301 USA.
import os
import sys
import livestatus
try:
omd_root = os.getenv("OMD_ROOT")
socket_path = "unix:" + omd_root + "/tmp/run/live"
except:
sys.stderr.write("This example is indented to run in an OMD site\n")
sys.stderr.write("Please change socket_path in this example, if you are\n")
sys.stderr.write("not using OMD.\n")
sys.exit(1)
sites = {
"muc" : {
"socket" : socket_path,
"alias" : "Munich",
},
"sitea" : {
"alias" : "Augsburg",
"socket" : "tcp:sitea:6557",
"nagios_url" : "/nagios/",
"timeout" : 2,
},
"siteb" : {
"alias" : "Berlin",
"socket" : "tcp:siteb:6557",
"nagios_url" : "/nagios/",
"timeout" : 10,
},
}
c = livestatus.MultiSiteConnection(sites)
c.set_prepend_site(True)
print c.query("GET hosts\nColumns: name state\n")
c.set_prepend_site(False)
print c.query("GET hosts\nColumns: name state\n")
# Beware: When doing stats, you need to aggregate yourself:
print sum(c.query_column("GET hosts\nStats: state >= 0\n"))
# Detect errors:
sites = {
"muc" : {
"socket" : "unix:/var/run/nagios/rw/live",
"alias" : "Munich",
},
"sitea" : {
"alias" : "Augsburg",
"socket" : "tcp:sitea:6558", # BROKEN
"nagios_url" : "/nagios/",
"timeout" : 2,
},
"siteb" : {
"alias" : "Berlin",
"socket" : "tcp:siteb:6557",
"nagios_url" : "/nagios/",
"timeout" : 10,
},
}
c = livestatus.MultiSiteConnection(sites)
for name, state in c.query("GET hosts\nColumns: name state\n"):
print "%-15s: %d" % (name, state)
print "Dead sites:"
for sitename, info in c.dead_sites().items():
print "%s: %s" % (sitename, info["exception"])

839
api/python/livestatus.py Normal file
View File

@@ -0,0 +1,839 @@
#!/usr/bin/python
# -*- encoding: utf-8; py-indent-offset: 4 -*-
# +------------------------------------------------------------------+
# | ____ _ _ __ __ _ __ |
# | / ___| |__ ___ ___| | __ | \/ | |/ / |
# | | | | '_ \ / _ \/ __| |/ / | |\/| | ' / |
# | | |___| | | | __/ (__| < | | | | . \ |
# | \____|_| |_|\___|\___|_|\_\___|_| |_|_|\_\ |
# | |
# | Copyright Mathias Kettner 2014 mk@mathias-kettner.de |
# +------------------------------------------------------------------+
#
# This file is part of Check_MK.
# The official homepage is at http://mathias-kettner.de/check_mk.
#
# check_mk is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation in version 2. check_mk is distributed
# in the hope that it will be useful, but WITHOUT ANY WARRANTY; with-
# out even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE. See the GNU General Public License for more de-
# tails. You should have received a copy of the GNU General Public
# License along with GNU Make; see the file COPYING. If not, write
# to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
# Boston, MA 02110-1301 USA.
import socket, time, re, os
import ast
"""MK Livestatus Python API"""
# .--Globals-------------------------------------------------------------.
# | ____ _ _ _ |
# | / ___| | ___ | |__ __ _| |___ |
# | | | _| |/ _ \| '_ \ / _` | / __| |
# | | |_| | | (_) | |_) | (_| | \__ \ |
# | \____|_|\___/|_.__/ \__,_|_|___/ |
# | |
# +----------------------------------------------------------------------+
# | Global variables and Exception classes |
# '----------------------------------------------------------------------'
# Keep a global array of persistant connections
persistent_connections = {}
# Regular expression for removing Cache: headers if caching is not allowed
remove_cache_regex = re.compile("\nCache:[^\n]*")
class MKLivestatusException(Exception):
def __init__(self, value):
self.parameter = value
super(MKLivestatusException, self).__init__(value)
def __str__(self):
return str(self.parameter)
class MKLivestatusSocketError(MKLivestatusException):
pass
class MKLivestatusSocketClosed(MKLivestatusSocketError):
pass
class MKLivestatusConfigError(MKLivestatusException):
pass
class MKLivestatusQueryError(MKLivestatusException):
pass
class MKLivestatusNotFoundError(MKLivestatusException):
def __str__(self):
return "No matching entries found for query %s" % str(self.parameter)
class MKLivestatusTableNotFoundError(MKLivestatusException):
pass
# We need some unique value here
NO_DEFAULT = lambda: None
#.
# .--Helpers-------------------------------------------------------------.
# | _ _ _ |
# | | | | | ___| |_ __ ___ _ __ ___ |
# | | |_| |/ _ \ | '_ \ / _ \ '__/ __| |
# | | _ | __/ | |_) | __/ | \__ \ |
# | |_| |_|\___|_| .__/ \___|_| |___/ |
# | |_| |
# +----------------------------------------------------------------------+
# | Helper class implementing some generic shortcut functions, e.g. |
# | for fetching just one row or one single value. |
# '----------------------------------------------------------------------'
class Helpers:
def query(self, query, add_headers = ""):
raise NotImplementedError()
def query_value(self, query, deflt = NO_DEFAULT):
"""Issues a query that returns exactly one line and one columns and returns
the response as a single value"""
result = self.query(query, "ColumnHeaders: off\n")
try:
return result[0][0]
except:
if deflt == NO_DEFAULT:
raise MKLivestatusNotFoundError(query)
else:
return deflt
def query_row(self, query):
"""Issues a query that returns one line of data and returns the elements
of that line as list"""
result = self.query(query, "ColumnHeaders: off\n")
try:
return result[0]
except IndexError:
raise MKLivestatusNotFoundError(query)
def query_row_assoc(self, query):
"""Issues a query that returns one line of data and returns the elements
of that line as a dictionary from column names to values"""
r = self.query(query, "ColumnHeaders: on\n")[0:2]
return dict(zip(r[0], r[1]))
def query_column(self, query):
"""Issues a query that returns exactly one column and returns the values
of all lines in that column as a single list"""
return [ l[0] for l in self.query(query, "ColumnHeaders: off\n") ]
def query_column_unique(self, query):
"""Issues a query that returns exactly one column and returns the values
of all lines with duplicates removed"""
result = []
for line in self.query(query, "ColumnHeaders: off\n"):
if line[0] not in result:
result.append(line[0])
return result
def query_table(self, query):
"""Issues a query that may return multiple lines and columns and returns
a list of lists"""
return self.query(query, "ColumnHeaders: off\n")
def query_table_assoc(self, query):
"""Issues a query that may return multiple lines and columns and returns
a dictionary from column names to values for each line. This can be
very ineffective for large response sets."""
response = self.query(query, "ColumnHeaders: on\n")
headers = response[0]
result = []
for line in response[1:]:
result.append(dict(zip(headers, line)))
return result
def query_summed_stats(self, query, add_headers = ""):
"""Conveniance function for adding up numbers from Stats queries
Adds up results column-wise. This is useful for multisite queries."""
data = self.query(query, add_headers)
if len(data) == 1:
return data[0]
elif len(data) == 0:
raise MKLivestatusNotFoundError("Empty result to Stats-Query")
result = []
for x in range(0, len(data[0])):
result.append(sum([row[x] for row in data]))
return result
# TODO: Add more functionality to the Query class:
# - set_prepend_site
# - set_only_sites
# - set_auth_domain
# All these are mostly set for a single query and reset back to another
# value after the query. But nearly all of these usages does not care
# about resetting the option in case of an exception. This could be
# handled better using the query class
class Query(object):
"""This object can be passed to all livestatus methods accepting a livestatus
query. The object can be used to hand over the handling code some flags, for
example to influence the error handling during query processing."""
default_suppressed_exceptions = [MKLivestatusTableNotFoundError]
def __init__(self, query, suppress_exceptions=None):
super(Query, self).__init__()
self._query = self._ensure_unicode(query)
if suppress_exceptions == None:
self.suppress_exceptions = self.default_suppressed_exceptions
else:
self.suppress_exceptions = suppress_exceptions
def _ensure_unicode(self, thing):
try:
return unicode(thing)
except UnicodeDecodeError:
return thing.decode("utf-8")
def __unicode__(self):
return self._query
def __str__(self):
return self._query.encode("utf-8")
#.
# .--BaseConnection----------------------------------------------------------.
# | ____ ____ _ _ |
# || __ ) __ _ ___ ___ / ___|___ _ __ _ __ ___ ___| |_(_) ___ _ __ |
# || _ \ / _` / __|/ _ \ | / _ \| '_ \| '_ \ / _ \/ __| __| |/ _ \ | '_ \ |
# || |_) | (_| \__ \ __/ |__| (_) | | | | | | | __/ (__| |_| | (_) || | | ||
# ||____/ \__,_|___/\___|\____\___/|_| |_|_| |_|\___|\___|\__|_|\___/ |_| |_||
# | |
# +--------------------------------------------------------------------------+
# | Abstract base class of SingleSiteConnection and MultiSiteConnection |
# '--------------------------------------------------------------------------'
class BaseConnection:
def __init__(self, socketurl, persist = False, allow_cache = False):
"""Create a new connection to a MK Livestatus socket"""
self.add_headers = ""
self.auth_header = ""
self.persist = persist
self.allow_cache = allow_cache
self.socketurl = socketurl
self.socket = None
self.timeout = None
self.successful_persistence = False
def successfully_persisted(self):
return self.successful_persistence
def add_header(self, header):
self.add_headers += header + "\n"
def set_timeout(self, timeout):
self.timeout = timeout
if self.socket:
self.socket.settimeout(float(timeout))
def connect(self):
if self.persist and self.socketurl in persistent_connections:
self.socket = persistent_connections[self.socketurl]
self.successful_persistence = True
return
self.successful_persistence = False
# Create new socket
self.socket = None
url = self.socketurl
parts = url.split(":")
if parts[0] == "unix":
if len(parts) != 2:
raise MKLivestatusConfigError("Invalid livestatus unix URL: %s. "
"Correct example is 'unix:/var/run/nagios/rw/live'" % url)
self.socket = socket.socket(socket.AF_UNIX, socket.SOCK_STREAM)
target = parts[1]
elif parts[0] == "tcp":
try:
host = parts[1]
port = int(parts[2])
except:
raise MKLivestatusConfigError("Invalid livestatus tcp URL '%s'. "
"Correct example is 'tcp:somehost:6557'" % url)
self.socket = socket.socket(socket.AF_INET, socket.SOCK_STREAM)
target = (host, port)
else:
raise MKLivestatusConfigError("Invalid livestatus URL '%s'. "
"Must begin with 'tcp:' or 'unix:'" % url)
# If a timeout is set, then we retry after a failure with mild
# a binary backoff.
if self.timeout:
before = time.time()
sleep_interval = 0.1
while True:
try:
if self.timeout:
self.socket.settimeout(float(sleep_interval))
self.socket.connect(target)
break
except Exception, e:
if self.timeout:
time_left = self.timeout - (time.time() - before)
# only try again, if there is substantial time left
if time_left > sleep_interval:
time.sleep(sleep_interval)
sleep_interval *= 1.5
continue
self.socket = None
raise MKLivestatusSocketError("Cannot connect to '%s': %s" % (self.socketurl, e))
if self.persist:
persistent_connections[self.socketurl] = self.socket
def disconnect(self):
self.socket = None
if self.persist:
try:
del persistent_connections[self.socketurl]
except KeyError:
pass
def receive_data(self, size):
result = b""
# Timeout is only honored when connecting
self.socket.settimeout(None)
while size > 0:
packet = self.socket.recv(size)
if len(packet) == 0:
raise MKLivestatusSocketClosed("Read zero data from socket, nagios server closed connection")
size -= len(packet)
result += packet
return result
def do_query(self, query, add_headers = ""):
self.send_query(query, add_headers)
return self.recv_response(query, add_headers)
def send_query(self, query_obj, add_headers = "", do_reconnect=True):
orig_query = query_obj
query = "%s" % query_obj
if not self.allow_cache:
query = remove_cache_regex.sub("", query)
if self.socket == None:
self.connect()
if not query.endswith("\n"):
query += "\n"
query += self.auth_header + self.add_headers
query += "Localtime: %d\nOutputFormat: python\nKeepAlive: on\nResponseHeader: fixed16\n" % int(time.time())
query += add_headers
if not query.endswith("\n"):
query += "\n"
query += "\n"
try:
# socket.send() will implicitely cast to str(), we need ot
# convert to UTF-8 in order to avoid exceptions
if type(query) == unicode:
query = query.encode("utf-8")
self.socket.send(query)
except IOError, e:
if self.persist:
del persistent_connections[self.socketurl]
self.successful_persistence = False
self.socket = None
if do_reconnect:
# Automatically try to reconnect in case of an error, but
# only once.
self.connect()
self.send_query(orig_query, add_headers, False)
return
raise MKLivestatusSocketError("RC1:" + str(e))
# Reads a response from the livestatus socket. If the socket is closed
# by the livestatus server, we automatically make a reconnect and send
# the query again (once). This is due to timeouts during keepalive.
def recv_response(self, query = None, add_headers = "", timeout_at = None):
try:
# Headers are always ASCII encoded
resp = self.receive_data(16)
code = resp[0:3]
try:
length = int(resp[4:15].lstrip())
except:
self.disconnect()
raise MKLivestatusSocketError("Malformed output. Livestatus TCP socket might be unreachable.")
data = self.receive_data(length).decode("utf-8")
if code == "200":
try:
return ast.literal_eval(data)
except:
self.disconnect()
raise MKLivestatusSocketError("Malformed output")
elif code == "404":
raise MKLivestatusTableNotFoundError("Not Found (%s): %s" % (code, data.strip()))
else:
raise MKLivestatusQueryError("%s: %s" % (code, data.strip()))
except (MKLivestatusSocketClosed, IOError), e:
# In case of an IO error or the other side having
# closed the socket do a reconnect and try again
self.disconnect()
now = time.time()
if query and (not timeout_at or timeout_at > now):
if timeout_at == None:
# Try until timeout reached in case there was a timeout configured.
# Otherwise only retry once.
timeout_at = now
if self.timeout:
timeout_at += self.timeout
time.sleep(0.1)
self.connect()
self.send_query(query, add_headers)
return self.recv_response(query, add_headers, timeout_at) # do not send query again -> danger of infinite loop
else:
raise MKLivestatusSocketError(str(e))
except MKLivestatusTableNotFoundError:
raise
except Exception, e:
# Catches
# MKLivestatusQueryError
# MKLivestatusSocketError
# FIXME: ? self.disconnect()
raise MKLivestatusSocketError("Unhandled exception: %s" % e)
def do_command(self, command):
if self.socket == None:
self.connect()
if not command.endswith("\n"):
command += "\n"
try:
self.socket.send("COMMAND " + command + "\n")
except IOError, e:
self.socket = None
if self.persist:
del persistent_connections[self.socketurl]
raise MKLivestatusSocketError(str(e))
#.
# .--SingleSiteConn------------------------------------------------------.
# | ____ _ _ ____ _ _ ____ |
# | / ___|(_)_ __ __ _| | ___/ ___|(_) |_ ___ / ___|___ _ __ _ __ |
# | \___ \| | '_ \ / _` | |/ _ \___ \| | __/ _ \ | / _ \| '_ \| '_ \ |
# | ___) | | | | | (_| | | __/___) | | || __/ |__| (_) | | | | | | | |
# | |____/|_|_| |_|\__, |_|\___|____/|_|\__\___|\____\___/|_| |_|_| |_| |
# | |___/ |
# +----------------------------------------------------------------------+
# | Connections to one local Unix or remote TCP socket. |
# '----------------------------------------------------------------------'
class SingleSiteConnection(BaseConnection, Helpers):
def __init__(self, socketurl, persist = False, allow_cache = False):
BaseConnection.__init__(self, socketurl, persist, allow_cache)
self.prepend_site = False
self.auth_users = {}
self.deadsites = {} # never filled, just for compatibility
self.limit = None
def set_prepend_site(self, p):
self.prepend_site = p
def set_only_sites(self, os = None):
pass
def set_limit(self, limit = None):
self.limit = limit
def query(self, query, add_headers = ""):
if self.limit != None:
query += "Limit: %d\n" % self.limit
data = self.do_query(query, add_headers)
if self.prepend_site:
return [ [''] + line for line in data ]
else:
return data
def command(self, command, site = None):
self.do_command(command)
# Set user to be used in certain authorization domain
def set_auth_user(self, domain, user):
if user:
self.auth_users[domain] = user
elif domain in self.auth_users:
del self.auth_users[domain]
# Switch future request to new authorization domain
def set_auth_domain(self, domain):
auth_user = self.auth_users.get(domain)
if auth_user:
self.auth_header = "AuthUser: %s\n" % auth_user
else:
self.auth_header = ""
#.
# .--MultiSiteConn-------------------------------------------------------.
# | __ __ _ _ _ ____ _ _ ____ |
# | | \/ |_ _| | |_(_) ___|(_) |_ ___ / ___|___ _ __ _ __ |
# | | |\/| | | | | | __| \___ \| | __/ _ \ | / _ \| '_ \| '_ \ |
# | | | | | |_| | | |_| |___) | | || __/ |__| (_) | | | | | | | |
# | |_| |_|\__,_|_|\__|_|____/|_|\__\___|\____\___/|_| |_|_| |_| |
# | |
# +----------------------------------------------------------------------+
# | Connections to a list of local and remote sites. |
# '----------------------------------------------------------------------'
# sites is a dictionary from site name to a dict.
# Keys in the dictionary:
# socket: socketurl (obligatory)
# timeout: timeout for tcp/unix in seconds
# TODO: Move the connect/disconnect stuff to separate methods. Then make
# it possible to connect/disconnect duing existance of a single object.
class MultiSiteConnection(Helpers):
def __init__(self, sites, disabled_sites = None):
if disabled_sites is None:
disabled_sites = {}
self.sites = sites
self.connections = []
self.deadsites = {}
self.prepend_site = False
self.only_sites = None
self.limit = None
self.parallelize = True
# Helper function for connecting to a site
def connect_to_site(sitename, site, temporary=False):
try:
url = site["socket"]
persist = not temporary and site.get("persist", False)
connection = SingleSiteConnection(url, persist, allow_cache=site.get("cache", False))
if "timeout" in site:
connection.set_timeout(int(site["timeout"]))
connection.connect()
self.connections.append((sitename, site, connection))
except Exception, e:
self.deadsites[sitename] = {
"exception" : e,
"site" : site,
}
# Needed for temporary connection for status_hosts in disabled sites
def disconnect_site(sitename):
i = 0
for name, site, connection in self.connections:
if name == sitename:
del self.connections[i]
return
i += 1
# Status host: A status host helps to prevent trying to connect
# to a remote site which is unreachable. This is done by looking
# at the current state of a certain host on a local site that is
# representing the connection to the remote site. The status host
# is specified as an optional pair of (site, host) in the entry
# "status_host". We first connect to all sites without a status_host
# entry, then retrieve the host states of the status hosts and then
# connect to the remote site which are reachable
# Tackle very special problem: If the user disables a site which
# provides status_host information for other sites, the dead-detection
# would not work. For that cases we make a temporary connection just
# to fetch the status information
extra_status_sites = {}
if len(disabled_sites) > 0:
status_sitenames = set([])
for sitename, site in sites.items():
try:
s, h = site.get("status_host")
status_sitenames.add(s)
except:
continue
for sitename in status_sitenames:
site = disabled_sites.get(sitename)
if site:
extra_status_sites[sitename] = site
# First connect to sites without status host. Collect status
# hosts at the same time.
status_hosts = {} # dict from site to list of status_hosts
for sitename, site in sites.items() + extra_status_sites.items():
status_host = site.get("status_host")
if status_host:
if type(status_host) != tuple or len(status_host) != 2:
raise MKLivestatusConfigError("Status host of site %s is %r, but must be pair of site and host" %
(sitename, status_host))
s, h = status_host
status_hosts[s] = status_hosts.get(s, []) + [h]
else:
connect_to_site(sitename, site)
# Now learn current states of status hosts and store it in a dictionary
# from (local_site, host) => state
status_host_states = {}
for sitename, hosts in status_hosts.items():
# Fetch all the states of status hosts of this local site in one query
query = "GET hosts\nColumns: name state has_been_checked last_time_up\n"
for host in hosts:
query += "Filter: name = %s\n" % host
query += "Or: %d\n" % len(hosts)
self.set_only_sites([sitename]) # only connect one site
try:
result = self.query_table(query)
# raise MKLivestatusConfigError("TRESulT: %s" % (result,))
for host, state, has_been_checked, lastup in result:
if has_been_checked == 0:
state = 3
status_host_states[(sitename, host)] = (state, lastup)
except Exception, e:
raise MKLivestatusConfigError(e)
status_host_states[(sitename, host)] = (str(e), None)
self.set_only_sites() # clear site filter
# Disconnect from disabled sites that we connected to only to
# get status information from
for sitename, site in extra_status_sites.items():
disconnect_site(sitename)
# Now loop over all sites having a status_host and take that state
# of that into consideration
for sitename, site in sites.items():
status_host = site.get("status_host")
if status_host:
now = time.time()
shs, lastup = status_host_states.get(status_host, (4, now)) # None => Status host not existing
deltatime = now - lastup
if shs == 0 or shs == None:
connect_to_site(sitename, site)
else:
if shs == 1:
ex = "The remote monitoring host is down"
elif shs == 2:
ex = "The remote monitoring host is unreachable"
elif shs == 3:
ex = "The remote monitoring host's state it not yet determined"
elif shs == 4:
ex = "Invalid status host: site %s has no host %s" % (status_host[0], status_host[1])
else:
ex = "Error determining state of remote monitoring host: %s" % shs
self.deadsites[sitename] = {
"site" : site,
"status_host_state" : shs,
"exception" : ex,
}
def add_header(self, header):
for sitename, site, connection in self.connections:
connection.add_header(header)
def set_prepend_site(self, p):
self.prepend_site = p
def set_only_sites(self, sites=None):
"""Make future queries only contact the given sites.
Provide a list of site IDs to not contact all configured sites, but only the listed
site IDs. In case None is given, the limitation is removed.
"""
self.only_sites = sites
# Impose Limit on number of returned datasets (distributed amoung sites)
def set_limit(self, limit = None):
self.limit = limit
def dead_sites(self):
return self.deadsites
def alive_sites(self):
return [ s[0] for s in self.connections ]
def successfully_persisted(self):
for sitename, site, connection in self.connections:
if connection.successfully_persisted():
return True
return False
def set_auth_user(self, domain, user):
for sitename, site, connection in self.connections:
connection.set_auth_user(domain, user)
def set_auth_domain(self, domain):
for sitename, site, connection in self.connections:
connection.set_auth_domain(domain)
def query(self, query, add_headers = ""):
if self.parallelize:
return self.query_parallel(query, add_headers)
else:
return self.query_non_parallel(query, add_headers)
def query_non_parallel(self, query, add_headers = ""):
result = []
stillalive = []
limit = self.limit
for sitename, site, connection in self.connections:
if self.only_sites != None and sitename not in self.only_sites:
stillalive.append( (sitename, site, connection) ) # state unknown, assume still alive
continue
try:
if limit != None:
limit_header = "Limit: %d\n" % limit
else:
limit_header = ""
r = connection.query(query, add_headers + limit_header)
if self.prepend_site:
r = [ [sitename] + l for l in r ]
if limit != None:
limit -= len(r) # Account for portion of limit used by this site
result += r
stillalive.append( (sitename, site, connection) )
except Exception, e:
connection.disconnect()
self.deadsites[sitename] = {
"exception" : e,
"site" : site,
}
self.connections = stillalive
return result
# New parallelized version of query(). The semantics differs in the handling
# of Limit: since all sites are queried in parallel, the Limit: is simply
# applied to all sites - resulting in possibly more results then Limit requests.
def query_parallel(self, query, add_headers = ""):
stillalive = []
if self.only_sites != None:
connect_to_sites = [ c for c in self.connections if c[0] in self.only_sites ]
# Unused sites are assumed to be alive
stillalive.extend( [ c for c in self.connections if c[0] not in self.only_sites])
else:
connect_to_sites = self.connections
start_time = time.time()
limit = self.limit
if limit != None:
limit_header = "Limit: %d\n" % limit
else:
limit_header = ""
# First send all queries
for sitename, site, connection in connect_to_sites:
try:
connection.send_query(query, add_headers + limit_header)
except Exception, e:
self.deadsites[sitename] = {
"exception" : e,
"site" : site,
}
if isinstance(query, Query):
suppress_exceptions = tuple(query.suppress_exceptions)
else:
suppress_exceptions = tuple(Query.default_suppressed_exceptions)
# Then retrieve all answers. We will be as slow as the slowest of all
# connections.
result = []
for sitename, site, connection in connect_to_sites:
try:
r = connection.recv_response(query, add_headers + limit_header)
stillalive.append( (sitename, site, connection) )
if self.prepend_site:
r = [ [sitename] + l for l in r ]
result += r
except suppress_exceptions:
stillalive.append( (sitename, site, connection) )
continue
except Exception, e:
connection.disconnect()
self.deadsites[sitename] = {
"exception" : e,
"site" : site,
}
self.connections = stillalive
return result
def command(self, command, sitename = "local"):
if sitename in self.deadsites:
raise MKLivestatusSocketError("Connection to site %s is dead: %s" % \
(sitename, self.deadsites[sitename]["exception"]))
conn = [t[2] for t in self.connections if t[0] == sitename]
if len(conn) == 0:
raise MKLivestatusConfigError("Cannot send command to unconfigured site '%s'" % sitename)
conn[0].do_command(command)
# Return connection to localhost (UNIX), if available
def local_connection(self):
for sitename, site, connection in self.connections:
if site["socket"].startswith("unix:") and "liveproxy" not in site["socket"]:
return connection
raise MKLivestatusConfigError("No livestatus connection to local host")
#.
# .--LocalConn-----------------------------------------------------------.
# | _ _ ____ |
# | | | ___ ___ __ _| |/ ___|___ _ __ _ __ |
# | | | / _ \ / __/ _` | | | / _ \| '_ \| '_ \ |
# | | |__| (_) | (_| (_| | | |__| (_) | | | | | | | |
# | |_____\___/ \___\__,_|_|\____\___/|_| |_|_| |_| |
# | |
# +----------------------------------------------------------------------+
# | LocalConnection is a convenciance class for connecting to the |
# | local Livestatus socket within an OMD site. It only works within |
# | OMD context. It immediately connects() |
# '----------------------------------------------------------------------'
class LocalConnection(SingleSiteConnection):
def __init__(self, *args, **kwargs):
omd_root = os.getenv("OMD_ROOT")
if not omd_root:
raise MKLivestatusConfigError("OMD_ROOT is not set. You are not running in OMD context.")
SingleSiteConnection.__init__(self, "unix:" + omd_root + "/tmp/run/live", *args, **kwargs)
self.connect()

119
api/python/make_nagvis_map.py Executable file
View File

@@ -0,0 +1,119 @@
#!/usr/bin/python
# -*- encoding: utf-8; py-indent-offset: 4 -*-
# +------------------------------------------------------------------+
# | ____ _ _ __ __ _ __ |
# | / ___| |__ ___ ___| | __ | \/ | |/ / |
# | | | | '_ \ / _ \/ __| |/ / | |\/| | ' / |
# | | |___| | | | __/ (__| < | | | | . \ |
# | \____|_| |_|\___|\___|_|\_\___|_| |_|_|\_\ |
# | |
# | Copyright Mathias Kettner 2014 mk@mathias-kettner.de |
# +------------------------------------------------------------------+
#
# This file is part of Check_MK.
# The official homepage is at http://mathias-kettner.de/check_mk.
#
# check_mk is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation in version 2. check_mk is distributed
# in the hope that it will be useful, but WITHOUT ANY WARRANTY; with-
# out even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE. See the GNU General Public License for more de-
# tails. You should have received a copy of the GNU General Public
# License along with GNU Make; see the file COPYING. If not, write
# to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
# Boston, MA 02110-1301 USA.
# This is an example for a usage of Livestatus: it creates
# a NagVis map using actual live data from a running Nagios
# system. Most things are hardcoded here but this might by
# a useful example for coding your own stuff...
import livestatus
g_y = 50
y_title = 40
lineheight = 30
x_hostgroup = 30
x_therm = 200
x_usv = 560
def make_label(text, x, y, width):
print """
define textbox {
text=%s
x=%d
y=%d
background_color=#C0C0C1
border_color=#000055
w=%d
}""" % (text, x, y, width)
def render_hostgroup(name, alias):
global g_y
g_y += lineheight
# Name des Serverraums
make_label(alias, x_hostgroup, g_y, x_therm - x_hostgroup - 20)
def display_servicegroup(name, x):
if live.query_value("GET servicegroups\nStats: name = %s\n" % name) == 1:
print """
define servicegroup {
servicegroup_name = %s
x=%d
y=%d
}""" % (name, x, g_y)
# Einzelauflistung der Thermometer
num = 0
shift = 16
for host, service in live.query("GET services\nFilter: groups >= %s\nColumns: host_name description" % name):
num += 1
print """
define service {
host_name=%s
service_description=%s
x=%d
y=%d
url=/pnp4nagios/graph?host=%s&srv=%s
}
""" % (host, service, x + 30 + shift * num, g_y, host, service)
# Gesamtzustand Thermometer
display_servicegroup(name + "_therm", x_therm)
# Auflistung der USV-Parameter
display_servicegroup(name + "_usv", x_usv)
socket_path = "unix:/var/run/nagios/rw/live"
live = livestatus.SingleSiteConnection(socket_path)
print """
define global {
allowed_for_config=nagiosadmin
allowed_user=nagiosadmin
map_image=demo_background.png
iconset=std_medium
}
"""
# hostgroups = live.query("GET hostgroups\nColumns: name alias")
hostgroups = [
( "s02", "S-02" ),
( "s06", "S-06" ),
( "s48", "S-48" ),
( "ad214", "AD-214" ),
( "ik026", "IK-026" ),
( "etage", "Etagenverteiler" ),
]
for name, alias in hostgroups:
render_hostgroup(name, alias)
make_label("Temperaturen", x_therm, y_title, 250)
make_label("USV-Status", x_usv, y_title, 160)