aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/App/Ping903.pm119
-rw-r--r--lib/App/Ping903/Command.pm116
-rw-r--r--lib/App/Ping903/Command/dbload.pm95
-rw-r--r--lib/App/Ping903/Command/inspect.pm41
-rw-r--r--lib/App/Ping903/Command/ipadd.pm16
-rw-r--r--lib/App/Ping903/Command/ipdel.pm16
-rw-r--r--lib/App/Ping903/Command/nagios.pm136
-rw-r--r--lib/LWP/Ping903.pm49
-rw-r--r--lib/Net/Ping903.pm133
9 files changed, 721 insertions, 0 deletions
diff --git a/lib/App/Ping903.pm b/lib/App/Ping903.pm
new file mode 100644
index 0000000..7bb18f0
--- /dev/null
+++ b/lib/App/Ping903.pm
@@ -0,0 +1,119 @@
+package App::Ping903;
+use strict;
+use warnings;
+use Getopt::Long qw(:config gnu_getopt no_ignore_case require_order);
+use Pod::Man;
+use Pod::Usage;
+use Pod::Find qw(pod_where);
+use Net::Ping903;
+use App::Ping903::Command ':exit_codes';
+
+our $VERSION = '0.4.90';
+
+my $DEFAULT_URL = 'http://localhost:8080';
+
+sub new {
+ my $class = shift;
+ my $config_file;
+ my $url;
+ my $config = {};
+
+ GetOptions(
+ 'shorthelp|?' => sub {
+ pod2usage(-input => pod_where({-inc => 1}, __PACKAGE__),
+ -verbose => 99,
+ -sections => [qw(NAME SYNOPSIS COMMANDS)],
+ -exitstatus => EX_OK)
+ },
+ 'help' => sub {
+ pod2usage(-exitstatus => EX_OK,
+ -input => pod_where({-inc => 1}, __PACKAGE__),
+ -verbose => 2)
+ },
+ 'usage' => sub {
+ pod2usage(-exitstatus => EX_OK,
+ -input => pod_where({-inc => 1}, __PACKAGE__),
+ -verbose => 0)
+ },
+ 'config|c=s' => \$config_file,
+ 'url|u=s' => \$url
+ ) or exit(EX_USAGE);
+
+ if ($config_file) {
+ if (-f $config_file) {
+ $config = $class->readconfig($config_file);
+ } else {
+ die "configuration file $config_file does not exists\n";
+ }
+ } else {
+ $config_file = '/etc/ping903.conf';
+ if (-f $config_file) {
+ $config = $class->readconfig($config_file);
+ }
+ }
+
+ if ($url) {
+ $config->{baseurl} = $url;
+ } elsif (!$config->{baseurl}) {
+ $config->{baseurl} = $DEFAULT_URL;
+ }
+
+ unless ($config->{baseurl} =~ m{^https?://}) {
+ $config->{baseurl} = "http://$url";
+ }
+
+ my $agent = new Net::Ping903($config->{baseurl});
+
+ my $com = shift @ARGV;
+ die "no command name\n" unless $com;
+
+ my $modname = __PACKAGE__ . '::Command::' . $com;
+ my $modpath = $modname;
+ $modpath =~ s{::}{/}g;
+ $modpath .= '.pm';
+ my $cmd;
+ eval {
+ require $modpath;
+ $cmd = $modname->new($com, $agent);
+ };
+ if ($@) {
+ if ($@ =~ /Can't locate $modpath/) {
+ die "unknown command: $com\n"
+ }
+ die $@;
+ }
+ return $cmd;
+}
+
+sub readconfig {
+ my ($class, $file) = @_;
+ my $config = {};
+ if (open(my $fh, '<', $file)) {
+ while (<$fh>) {
+ chomp;
+ s/^\s+//;
+ s/\s+$//;
+ next if /^(#.*)?$/;
+ if (m{^listen\s+(.+)$}) {
+ $config->{baseurl} = $1;
+ last;
+ }
+ }
+ close $fh;
+ } else {
+ die "$file: file doesn't exist\n";
+ }
+ return $config;
+}
+
+1;
+
+=head1 NAME
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 OPTIONS
+
+
diff --git a/lib/App/Ping903/Command.pm b/lib/App/Ping903/Command.pm
new file mode 100644
index 0000000..f6cb2c6
--- /dev/null
+++ b/lib/App/Ping903/Command.pm
@@ -0,0 +1,116 @@
+package App::Ping903::Command;
+use strict;
+use warnings;
+use Getopt::Long;
+use Pod::Man;
+use Pod::Usage;
+use Pod::Find qw(pod_where);
+use Carp;
+use parent 'Exporter';
+
+use constant {
+ EX_OK => 0,
+ EX_FAIL => 1,
+ EX_USAGE => 2
+};
+
+our @EXPORT_OK = qw(EX_OK EX_FAIL EX_USAGE);
+our %EXPORT_TAGS = ( 'exit_codes' => [
+ qw(EX_OK EX_FAIL EX_USAGE)
+ ] );
+
+sub new {
+ my ($class, $com, $agent, %opts) = @_;
+ my $self = bless { progname => $com, agent => $agent }, $class;
+
+ $self->{options} = {};
+
+ $self->{optdef}{'shorthelp|?'} = sub {
+ pod2usage(-message => $class->pod_usage_msg,
+ -input => pod_where({-inc => 1}, $class),
+ -exitstatus => EX_OK)
+ };
+ $self->{optdef}{help} = sub {
+ pod2usage(-exitstatus => EX_OK,
+ -verbose => 2,
+ -input => pod_where({-inc => 1}, $class))
+ };
+ $self->{optdef}{usage} = sub {
+ pod2usage(-exitstatus => EX_OK,
+ -verbose => 0,
+ -input => pod_where({-inc => 1}, $class))
+ };
+
+ foreach my $k (keys %opts) {
+ if (ref($opts{$k}) eq 'CODE') {
+ $self->{optdef}{$k} = sub { &{$opts{$k}}($self, @_ ) }
+ } elsif (ref($opts{$k})) {
+ $self->{optdef}{$k} = $opts{$k};
+ } else {
+ $self->{optdef}{$k} = \$self->{options}{$opts{$k}}
+ }
+ }
+ $self;
+}
+
+sub run {
+ my $self = shift;
+ GetOptions(%{$self->{optdef}}) or exit(EX_USAGE);
+}
+
+sub agent { shift->{agent} }
+
+sub option {
+ my $self = shift;
+ my $name = shift;
+ if (defined(my $v = shift)) {
+ croak "too many arguments" if @_;
+ $self->{options}{$name} = $v;
+ }
+ return $self->{options}{$name};
+}
+
+sub pod_usage_msg {
+ my ($class) = @_;
+
+ my $msg = "";
+
+ open my $fd, '>', \$msg;
+
+ my $input = pod_where({-inc => 1}, $class);
+
+ pod2usage(-verbose => 99,
+ -sections => 'NAME',
+ -output => $fd,
+ -exitval => 'NOEXIT',
+ -input => $input);
+
+ my @a = split /\n/, $msg;
+ if ($#a < 1) {
+ croak "missing or malformed NAME section in " . ($input // $0);
+ }
+ $msg = $a[1];
+ $msg =~ s/^\s+//;
+ $msg =~ s/ - /: /;
+ return $msg;
+}
+
+sub error {
+ my ($self, @msg) = @_;
+ print STDERR "$self->{progname}: ";
+ print STDERR "@msg\n";
+}
+
+sub abend {
+ my ($self, $code, @msg) = @_;
+ $self->error(@msg);
+ exit $code;
+}
+
+sub usage_error {
+ my $self = shift;
+ $self->abend(EX_USAGE, @_);
+}
+
+1;
+
diff --git a/lib/App/Ping903/Command/dbload.pm b/lib/App/Ping903/Command/dbload.pm
new file mode 100644
index 0000000..d7b4e20
--- /dev/null
+++ b/lib/App/Ping903/Command/dbload.pm
@@ -0,0 +1,95 @@
+package App::Ping903::Command::dbload;
+use strict;
+use warnings;
+use parent 'App::Ping903::Command';
+use App::Ping903::Command ':exit_codes';
+use JSON;
+use DBI;
+use File::Spec;
+
+sub new {
+ my ($class, $com, $agent) = @_;
+
+ my $self = bless $class->SUPER::new($com, $agent,
+ 'D|driver=s' => 'driver',
+ 'd|database=s' => sub {
+ my $self = shift;
+ push @{$self->{options}{connarg}}, "database=$_[1]";
+ },
+ 'h|host=s' => sub {
+ my $self = shift;
+ push @{$self->{options}{connarg}}, "host=$_[1]";
+ },
+ 'P|port=s' => sub {
+ my $self = shift;
+ push @{$self->{options}{connarg}}, "port=$_[1]";
+ },
+ 'u|user=s' => 'dbuser',
+ 'p|password=s' => 'dbpass',
+ 'params=s' => 'dbparams',
+ 'defaults-file=s' => 'defaults-file',
+ 't|table=s' => 'table',
+ 'c|column=s' => 'column',
+ 'q|query=s' => 'query');
+
+ $self->{options}{driver} = 'mysql';
+
+ $self;
+}
+
+sub run {
+ my $self = shift;
+ $self->SUPER::run;
+ $self->usage_error("extra parameters") if @ARGV;
+
+ my $query = $self->option('query');
+ unless ($query) {
+ $self->usage_error("--table option must be specified")
+ unless $self->option('table');
+ $self->usage_error("--column option must be specified")
+ unless $self->option('column');
+ $query = qq{SELECT $self->{options}{column} FROM $self->{options}{table}};
+ }
+
+ if (my $p = $self->option('dbparams')) {
+ push @{$self->{options}{connarg}}, $p;
+ }
+
+ unless ($self->{options}{connarg}) {
+ $self->usage_error('Database parameters not initialized. Please use the --database (optionally - --host and --port) option.');
+ }
+
+ if ($self->option('driver') eq 'mysql') {
+ unless ($self->option('defaults-file')) {
+ my $f = File::Spec->catfile($ENV{HOME}, '.my.cnf');
+ if (-f $f) {
+ $self->option('defaults-file', $f);
+ }
+ }
+ }
+ if (my $p = $self->option('defaults-file')) {
+ push @{$self->{options}{connarg}}, ";mysql_read_default_file=$p";
+ }
+
+ my $arg = join(':', ('DBI',$self->{options}{driver},
+ @{$self->{options}{connarg}}));
+
+ my $dbh = DBI->connect($arg, $self->{options}{dbuser},
+ $self->{options}{dbpass},
+ { RaiseError => 0, PrintError => 1, AutoCommit => 1})
+ or $self->abend(EX_FAIL, "can't connect to the database server");
+
+ my $res = $dbh->selectall_arrayref($query,
+ { RaiseError => 0, PrintError => 1 })
+ or $self->abend(EX_FAIL, "query failed");
+
+ unless ($self->agent->set_ip_list([ map { $_->[0] } @$res ])) {
+ $self->abend(EX_FAIL, $self->agent->error_message);
+ }
+}
+
+1;
+
+
+
+
diff --git a/lib/App/Ping903/Command/inspect.pm b/lib/App/Ping903/Command/inspect.pm
new file mode 100644
index 0000000..464a1b6
--- /dev/null
+++ b/lib/App/Ping903/Command/inspect.pm
@@ -0,0 +1,41 @@
+package App::Ping903::Command::inspect;
+use strict;
+use warnings;
+use parent 'App::Ping903::Command';
+use App::Ping903::Command ':exit_codes';
+
+sub run {
+ my $self = shift;
+ $self->SUPER::run;
+
+ my $cfg = $self->agent->get_config;
+ unless ($cfg) {
+ $self->abend(EX_FAIL, $self->agent->error_message);
+ }
+
+ foreach my $kw (sort keys %$cfg) {
+ my $val = $cfg->{$kw} or next;
+ print "$kw ";
+ if (ref($val) eq 'ARRAY') {
+ print "<<EOF\n";
+ foreach my $ip (@$val) {
+ print " $ip\n";
+ }
+ print "EOF";
+ } elsif (JSON::is_bool($val)) {
+ print $val ? "on" : "off";
+ } else {
+ print $val
+ }
+ print "\n";
+ }
+}
+
+1;
+=head1 NAME
+
+inspect - inspect ping903 server configuration
+
+=head1 DESCRIPTION
+
+Text
diff --git a/lib/App/Ping903/Command/ipadd.pm b/lib/App/Ping903/Command/ipadd.pm
new file mode 100644
index 0000000..a516aba
--- /dev/null
+++ b/lib/App/Ping903/Command/ipadd.pm
@@ -0,0 +1,16 @@
+package App::Ping903::Command::ipadd;
+use strict;
+use warnings;
+use parent 'App::Ping903::Command';
+use App::Ping903::Command ':exit_codes';
+
+sub run {
+ my $self = shift;
+ $self->SUPER::run;
+ $self->usage_error("required parameters missing") unless @ARGV == 1;
+ my $ip = shift @ARGV;
+ unless ($self->agent->ipadd($ip)) {
+ $self->abend(EX_FAIL, $self->agent->error_message);
+ }
+}
+1;
diff --git a/lib/App/Ping903/Command/ipdel.pm b/lib/App/Ping903/Command/ipdel.pm
new file mode 100644
index 0000000..3c14779
--- /dev/null
+++ b/lib/App/Ping903/Command/ipdel.pm
@@ -0,0 +1,16 @@
+package App::Ping903::Command::ipdel;
+use strict;
+use warnings;
+use parent 'App::Ping903::Command';
+use App::Ping903::Command ':exit_codes';
+
+sub run {
+ my $self = shift;
+ $self->SUPER::run;
+ $self->usage_error("required parameters missing") unless @ARGV == 1;
+ my $ip = shift @ARGV;
+ unless ($self->agent->ipdel($ip)) {
+ $self->abend(EX_FAIL, $self->agent->error_message);
+ }
+}
+1;
diff --git a/lib/App/Ping903/Command/nagios.pm b/lib/App/Ping903/Command/nagios.pm
new file mode 100644
index 0000000..2c8405c
--- /dev/null
+++ b/lib/App/Ping903/Command/nagios.pm
@@ -0,0 +1,136 @@
+package App::Ping903::Command::nagios;
+use strict;
+use warnings;
+use parent 'App::Ping903::Command';
+use App::Ping903::Command ':exit_codes';
+use File::Spec;
+use File::Basename;
+use Text::Locus;
+
+sub new {
+ my ($class, $com, $agent) = @_;
+
+ bless $class->SUPER::new($com, $agent,
+ 'progname|p=s@' => 'prognames',
+ 'config|c=s' => 'nagiosconf');
+}
+
+sub run {
+ my $self = shift;
+ $self->SUPER::run;
+ $self->usage_error("extra parameters") if @ARGV;
+ my $cf = $self->{options}{nagiosconf} // '/etc/nagios/nagios.cfg';
+ push @{$self->{options}{prognames}}, 'ping903q';
+ $self->{commands} = [];
+ $self->scanconf($cf, new Text::Locus('<cli>',0));
+ if (my $n = @{$self->{iplist}}) {
+ $self->error("info: collected $n addresses");
+ unless ($self->agent->set_ip_list($self->{iplist})) {
+ $self->abend(EX_FAIL, $self->agent->error_message);
+ }
+ }
+}
+
+sub scanconf {
+ my ($self, $cf, $loc) = @_;
+# print "$loc: parsing $cf\n";
+ open(my $fh, '<', $cf) or
+ $self->abend(EX_FAIL, "$loc: can't open $cf: $!");
+ my $line = 0;
+ while (<$fh>) {
+ ++$line;
+ chomp;
+ s/^\s+//;
+ s/\s+$//;
+ next if /^(#.*)$/;
+
+ if (/cfg_file\s*=\s*(.+)/) {
+ $self->scanconf($1, new Text::Locus($cf, $line));
+ } elsif (/cfg_dir\s*=\s*(.+)/) {
+ my $loc = new Text::Locus($cf, $line);
+ foreach my $file (glob File::Spec->catfile($1, '*.cfg')) {
+ $self->scanconf($file, $loc);
+ }
+ } elsif (/define\s+(command|service|host)\s+\{/) {
+ $self->${\ "parse_$1"}($fh, $cf, \$line);
+ }
+ #...
+ }
+ close $fh;
+}
+
+sub parse_host {
+ my ($self, $fh, $file, $lref) = @_;
+ my ($host_name,$address);
+ while (<$fh>) {
+ ++$$lref;
+ chomp;
+ s/^\s+//;
+ s/\s+$//;
+ next if /^(#.*)$/;
+ last if /^\s*}/;
+ if (/^host_name\s+(.+)/) {
+ $host_name = $1;
+ } elsif (/^address\s+(.+)/) {
+ $address = $1;
+ }
+ }
+ if ($host_name) {
+ $self->{hosts}{$host_name} = $address || $host_name;
+ }
+}
+
+sub parse_command {
+ my ($self, $fh, $file, $lref) = @_;
+ my ($command_name,$matches);
+ while (<$fh>) {
+ ++$$lref;
+ chomp;
+ s/^\s+//;
+ s/\s+$//;
+ next if /^(#.*)$/;
+ last if /^\s*}/;
+ if (/^command_name\s+(.+)/) {
+ $command_name = $1;
+ } elsif (/^command_line\s+(.+)/) {
+ my ($cmd) = split(/\s+/, $1);
+ $matches = grep {
+ File::Spec->file_name_is_absolute($_)
+ ? $cmd eq $_
+ : basename($cmd) eq $_
+ } @{$self->{options}{prognames}};
+ }
+ }
+ if ($matches && $command_name) {
+# print "FOUND $command_name\n";
+ push @{$self->{commands}}, $command_name;
+ }
+}
+
+
+sub parse_service {
+ my ($self, $fh, $file, $lref) = @_;
+ my ($hostname,$matches,$loc);
+ while (<$fh>) {
+ ++$$lref;
+ chomp;
+ s/^\s+//;
+ s/\s+$//;
+ next if /^(#.*)$/;
+ last if /^\s*}/;
+ if (/^host_name\s+(.+)/) {
+ $hostname = $1;
+ $loc = new Text::Locus($file, $$lref);
+ } elsif (/check_command\s+(.+)/) {
+ my ($cmd) = split(/!/,$1);
+ $matches = grep { $cmd eq $_ } @{$self->{commands}}
+ }
+ }
+ if ($matches) {
+# print "$loc: $hostname -> $self->{hosts}{$hostname}\n";
+ push @{$self->{iplist}}, $self->{hosts}{$hostname};
+ }
+}
+
+1;
+
diff --git a/lib/LWP/Ping903.pm b/lib/LWP/Ping903.pm
new file mode 100644
index 0000000..8fc398e
--- /dev/null
+++ b/lib/LWP/Ping903.pm
@@ -0,0 +1,49 @@
+package LWP::Ping903;
+use parent 'LWP::UserAgent';
+use File::Spec;
+use HTTP::Status qw(:constants);
+use strict;
+use warnings;
+use Carp;
+
+my $VERSION = '0.3';
+
+sub new {
+ my $class = shift;
+ my $self = bless $class->SUPER::new(@_), $class;
+ $self->agent("$class/$VERSION");
+ return $self;
+}
+
+sub get_basic_credentials {
+ my ($self, $realm, $uri, $isproxy) = @_;
+ my $cf = File::Spec->catfile($ENV{HOME}, ".ping903.cred");
+ if (open(my $fh, '<', $cf)) {
+ while (<$fh>) {
+ chomp;
+ s/^\s+//;
+ s/\s+$//;
+ next if /^(#.*)?$/;
+ my @words;
+ while ($_) {
+ no warnings 'uninitialized';
+ if (s/^"(.*?)(?<!\\)"(?:\s+(.*))?$/$2/) {
+ (my $s = $1) =~ s/\\([\\\"])/$1/g;
+ push @words, $s;
+ } else {
+ s/^(.+?)(?:\s+(.+))?$/$2/;
+ push @words, $1;
+ }
+ }
+ if (@words == 4) {
+ my($h,$p) = split /:/, $words[0], 2;
+ if (($h eq '*' || $h eq $uri->host)
+ && (!$p || $p eq '*' || $p eq $uri->port)
+ && ($words[1] eq $realm || $words[1] eq '*')) {
+ return @words[2..3];
+ }
+ }
+ }
+ }
+ return ();
+}
diff --git a/lib/Net/Ping903.pm b/lib/Net/Ping903.pm
new file mode 100644
index 0000000..a23f61a
--- /dev/null
+++ b/lib/Net/Ping903.pm
@@ -0,0 +1,133 @@
+package Net::Ping903;
+use strict;
+use warnings;
+use LWP::Ping903;
+use JSON;
+use Carp;
+use HTTP::Status qw(:constants);
+
+my $VERSION = '0.3';
+
+sub new {
+ my $class = shift;
+ my $baseurl = shift;
+ my $ua = new LWP::Ping903(@_);
+ bless { baseurl => $baseurl, ua => $ua }, $class;
+}
+
+sub get_config {
+ my ($self, $param) = @_;
+ my $url = "$self->{baseurl}/config";
+ $url .= '/' . $param if $param;
+ my $resp = $self->{ua}->get($url);
+ $self->response($resp);
+ unless ($resp->is_success) {
+ $self->_set_error;
+ return
+ }
+ if (my $ctype = $resp->header('Content-Type')) {
+ if ($ctype ne 'application/json') {
+ $self->{error} = {
+ message => 'Unsupported Content-Type in response'
+ };
+ return;
+ }
+ } else {
+ $self->{error} = {
+ message => 'No Content-Type in response'
+ };
+ return;
+ }
+ return JSON->new->decode($resp->decoded_content);
+}
+
+sub error_message {
+ my $self = shift;
+ if ($self->{error} && exists($self->{error}{message})) {
+ my $msg = $self->{error}{message};
+ if ($self->{error}{index}) {
+ $msg .= " at #$self->{error}{index}";
+ }
+ return $msg;
+ }
+ if ($self->response) {
+ return $self->response->status_line;
+ }
+}
+
+sub error_index {
+ my $self = shift;
+ return unless $self->{error};
+ return $self->{error}{index};
+}
+
+sub response {
+ my $self = shift;
+ if (@_) {
+ $self->{response} = shift;
+ }
+ return $self->{response};
+}
+
+sub _set_error {
+ my $self = shift;
+
+ my $ctype = $self->response->header('Content-Type');
+ if ($ctype && $ctype eq 'application/json') {
+ $self->{error} = JSON->new->decode($self->response->decoded_content);
+ } elsif ($self->response->code eq HTTP_UNAUTHORIZED) {
+ my $s = $self->response->header('WWW-Authenticate');
+ $s =~ s/Basic realm=//;
+ $s =~ s/^"(.*)"$/$1/;
+ $s =~ s/\\([\\\"])/$1/g;
+ $self->{error} = { message => "$s: not authorized" };
+ } else {
+ $self->{error} = {};
+ }
+}
+
+sub ipadd {
+ my ($self, $ip) = @_;
+ my $resp = $self->{ua}->put("$self->{baseurl}/config/ip-list/$ip");
+ $self->response($resp);
+ if ($resp->is_success) {
+ if ($resp->code != HTTP_CREATED) {
+ $self->{error} = { message => 'Unexpected response code' };
+ }
+ } else {
+ $self->_set_error
+ }
+ return $resp->is_success;
+}
+
+sub ipdel {
+ my ($self, $ip) = @_;
+ my $resp = $self->{ua}->delete("$self->{baseurl}/config/ip-list/$ip");
+ $self->response($resp);
+ unless ($resp->is_success) {
+ $self->_set_error;
+ }
+ return $resp->is_success;
+}
+
+sub set_ip_list {
+ my ($self, $lref) = @_;
+
+ my $json_text = JSON->new->encode({
+ 'mode' => 'replace',
+ 'ip-list' => $lref
+ });
+
+ my $resp = $self->{ua}->post("$self->{baseurl}/config/ip-list",
+ 'Content-Type' => 'application/json',
+ 'Content' => $json_text);
+
+ $self->response($resp);
+ unless ($resp->is_success) {
+ $self->_set_error;
+ }
+ return $resp->is_success;
+}
+
+1;
+

Return to:

Send suggestions and report system problems to the System administrator.