package Smokeping::probes::CiscoRTTMonEchoICMP; =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 Symbol; use Carp; use BER; use SNMP_Session; use SNMP_util "0.97"; use Smokeping::ciscoRttMonMIB "0.2"; sub pod_hash { my $e = "="; return { name => < < < < < L The best source for background info on SAA is Cisco's documentation on L and the CISCO-RTTMON-MIB documentation, which is available at: L DOC authors => <SUPER::new(@_); # no need for this if we run as a cgi unless ( $ENV{SERVER_SOFTWARE} ) { $self->{pingfactor} = 1000; }; return $self; } sub ProbeDesc($){ my $self = shift; my $bytes = $self->{properties}{packetsize}; return "CiscoRTTMonEchoICMP ($bytes Bytes)"; } sub pingone ($$) { my $self = shift; my $target = shift; my $pings = $self->pings($target) || 20; my $tos = $target->{vars}{tos}; my $bytes = $target->{properties}{packetsize}; # use the proces ID as as row number to make this poll distinct on the router; my $row=$$; if (defined StartRttMibEcho($target->{vars}{ioshost}.":::::2", $target->{addr}, $bytes, $pings, $target->{vars}{iosint}, $tos, $row)) { # wait for the series to finish sleep ($pings*$pingtimeout+5); if (my @times=FillTimesFromHistoryTable($target->{vars}{ioshost}.":::::2", $pings, $row)){ DestroyData ($target->{vars}{ioshost}.":::::2", $row); return @times; } else { return(); } } else { return (); } } sub StartRttMibEcho ($$$$$$){ my ($host, $target, $size, $pings, $sourceip, $tos, $row) = @_; # resolve the target name and encode its IP address $_=$target; if (!/^([0-9]|\.)+/) { (my $name, my $aliases, my $addrtype, my $length, my @addrs) = gethostbyname ($target); $target=join('.',(unpack("C4",$addrs[0]))); } my @octets=split(/\./,$target); my $encoded_target= pack ("CCCC", @octets); # resolve the source name and encode its IP address my $encoded_source = undef; if (defined $sourceip) { $_=$sourceip; if (!/^([0-9]|\.)+/) { (my $name, my $aliases, my $addrtype, my $length, my @addrs) = gethostbyname ($sourceip); $sourceip=join('.',(unpack("C4",$addrs[0]))); } my @octets=split(/\./,$sourceip); $encoded_source= pack ("CCCC", @octets); } ############################################################# # rttMonCtrlAdminStatus - 1:active 2:notInService 3:notReady 4:createAndGo 5:createAndWait 6:destroy #delete data from former measurements #return undef unless defined # &snmpset($host, "rttMonCtrlAdminStatus.$row",'integer', 6); ############################################################# # Check RTTMon version and supported protocols $SNMP_Session::suppress_warnings = 10; # be silent (my $version)=&snmpget ($host, "rttMonApplVersion"); if (! defined $version ) { Smokeping::do_log ("$host doesn't support or allow RTTMon !\n"); return undef; } Smokeping::do_log ("$host supports $version\n"); $SNMP_Session::suppress_warnings = 0; # report errors # echo(1), pathEcho(2), fileIO(3), script(4), udpEcho(5), tcpConnect(6), http(7), # dns(8), jitter(9), dlsw(10), dhcp(11), ftp(12) my $udpEchoSupported=0==1; snmpmaptable ($host, sub () { my ($proto, $supported) = @_; # 1 is true , 2 is false $udpEchoSupported=0==0 if ($proto==5 && $supported==1); }, "rttMonApplSupportedRttTypesValid"); ############################################################# #setup the new data row my @params=(); push @params, "rttMonCtrlAdminStatus.$row", 'integer', 5, "rttMonCtrlAdminRttType.$row", 'integer', 1, "rttMonEchoAdminProtocol.$row", 'integer', 2, "rttMonEchoAdminTargetAddress.$row", 'octetstring', $encoded_target, "rttMonCtrlAdminTimeout.$row", 'integer', $pingtimeout*1000, "rttMonCtrlAdminFrequency.$row", 'integer', $pingtimeout, "rttMonHistoryAdminNumBuckets.$row", 'integer', $pings, "rttMonHistoryAdminNumLives.$row", 'integer', 1, "rttMonHistoryAdminFilter.$row", 'integer', 2, "rttMonEchoAdminPktDataRequestSize.$row",'integer', $size-8, "rttMonScheduleAdminRttStartTime.$row", 'timeticks', 1, "rttMonScheduleAdminRttLife.$row", 'integer', $pings*$pingtimeout+3, "rttMonScheduleAdminConceptRowAgeout.$row",'integer', 60; # with udpEcho support (>= 12.0(3)T ) the ICMP ping support was enhanced in the RTTMon SW - we are # NOT using udpEcho, but echo (ICMP echo, ping) if ($udpEchoSupported) { push @params, "rttMonEchoAdminTOS.$row", 'integer', $tos; push @params, "rttMonCtrlAdminNvgen.$row", 'integer', 2; # the router (or this script) doesn't check whether the IP address is one of # the router's IP address, i.e. the router might send packets, but never # gets ping replies.. if (defined $sourceip) { push @params, "rttMonEchoAdminSourceAddress.$row", 'octetstring', $encoded_source; } } else { Smokeping::do_log ("Warning this host does not support ToS or iosint\n"); } return undef unless defined &snmpset($host, @params); ############################################################# # and go ! return undef unless defined &snmpset($host, "rttMonCtrlAdminStatus.$row",'integer',1); return 1; } # RttResponseSense values # 1:ok 2:disconnected 3:overThreshold 4:timeout 5:busy 6:notConnected 7:dropped 8:sequenceError # 9:verifyError 10:applicationSpecific 11:dnsServerTimeout 12:tcpConnectTimeout 13:httpTransactionTimeout #14:dnsQueryError 15:httpError 16:error sub FillTimesFromHistoryTable($$$$) { my ($host, $pings, $row) = @_; my @times; # snmpmaptable walks two tables (of equal size) # - "rttMonHistoryCollectionCompletionTime.$row", # - "rttMonHistoryCollectionSense.$row" # The code in the sub() argument is executed for each index value snmptable walks snmpmaptable ($host, sub () { my ($index, $rtt, $status) = @_; push @times, (sprintf ("%.10e", $rtt/1000)) if ($status==1); }, "rttMonHistoryCollectionCompletionTime.$row", "rttMonHistoryCollectionSense.$row"); return sort { $a <=> $b } @times; } sub DestroyData ($$) { my ($host, $row) = @_; &snmpset($host, "rttMonCtrlOperState.$row", 'integer', 3); &snmpset($host, "rttMonCtrlAdminStatus.$row", 'integer', 2); #delete any old config &snmpset($host, "rttMonCtrlAdminStatus.$row", 'integer', 6); } sub probevars { my $class = shift; return $class->_makevars($class->SUPER::probevars, { packetsize => { _doc => < 56, _re => '\d+', _sub => sub { my $val = shift; return "ERROR: packetsize must be between 8 and 16392" unless $val >= 8 and $val <= 16392; return undef; }, }, }); } sub targetvars { my $class = shift; return $class->_makevars($class->SUPER::targetvars, { _mandatory => [ 'ioshost' ], ioshost => { _example => 'RTTcommunity@Myrouter.foobar.com.au', _doc => < { _example => '10.33.22.11', _doc => < { _example => 160, _default => 0, _doc => <