From 09df26f453b88aafaddf53c08c740d32e1342336 Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Wed, 16 Feb 2005 20:18:48 +0000 Subject: * announce smokeping version at startup * add matcher list to smokeping_config * make matcher names start with a capital letter * make probe names start with a capital letter * small doc updates * one more pod2html makefile fix --- lib/Smokeping.pm | 45 ++++-- lib/Smokeping/matchers/Avgratio.pm | 148 ++++++++++++++++++ lib/Smokeping/matchers/Median.pm | 80 ++++++++++ lib/Smokeping/matchers/avgratio.pm | 148 ------------------ lib/Smokeping/matchers/base.pm | 11 +- lib/Smokeping/matchers/median.pm | 80 ---------- lib/Smokeping/probes/TelnetIOSPing.pm | 283 ++++++++++++++++++++++++++++++++++ lib/Smokeping/probes/telnetIOSPing.pm | 283 ---------------------------------- 8 files changed, 553 insertions(+), 525 deletions(-) create mode 100644 lib/Smokeping/matchers/Avgratio.pm create mode 100644 lib/Smokeping/matchers/Median.pm delete mode 100644 lib/Smokeping/matchers/avgratio.pm delete mode 100644 lib/Smokeping/matchers/median.pm create mode 100644 lib/Smokeping/probes/TelnetIOSPing.pm delete mode 100644 lib/Smokeping/probes/telnetIOSPing.pm (limited to 'lib') diff --git a/lib/Smokeping.pm b/lib/Smokeping.pm index 16654f1..8afa5ee 100644 --- a/lib/Smokeping.pm +++ b/lib/Smokeping.pm @@ -34,14 +34,14 @@ my $DEFAULTPRIORITY = 'info'; # default syslog priority my $logging = 0; # keeps track of whether we have a logging method enabled -sub find_probedir { - # find the directory where the probe modules are located +sub find_libdir { + # find the directory where the probe and matcher modules are located # by looking for 'Smokeping/probes/FPing.pm' in @INC # # yes, this is ugly. Suggestions welcome. for (@INC) { -f "$_/Smokeping/probes/FPing.pm" or next; - return "$_/Smokeping/probes"; + return $_; } return undef; } @@ -184,6 +184,8 @@ sub init_alerts ($){ or die "ERROR: Alert $al pattern entry '$_' is invalid\n"; my $matcher = $1; my $arg = $2; + die "ERROR: matcher $matcher: all matchers start with a capital letter since version 2.0\n" + unless $matcher =~ /^[A-Z]/; eval 'require Smokeping::matchers::'.$matcher; die "Matcher '$matcher' could not be loaded: $@\n" if $@; my $hand; @@ -1068,12 +1070,17 @@ sub get_parser () { my $KEY_RE = '[-_0-9a-zA-Z]+'; my $KEYD_RE = '[-_0-9a-zA-Z.]+'; - my $PROBE_RE = '[a-z]*[A-Z][a-zA-Z]+'; + my $PROBE_RE = '[A-Z][a-zA-Z]+'; my %knownprobes; # the probes encountered so far # get a list of available probes for _dyndoc sections - my $probedir = find_probedir(); + my $libdir = find_libdir(); + my $probedir = $libdir . "/Smokeping/probes"; + my $matcherdir = $libdir . "/Smokeping/matchers"; + my $probelist; + my @matcherlist; + die("Can't find probe module directory") unless defined $probedir; opendir(D, $probedir) or die("opendir $probedir: $!"); for (readdir D) { @@ -1083,6 +1090,14 @@ sub get_parser () { } closedir D; + die("Can't find matcher module directory") unless defined $matcherdir; + opendir(D, $matcherdir) or die("opendir $matcherdir: $!"); + for (sort readdir D) { + next unless /[A-Z]/; + next unless s/\.pm$//; + push @matcherlist, $_; + } + # The target-specific vars of each probe # We need to store them to relay information from Probes section to Target section # see 1.2 above @@ -2064,9 +2079,19 @@ DOC }, type => { - _doc => 'Currently the pattern types B and B and B are known', + _doc => < and B and B are known. + +Matchers are plugin modules that extend the alert conditions. Known +matchers are @{[join (", ", map { "L<$_|Smokeping::matchers::$_>" } +@matcherlist)]}. + +See the documentation of the corresponding matcher module +(eg. L) for instructions on +configuring it. +DOC _re => '(rtt|loss|matcher)', - _re_error => 'Use loss or rtt' + _re_error => 'Use loss, rtt or matcher' }, pattern => { _doc => "a comma separated list of comparison operators and numbers. rtt patterns are in milliseconds, loss patterns are in percents", @@ -2564,7 +2589,7 @@ sub main (;$) { } daemonize_me $cfg->{General}{piddir}."/smokeping.pid"; } - do_log "Launched successfully"; + do_log "Smokeping version $VERSION successfully launched."; my $myprobe; my $forkprobes = $cfg->{General}{concurrentprobes} || 'yes'; @@ -2593,7 +2618,7 @@ sub main (;$) { $probepids{$pid} = $myprobe; } # parent - do_log("All probe processes started succesfully."); + do_log("All probe processes started successfully."); my $exiting = 0; for my $sig (qw(INT TERM)) { $SIG{$sig} = sub { @@ -2608,7 +2633,7 @@ sub main (;$) { } sleep 1; } - do_log("All child processes succesfully terminated, exiting."); + do_log("All child processes successfully terminated, exiting."); exit 0; } }; diff --git a/lib/Smokeping/matchers/Avgratio.pm b/lib/Smokeping/matchers/Avgratio.pm new file mode 100644 index 0000000..8679fe9 --- /dev/null +++ b/lib/Smokeping/matchers/Avgratio.pm @@ -0,0 +1,148 @@ +package Smokeping::matchers::Avgratio; + +=head1 NAME + +Smokeping::matchers::Avgratio - detect changes in average median latency + +=head1 OVERVIEW + +The Avgratio matcher establishes a historic average median latency over +several measurement rounds. It compares this average, against a second +average latency value again build over several rounds of measurement. + +=head1 DESCRIPTION + +Call the matcher with the following sequence: + + type = matcher + pattern = Avgratio(historic=>a,current=>b,comparator=>o,percentage=>p) + +=over + +=item historic + +The number of median values to use for building the 'historic' average. + +=item current + +The number of median values to use for building the 'current' average. + +=item comparator + +Which comparison operator should be used to compare current/historic with percentage. + +=item percentage + +Right hand side of the comparison. + +=back + + old <--- historic ---><--- current ---> now + +=head1 EXAMPLE + +Take build the average median latency over 10 samples, use this to divide the +current average latency built over 2 samples and check if it is bigger than +150%. + + Avgratio(historic=>10,current=>2,comparator=>'>',percentage=>150); + + avg(current)/avg(historic) > 150/100 + +This means the matcher will activate when the current latency average is +more than 1.5 times the historic latency average established over the last +10 rounds of measurement. + +=head1 COPYRIGHT + +Copyright (c) 2004 by OETIKER+PARTNER AG. All rights reserved. + +=head1 SPONSORSHIP + +The development of this matcher has been sponsored by Virtela Communications, L. + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +=head1 AUTHOR + +Tobias Oetiker + +=cut + +use vars qw($VERSION); + + +$VERSION = 1.0; + +use strict; +use base qw(Smokeping::matchers::base); +use Carp; + +sub new(@) +{ + my $class = shift; + my $rules = { + historic=>'\d+', + current=>'\d+', + comparator=>'(<|>|<=|>=|==)', + percentage=>'\d+(\.\d+)?' }; + + my $self = $class->SUPER::new($rules,@_); + $self->{param}{sub} = eval "sub {\$_[0] ".$self->{param}{comparator}." \$_[1]}"; + croak "compiling comparator $self->{param}{comparator}: $@" if $@; + $self->{param}{value} = $self->{param}{percentage}/100; + return $self; +} + +sub Length($) +{ + my $self = shift; + return $self->{param}{historic} + $self->{param}{current}; +} + +sub Desc ($) { + croak "Detect changes in average median latency"; +} + +sub avg(@){ + my $sum=0; + my $cnt=0; + for (@_){ + next unless defined $_; + $sum += $_; + $cnt ++; + } + return $sum/$cnt if $cnt; + return undef; +} + +sub Test($$) +{ my $self = shift; + my $data = shift; # @{$data->{rtt}} and @{$data->{loss}} + my $len = $self->Length; + my $rlen = scalar @{$data->{rtt}}; + return undef + if $rlen < $len + or (defined $data->{rtt}[-$len] and $data->{rtt}[-$len] eq 'S'); + my $ac = $self->{param}{historic}; + my $bc = $self->{param}{current}; + my $cc = $ac +$bc; + my $ha = avg(@{$data->{rtt}}[-$cc..-$bc-1]); + my $ca = avg(@{$data->{rtt}}[-$bc..-1]); + return undef unless $ha and $ca; + return &{$self->{param}{sub}}($ca/$ha,$self->{param}{value}); +} diff --git a/lib/Smokeping/matchers/Median.pm b/lib/Smokeping/matchers/Median.pm new file mode 100644 index 0000000..3c8560a --- /dev/null +++ b/lib/Smokeping/matchers/Median.pm @@ -0,0 +1,80 @@ +package Smokeping::matchers::Median; + +=head1 NAME + +Smokeping::matchers::Median - Find persistant changes in latency + +=head1 OVERVIEW + +The idea behind this matcher is to find sustained changes in latency. + +The median matcher takes a number of past median latencies. It splits the latencies into +two groups (old and new) and again finds the median for each groups. If the +difference between the two medians is bigger than a certain value, it will +give a match. + +=head1 DESCRIPTION + +Call the matcher with the following sequence: + + type = matcher + pattern = Median(old=>x,new=>y,diff=>z) + +This will create a matcher which consumes x+y latency-datapoints, builds the +two medians and the matches if the difference between the median latency is +larger than z seconds. + +=head1 COPYRIGHT + +Copyright (c) 2004 by OETIKER+PARTNER AG. All rights reserved. + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +=head1 AUTHOR + +Tobias Oetiker + +=cut + +use strict; +use base qw(Smokeping::matchers::base); +use vars qw($VERSION); +$VERSION = 1.0; +use Carp; + +# how many values does the matcher need to do it's magic +sub Length($) +{ + my $self = shift; + return $self->{param}{old} + $self->{param}{new}; +} + +sub Desc ($) { + croak "Find changes in median latency"; +} + +sub Test($$) +{ my $self = shift; + my $data = shift; # @{$data->{rtt}} and @{$data->{loss}} + my $ac = $self->{param}{old}; + my $bc = $self->{param}{new}; + my $cc = $ac +$bc; + my $oldm = (sort {$a <=> $b} @{$data->{rtt}}[-$cc..-$bc-1])[int($a/2)]; + $ac++; + my $newm = (sort {$a <=> $b} @{$data->{rtt}}[-$bc..-1])[int($bc/2)]; + return abs($oldm-$newm) > $self->{param}{diff}; +} diff --git a/lib/Smokeping/matchers/avgratio.pm b/lib/Smokeping/matchers/avgratio.pm deleted file mode 100644 index fab0164..0000000 --- a/lib/Smokeping/matchers/avgratio.pm +++ /dev/null @@ -1,148 +0,0 @@ -package Smokeping::matchers::avgratio; - -=head1 NAME - -Smokeping::matchers::avgratio - detect changes in average median latency - -=head1 OVERVIEW - -The avgratio matcher establishes a historic average median latency over -several measurement rounds. It compares this average, against a second -average latency value again build over several rounds of measurment. - -=head1 DESCRIPTION - -Call the matcher with the following sequence: - - type = matcher - pattern = avgratio(historic=>a,current=>b,comparator=>o,percentage=>p) - -=over - -=item historic - -The number of median values to use for building the 'historic' average. - -=item current - -The number of median values to use for building the 'current' average. - -=item comparator - -Which comparison operator should be used to compare current/historic with percentage. - -=item percentage - -Right hand side of the comparison. - -=back - - old <--- historic ---><--- current ---> now - -=head1 EXAMPLE - -Take build the average median latency over 10 samples, use this to divid the -current average latency built over 2 samples and check if it is bigger than -150%. - - avgratio(historic=>10,current=>2,comparator=>'>',percentage=>150); - - avg(current)/avg(historic) > 150/100 - -This means the matcher will activate when the current latency average if -more than 1.5 times the historic latency average established over the last -10 rounds of measurement. - -=head1 COPYRIGHT - -Copyright (c) 2004 by OETIKER+PARTNER AG. All rights reserved. - -=head1 SPONSORSHIP - -The development of this matcher has been sponsored by Virtela Communications www.virtela.net. - -=head1 LICENSE - -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -=head1 AUTHOR - -Tobias Oetiker - -=cut - -use vars qw($VERSION); - - -$VERSION = 1.0; - -use strict; -use base qw(Smokeping::matchers::base); -use Carp; - -sub new(@) -{ - my $class = shift; - my $rules = { - historic=>'\d+', - current=>'\d+', - comparator=>'(<|>|<=|>=|==)', - percentage=>'\d+(\.\d+)?' }; - - my $self = $class->SUPER::new($rules,@_); - $self->{param}{sub} = eval "sub {\$_[0] ".$self->{param}{comparator}." \$_[1]}"; - croak "compiling comparator $self->{param}{comparator}: $@" if $@; - $self->{param}{value} = $self->{param}{percentage}/100; - return $self; -} - -sub Length($) -{ - my $self = shift; - return $self->{param}{historic} + $self->{param}{current}; -} - -sub Desc ($) { - croak "Detect changes in average median latency"; -} - -sub avg(@){ - my $sum=0; - my $cnt=0; - for (@_){ - next unless defined $_; - $sum += $_; - $cnt ++; - } - return $sum/$cnt if $cnt; - return undef; -} - -sub Test($$) -{ my $self = shift; - my $data = shift; # @{$data->{rtt}} and @{$data->{loss}} - my $len = $self->Length; - my $rlen = scalar @{$data->{rtt}}; - return undef - if $rlen < $len - or (defined $data->{rtt}[-$len] and $data->{rtt}[-$len] eq 'S'); - my $ac = $self->{param}{historic}; - my $bc = $self->{param}{current}; - my $cc = $ac +$bc; - my $ha = avg(@{$data->{rtt}}[-$cc..-$bc-1]); - my $ca = avg(@{$data->{rtt}}[-$bc..-1]); - return undef unless $ha and $ca; - return &{$self->{param}{sub}}($ca/$ha,$self->{param}{value}); -} diff --git a/lib/Smokeping/matchers/base.pm b/lib/Smokeping/matchers/base.pm index cd69871..130634f 100644 --- a/lib/Smokeping/matchers/base.pm +++ b/lib/Smokeping/matchers/base.pm @@ -7,9 +7,12 @@ Smokeping::matchers::base - Base Class for implementing SmokePing Matchers =head1 OVERVIEW This is the base class for writing SmokePing matchers. Every matcher must -inherit from the base class and provide it's own methods for the 'buisness' +inherit from the base class and provide it's own methods for the 'business' logic. +Note that the actual matchers must have at least one capital letter in their +name, to differentiate them from the base class(es). + =head1 DESCRIPTION Every matcher must provide the following methods: @@ -29,7 +32,7 @@ The new method expects hash elements as an argument eg new({x=>'\d+',y=>'\d+'},x=>1,y=>2). The first part is a syntax rule for the arguments it should expect and the second part are the arguments itself. The first part will be supplied -by the child class as it calls the partent method. +by the child class as it calls the parent method. =cut @@ -41,7 +44,7 @@ sub new(@) my $self = { param => { @_ } }; foreach my $key (keys %{$self->{param}}){ my $regex = $rules->{$key}; - croak "key '$key' is not known byt this matcher" unless defined $rules->{$key}; + croak "key '$key' is not known by this matcher" unless defined $rules->{$key}; croak "key '$key' contains invalid data: '$self->{param}{$key}'" unless $self->{param}{$key} =~ m/^$regex$/; } bless $self, $class; @@ -77,7 +80,7 @@ sub Desc ($) { =head2 Test Run the matcher and return true or false. The Test method is called -with a hash of two arrays giving it access to both rtt and loss values +with a hash of two arrays giving it access to both rtt and loss values. my $data=shift; my @rtt = @{$data->{rtt}}; diff --git a/lib/Smokeping/matchers/median.pm b/lib/Smokeping/matchers/median.pm deleted file mode 100644 index e8d43cf..0000000 --- a/lib/Smokeping/matchers/median.pm +++ /dev/null @@ -1,80 +0,0 @@ -package Smokeping::matchers::median; - -=head1 NAME - -Smokeping::matchers::median - Find persistant change in latency - -=head1 OVERVIEW - -The idea behind this matcher is to find sustained changes in latency. - -The median matcher takes a number of past median latencies. It splits the latencies into -two groups (old and new) and again finds the median for each groups. If the -difference between the two medians is bigger than a certain value, it will -give a match. - -=head1 DESCRIPTION - -Call the matcher with the following sequence: - - type = matcher - pattern = median(old=>x,new=>y,diff=>z) - -This will create a matcher which consumes x+y latency-datapoints, builds the -two medians and the matches if the difference between the median latency is -larger than z seconds. - -=head1 COPYRIGHT - -Copyright (c) 2004 by OETIKER+PARTNER AG. All rights reserved. - -=head1 LICENSE - -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -=head1 AUTHOR - -Tobias Oetiker - -=cut - -use strict; -use base qw(Smokeping::matchers::base); -use vars qw($VERSION); -$VERSION = 1.0; -use Carp; - -# how many values does the matcher need to do it's magic -sub Length($) -{ - my $self = shift; - return $self->{param}{old} + $self->{param}{new}; -} - -sub Desc ($) { - croak "Finde changes in median latency"; -} - -sub Test($$) -{ my $self = shift; - my $data = shift; # @{$data->{rtt}} and @{$data->{loss}} - my $ac = $self->{param}{old}; - my $bc = $self->{param}{new}; - my $cc = $ac +$bc; - my $oldm = (sort {$a <=> $b} @{$data->{rtt}}[-$cc..-$bc-1])[int($a/2)]; - $ac++; - my $newm = (sort {$a <=> $b} @{$data->{rtt}}[-$bc..-1])[int($bc/2)]; - return abs($oldm-$newm) > $self->{param}{diff}; -} diff --git a/lib/Smokeping/probes/TelnetIOSPing.pm b/lib/Smokeping/probes/TelnetIOSPing.pm new file mode 100644 index 0000000..5f68877 --- /dev/null +++ b/lib/Smokeping/probes/TelnetIOSPing.pm @@ -0,0 +1,283 @@ +package Smokeping::probes::TelnetIOSPing; + +=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 Net::Telnet (); +use Carp; + +my $e = "="; +sub pod_hash { + return { + name => < < < <<'DOC', +John A Jackson + +based HEAVILY on Smokeping::probes::IOSPing by + +Paul J Murphy + +based on Smokeping::probes::FPing 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 "InfoAve Cisco IOS - ICMP Echo Pings ($bytes Bytes)"; +} + +sub pingone ($$){ + my $self = shift; + my $target = shift; + my $source = $target->{vars}{source}; + my $dest = $target->{vars}{host}; + my $psource = $target->{vars}{psource} || ""; + my $port = 23; + my @output = (); + my $login = $target->{vars}{iosuser}; + my $pssword = $target->{vars}{iospass}; + my $bytes = $self->{properties}{packetsize}; + my $pings = $self->pings($target); + + # do NOT call superclass ... the ping method MUST be overwriten + my %upd; + my @args = (); + + + my $telnet = new Net::Telnet; +# These are for debugging +# $telnet->errmode("TIPreturn"); +# $telnet->input_log("TIPinlog"); +# $telnet->dump_log("TIPdumplog"); + +#Open the Connection to the router +# open(OUTF,">outfile.IA") || die "Can't open OUTF: $!"; +# print OUTF "target => $dest\nsource => $source\nuser => $login\n"; + my $ok = $telnet->open(Host => $source, + Port => $port); +# print OUTF "Connection is a $ok\n"; + + #Authenticate + $telnet->waitfor('/(ogin|name|word):.*$/'); + $telnet->print("$login"); + $telnet->waitfor('/word:.*$/'); + $telnet->print("$pssword"); + #Do the work + $telnet->waitfor('/[\@\w\-\.]+[>#][ ]*$/'); + $telnet->print("terminal length 0"); + $telnet->waitfor('/[\@\w\-\.]+[>#][ ]*$/'); + $telnet->print("ping"); + $telnet->waitfor('/Protocol \[ip\]: $/'); + $telnet->print(""); + $telnet->waitfor('/Target IP address: $/'); + $telnet->print("$dest"); + $telnet->waitfor('/Repeat count \[5\]: $/'); + $telnet->print($pings); + $telnet->waitfor('/Datagram size \[100\]: $/'); + $telnet->print("$bytes"); + $telnet->waitfor('/Timeout in seconds \[2\]: $/'); + $telnet->print(""); + $telnet->waitfor('/Extended commands \[n\]: $/'); + $telnet->print("y"); + $telnet->waitfor('/Source address or interface: $/'); + $telnet->print("$psource"); + $telnet->waitfor('/Type of service \[0\]: $/'); + $telnet->print(""); + $telnet->waitfor('/Set DF bit in IP header\? \[no\]: $/'); + $telnet->print(""); + $telnet->waitfor('/Validate reply data\? \[no\]: $/'); + $telnet->print(""); + $telnet->waitfor('/Data pattern \[0xABCD\]: $/'); + $telnet->print(""); + $telnet->waitfor('/Loose, Strict, Record, Timestamp, Verbose\[none\]: $/'); + $telnet->print("v"); + $telnet->waitfor('/Loose, Strict, Record, Timestamp, Verbose\[V\]: $/'); + $telnet->print(""); + $telnet->waitfor('/Sweep range of sizes.+$/'); + + $telnet->prompt('/[\@\w\-\.]+[>#][ ]*$/'); + @output = $telnet->cmd("n"); + + #$telnet->waitfor('/[\@\w\-\.]+[>#][ ]*$/'); + $telnet->print("quit"); + $telnet->close; +# print OUTF "closed Telnet connection\n"; + + my @times = (); + while (@output) { + my $outputline = shift @output; + chomp($outputline); +# print OUTF "$outputline\n"; + $outputline =~ /^Reply to request \d+ \((\d+) ms\)/ && push(@times,$1); + #print OUTF "$outputline => $1\n"; + } + @times = map {sprintf "%.10e", $_ / $self->{pingfactor}} sort {$a <=> $b} @times; +# close(OUTF); + return @times; +} + +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 12 and 64000" + unless $val >= 12 and $val <= 64000; + return undef; + }, + }, + }); +} + +sub targetvars { + my $class = shift; + return $class->_makevars($class->SUPER::targetvars, { + _mandatory => [ 'iosuser', 'iospass', 'source' ], + source => { + _doc => < "192.168.2.1", + }, + psource => { + _doc => < "192.168.2.129", + }, + iosuser => { + _doc => < 'user', + }, + iospass => { + _doc => < 'password', + }, + }); +} + +1; diff --git a/lib/Smokeping/probes/telnetIOSPing.pm b/lib/Smokeping/probes/telnetIOSPing.pm deleted file mode 100644 index 260cec7..0000000 --- a/lib/Smokeping/probes/telnetIOSPing.pm +++ /dev/null @@ -1,283 +0,0 @@ -package Smokeping::probes::telnetIOSPing; - -=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 Net::Telnet (); -use Carp; - -my $e = "="; -sub pod_hash { - return { - name => < < < <<'DOC', -John A Jackson - -based HEAVILY on Smokeping::probes::IOSPing by - -Paul J Murphy - -based on Smokeping::probes::FPing 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 "InfoAve Cisco IOS - ICMP Echo Pings ($bytes Bytes)"; -} - -sub pingone ($$){ - my $self = shift; - my $target = shift; - my $source = $target->{vars}{source}; - my $dest = $target->{vars}{host}; - my $psource = $target->{vars}{psource} || ""; - my $port = 23; - my @output = (); - my $login = $target->{vars}{iosuser}; - my $pssword = $target->{vars}{iospass}; - my $bytes = $self->{properties}{packetsize}; - my $pings = $self->pings($target); - - # do NOT call superclass ... the ping method MUST be overwriten - my %upd; - my @args = (); - - - my $telnet = new Net::Telnet; -# These are for debugging -# $telnet->errmode("TIPreturn"); -# $telnet->input_log("TIPinlog"); -# $telnet->dump_log("TIPdumplog"); - -#Open the Connection to the router -# open(OUTF,">outfile.IA") || die "Can't open OUTF: $!"; -# print OUTF "target => $dest\nsource => $source\nuser => $login\n"; - my $ok = $telnet->open(Host => $source, - Port => $port); -# print OUTF "Connection is a $ok\n"; - - #Authenticate - $telnet->waitfor('/(ogin|name|word):.*$/'); - $telnet->print("$login"); - $telnet->waitfor('/word:.*$/'); - $telnet->print("$pssword"); - #Do the work - $telnet->waitfor('/[\@\w\-\.]+[>#][ ]*$/'); - $telnet->print("terminal length 0"); - $telnet->waitfor('/[\@\w\-\.]+[>#][ ]*$/'); - $telnet->print("ping"); - $telnet->waitfor('/Protocol \[ip\]: $/'); - $telnet->print(""); - $telnet->waitfor('/Target IP address: $/'); - $telnet->print("$dest"); - $telnet->waitfor('/Repeat count \[5\]: $/'); - $telnet->print($pings); - $telnet->waitfor('/Datagram size \[100\]: $/'); - $telnet->print("$bytes"); - $telnet->waitfor('/Timeout in seconds \[2\]: $/'); - $telnet->print(""); - $telnet->waitfor('/Extended commands \[n\]: $/'); - $telnet->print("y"); - $telnet->waitfor('/Source address or interface: $/'); - $telnet->print("$psource"); - $telnet->waitfor('/Type of service \[0\]: $/'); - $telnet->print(""); - $telnet->waitfor('/Set DF bit in IP header\? \[no\]: $/'); - $telnet->print(""); - $telnet->waitfor('/Validate reply data\? \[no\]: $/'); - $telnet->print(""); - $telnet->waitfor('/Data pattern \[0xABCD\]: $/'); - $telnet->print(""); - $telnet->waitfor('/Loose, Strict, Record, Timestamp, Verbose\[none\]: $/'); - $telnet->print("v"); - $telnet->waitfor('/Loose, Strict, Record, Timestamp, Verbose\[V\]: $/'); - $telnet->print(""); - $telnet->waitfor('/Sweep range of sizes.+$/'); - - $telnet->prompt('/[\@\w\-\.]+[>#][ ]*$/'); - @output = $telnet->cmd("n"); - - #$telnet->waitfor('/[\@\w\-\.]+[>#][ ]*$/'); - $telnet->print("quit"); - $telnet->close; -# print OUTF "closed Telnet connection\n"; - - my @times = (); - while (@output) { - my $outputline = shift @output; - chomp($outputline); -# print OUTF "$outputline\n"; - $outputline =~ /^Reply to request \d+ \((\d+) ms\)/ && push(@times,$1); - #print OUTF "$outputline => $1\n"; - } - @times = map {sprintf "%.10e", $_ / $self->{pingfactor}} sort {$a <=> $b} @times; -# close(OUTF); - return @times; -} - -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 12 and 64000" - unless $val >= 12 and $val <= 64000; - return undef; - }, - }, - }); -} - -sub targetvars { - my $class = shift; - return $class->_makevars($class->SUPER::targetvars, { - _mandatory => [ 'iosuser', 'iospass', 'source' ], - source => { - _doc => < "192.168.2.1", - }, - psource => { - _doc => < "192.168.2.129", - }, - iosuser => { - _doc => < 'user', - }, - iospass => { - _doc => < 'password', - }, - }); -} - -1; -- cgit v1.2.3-24-g4f1b