commit
This commit is contained in:
root
276
debian/smokeping/usr/share/perl5/Smokeping/probes/EchoPing.pm
vendored
Normal file
276
debian/smokeping/usr/share/perl5/Smokeping/probes/EchoPing.pm
vendored
Normal file
@@ -0,0 +1,276 @@
|
||||
package Smokeping::probes::EchoPing;
|
||||
|
||||
=head1 301 Moved Permanently
|
||||
|
||||
This is a Smokeping probe module. Please use the command
|
||||
|
||||
C<smokeping -man Smokeping::probes::EchoPing>
|
||||
|
||||
to view the documentation or the command
|
||||
|
||||
C<smokeping -makepod Smokeping::probes::EchoPing>
|
||||
|
||||
to generate the POD document.
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use base qw(Smokeping::probes::basefork);
|
||||
use Carp;
|
||||
|
||||
my $DEFAULTBIN = "/usr/bin/echoping";
|
||||
|
||||
sub pod_hash {
|
||||
return {
|
||||
name => <<DOC,
|
||||
Smokeping::probes::EchoPing - an echoping(1) probe for SmokePing
|
||||
DOC
|
||||
overview => <<DOC,
|
||||
Measures TCP or UDP echo (port 7) roundtrip times for SmokePing. Can also be
|
||||
used as a base class for other echoping(1) probes.
|
||||
DOC
|
||||
description => <<DOC,
|
||||
See echoping(1) for details of the options below.
|
||||
DOC
|
||||
bugs => <<DOC,
|
||||
Should we test the availability of the service at startup? After that it's
|
||||
too late to complain.
|
||||
|
||||
The location of the echoping binary should probably be a global variable
|
||||
instead of a probe-specific one. As things are, every EchoPing -derived probe
|
||||
has to declare it if the default ($DEFAULTBIN) isn't correct.
|
||||
DOC
|
||||
authors => <<'DOC',
|
||||
Niko Tyni <ntyni@iki.fi>
|
||||
DOC
|
||||
see_also => <<DOC,
|
||||
echoping(1), L<Smokeping::probes::EchoPingHttp> etc., L<http://echoping.sourceforge.net/>
|
||||
DOC
|
||||
}
|
||||
}
|
||||
|
||||
#
|
||||
# derived class will mess with this through the 'features' method below
|
||||
my $featurehash = {
|
||||
waittime => "-w",
|
||||
timeout => "-t",
|
||||
size => "-s",
|
||||
tos => "-P",
|
||||
priority => "-p",
|
||||
fill => "-f",
|
||||
};
|
||||
|
||||
sub features {
|
||||
my $self = shift;
|
||||
my $newval = shift;
|
||||
$featurehash = $newval if defined $newval;
|
||||
return $featurehash;
|
||||
}
|
||||
|
||||
sub new {
|
||||
my $proto = shift;
|
||||
my $class = ref($proto) || $proto;
|
||||
my $self = $class->SUPER::new(@_);
|
||||
|
||||
$self->_init if $self->can('_init');
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub ProbeDesc($) {
|
||||
return "TCP or UDP Echo pings using echoping(1)";
|
||||
}
|
||||
|
||||
# This can be overridden to tag the port number to the address
|
||||
# in derived classes (namely EchoPingHttp)
|
||||
sub make_host {
|
||||
my $self = shift;
|
||||
my $target = shift;
|
||||
return $target->{addr};
|
||||
}
|
||||
|
||||
# This will be overridden by the EchoPingPlugin-derived probes
|
||||
sub post_args {
|
||||
return ();
|
||||
}
|
||||
|
||||
# other than host, count and protocol-specific args come from here
|
||||
sub make_args {
|
||||
my $self = shift;
|
||||
my $target = shift;
|
||||
my @args;
|
||||
my %arghash = %{$self->features};
|
||||
|
||||
for (keys %arghash) {
|
||||
my $val = $target->{vars}{$_};
|
||||
push @args, ($arghash{$_}, $val) if defined $val;
|
||||
}
|
||||
push @args, $self->ipversion_arg($target);
|
||||
push @args, $target->{vars}{extraopts} if exists $target->{vars}{extraopts};
|
||||
|
||||
return @args;
|
||||
}
|
||||
|
||||
# this is separated to make it possible to test the service
|
||||
# at startup, although we don't do it at the moment.
|
||||
sub count_args {
|
||||
my $self = shift;
|
||||
my $count = shift;
|
||||
|
||||
$count = $self->pings() unless defined $count;
|
||||
return ("-n", $count);
|
||||
}
|
||||
|
||||
# This is what derived classes will override
|
||||
sub proto_args {
|
||||
my $self = shift;
|
||||
return $self->udp_arg(@_);
|
||||
}
|
||||
|
||||
# UDP is defined only for echo and discard
|
||||
sub udp_arg {
|
||||
my $self = shift;
|
||||
my $target = shift;
|
||||
my @args;
|
||||
|
||||
my $udp = $target->{vars}{udp};
|
||||
push @args, "-u" if (defined $udp and $udp ne "no" and $udp ne "0");
|
||||
|
||||
return @args;
|
||||
}
|
||||
|
||||
sub ipversion_arg {
|
||||
my $self = shift;
|
||||
my $target = shift;
|
||||
my $vers = $target->{vars}{ipversion};
|
||||
if (defined $vers and $vers =~ /^([46])$/) {
|
||||
return ("-" . $1);
|
||||
} else {
|
||||
$self->do_log("Invalid `ipversion' value: $vers") if defined $vers;
|
||||
return ();
|
||||
}
|
||||
}
|
||||
|
||||
sub make_commandline {
|
||||
my $self = shift;
|
||||
my $target = shift;
|
||||
my $count = shift;
|
||||
|
||||
$count |= $self->pings($target);
|
||||
|
||||
my @args = $self->make_args($target);
|
||||
my @post_args = $self->post_args($target);
|
||||
my $host = $self->make_host($target);
|
||||
push @args, $self->proto_args($target);
|
||||
push @args, $self->count_args($count);
|
||||
|
||||
return ($self->{properties}{binary}, @args, $host, @post_args);
|
||||
}
|
||||
|
||||
sub pingone {
|
||||
my $self = shift;
|
||||
my $t = shift;
|
||||
|
||||
my @cmd = $self->make_commandline($t);
|
||||
|
||||
my $cmd = join(" ", @cmd);
|
||||
|
||||
$self->do_debug("executing cmd $cmd");
|
||||
|
||||
my @times;
|
||||
|
||||
open(P, "$cmd 2>&1 |") or carp("fork: $!");
|
||||
|
||||
my @output;
|
||||
while (<P>) {
|
||||
chomp;
|
||||
push @output, $_;
|
||||
/^Elapsed time: (\d+\.\d+) seconds/ and push @times, $1;
|
||||
}
|
||||
close P;
|
||||
if ($?) {
|
||||
my $status = $? >> 8;
|
||||
my $signal = $? & 127;
|
||||
my $why = "with status $status";
|
||||
$why .= " [signal $signal]" if $signal;
|
||||
|
||||
# only log warnings on the first ping round
|
||||
my $function = ($self->rounds_count == 1 ? "do_log" : "do_debug");
|
||||
|
||||
$self->$function(qq(WARNING: "$cmd" exited $why - output follows));
|
||||
$self->$function(qq( $_)) for @output;
|
||||
}
|
||||
# carp("Got @times") if $self->debug;
|
||||
return sort { $a <=> $b } @times;
|
||||
}
|
||||
|
||||
sub probevars {
|
||||
my $class = shift;
|
||||
my $h = $class->SUPER::probevars;
|
||||
delete $h->{timeout};
|
||||
return $class->_makevars($h, {
|
||||
binary => {
|
||||
_doc => "The location of your echoping binary.",
|
||||
_default => $DEFAULTBIN,
|
||||
_sub => sub {
|
||||
my $val = shift;
|
||||
-x $val or return "ERROR: binary '$val' is not executable";
|
||||
return undef;
|
||||
},
|
||||
},
|
||||
});
|
||||
}
|
||||
|
||||
sub targetvars {
|
||||
my $class = shift;
|
||||
return $class->_makevars($class->SUPER::targetvars, {
|
||||
timeout => {
|
||||
_doc => 'The "-t" echoping(1) option.',
|
||||
_example => 1,
|
||||
_default => 5,
|
||||
_re => '(\d*\.)?\d+',
|
||||
},
|
||||
waittime => {
|
||||
_doc => 'The "-w" echoping(1) option.',
|
||||
_example => 1,
|
||||
_re => '\d+(?:\.\d+)?',
|
||||
},
|
||||
size => {
|
||||
_doc => 'The "-s" echoping(1) option.',
|
||||
_example => 510,
|
||||
_re => '\d+',
|
||||
},
|
||||
udp => {
|
||||
_doc => q{The "-u" echoping(1) option. Values other than '0' and 'no' enable UDP.},
|
||||
_example => 'no',
|
||||
},
|
||||
fill => {
|
||||
_doc => 'The "-f" echoping(1) option.',
|
||||
_example => 'A',
|
||||
_re => '.',
|
||||
},
|
||||
priority => {
|
||||
_doc => 'The "-p" echoping(1) option.',
|
||||
_example => 6,
|
||||
_re => '\d+',
|
||||
},
|
||||
tos => {
|
||||
_doc => 'The "-P" echoping(1) option.',
|
||||
_example => '0xa0',
|
||||
},
|
||||
ipversion => {
|
||||
_doc => <<DOC,
|
||||
The IP protocol used. Possible values are "4" and "6".
|
||||
Passed to echoping(1) as the "-4" or "-6" options.
|
||||
DOC
|
||||
_example => 4,
|
||||
_re => '[46]'
|
||||
},
|
||||
extraopts => {
|
||||
_doc => 'Any extra options specified here will be passed unmodified to echoping(1).',
|
||||
_example => '-some-letter-the-author-did-not-think-of',
|
||||
},
|
||||
});
|
||||
}
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user