package Smokeping::probes::IOSPing; =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 IPC::Open2; use Symbol; use Carp; my $e = "="; sub pod_hash { return { name => < < < <<'DOC', Paul J Murphy based on L by Tobias Oetiker DOC } } sub new($$$) { my $proto = shift; my $class = ref($proto) || $proto; my $self = $class->SUPER::new(@_); # no need for this if we run as a cgi unless ( $ENV{SERVER_SOFTWARE} ) { $self->{pingfactor} = 1000; # Gives us a good-guess default print "### assuming you are using an IOS reporting in miliseconds\n"; }; return $self; } sub ProbeDesc($){ my $self = shift; my $bytes = $self->{properties}{packetsize}; return "Cisco IOS - ICMP Echo Pings ($bytes Bytes)"; } sub pingone ($$){ my $self = shift; my $target = shift; my $bytes = $self->{properties}{packetsize}; # do NOT call superclass ... the ping method MUST be overwriten my %upd; my $inh = gensym; my $outh = gensym; my @args = (); my $pings = $self->pings($target); push(@args,$self->{properties}{binary}); push(@args,'-l',$target->{vars}{iosuser}) if defined $target->{vars}{iosuser}; push(@args,$target->{vars}{ioshost}); push(@args,'ping'); my $pid = open2($outh,$inh,@args); # # The following comments are the dialog produced by # "remsh ping" to a Cisco 800 series running IOS 12.2T # # Other hardware or versions of IOS may need adjustments here. # # Protocol [ip]: print { $inh } "\n"; # Target IP address: print { $inh } $target->{addr},"\n"; # Repeat count [5]: print { $inh } $pings,"\n"; # Datagram size [100]: print { $inh } $bytes,"\n"; # Timeout in seconds [2]: print { $inh } "\n"; # Extended commands [n]: print { $inh } "y\n"; # Source address or interface: print { $inh } "".($target->{vars}{iosint} || "") ,"\n"; # Added by Mars Wei to make # Source address an option # Type of service [0]: print { $inh } "\n"; # Set DF bit in IP header? [no]: print { $inh } "\n"; # Validate reply data? [no]: print { $inh } "\n"; # Data pattern [0xABCD]: print { $inh } "\n"; # Loose, Strict, Record, Timestamp, Verbose[none]: print { $inh } "V\n"; # Loose, Strict, Record, Timestamp, Verbose[V]: print { $inh } "\n"; # Sweep range of sizes [n]: print { $inh } "\n"; # # Type escape sequence to abort. # Sending 20, 56-byte ICMP Echos to 192.168.1.2, timeout is 2 seconds: # Reply to request 0 (4 ms) # Reply to request 1 (4 ms) # Reply to request 2 (4 ms) # Reply to request 3 (1 ms) # Reply to request 4 (1 ms) # Reply to request 5 (1 ms) # Reply to request 6 (4 ms) # Reply to request 7 (4 ms) # Reply to request 8 (4 ms) # Reply to request 9 (4 ms) # Reply to request 10 (1 ms) # Reply to request 11 (1 ms) # Reply to request 12 (1 ms) # Reply to request 13 (1 ms) # Reply to request 14 (4 ms) # Reply to request 15 (4 ms) # Reply to request 16 (4 ms) # Reply to request 17 (4 ms) # Reply to request 18 (1 ms) # Reply to request 19 (1 ms) # Success rate is 100 percent (20/20), round-trip min/avg/max = 1/2/4 ms my @times = (); while (<$outh>){ chomp; /^Reply to request \d+ \((\d+) ms\)/ && push(@times,$1); } @times = map {sprintf "%.10e", $_ / $self->{pingfactor}} sort {$a <=> $b} @times; waitpid $pid,0; close $inh; close $outh; return @times; } sub probevars { my $class = shift; return $class->_makevars($class->SUPER::probevars, { _mandatory => ['binary'], binary => { _doc => < '/usr/bin/rsh', _sub => sub { my $val = shift; -x $val or return "ERROR: binary '$val' is not executable"; return undef; }, }, packetsize => { _doc => < 56, _re => '\d+', _sub => sub { my $val = shift; return "ERROR: packetsize must be between 12 and 64000" unless $val >= 12 and $val <= 64000; return undef; }, }, }); } sub targetvars { my $class = shift; return $class->_makevars($class->SUPER::targetvars, { _mandatory => [ 'ioshost' ], ioshost => { _doc => < 'my.cisco.router', }, iosuser => { _doc => < 'admin', }, iosint => { _doc => < 'Ethernet 1/0', }, }); } 1;