package Smokeping::probes::EchoPing; =head1 301 Moved Permanently This is a Smokeping probe module. Please use the command C to view the documentation or the command C 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', Niko Tyni DOC see_also => < etc., L 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'); # no need for this if running as a CGI $self->test_usage unless $ENV{SERVER_SOFTWARE}; return $self; } # warn about unsupported features sub test_usage { my $self = shift; my $bin = $self->{properties}{binary}; my @unsupported; my $arghashref = $self->features; my %arghash = %$arghashref; for my $feature (keys %arghash) { if (`$bin $arghash{$feature} 1 127.0.0.1 2>&1` =~ /invalid option|usage/i) { push @unsupported, $feature; $self->do_log("Note: your echoping doesn't support the $feature feature (option $arghash{$feature}), disabling it"); } } map { delete $arghashref->{$_} } @unsupported; return; } 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}; } 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: $!"); # what should we do with error messages? my $echoret; while (

) { $echoret .= $_; /^Elapsed time: (\d+\.\d+) seconds/ and push @times, $1; } close P; $self->do_log("WARNING: $cmd was not happy: $echoret") if $?; # 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+', }, 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 => < 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;