diff options
author | Niko Tyni <ntyni@iki.fi> | 2005-02-13 20:23:04 +0100 |
---|---|---|
committer | Niko Tyni <ntyni@iki.fi> | 2005-02-13 20:23:04 +0100 |
commit | 6d76521656e91daa160bc8019828f1b68d7aa5dc (patch) | |
tree | aaa27615a0702942fa1606d9a5c89f0a3547467c /lib/Smokeping | |
parent | 6dba1afbe4b475a7d34f5ef867b7b37291cd1484 (diff) | |
download | smokeping-6d76521656e91daa160bc8019828f1b68d7aa5dc.tar.gz smokeping-6d76521656e91daa160bc8019828f1b68d7aa5dc.tar.xz |
Moved probes, matchers and ciscoRttMonMIB modules to lib/Smokeping.
Diffstat (limited to 'lib/Smokeping')
31 files changed, 5479 insertions, 0 deletions
diff --git a/lib/Smokeping/ciscoRttMonMIB.pm b/lib/Smokeping/ciscoRttMonMIB.pm new file mode 100644 index 0000000..88b4280 --- /dev/null +++ b/lib/Smokeping/ciscoRttMonMIB.pm @@ -0,0 +1,111 @@ +# +# +# a few variable definitions to use ciscoRttMonMIB +# +# Joerg Kummer, 10/9/03 +# + +package Smokeping::ciscoRttMonMIB; + +require 5.004; + +use vars qw($VERSION); +use Exporter; + +use BER; +use SNMP_Session; +use SNMP_util "0.89"; + +$VERSION = '0.2'; + +@ISA = qw(Exporter); + +sub version () { $VERSION; }; + +snmpmapOID("rttMonApplVersion", "1.3.6.1.4.1.9.9.42.1.1.1.0"); +snmpmapOID("rttMonApplSupportedRttTypesValid", "1.3.6.1.4.1.9.9.42.1.1.7.1.2"); + +# generic variables for all measurement types +# cisco(9).ciscoMgmt(9).ciscoRttMonMIB(42).ciscoRttMonObjects(1).rttMonCtrl(2).rttMonCtrlAdminTable(1).rttMonCtrlAdminEntry(1) +snmpmapOID("rttMonCtrlAdminIndex", "1.3.6.1.4.1.9.9.42.1.2.1.1.1"); +snmpmapOID("rttMonCtrlAdminOwner", "1.3.6.1.4.1.9.9.42.1.2.1.1.2"); +snmpmapOID("rttMonCtrlAdminTag", "1.3.6.1.4.1.9.9.42.1.2.1.1.3"); +snmpmapOID("rttMonCtrlAdminRttType", "1.3.6.1.4.1.9.9.42.1.2.1.1.4"); +snmpmapOID("rttMonCtrlAdminThreshold", "1.3.6.1.4.1.9.9.42.1.2.1.1.5"); +snmpmapOID("rttMonCtrlAdminFrequency", "1.3.6.1.4.1.9.9.42.1.2.1.1.6"); +snmpmapOID("rttMonCtrlAdminTimeout", "1.3.6.1.4.1.9.9.42.1.2.1.1.7"); +snmpmapOID("rttMonCtrlAdminVerifyData", "1.3.6.1.4.1.9.9.42.1.2.1.1.8"); +snmpmapOID("rttMonCtrlAdminStatus", "1.3.6.1.4.1.9.9.42.1.2.1.1.9"); +snmpmapOID("rttMonCtrlAdminNvgen", "1.3.6.1.4.1.9.9.42.1.2.1.1.10"); + + +#1. For echo, pathEcho and dlsw operations +# cisco(9).ciscoMgmt(9).ciscoRttMonMIB(42).ciscoRttMonObjects(1).rttMonCtrl(2).rttMonEchoAdminTable(2).rttMonEchoAdminEntry (1) +snmpmapOID("rttMonEchoAdminProtocol", "1.3.6.1.4.1.9.9.42.1.2.2.1.1"); +snmpmapOID("rttMonEchoAdminTargetAddress", "1.3.6.1.4.1.9.9.42.1.2.2.1.2"); +snmpmapOID("rttMonEchoAdminPktDataRequestSize", "1.3.6.1.4.1.9.9.42.1.2.2.1.3"); +snmpmapOID("rttMonEchoAdminPktDataResponseSize", "1.3.6.1.4.1.9.9.42.1.2.2.1.4"); +snmpmapOID("rttMonEchoAdminTargetPort", "1.3.6.1.4.1.9.9.42.1.2.2.1.5"); +snmpmapOID("rttMonEchoAdminSourceAddress", "1.3.6.1.4.1.9.9.42.1.2.2.1.6"); +snmpmapOID("rttMonEchoAdminSourcePort", "1.3.6.1.4.1.9.9.42.1.2.2.1.7"); +snmpmapOID("rttMonEchoAdminControlEnable", "1.3.6.1.4.1.9.9.42.1.2.2.1.8"); +snmpmapOID("rttMonEchoAdminTOS", "1.3.6.1.4.1.9.9.42.1.2.2.1.9"); +snmpmapOID("rttMonEchoAdminLSREnable", "1.3.6.1.4.1.9.9.42.1.2.2.1.10"); +snmpmapOID("rttMonEchoAdminTargetAddressString", "1.3.6.1.4.1.9.9.42.1.2.2.1.11"); +snmpmapOID("rttMonEchoAdminNameServer", "1.3.6.1.4.1.9.9.42.1.2.2.1.12"); +snmpmapOID("rttMonEchoAdminOperation", "1.3.6.1.4.1.9.9.42.1.2.2.1.13"); +snmpmapOID("rttMonEchoAdminHTTPVersion", "1.3.6.1.4.1.9.9.42.1.2.2.1.14"); +snmpmapOID("rttMonEchoAdminURL", "1.3.6.1.4.1.9.9.42.1.2.2.1.15"); +snmpmapOID("rttMonEchoAdminCache", "1.3.6.1.4.1.9.9.42.1.2.2.1.16"); +snmpmapOID("rttMonEchoAdminInterval", "1.3.6.1.4.1.9.9.42.1.2.2.1.17"); +snmpmapOID("rttMonEchoAdminNumPackets", "1.3.6.1.4.1.9.9.42.1.2.2.1.18"); +snmpmapOID("rttMonEchoAdminProxy", "1.3.6.1.4.1.9.9.42.1.2.2.1.19"); +snmpmapOID("rttMonEchoAdminString1", "1.3.6.1.4.1.9.9.42.1.2.2.1.20"); +snmpmapOID("rttMonEchoAdminString2", "1.3.6.1.4.1.9.9.42.1.2.2.1.21"); +snmpmapOID("rttMonEchoAdminString3", "1.3.6.1.4.1.9.9.42.1.2.2.1.22"); +snmpmapOID("rttMonEchoAdminString4", "1.3.6.1.4.1.9.9.42.1.2.2.1.231"); +snmpmapOID("rttMonEchoAdminString5", "1.3.6.1.4.1.9.9.42.1.2.2.1.24"); +snmpmapOID("rttMonEchoAdminMode", "1.3.6.1.4.1.9.9.42.1.2.2.1.25"); +snmpmapOID("rttMonEchoAdminVrfName", "1.3.6.1.4.1.9.9.42.1.2.2.1.26"); + +# cisco(9).ciscoMgmt(9).ciscoRttMonMIB(42).ciscoRttMonObjects(1).rttMonCtrl(2).rttMonScheduleAdminTable(5).rttMonScheduleAdminEntry(1) +snmpmapOID("rttMonScheduleAdminRttLife", "1.3.6.1.4.1.9.9.42.1.2.5.1.1"); +snmpmapOID("rttMonScheduleAdminRttStartTime", "1.3.6.1.4.1.9.9.42.1.2.5.1.2"); +snmpmapOID("rttMonScheduleAdminConceptRowAgeout", "1.3.6.1.4.1.9.9.42.1.2.5.1.3"); + +# cisco(9).ciscoMgmt(9).ciscoRttMonMIB(42).ciscoRttMonObjects(1).rttMonCtrl(2).rttMonScheduleAdminTable(5).rttMonScheduleAdminEntry(1) +snmpmapOID("rttMonScheduleAdminRttLife", "1.3.6.1.4.1.9.9.42.1.2.5.1.1"); + + +# cisco(9).ciscoMgmt(9).ciscoRttMonMIB(42).ciscoRttMonObjects(1).rttMonCtrl(2).rttMonHistoryAdminTable(8).rttMonHistoryAdminEntry(1) +snmpmapOID("rttMonHistoryAdminNumLives", "1.3.6.1.4.1.9.9.42.1.2.8.1.1"); +snmpmapOID("rttMonHistoryAdminNumBuckets", "1.3.6.1.4.1.9.9.42.1.2.8.1.2"); +snmpmapOID("rttMonHistoryAdminNumSamples", "1.3.6.1.4.1.9.9.42.1.2.8.1.3"); +snmpmapOID("rttMonHistoryAdminFilter", "1.3.6.1.4.1.9.9.42.1.2.8.1.4"); + +snmpmapOID("rttMonCtrlOperConnectionLostOccurred", "1.3.6.1.4.1.9.9.42.1.2.9.1.5"); +snmpmapOID("rttMonCtrlOperTimeoutOccurred", "1.3.6.1.4.1.9.9.42.1.2.9.1.6"); +snmpmapOID("rttMonCtrlOperOverThresholdOccurred", "1.3.6.1.4.1.9.9.42.1.2.9.1.7"); +snmpmapOID("rttMonCtrlOperNumRtts", "1.3.6.1.4.1.9.9.42.1.2.9.1.8"); +snmpmapOID("rttMonCtrlOperRttLife", "1.3.6.1.4.1.9.9.42.1.2.9.1.9"); +snmpmapOID("rttMonCtrlOperState", "1.3.6.1.4.1.9.9.42.1.2.9.1.10"); +snmpmapOID("rttMonCtrlOperVerifyErrorOccurred", "1.3.6.1.4.1.9.9.42.1.2.9.1.11"); + +# cisco(9).ciscoMgmt(9).ciscoRttMonMIB(42).ciscoRttMonObjects(1).rttMonHistory(4).rttMonHistoryCollectionTable(1).rttMonHistoryCollectionEntry(1) +snmpmapOID("rttMonStatisticsAdminNumPaths", "1.3.6.1.4.1.9.9.42.1.2.7.1.2"); +snmpmapOID("rttMonStatisticsAdminNumHops", "1.3.6.1.4.1.9.9.42.1.2.7.1.3"); + +# cisco(9).ciscoMgmt(9).ciscoRttMonMIB(42).ciscoRttMonObjects(1).rttMonHistory(4).rttMonHistoryCollectionTable(1).rttMonHistoryCollectionEntry(1) +snmpmapOID("rttMonHistoryCollectionLifeIndex", "1.3.6.1.4.1.9.9.42.1.4.1.1.1"); +snmpmapOID("rttMonHistoryCollectionBucketIndex", "1.3.6.1.4.1.9.9.42.1.4.1.1.2"); +snmpmapOID("rttMonHistoryCollectionSampleIndex", "1.3.6.1.4.1.9.9.42.1.4.1.1.3"); +snmpmapOID("rttMonHistoryCollectionSampleTime", "1.3.6.1.4.1.9.9.42.1.4.1.1.4"); +snmpmapOID("rttMonHistoryCollectionAddress", "1.3.6.1.4.1.9.9.42.1.4.1.1.5"); +snmpmapOID("rttMonHistoryCollectionCompletionTime", "1.3.6.1.4.1.9.9.42.1.4.1.1.6"); +snmpmapOID("rttMonHistoryCollectionSense", "1.3.6.1.4.1.9.9.42.1.4.1.1.7"); +snmpmapOID("rttMonHistoryCollectionApplSpecificSense", "1.3.6.1.4.1.9.9.42.1.4.1.1.8"); +snmpmapOID("rttMonHistoryCollectionSenseDescription", "1.3.6.1.4.1.9.9.42.1.4.1.1.9"); + + +# return 1 to indicate that all is ok.. +1; diff --git a/lib/Smokeping/matchers/avgratio.pm b/lib/Smokeping/matchers/avgratio.pm new file mode 100644 index 0000000..fab0164 --- /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 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 <tobi@oetiker.ch> + +=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 new file mode 100644 index 0000000..cd69871 --- /dev/null +++ b/lib/Smokeping/matchers/base.pm @@ -0,0 +1,127 @@ +package Smokeping::matchers::base; + +=head1 NAME + +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' +logic. + +=head1 DESCRIPTION + +Every matcher must provide the following methods: + +=cut + +use vars qw($VERSION); +use Carp; + +$VERSION = 1.0; + +use strict; + +=head2 new + +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. + +=cut + +sub new(@) +{ + my $this = shift; + my $class = ref($this) || $this; + my $rules = shift; + 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' contains invalid data: '$self->{param}{$key}'" unless $self->{param}{$key} =~ m/^$regex$/; + } + bless $self, $class; + return $self; +} + +=head2 Length + +The Length method returns the number of values the +matcher will expect from SmokePing. This method must +be overridden by the children of the base class. + +=cut + +sub Length($) +{ + my $self = shift; + croak "SequenceLength must be overridden by the subclass"; +} + +=head2 Desc + +Simply return the description of the function. This method must +be overwritten by a children of the base class. + +=cut + + +sub Desc ($) { + croak "MatcherDesc must be overridden by the subclass"; +} + +=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 + + my $data=shift; + my @rtt = @{$data->{rtt}}; + my @loss = @{$data->{loss}}; + +The arrays are ordered from old to new. + + @rdd[old..new] + +There may be more than the expected number of elements in this array. Address them with +$x[-1] to $x[-max]. + + +=cut + +sub Test($$) +{ my $self = shift; + my $data = shift; # @{$data->{rtt}} and @{$data->{loss}} + croak "Match must be overridden by the subclass"; + +} + +=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 <tobi@oetiker.ch> + +=cut diff --git a/lib/Smokeping/matchers/median.pm b/lib/Smokeping/matchers/median.pm new file mode 100644 index 0000000..e8d43cf --- /dev/null +++ b/lib/Smokeping/matchers/median.pm @@ -0,0 +1,80 @@ +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 <tobi@oetiker.ch> + +=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/AnotherDNS.pm b/lib/Smokeping/probes/AnotherDNS.pm new file mode 100644 index 0000000..6d5a63f --- /dev/null +++ b/lib/Smokeping/probes/AnotherDNS.pm @@ -0,0 +1,157 @@ +package Smokeping::probes::AnotherDNS; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::AnotherDNS> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::AnotherDNS> + +to generate the POD document. + +=cut + +use strict; + +# And now, an extra ugly hack +# Reason: Net::DNS does an eval("use Win32:Registry") to +# find out if it is running on Windows. This triggers the signal +# handler in the cgi mode. + +my $tmp = $SIG{__DIE__}; +$SIG{__DIE__} = sub { }; +eval("use Net::DNS;"); +$SIG{__DIE__} = $tmp; + +use base qw(Smokeping::probes::basefork); +use IPC::Open3; +use Symbol; +use Carp; +use Time::HiRes qw(sleep ualarm gettimeofday tv_interval); +use IO::Socket; +use IO::Select; + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::AnotherDNS - Alternate DNS Probe +DOC + description => <<DOC, +Like DNS, but uses Net::DNS and Time::HiRes instead of dig. This probe does +*not* retry the request three times before it is considerd "lost", like dig and +other resolver do by default. If operating as caching Nameserver, BIND (and +maybe others) expect clients to retry the request if the answer is not in the +cache. So, ask the nameserver for something that he is authoritative for if you +want measure the network packet loss correctly. + +If you have a really fast network and nameserver, you will notice that this +probe reports the query time in microsecond resolution. :-) +DOC + authors => <<'DOC', +Christoph Heine <Christoph.Heine@HaDiKo.DE> +DOC + } +} + +sub new($$$) { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(@_); + return $self; +} + +sub ProbeDesc($) { + my $self = shift; + return "DNS requests"; +} + +sub pingone ($) { + my $self = shift; + my $target = shift; + + my $host = $target->{addr}; + my $lookuphost = $target->{vars}{lookup}; + my $mininterval = $target->{vars}{mininterval}; + my $recordtype = $target->{vars}{recordtype}; + my $timeout = $target->{vars}{timeout}; + my $port = $target->{vars}{port}; + $lookuphost = $target->{addr} unless defined $lookuphost; + + my $packet = Net::DNS::Packet->new( $lookuphost, $recordtype )->data; + my $sock = IO::Socket::INET->new( + "PeerAddr" => $host, + "PeerPort" => $port, + "Proto" => "udp", + ); + my $sel = IO::Select->new($sock); + + my @times; + + my $elapsed; + for ( my $run = 0 ; $run < $self->pings($target) ; $run++ ) { + if (defined $elapsed) { + my $timeleft = $mininterval - $elapsed; + sleep $timeleft if $timeleft > 0; + } + my $t0 = [gettimeofday]; + $sock->send($packet); + my ($ready) = $sel->can_read($timeout); + my $t1 = [gettimeofday]; + $elapsed = tv_interval( $t0, $t1 ); + if ( defined $ready ) { + push @times, $elapsed; + my $buf = ''; + $ready->recv( $buf, &Net::DNS::PACKETSZ ); + } + } + @times = + map { sprintf "%.10e", $_ } sort { $a <=> $b } grep { $_ ne "-" } @times; + + return @times; +} + +sub probevars { + my $class = shift; + my $h = $class->SUPER::probevars; + delete $h->{timeout}; + return $h; +} + +sub targetvars { + my $class = shift; + return $class->_makevars($class->SUPER::targetvars, { + lookup => { + _doc => <<DOC, +Name of the host to look up in the dns. +DOC + _example => 'www.example.org', + }, + mininterval => { + _doc => <<DOC, +Minimum time between sending two lookup queries in (possibly fractional) seconds. +DOC + _default => .5, + _re => '(\d*\.)?\d+', + }, + recordtype => { + _doc => 'Record type to look up.', + _default => 'A', + }, + timeout => { + _doc => 'Timeout for a single request in seconds.', + _default => 5, + _re => '\d+', + }, + port => { + _doc => 'The UDP Port to use.', + _default => 53, + _re => '\d+', + }, + }); +} + +1; + diff --git a/lib/Smokeping/probes/AnotherSSH.pm b/lib/Smokeping/probes/AnotherSSH.pm new file mode 100644 index 0000000..c708de9 --- /dev/null +++ b/lib/Smokeping/probes/AnotherSSH.pm @@ -0,0 +1,238 @@ +package Smokeping::probes::AnotherSSH; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::AnotherSSH> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::AnotherSSH> + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::basefork); +use Carp; +use Time::HiRes qw(sleep ualarm gettimeofday tv_interval); +use IO::Select; +use Socket; +use Fcntl; + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::AnotherSSH - Another SSH probe +DOC + description => <<DOC, +Latency measurement using SSH. This generates Logfile messages on the other +Host, so get permission from the owner first! +DOC + authors => <<'DOC', +Christoph Heine <Christoph.Heine@HaDiKo.DE> +DOC + } +} + +sub new($$$) { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(@_); + return $self; +} + +sub ProbeDesc($) { + my $self = shift; + return "SSH connections"; +} + +sub pingone ($) { + my $self = shift; + my $target = shift; + + my $host = $target->{addr}; + + # Time + my $mininterval = $target->{vars}{mininterval}; + + # Our greeting string. + my $greeting = $target->{vars}{greeting}; + + # Interval to measure + my $interval = $target->{vars}{interval}; + + # Connect to this port. + my $port = $target->{vars}{port}; + + #Timeout for the select() calls. + my $timeout = $target->{vars}{timeout}; + + my @times; # Result times + + my $t0; + for ( my $run = 0 ; $run < $self->pings($target) ; $run++ ) { + if (defined $t0) { + my $elapsed = tv_interval($t0, [gettimeofday]); + my $timeleft = $mininterval - $elapsed; + sleep $timeleft if $timeleft > 0; + } + my ($t1,$t2,$t3); # Timestamps. + + #Temporary variables to play with. + my $ready; + my $buf; + my $nbytes; + + my $proto = getprotobyname('tcp'); + my $iaddr = gethostbyname($host); + my $sin = sockaddr_in( $port, $iaddr ); + socket( Socket_Handle, PF_INET, SOCK_STREAM, $proto ); + + # Make the Socket non-blocking + my $flags = fcntl( Socket_Handle, F_GETFL, 0 ) or do { + $self->do_debug("Can't get flags for socket: $!"); + close(Socket_Handle); + next; + }; + + fcntl( Socket_Handle, F_SETFL, $flags | O_NONBLOCK ) or do { + $self->do_debug("Can't make socket nonblocking: $!"); + close(Socket_Handle); next; + }; + + my $sel = IO::Select->new( \*Socket_Handle ); + + # connect () and measure the Time. + $t0 = [gettimeofday]; + connect( Socket_Handle, $sin ); + ($ready) = $sel->can_read($timeout); + $t1 = [gettimeofday]; + + if(not defined $ready) { + $self->do_debug("Timeout!"); + close(Socket_Handle); next; + } + $nbytes = sysread( Socket_Handle, $buf, 1500 ); + if (not defined $nbytes or $nbytes <= 0) { + $self->do_debug("Read nothing and Connection closed!"); + close(Socket_Handle); next; + } + # $self->do_debug("Got '$buf' from remote Server"); + if (not $buf =~ m/^SSH/) { + $self->do_debug("Not an SSH Server"); + close(Socket_Handle); next; + } + + ($ready) = $sel->can_write($timeout); + if (not defined($ready)) { + $self->do_debug("Huh? Can't write."); + close(Socket_Handle); next; + } + $t2 = [gettimeofday]; + syswrite( Socket_Handle, $greeting . "\n" ); + ($ready) = $sel->can_read($timeout); + $t3 = [gettimeofday]; + if(not defined $ready) { + $self->do_debug("Timeout!"); + close(Socket_Handle); next; + } + close(Socket_Handle); + + # We made it! Yeah! + + if( $interval eq "connect") { + push @times, tv_interval( $t0, $t1 ); + } elsif ( $interval eq "established") { + push @times, tv_interval($t2,$t3); + } elsif ($interval eq "complete") { + push @times, tv_interval($t0,$t3); + } else { + $self->do_debug("You should never see this message.\n The universe will now collapse. Goodbye!\n"); + } + + + } + @times = + map { sprintf "%.10e", $_ } sort { $a <=> $b } grep { $_ ne "-" } @times; + + return @times; +} + +sub probevars { + my $class = shift; + my $h = $class->SUPER::probevars; + delete $h->{timeout}; + return $h; +} + +sub targetvars { + my $class = shift; + my $e = "="; + return $class->_makevars($class->SUPER::targetvars, { + greeting => { + _doc => <<DOC, +Greeting string to send to the SSH Server. This will appear in the Logfile. +Use this to make clear, who you are and what you are doing to avoid confusion. + +Also, don't use something that is a valid version string. This probe assumes +that the connection gets terminated because of protocol mismatch. +DOC + _default => "SSH-Latency-Measurement-Sorry-for-this-logmessage" , + }, + mininterval => { + _doc => "Minimum interval between the start of two connection attempts in (possibly fractional) seconds.", + _default => 0.5, + _re => '(\d*\.)?\d+', + }, + interval => { + _doc => <<DOC, +The interval to be measured. One of: + +${e}over + +${e}item connect + +Interval between connect() and the greeting string from the host. + +${e}item established + +Interval between our greeting message and the end of the connection +because of Protocol mismatch. This is the default. + +${e}item complete + +From connect() to the end of the connection. + +${e}back + +DOC + + _sub => sub { + my $interval = shift; + if(not ( $interval eq "connect" + or $interval eq "established" + or $interval eq "complete")) { + return "ERROR: Invalid interval parameter"; + } + return undef; + }, + _default => 'established', + }, + timeout => { + _doc => 'Timeout for the connection.', + _re => '\d+', + _default => 5, + }, + port => { + _doc => 'Connect to this port.', + _re => '\d+', + _default => 22, + }, + }); +} + +1; + diff --git a/lib/Smokeping/probes/CiscoRTTMonDNS.pm b/lib/Smokeping/probes/CiscoRTTMonDNS.pm new file mode 100644 index 0000000..0f16154 --- /dev/null +++ b/lib/Smokeping/probes/CiscoRTTMonDNS.pm @@ -0,0 +1,294 @@ +package Smokeping::probes::CiscoRTTMonDNS; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::CiscoRTTMonDNS> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::CiscoRTTMonDNS> + +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"; + +my $e = "="; +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::CiscoRTTMonDNS.pm - Probe for SmokePing +DOC, + description => <<DOC, +A probe for smokeping, which uses the ciscoRttMon MIB functionality ("Service Assurance Agent", "SAA") of Cisco IOS to time ( recursive, type A) DNS queries to a DNS server. + +DOC + + notes => <<DOC, +${e}head2 host parameter + +The host parameter specifies the DNS server, which the router will use. + +${e}head2 IOS VERSIONS + +This probe only works with IOS 12.0(3)T or higher. It is recommended to test it on less critical routers first. + +${e}head2 INSTALLATION + +To install this probe copy ciscoRttMonMIB.pm to (\$SMOKEPINGINSTALLDIR)/lib/Smokeping and CiscoRTTMonDNS.pm to (\$SMOKEPINGINSTALLDIR)/lib/Smokeping/probes. + +The router(s) must be configured to allow read/write SNMP access. Sufficient is: + + snmp-server community RTTCommunity RW + +If you want to be a bit more restrictive with SNMP write access to the router, then consider configuring something like this + + access-list 2 permit 10.37.3.5 + snmp-server view RttMon ciscoRttMonMIB included + snmp-server community RTTCommunity view RttMon RW 2 + +The above configuration grants SNMP read-write only to 10.37.3.5 (the smokeping host) and only to the ciscoRttMon MIB tree. The probe does not need access to SNMP variables outside the RttMon tree. +DOC + bugs => <<DOC, +The probe does unnecessary DNS queries, i.e. more than configured in the "pings" variable, because the RTTMon MIB only allows to set a total time for all queries in one measurement run (one "life"). Currently the probe sets the life duration to "pings"*2+3 seconds (2 secs is the timeout value hardcoded into this probe). +DOC + see_also => <<DOC, +http://people.ee.ethz.ch/~oetiker/webtools/smokeping/ + +http://www.switch.ch/misc/leinen/snmp/perl/ + +The best source for background info on SAA is Cisco's documentation on http://www.cisco.com and the CISCO-RTTMON-MIB documentation, which is available at: + +ftp://ftp.cisco.com/pub/mibs/v2/CISCO-RTTMON-MIB.my +DOC + authors => <<DOC, +Joerg.Kummer at Roche.com +DOC + } +} + +my $pingtimeout =2; + +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; + }; + return $self; +} + +sub ProbeDesc($){ + my $self = shift; + return "CiscoRTTMonDNS.pm"; +} + +sub pingone ($$) { + my $self = shift; + my $target = shift; + + my $name = $target->{vars}{name}; + + my $pings = $self->pings($target) || 20; + + # 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}, $name, + $pings, $target->{vars}{iosint}, $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, $dnsName, $pings, $sourceip, $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 $DnsSupported=0==1; + snmpmaptable ($host, + sub () { + my ($proto, $supported) = @_; + # 1 is true , 2 is false + $DnsSupported=0==0 if ($proto==8 && $supported==1); + }, + "rttMonApplSupportedRttTypesValid"); + + if (! $DnsSupported) { + Smokeping::do_log ("$host doesn't support DNS resolution time measurements !\n"); + return undef; + } + + + ############################################################# + #setup the new data row + + my @params=(); + push @params, + "rttMonCtrlAdminStatus.$row", 'integer', 5, + "rttMonCtrlAdminRttType.$row", 'integer', 8, + "rttMonEchoAdminProtocol.$row", 'integer', 26, + "rttMonEchoAdminNameServer.$row", 'octetstring', $encoded_target, + "rttMonEchoAdminTargetAddressString.$row",'octetstring', $dnsName, + "rttMonCtrlAdminTimeout.$row", 'integer', $pingtimeout*1000, + "rttMonCtrlAdminFrequency.$row", 'integer', $pingtimeout, + "rttMonCtrlAdminNvgen.$row", 'integer', 2, + "rttMonHistoryAdminNumBuckets.$row", 'integer', $pings, + "rttMonHistoryAdminNumLives.$row", 'integer', 1, + "rttMonHistoryAdminFilter.$row", 'integer', 2, + "rttMonScheduleAdminRttStartTime.$row", 'timeticks', 1, + "rttMonScheduleAdminRttLife.$row", 'integer', $pings*$pingtimeout+3, + "rttMonScheduleAdminConceptRowAgeout.$row",'integer', 60; + + # 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 replies.. + if (defined $sourceip) { + push @params, "rttMonEchoAdminSourceAddress.$row", 'octetstring', $encoded_source; + } + + 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 targetvars { + my $class = shift; + return $class->_makevars($class->SUPER::targetvars, { + _mandatory => [ 'ioshost', 'name' ], + ioshost => { + _doc => <<DOC, +The (mandatory) ioshost parameter specifies the Cisco router, which will send the DNS requests, +as well as the SNMP community string on the router. +DOC + _example => 'RTTcommunity@Myrouter.foobar.com.au', + }, + name => { + _doc => "The (mandatory) name parameter is the DNS name to resolve.", + _example => 'www.foobar.com.au', + }, + iosint => { + _doc => <<DOC, +The (optional) iosint parameter is the source address for the DNS packets. +This should be one of the active (!) IP addresses of the router to get +results. IOS looks up the target host address in the forwarding table +and then uses the interface(s) listed there to send the DNS packets. By +default IOS uses the (primary) IP address on the sending interface as +source address for packets originated by the router. +DOC + _example => '10.33.22.11', + }, + }); +} + +=head1 +1; + diff --git a/lib/Smokeping/probes/CiscoRTTMonEchoICMP.pm b/lib/Smokeping/probes/CiscoRTTMonEchoICMP.pm new file mode 100644 index 0000000..550921f --- /dev/null +++ b/lib/Smokeping/probes/CiscoRTTMonEchoICMP.pm @@ -0,0 +1,322 @@ +package Smokeping::probes::CiscoRTTMonEchoICMP; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::CiscoRTTMonEchoICMP> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::CiscoRTTMonEchoICMP> + +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 => <<DOC, +Smokeping::probes::CiscoRTTMonEchoICMP - Probe for SmokePing +DOC + description => <<DOC, +A probe for smokeping, which uses the ciscoRttMon MIB functionality ("Service Assurance Agent", "SAA") of Cisco IOS to measure ICMP echo ("ping") roundtrip times between a Cisco router and any IP address. +DOC + notes => <<DOC, +${e}head2 IOS VERSIONS + +It is highly recommended to use this probe with routers running IOS 12.0(3)T or higher and to test it on less critical routers first. I managed to crash a router with 12.0(9) quite consistently ( in IOS lingo 12.0(9) is older code than 12.0(3)T ). I did not observe crashes on higher IOS releases, but messages on the router like the one below, when multiple processes concurrently accessed the same router (this case was IOS 12.1(12b) ): + +Aug 20 07:30:14: %RTT-3-SemaphoreBadUnlock: %RTR: Attempt to unlock semaphore by wrong RTR process 70, locked by 78 + +Aug 20 07:35:15: %RTT-3-SemaphoreInUse: %RTR: Could not obtain a lock for RTR. Process 80 + + +${e}head2 INSTALLATION + +To install this probe copy ciscoRttMonMIB.pm files to (\$SMOKEPINGINSTALLDIR)/lib/Smokeping and CiscoRTTMonEchoICMP.pm to (\$SMOKEPINGINSTALLDIR)/lib/Smokeping/probes. V0.97 or higher of Simon Leinen's SNMP_Session.pm is required. + +The router(s) must be configured to allow read/write SNMP access. Sufficient is: + + snmp-server community RTTCommunity RW + +If you want to be a bit more restrictive with SNMP write access to the router, then consider configuring something like this + + access-list 2 permit 10.37.3.5 + snmp-server view RttMon ciscoRttMonMIB included + snmp-server community RTTCommunity view RttMon RW 2 + +The above configuration grants SNMP read-write only to 10.37.3.5 (the smokeping host) and only to the ciscoRttMon MIB tree. The probe does not need access to SNMP variables outside the RttMon tree. +DOC + bugs => <<DOC, +The probe sends unnecessary pings, i.e. more than configured in the "pings" variable, because the RTTMon MIB only allows to set a total time for all pings in one measurement run (one "life"). Currently the probe sets the life duration to "pings"*2+3 seconds (2 secs is the ping timeout value hardcoded into this probe). +DOC + see_also => <<DOC, +http://people.ee.ethz.ch/~oetiker/webtools/smokeping/ + +http://www.switch.ch/misc/leinen/snmp/perl/ + +The best source for background info on SAA is Cisco's documentation on http://www.cisco.com and the CISCO-RTTMON-MIB documentation, which is available at: +ftp://ftp.cisco.com/pub/mibs/v2/CISCO-RTTMON-MIB.my +DOC + authors => <<DOC, +Joerg.Kummer at Roche.com +DOC + } +} + +my $pingtimeout =2; + +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; + }; + 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 => <<DOC, +The packetsize parameter lets you configure the packetsize for the pings +sent. The minimum is 8, the maximum 16392. Use the same number as with +fping, if you want the same packet sizes being used on the network. +DOC + _default => 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 => <<DOC, +The (mandatory) ioshost parameter specifies the Cisco router, which will +execute the pings, as well as the SNMP community string on the router. +DOC + }, + iosint => { + _example => '10.33.22.11', + _doc => <<DOC, +The (optional) iosint parameter is the source address for the pings +sent. This should be one of the active (!) IP addresses of the router to +get results. IOS looks up the target host address in the forwarding table +and then uses the interface(s) listed there to send the ping packets. By +default IOS uses the (primary) IP address on the sending interface as +source address for a ping. The RTTMon MIB versions before IOS 12.0(3)T +didn't support this parameter. +DOC + }, + tos => { + _example => 160, + _default => 0, + _doc => <<DOC, +The (optional) tos parameter specifies the value of the ToS byte in +the IP header of the pings. Multiply DSCP values times 4 and Precedence +values times 32 to calculate the ToS values to configure, e.g. ToS 160 +corresponds to a DSCP value 40 and a Precedence value of 5. The RTTMon +MIB versions before IOS 12.0(3)T didn't support this parameter. +DOC + }, + }); +} + +1; + diff --git a/lib/Smokeping/probes/CiscoRTTMonTcpConnect.pm b/lib/Smokeping/probes/CiscoRTTMonTcpConnect.pm new file mode 100644 index 0000000..d11f76b --- /dev/null +++ b/lib/Smokeping/probes/CiscoRTTMonTcpConnect.pm @@ -0,0 +1,305 @@ +package Smokeping::probes::CiscoRTTMonTcpConnect; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::CiscoRTTMonTcpConnect> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::CiscoRTTMonTcpConnect> + +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 => <<DOC, +Smokeping::probes::CiscoRTTMonTcpConnect - Probe for SmokePing +DOC + description => <<DOC, +A probe for smokeping, which uses the ciscoRttMon MIB functionality ("Service Assurance Agent", "SAA") of Cisco IOS to measure TCP connect times between a Cisco router and a TCP server. The measured value is the time is the time to establish a TCP session, i.e. the time between the initial "SYN" TCP packet of the router and the "SYN ACK" packet of the host. The router terminates the TCP session immediately after the reception of "SYN ACK" with a "FIN" packet. +DOC + notes => <<DOC, +${e}head2 IOS VERSIONS + +This probe only works with Cisco IOS 12.0(3)T or higher. It is recommended to test it on less critical routers first. + +${e}head2 INSTALLATION + +To install this probe copy ciscoRttMonMIB.pm to (\$SMOKEPINGINSTALLDIR)/Smokeping/lib and CiscoRTTMonTcpConnect.pm to (\$SMOKEPINGINSTALLDIR)/lib/Smokeping/probes. V0.97 or higher of Simon Leinen's SNMP_Session.pm is required. + +The router(s) must be configured to allow read/write SNMP access. Sufficient is: + + snmp-server community RTTCommunity RW + +If you want to be a bit more restrictive with SNMP write access to the router, then consider configuring something like this + + access-list 2 permit 10.37.3.5 + snmp-server view RttMon ciscoRttMonMIB included + snmp-server community RTTCommunity view RttMon RW 2 + +The above configuration grants SNMP read-write only to 10.37.3.5 (the smokeping host) and only to the ciscoRttMon MIB tree. The probe does not need access to SNMP variables outside the RttMon tree. +DOC + bugs => <<DOC, +The probe establishes unnecessary connections, i.e. more than configured in the "pings" variable, because the RTTMon MIB only allows to set a total time for all connections in one measurement run (one "life"). Currently the probe sets the life duration to "pings"*2+3 seconds (2 secs is the timeout value hardcoded into this probe). +DOC + see_also => <<DOC, +http://people.ee.ethz.ch/~oetiker/webtools/smokeping/ + +http://www.switch.ch/misc/leinen/snmp/perl/ + +The best source for background info on SAA is Cisco's documentation on http://www.cisco.com and the CISCO-RTTMON-MIB documentation, which is available at: +ftp://ftp.cisco.com/pub/mibs/v2/CISCO-RTTMON-MIB.my +DOC + authors => <<DOC, +Joerg.Kummer at Roche.com +DOC + } +} + +my $pingtimeout =2; + +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; + }; + return $self; +} + +sub ProbeDesc($){ + my $self = shift; + return "CiscoRTTMonTcpConnect"; +} + +sub pingone ($$) { + my $self = shift; + my $target = shift; + + my $pings = $self->pings($target) || 20; + my $tos = $target->{vars}{tos}; + my $port = $target->{vars}{port}; + + # 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}, $port, + $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, $port, $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 $tcpConnSupported=0==1; + snmpmaptable ($host, + sub () { + my ($proto, $supported) = @_; + # 1 is true , 2 is false + $tcpConnSupported=0==0 if ($proto==6 && $supported==1); + }, + "rttMonApplSupportedRttTypesValid"); + + if (! $tcpConnSupported) { + Smokeping::do_log ("$host doesn't support TCP connection time measurements !\n"); + return undef; + } + + + ############################################################# + #setup the new data row + + my @params=(); + push @params, + "rttMonCtrlAdminStatus.$row", 'integer', 5, + "rttMonCtrlAdminRttType.$row", 'integer', 6, + "rttMonEchoAdminProtocol.$row", 'integer', 24, + "rttMonEchoAdminTargetAddress.$row", 'octetstring', $encoded_target, + "rttMonEchoAdminTargetPort.$row", 'integer', $port, + "rttMonCtrlAdminTimeout.$row", 'integer', $pingtimeout*1000, + "rttMonCtrlAdminFrequency.$row", 'integer', $pingtimeout, + "rttMonEchoAdminControlEnable.$row", 'integer', 2, + "rttMonEchoAdminTOS.$row", 'integer', $tos, + "rttMonCtrlAdminNvgen.$row", 'integer', 2, + "rttMonHistoryAdminNumBuckets.$row", 'integer', $pings, + "rttMonHistoryAdminNumLives.$row", 'integer', 1, + "rttMonHistoryAdminFilter.$row", 'integer', 2, + "rttMonScheduleAdminRttStartTime.$row", 'timeticks', 1, + "rttMonScheduleAdminRttLife.$row", 'integer', $pings*$pingtimeout+3, + "rttMonScheduleAdminConceptRowAgeout.$row",'integer', 60; + + # 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 replies.. + if (defined $sourceip) { + push @params, "rttMonEchoAdminSourceAddress.$row", 'octetstring', $encoded_source; + } + + 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 columns of rttMonHistoryCollectionTable + # - "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 targetvars { + my $class = shift; + return $class->_makevars($class->SUPER::targetvars, { + _mandatory => [ 'ioshost' ], + ioshost => { + _example => 'RTTcommunity@Myrouter.foobar.com.au', + _doc => <<DOC, +The (mandatory) ioshost parameter specifies the Cisco router, which will +establish the TCP connections as well as the SNMP community string on +the router. +DOC + }, + port => { + _default => 80, + _re => '\d+', + _doc => <<DOC, +The (optional) port parameter lets you configure the destination TCP +port on the host. The default is the http port 80. +DOC + }, + iosint => { + _example => '10.33.22.11', + _doc => <<DOC, +The (optional) iosint parameter is the source address for the TCP +connections. This should be one of the active (!) IP addresses of the +router to get results. IOS looks up the target host address in the +forwarding table and then uses the interface(s) listed there to send +the TCP packets. By default IOS uses the (primary) IP address on the +sending interface as source address for a connection. +DOC + }, + tos => { + _default => 0, + _example => 160, + _re => '\d+', + _doc => <<DOC, +The (optional) tos parameter specifies the value of the ToS byte in the +IP header of the packets from the router. Multiply DSCP values times 4 +and Precedence values times 32 to calculate the ToS values to configure, +e.g. ToS 160 corresponds to a DSCP value 40 and a Precedence value of +5. Please note that this will not influence the ToS value in the packets +sent by the the host. +DOC + }, + }); +} + +1; + diff --git a/lib/Smokeping/probes/Curl.pm b/lib/Smokeping/probes/Curl.pm new file mode 100644 index 0000000..2bbf476 --- /dev/null +++ b/lib/Smokeping/probes/Curl.pm @@ -0,0 +1,218 @@ +package Smokeping::probes::Curl; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::Curl> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::Curl> + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::basefork); +use Carp; + +my $DEFAULTBIN = "/usr/bin/curl"; + +sub pod_hash { + return { + name => "Smokeping::probes::Curl - a curl(1) probe for SmokePing", + overview => "Fetches an HTTP or HTTPS URL using curl(1).", + description => "(see curl(1) for details of the options below)", + authors => <<'DOC', + Gerald Combs <gerald [AT] ethereal.com> + Niko Tyni <ntyni@iki.fi> +DOC + notes => <<DOC, +The URL to be tested used to be specified by the variable 'url' in earlier +versions of Smokeping, and the 'host' setting did not influence it in any +way. The variable name has now been changed to 'urlformat', and it can +(and in most cases should) contain a placeholder for the 'host' variable. +DOC + see_also => "curl(1), Smokeping::probes::Curl(3pm) etc., http://curl.haxx.se/", + } +} + +sub probevars { + my $class = shift; + my $h = $class->SUPER::probevars; + delete $h->{timeout}; + return $class->_makevars($h, { + binary => { + _doc => "The location of your curl binary.", + _default => $DEFAULTBIN, + _sub => sub { + my $val = shift; + return "ERROR: Curl 'binary' $val does not point to an executable" + unless -f $val and -x _; + return undef; + }, + }, + }); +} + +sub targetvars { + my $class = shift; + return $class->_makevars($class->SUPER::targetvars, { + _mandatory => [ 'urlformat' ], + agent => { + _doc => <<DOC, +The "-A" curl(1) option. This is a full HTTP User-Agent header including +the words "User-Agent:". It should be enclosed in quotes if it contains +shell metacharacters. +DOC + _example => '"User-Agent: Lynx/2.8.4rel.1 libwww-FM/2.14 SSL-MM/1.4.1 OpenSSL/0.9.6c"', + }, + timeout => { + _doc => qq{The "-m" curl(1) option. Maximum timeout in seconds.}, + _re => '\d+', + _example => 10, + _default => 5, + }, + interface => { + _doc => <<DOC, +The "--interface" curl(1) option. Bind to a specific interface, IP address or +host name. +DOC + _example => 'eth0', + }, + ssl2 => { + _doc => qq{The "-2" curl(1) option. Force SSL2.}, + _example => 1, + }, + urlformat => { + _doc => <<DOC, +The template of the URL to fetch. Can be any one that curl supports. +Any occurrence of the string '%host%' will be replaced with the +host to be probed. +DOC + _example => "http://%host%/", + }, + }); +} + +# derived class will mess with this through the 'features' method below +my $featurehash = { + agent => "-A", + timeout => "-m", + interface => "--interface", +}; + +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'); + + $self->test_usage; + + 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 curl doesn't support the $feature feature (option $arghash{$feature}), disabling it"); + } + } + map { delete $arghashref->{$_} } @unsupported; + + return; +} + +sub ProbeDesc($) { + return "HTTP, HTTPS, and FTP URLs using curl(1)"; +} + +# 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; + } + return @args; +} + +# This is what derived classes will override +sub proto_args { + my $self = shift; + my $target = shift; + # XXX - It would be neat if curl had a "time_transfer". For now, + # we take the total time minus the DNS lookup time. + my @args = ("-o /dev/null", "-w 'Time: %{time_total} DNS time: %{time_namelookup}\\n'"); + my $ssl2 = $target->{vars}{ssl2}; + push (@args, "-2") if defined($ssl2); + return(@args); + +} + +sub make_commandline { + my $self = shift; + my $target = shift; + my $count = shift; + + my @args = $self->make_args($target); + my $url = $target->{vars}{urlformat}; + my $host = $target->{addr}; + $url =~ s/%host%/$host/g; + push @args, $self->proto_args($target); + + return ($self->{properties}{binary}, @args, $url); +} + +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; + my $count = $self->pings($t); + + for (my $i = 0 ; $i < $count; $i++) { + open(P, "$cmd 2>&1 |") or croak("fork: $!"); + + # what should we do with error messages? + while (<P>) { + /^Time: (\d+\.\d+) DNS time: (\d+\.\d+)/ and push @times, $1 - $2; + } + close P; + } + + # carp("Got @times") if $self->debug; + return sort { $a <=> $b } @times; +} + +1; diff --git a/lib/Smokeping/probes/DNS.pm b/lib/Smokeping/probes/DNS.pm new file mode 100644 index 0000000..1cb188f --- /dev/null +++ b/lib/Smokeping/probes/DNS.pm @@ -0,0 +1,136 @@ +package Smokeping::probes::DNS; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::DNS> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::DNS> + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::basefork); +use IPC::Open3; +use Symbol; +use Carp; + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::DNS - Name Service Probe for SmokePing +DOC + description => <<DOC, +Integrates dig as a probe into smokeping. The variable B<binary> must +point to your copy of the dig program. If it is not installed on +your system yet, you should install bind-utils >= 9.0.0. + +The Probe asks the given host n-times for it's name. Where n is +the amount specified in the config File. +DOC + authors => <<'DOC', + Igor Petrovski <pigor@myrealbox.com>, + Carl Elkins <carl@celkins.org.uk>, + Andre Stolze <stolze@uni-muenster.de>, + Niko Tyni <ntyni@iki.fi>, + Chris Poetzel<cpoetzel@anl.gov> +DOC + }; +} + +my $dig_re=qr/query time:\s+([0-9.]+)\smsec.*/i; + +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} ) { + + my $call = "$self->{properties}{binary} localhost"; + my $return = `$call 2>&1`; + if ($return =~ m/$dig_re/s){ + $self->{pingfactor} = 1000; + print "### parsing dig output...OK\n"; + } else { + croak "ERROR: output of '$call' does not match $dig_re\n"; + } + }; + + return $self; +} + +sub probevars { + my $class = shift; + return $class->_makevars($class->SUPER::probevars, { + _mandatory => [ 'binary' ], + binary => { + _doc => "The location of your dig binary.", + _example => '/usr/bin/dig', + _sub => sub { + my $val = shift; + return "ERROR: DNS 'binary' does not point to an executable" + unless -f $val and -x _; + return undef; + }, + }, + }); +} + +sub targetvars { + my $class = shift; + return $class->_makevars($class->SUPER::targetvars, { + lookup => { _doc => "Name of the host to look up in the dns.", + _example => "www.example.org", + }, + }); +} + +sub ProbeDesc($){ + my $self = shift; + return "DNS requests"; +} + +sub pingone ($){ + my $self = shift; + my $target = shift; + + my $inh = gensym; + my $outh = gensym; + my $errh = gensym; + + my $host = $target->{addr}; + my $lookuphost = $target->{vars}{lookup}; + $lookuphost = $target->{addr} unless defined $lookuphost; + + my $query = "$self->{properties}{binary} \@$host $lookuphost"; + my @times; + + $self->do_debug("query=$query\n"); + for (my $run = 0; $run < $self->pings($target); $run++) { + my $pid = open3($inh,$outh,$errh, $query); + while (<$outh>) { + if (/$dig_re/i) { + push @times, $1; + last; + } + } + waitpid $pid,0; + close $errh; + close $inh; + close $outh; + } + @times = map {sprintf "%.10e", $_ / $self->{pingfactor}} sort {$a <=> $b} grep {$_ ne "-"} @times; + +# $self->do_debug("time=@times\n"); + return @times; +} + +1; diff --git a/lib/Smokeping/probes/EchoPing.pm b/lib/Smokeping/probes/EchoPing.pm new file mode 100644 index 0000000..f2aded2 --- /dev/null +++ b/lib/Smokeping/probes/EchoPing.pm @@ -0,0 +1,282 @@ +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), Smokeping::probes::EchoPingHttp(3pm) etc., 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'); + + $self->test_usage; + + 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}; +} + + +# 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 $host = $self->make_host($target); + push @args, $self->proto_args($target); + push @args, $self->count_args($count); + + return ($self->{properties}{binary}, @args, $host); +} + +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 (<P>) { + $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 => <<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; diff --git a/lib/Smokeping/probes/EchoPingChargen.pm b/lib/Smokeping/probes/EchoPingChargen.pm new file mode 100644 index 0000000..e0740c9 --- /dev/null +++ b/lib/Smokeping/probes/EchoPingChargen.pm @@ -0,0 +1,65 @@ +package Smokeping::probes::EchoPingChargen; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::EchoPingChargen> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::EchoPingChargen> + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::EchoPing); +use Carp; + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::EchoPingChargen - an echoping(1) probe for SmokePing +DOC + overview => <<DOC, +Measures TCP chargen (port 19) roundtrip times for SmokePing. +DOC + notes => <<DOC, +The I<udp> variable is not supported. +DOC + authors => <<'DOC', +Niko Tyni <ntyni@iki.fi> +DOC + see_also => <<DOC, +Smokeping::probes::EchoPing(3pm) +DOC + } +} + +sub proto_args { + return ("-c"); +} + +sub test_usage { + my $self = shift; + my $bin = $self->{properties}{binary}; + croak("Your echoping binary doesn't support CHARGEN") + if `$bin -c 2>&1 127.0.0.1` =~ /(usage|not compiled|invalid option)/i; + $self->SUPER::test_usage; + return; +} + +sub ProbeDesc($) { + return "TCP Chargen pings using echoping(1)"; +} + +sub targetvars { + my $class = shift; + my $h = $class->SUPER::targetvars; + delete $h->{udp}; + return $h; +} + +1; diff --git a/lib/Smokeping/probes/EchoPingDiscard.pm b/lib/Smokeping/probes/EchoPingDiscard.pm new file mode 100644 index 0000000..31ddd39 --- /dev/null +++ b/lib/Smokeping/probes/EchoPingDiscard.pm @@ -0,0 +1,59 @@ +package Smokeping::probes::EchoPingDiscard; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::EchoPingDiscard> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::EchoPingDiscard> + +to generate the POD document. + +=cut + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::EchoPingDiscard - an echoping(1) probe for SmokePing +DOC + overview => <<DOC, +Measures TCP or UDP discard (port 9) roundtrip times for SmokePing. +DOC + authors => <<'DOC', +Niko Tyni <ntyni@iki.fi> +DOC + see_also => <<DOC, +Smokeping::probes::EchoPing(3pm) +DOC + } +} + +use strict; +use base qw(Smokeping::probes::EchoPing); +use Carp; + +sub proto_args { + my $self = shift; + my $target = shift; + my @args = $self->udp_arg; + return ("-d", @args); +} + +sub test_usage { + my $self = shift; + my $bin = $self->{properties}{binary}; + croak("Your echoping binary doesn't support DISCARD") + if `$bin -d 127.0.0.1 2>&1` =~ /(not compiled|invalid option|usage)/i; + $self->SUPER::test_usage; + return; +} + +sub ProbeDesc($) { + return "TCP or UDP Discard pings using echoping(1)"; +} + + +1; diff --git a/lib/Smokeping/probes/EchoPingHttp.pm b/lib/Smokeping/probes/EchoPingHttp.pm new file mode 100644 index 0000000..45f9bd9 --- /dev/null +++ b/lib/Smokeping/probes/EchoPingHttp.pm @@ -0,0 +1,143 @@ +package Smokeping::probes::EchoPingHttp; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::EchoPingHttp> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::EchoPingHttp> + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::EchoPing); +use Carp; + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::EchoPingHttp - an echoping(1) probe for SmokePing +DOC + overview => <<DOC, +Measures HTTP roundtrip times (web servers and caches) for SmokePing. +DOC + notes => <<DOC, +The I<fill>, I<size> and I<udp> EchoPing variables are not valid for EchoPingHttp. +DOC + authors => <<'DOC', +Niko Tyni <ntyni@iki.fi> +DOC + see_also => <<DOC, +EchoPing(3pm), EchoPingHttps(3pm) +DOC + } +} + +sub _init { + my $self = shift; + # HTTP doesn't fit with filling or size + my $arghashref = $self->features; + delete $arghashref->{size}; + delete $arghashref->{fill}; +} + +# tag the port number after the hostname +sub make_host { + my $self = shift; + my $target = shift; + + my $host = $self->SUPER::make_host($target); + my $port = $target->{vars}{port}; + + $host .= ":$port" if defined $port; + return $host; +} + +sub proto_args { + my $self = shift; + my $target = shift; + my $url = $target->{vars}{url}; + + my @args = ("-h", $url); + + # -A : ignore cache + my $ignore = $target->{vars}{ignore_cache}; + $ignore = 1 + if (defined $ignore and $ignore ne "no" + and $ignore ne "0"); + push @args, "-A" if $ignore and not exists $self->{_disabled}{A}; + + # -a : force cache to revalidate the data + my $revalidate = $target->{vars}{revalidate_data}; + $revalidate= 1 if (defined $revalidate and $revalidate ne "no" + and $revalidate ne "0"); + push @args, "-a" if $revalidate and not exists $self->{_disabled}{a}; + + return @args; +} + +sub test_usage { + my $self = shift; + my $bin = $self->{properties}{binary}; + croak("Your echoping binary doesn't support HTTP") + if `$bin -h/ 127.0.0.1 2>&1` =~ /(invalid option|not compiled|usage)/i; + if (`$bin -a -h/ 127.0.0.1 2>&1` =~ /(invalid option|not compiled|usage)/i) { + carp("Note: your echoping binary doesn't support revalidating (-a), disabling it"); + $self->{_disabled}{a} = undef; + } + + if (`$bin -A -h/ 127.0.0.1 2>&1` =~ /(invalid option|not compiled|usage)/i) { + carp("Note: your echoping binary doesn't support ignoring cache (-A), disabling it"); + $self->{_disabled}{A} = undef; + } + + $self->SUPER::test_usage; + return; +} + +sub ProbeDesc($) { + return "HTTP pings using echoping(1)"; +} + +sub targetvars { + my $class = shift; + my $h = $class->SUPER::targetvars; + delete $h->{udp}; + delete $h->{fill}; + delete $h->{size}; + return $class->_makevars($h, { + url => { + _doc => <<DOC, +The URL to be requested from the web server or cache. Can be either relative +(/...) for web servers or absolute (http://...) for caches. +DOC + _default => '/', + }, + port => { + _doc => 'The TCP port to use.', + _example => 80, + _re => '\d+', + }, + ignore_cache => { + _doc => <<DOC, +The echoping(1) "-A" option: force the proxy to ignore the cache. +Enabled if the value is anything other than 'no' or '0'. +DOC + _example => 'yes', + }, + revalidate_data => { + _doc => <<DOC, +The echoping(1) "-a" option: force the proxy to revalidate data with original +server. Enabled if the value is anything other than 'no' or '0'. +DOC + _example => 'no', + }, + }); +} + +1; diff --git a/lib/Smokeping/probes/EchoPingHttps.pm b/lib/Smokeping/probes/EchoPingHttps.pm new file mode 100644 index 0000000..32e8cb0 --- /dev/null +++ b/lib/Smokeping/probes/EchoPingHttps.pm @@ -0,0 +1,65 @@ +package Smokeping::probes::EchoPingHttps; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::EchoPingHttps> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::EchoPingHttps> + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::EchoPingHttp); +use Carp; + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::EchoPingHttps - an echoping(1) probe for SmokePing +DOC + overview => <<DOC, +Measures HTTPS (HTTP over SSL) roundtrip times (web servers and caches) for +SmokePing. +DOC + description => <<DOC, +As EchoPingHttp(3pm), but SSL-enabled. +DOC + authors => <<'DOC', +Niko Tyni <ntyni@iki.fi> +DOC + see_also => <<DOC, +EchoPingHttp(3pm) +DOC + } +} + +sub proto_args { + my $self = shift; + my $target = shift; + my @args = $self->SUPER::proto_args($target); + return ("-C", @args); +} + +sub test_usage { + my $self = shift; + + my $bin = $self->{properties}{binary}; + my $response = `$bin -C -h/ 127.0.0.1 2>&1`; + croak("Your echoping binary doesn't support SSL") + if ($response =~ /(not compiled|invalid option|usage)/i); + $self->SUPER::test_usage; + return; +} + +sub ProbeDesc($) { + return "HTTPS pings using echoping(1)"; +} + + +1; diff --git a/lib/Smokeping/probes/EchoPingIcp.pm b/lib/Smokeping/probes/EchoPingIcp.pm new file mode 100644 index 0000000..0b781de --- /dev/null +++ b/lib/Smokeping/probes/EchoPingIcp.pm @@ -0,0 +1,88 @@ +package Smokeping::probes::EchoPingIcp; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::EchoPingIcp> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::EchoPingIcp> + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::EchoPing); +use Carp; + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::EchoPingIcp - an echoping(1) probe for SmokePing +DOC + overview => <<DOC, +Measures ICP (Internet Cache Protocol, spoken by web caches) +roundtrip times for SmokePing. +DOC + notes => <<DOC, +The I<fill>, I<size> and I<udp> EchoPing variables are not valid. +DOC + authors => <<'DOC', +Niko Tyni <ntyni@iki.fi> +DOC + see_also => <<DOC, +EchoPing(3pm), EchoPingHttp(3pm) +DOC + } +} + +sub _init { + my $self = shift; + # Icp doesn't fit with filling or size + my $arghashref = $self->features; + delete $arghashref->{size}; + delete $arghashref->{fill}; +} + +sub proto_args { + my $self = shift; + my $target = shift; + my $url = $target->{vars}{url}; + + my @args = ("-i", $url); + + return @args; +} + +sub test_usage { + my $self = shift; + my $bin = $self->{properties}{binary}; + croak("Your echoping binary doesn't support ICP") + if `$bin -t1 -i/ 127.0.0.1 2>&1` =~ /not compiled|usage/i; + $self->SUPER::test_usage; + return; +} + +sub ProbeDesc($) { + return "ICP pings using echoping(1)"; +} + +sub targetvars { + my $class = shift; + my $h = $class->SUPER::targetvars; + delete $h->{udp}; + delete $h->{fill}; + delete $h->{size}; + return $class->_makevars($h, { + _mandatory => [ 'url' ], + url => { + _doc => "The URL to be requested from the web cache.", + _example => 'http://www.example.org/', + }, + }); +} + +1; diff --git a/lib/Smokeping/probes/EchoPingSmtp.pm b/lib/Smokeping/probes/EchoPingSmtp.pm new file mode 100644 index 0000000..2c2115d --- /dev/null +++ b/lib/Smokeping/probes/EchoPingSmtp.pm @@ -0,0 +1,75 @@ +package Smokeping::probes::EchoPingSmtp; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::EchoPingSmtp> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::EchoPingSmtp> + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::EchoPing); +use Carp; + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::EchoPingSmtp - an echoping(1) probe for SmokePing +DOC + overview => <<DOC, +Measures SMTP roundtrip times (mail servers) for SmokePing. +DOC + notes => <<DOC, +The I<fill>, I<size> and I<udp> EchoPing variables are not valid. +DOC + authors => <<'DOC', +Niko Tyni <ntyni@iki.fi> +DOC + see_also => <<DOC, +EchoPing(3pm) +DOC + } +} + +sub _init { + my $self = shift; + # SMTP doesn't fit with filling or size + my $arghashref = $self->features; + delete $arghashref->{size}; + delete $arghashref->{fill}; +} + +sub proto_args { + return ("-S"); +} + +sub test_usage { + my $self = shift; + my $bin = $self->{properties}{binary}; + croak("Your echoping binary doesn't support SMTP") + if `$bin -S 127.0.0.1 2>&1` =~ /(not compiled|invalid option|usage)/i; + $self->SUPER::test_usage; + return; +} + +sub ProbeDesc($) { + return "SMTP pings using echoping(1)"; +} + +sub targetvars { + my $class = shift; + my $h = $class->SUPER::targetvars; + delete $h->{udp}; + delete $h->{fill}; + delete $h->{size}; + return $h; +} + +1; diff --git a/lib/Smokeping/probes/FPing.pm b/lib/Smokeping/probes/FPing.pm new file mode 100644 index 0000000..fca2a8d --- /dev/null +++ b/lib/Smokeping/probes/FPing.pm @@ -0,0 +1,184 @@ +package Smokeping::probes::FPing; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::FPing> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::FPing> + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::base); +use IPC::Open3; +use Symbol; +use Carp; + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::FPing - FPing Probe for SmokePing +DOC + description => <<DOC, +Integrates FPing as a probe into smokeping. The variable B<binary> must +point to your copy of the FPing program. If it is not installed on +your system yet, you can get it from http://www.fping.com/. + +The (optional) B<packetsize> option lets you configure the packetsize for the pings sent. + +The FPing manpage has the following to say on this topic: + +Number of bytes of ping data to send. The minimum size (normally 12) allows +room for the data that fping needs to do its work (sequence number, +timestamp). The reported received data size includes the IP header +(normally 20 bytes) and ICMP header (8 bytes), so the minimum total size is +40 bytes. Default is 56, as in ping. Maximum is the theoretical maximum IP +datagram size (64K), though most systems limit this to a smaller, +system-dependent number. +DOC + authors => <<'DOC', +Tobias Oetiker <tobi@oetiker.ch> +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} ) { + my $binary = join(" ", $self->binary); + my $testhost = $self->testhost; + my $return = `$binary -C 1 $testhost 2>&1`; + croak "ERROR: fping ('$binary -C 1 $testhost') could not be run: $return" + if $return =~ m/not found/; + croak "ERROR: FPing must be installed setuid root or it will not work\n" + if $return =~ m/only.+root/; + + if ($return =~ m/bytes, ([0-9.]+)\sms\s+.*\n.*\n.*:\s+([0-9.]+)/ and $1 > 0){ + $self->{pingfactor} = 1000 * $2/$1; + print "### fping seems to report in ", $1/$2, " milliseconds\n"; + } else { + $self->{pingfactor} = 1000; # Gives us a good-guess default + print "### assuming you are using an fping copy reporting in milliseconds\n"; + } + }; + + return $self; +} + +sub ProbeDesc($){ + my $self = shift; + my $bytes = $self->{properties}{packetsize}||56; + return "ICMP Echo Pings ($bytes Bytes)"; +} + +# derived class (ie. RemoteFPing) can override this +sub binary { + my $self = shift; + return $self->{properties}{binary}; +} + +# derived class (ie. FPing6) can override this +sub testhost { + return "localhost"; +} + +sub ping ($){ + my $self = shift; + # do NOT call superclass ... the ping method MUST be overwriten + my %upd; + my $inh = gensym; + my $outh = gensym; + my $errh = gensym; + # pinging nothing is pointless + return unless @{$self->addresses}; + my @bytes = () ; + push @bytes, "-b$self->{properties}{packetsize}" if $self->{properties}{packetsize}; + my @timeout = (); + push @timeout, "-t" . int(1000 * $self->{properties}{timeout}) if $self->{properties}{timeout}; + my @cmd = ( + $self->binary, @bytes, + '-C', $self->pings, '-q','-B1','-r1', + '-i' . $self->{properties}{mindelay}, + @timeout, + @{$self->addresses}); + $self->do_debug("Executing @cmd"); + my $pid = open3($inh,$outh,$errh, @cmd); + $self->{rtts}={}; + while (<$errh>){ + chomp; + next unless /^\S+\s+:\s+[\d\.]/; #filter out error messages from fping + my @times = split /\s+/; + my $ip = shift @times; + next unless ':' eq shift @times; #drop the colon + + @times = map {sprintf "%.10e", $_ / $self->{pingfactor}} sort {$a <=> $b} grep /^\d/, @times; + map { $self->{rtts}{$_} = [@times] } @{$self->{addrlookup}{$ip}} ; + } + waitpid $pid,0; + close $inh; + close $outh; + close $errh; +} + +sub probevars { + my $class = shift; + return $class->_makevars($class->SUPER::probevars, { + _mandatory => [ 'binary' ], + binary => { + _sub => sub { + my ($val) = @_; + return "ERROR: FPing 'binary' does not point to an executable" + unless -f $val and -x _; + return undef; + }, + _doc => "The location of your fping binary.", + _example => '/usr/bin/fping', + }, + packetsize => { + _re => '\d+', + _example => 5000, + _sub => sub { + my ($val) = @_; + return "ERROR: FPing packetsize must be between 12 and 64000" + if ( $val < 12 or $val > 64000 ); + return undef; + }, + _doc => "The ping packet size (in the range of 12-64000 bytes).", + + }, + timeout => { + _re => '(\d*\.)?\d+', + _example => 1.5, + _doc => <<DOC, +The fping "-t" parameter, but in (possibly fractional) seconds rather than +milliseconds, for consistency with other Smokeping probes. From fping(1): + +Initial target timeout. In the default mode, this is the amount of time that +ping waits for a response to its first request. Successive timeouts are multiplied by the backoff factor. +DOC + }, + mindelay => { + _re => '(\d*\.)?\d+', + _example => 1, + _default => 10, + _doc => <<DOC, +The fping "-i" parameter. From fping(1): + +The minimum amount of time (in milliseconds) between sending a ping packet to any target. +DOC + }, + }); +} + +1; diff --git a/lib/Smokeping/probes/FPing6.pm b/lib/Smokeping/probes/FPing6.pm new file mode 100644 index 0000000..27e6a59 --- /dev/null +++ b/lib/Smokeping/probes/FPing6.pm @@ -0,0 +1,58 @@ +package Smokeping::probes::FPing6; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::FPing6> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::FPing6> + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::FPing); + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::FPing6 - FPing6 Probe for SmokePing +DOC + description => <<DOC, +Integrates FPing6 as a probe into smokeping. This probe is derived from +FPing; the only difference is that the target host used for checking +the fping command output is ::1 instead of localhost. +DOC + authors => <<'DOC', +Tobias Oetiker <tobi@oetiker.ch> + +Niko Tyni <ntyni@iki.fi> +DOC + see_also => <<DOC +Smokeping::probes::FPing +DOC + } +} + +sub testhost { + return "::1"; +} + +sub probevars { + my $self = shift; + my $h = $self->SUPER::probevars; + $h->{binary}{_example} = "/usr/bin/fping6"; + return $h; +} + +sub ProbeDesc($){ + my $self = shift; + my $bytes = $self->{properties}{packetsize}||56; + return "IPv6-ICMP Echo Pings ($bytes Bytes)"; +} + +1; diff --git a/lib/Smokeping/probes/IOSPing.pm b/lib/Smokeping/probes/IOSPing.pm new file mode 100644 index 0000000..708c03f --- /dev/null +++ b/lib/Smokeping/probes/IOSPing.pm @@ -0,0 +1,262 @@ +package Smokeping::probes::IOSPing; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::IOSPing> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::IOSPing> + +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, +Smokeping::probes::IOSPing - Cisco IOS Probe for SmokePing +DOC + description => <<DOC, +Integrates Cisco IOS as a probe into smokeping. Uses the rsh / remsh +protocol to run a ping from an IOS device. +DOC + notes => <<DOC, +=head2 IOS Configuration + +The IOS device must have rsh enabled and an appropriate trust defined, +eg: + + ! + ip rcmd rsh-enable + ip rcmd remote-host smoke 192.168.1.2 smoke enable + ! + +Some IOS devices have a maximum of 5 VTYs available, so be careful not to +hit a limit with the 'forks' variable. + +${e}head2 Password authentication + +It is not possible to use password authentication with rsh or remsh +due to fundamental limitations of the protocol. + +${e}head2 Ping packet size + +The FPing manpage has the following to say on the topic of ping packet +size: + +Number of bytes of ping data to send. The minimum size (normally 12) +allows room for the data that fping needs to do its work (sequence +number, timestamp). The reported received data size includes the IP +header (normally 20 bytes) and ICMP header (8 bytes), so the minimum +total size is 40 bytes. Default is 56, as in ping. Maximum is the +theoretical maximum IP datagram size (64K), though most systems limit +this to a smaller, system-dependent number. +DOC + authors => <<'DOC', +Paul J Murphy <paul@murph.org> + +based on Smokeping::probes::FPing by + +Tobias Oetiker <tobi@oetiker.ch> +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 <router> 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 => <<DOC, +The binary option specifies the path of the binary to be used to +connect to the IOS device. Commonly used binaries are /usr/bin/rsh +and /usr/bin/remsh, although any script or binary should work if can +be called as + + /path/to/binary [ -l user ] router ping + +to produce the IOS ping dialog on stdin & stdout. +DOC + _example => '/usr/bin/rsh', + _sub => sub { + my $val = shift; + -x $val or return "ERROR: binary '$val' is not executable"; + return undef; + }, + }, + packetsize => { + _doc => <<DOC, +The (optional) packetsize option lets you configure the packetsize for +the pings sent. +DOC + _default => 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 => <<DOC, +The ioshost option specifies the IOS device which should be used for +the ping. +DOC + _example => 'my.cisco.router', + }, + iosuser => { + _doc => <<DOC, +The (optional) iosuser option allows you to specify the remote +username the IOS device. If this option is omitted, the username +defaults to the default user used by the remsh command (usually the +user running the remsh command, ie the user running SmokePing). +DOC + _example => 'admin', + }, + iosint => { + _doc => <<DOC, +The (optional) iosint option allows you to specify the source address +or interface in the IOS device. The value should be an IP address or +an interface name such as "Ethernet 1/0". If this option is omitted, +the IOS device will pick the IP address of the outbound interface to +use. +DOC + _example => 'Ethernet 1/0', + }, + }); +} + +1; diff --git a/lib/Smokeping/probes/LDAP.pm b/lib/Smokeping/probes/LDAP.pm new file mode 100644 index 0000000..07dd7f6 --- /dev/null +++ b/lib/Smokeping/probes/LDAP.pm @@ -0,0 +1,235 @@ +package Smokeping::probes::LDAP; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::LDAP> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::LDAP> + +to generate the POD document. + +=cut + +use strict; +use Smokeping::probes::passwordchecker; +use Net::LDAP; +use Time::HiRes qw(gettimeofday sleep); +use base qw(Smokeping::probes::passwordchecker); +use IO::Socket::SSL; + +my $DEFAULTINTERVAL = 1; + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::LDAP - a LDAP probe for SmokePing +DOC + overview => <<DOC, +Measures LDAP search latency for SmokePing +DOC + description => <<DOC, +This probe measures LDAP query latency for SmokePing. +The query is specified by the target-specific variable `filter' and, +optionally, by the target-specific variable `base'. The attributes +queried can be specified in the comma-separated list `attrs'. + +The TCP port of the LDAP server and the LDAP version to be used can +be specified by the variables `port' and `version'. + +The probe can issue the starttls command to convert the connection +into encrypted mode, if so instructed by the `start_tls' variable. +It can also optionally do an authenticated LDAP bind, if the `binddn' +variable is present. The password to be used can be specified by the +target-specific variable `password' or in an external file. +The location of this file is given in the probe-specific variable +`passwordfile'. See Smokeping::probes::passwordchecker(3pm) for the format +of this file (summary: colon-separated triplets of the form +`<host>:<bind-dn>:<password>') + +The probe tries to be nice to the server and does not send authentication +requests more frequently than once every X seconds, where X is the value +of the target-specific "min_interval" variable ($DEFAULTINTERVAL by default). +DOC + authors => <<'DOC', +Niko Tyni <ntyni@iki.fi> +DOC + bugs => <<DOC, +There should be a way of specifying TLS options, such as the certificates +involved etc. + +The probe has an ugly way of working around the fact that the +IO::Socket::SSL class complains if start_tls() is done more than once +in the same program. But It Works For Me (tm). +DOC + } +} + +sub ProbeDesc { + return "LDAP queries"; +} + +sub probevars { + my $class = shift; + my $h = $class->SUPER::probevars; + delete $h->{timeout}; + return $h; +} + +sub targetvars { + my $class = shift; + return $class->_makevars($class->SUPER::targetvars, { + _mandatory => [ 'filter' ], + port => { + _re => '\d+', + _doc => "TCP port of the LDAP server", + _example => 389, + }, + version => { + _re => '\d+', + _doc => "The LDAP version to be used.", + _example => 3, + }, + start_tls => { + _doc => "If true, encrypt the connection with the starttls command. Disabled by default.", + _example => "1", + }, + timeout => { + _doc => "LDAP query timeout in seconds.", + _re => '\d+', + _example => 10, + _default => 5, + }, + base => { + _doc => "The base to be used in the LDAP query", + _example => "dc=foo,dc=bar", + }, + filter => { + _doc => "The actual search to be made", + _example => "uid=testuser", + }, + attrs => { + _doc => "The attributes queried.", + _example => "uid,someotherattr", + }, + binddn => { + _doc => "If present, authenticate the LDAP bind with this DN.", + _example => "uid=testuser,dc=foo,dc=bar", + }, + password => { + _doc => "The password to be used, if not present in <passwordfile>.", + _example => "mypass", + }, + mininterval => { + _default => $DEFAULTINTERVAL, + _doc => "The minimum interval between each query sent, in (possibly fractional) second +s.", + _re => '(\d*\.)?\d+', + }, + }); +} + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(@_); + + return $self; +} + +sub pingone { + my $self = shift; + my $target = shift; + my $host = $target->{addr}; + my $vars = $target->{vars}; + + my $version = $vars->{version} || 3; + my $port = $vars->{port}; + + my $mininterval = $vars->{mininterval}; + + my $binddn = $vars->{binddn}; + + my $timeout = $vars->{timeout}; + + my $password; + if (defined $binddn) { + $password = $self->password($host, $binddn); + if (defined $vars->{password} and + $vars->{password} ne ($self->{properties}{password}||"")) { + $password = $vars->{password}; + } + $password ||= $self->{properties}{password}; + } + + my $start_tls = $vars->{start_tls}; + + my $filter = $vars->{filter}; + + my $base = $vars->{base}; + + my $attrs = $vars->{attrs}; + + my @attrs = split(/,/, $attrs||""); + my $attrsref = @attrs ? \@attrs : undef; + + my @times; + + my $start; + for (1..$self->pings($target)) { + if (defined $start) { + my $elapsed = gettimeofday() - $start; + my $timeleft = $mininterval - $elapsed; + sleep $timeleft if $timeleft > 0; + } + local $IO::Socket::SSL::SSL_Context_obj; # ugly but necessary + $start = gettimeofday(); + my $ldap = new Net::LDAP($host, port => $port, version => $version, timeout => $timeout) + or do { + $self->do_log("connection error on $host: $!"); + next; + }; + my $mesg; + if ($start_tls) { + $mesg = $ldap->start_tls; + $mesg->code and do { + $self->do_log("start_tls error on $host: " . $mesg->error); + $ldap->unbind; + next; + } + } + if (defined $binddn and defined $password) { + $mesg = $ldap->bind($binddn, password => $password); + } else { + if (defined $binddn and not defined $password) { + $self->do_debug("No password specified for $binddn, doing anonymous bind instead"); + } + $mesg = $ldap->bind(); + } + $mesg->code and do { + $self->do_log("bind error on $host: " . $mesg->error); + $ldap->unbind; + next; + }; + $mesg = $ldap->search(base => $base, filter => $filter, attrs => $attrsref); + $mesg->code and do { + $self->do_log("filter error on $host: " . $mesg->error); + $ldap->unbind; + next; + }; + $ldap->unbind; + my $end = gettimeofday(); + my $elapsed = $end - $start; + + $self->do_debug("$host: LDAP query $_ took $elapsed seconds"); + + push @times, $elapsed; + } + return sort { $a <=> $b } @times; +} + + +1; diff --git a/lib/Smokeping/probes/Radius.pm b/lib/Smokeping/probes/Radius.pm new file mode 100644 index 0000000..bf2c3fd --- /dev/null +++ b/lib/Smokeping/probes/Radius.pm @@ -0,0 +1,248 @@ +package Smokeping::probes::Radius; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::Radius> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::Radius> + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::passwordchecker); +use Authen::Radius; +use Time::HiRes qw(gettimeofday sleep); +use Carp; + +my $DEFAULTINTERVAL = 1; + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::Radius - a RADIUS authentication probe for SmokePing +DOC + overview => <<DOC, +Measures RADIUS authentication latency for SmokePing +DOC + description => <<DOC, +This probe measures RADIUS (RFC 2865) authentication latency for SmokePing. + +The username to be tested is specified in either the probe-specific or the +target-specific variable `username', with the target-specific one overriding +the probe-specific one. + +The password can be specified either (in order of precedence, with +the latter overriding the former) in the probe-specific variable +`password', in an external file or in the target-specific variable +`password'. The location of this file is given in the probe-specific +variable `passwordfile'. See Smokeping::probes::passwordchecker(3pm) for the +format of this file (summary: colon-separated triplets of the form +`<host>:<username>:<password>') + +The RADIUS protocol requires a shared secret between the server and the client. +This secret can be specified either (in order of precedence, with the latter +overriding the former) in the probe-specific variable `secret', in an external file +or in the target-specific variable `secret'. +This external file is located by the probe-specific variable `secretfile', and it should +contain whitespace-separated pairs of the form `<host> <secret>'. Comments and blank lines +are OK. + +If the optional probe-specific variable `nas_ip_address' is specified, its +value is inserted into the authentication requests as the `NAS-IP-Address' +RADIUS attribute. + +The probe tries to be nice to the server and does not send authentication +requests more frequently than once every X seconds, where X is the value +of the target-specific "min_interval" variable ($DEFAULTINTERVAL by default). +DOC + authors => <<'DOC', +Niko Tyni <ntyni@iki.fi> +DOC + bugs => <<DOC, +There should be a more general way of specifying RADIUS attributes. +DOC + } +} + +sub ProbeDesc { + return "RADIUS queries"; +} + +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}) { + if (defined $self->{properties}{secretfile}) { + my @stat = stat($self->{properties}{secretfile}); + my $mode = $stat[2]; + carp("Warning: secret file $self->{properties}{secretfile} is world-readable\n") + if defined $mode and $mode & 04; + open(S, "<$self->{properties}{secretfile}") + or croak("Error opening specified secret file $self->{properties}{secretfile}: $!"); + while (<S>) { + chomp; + next unless /\S/; + next if /^\s*#/; + my ($host, $secret) = split; + carp("Line $. in $self->{properties}{secretfile} is invalid"), next + unless defined $host and defined $secret; + $self->secret($host, $secret); + } + close S; + } + + } + + return $self; +} + +sub secret { + my $self = shift; + my $host = shift; + my $newval = shift; + + $self->{secret}{$host} = $newval if defined $newval; + return $self->{secret}{$host}; +} + +sub pingone { + my $self = shift; + my $target = shift; + my $host = $target->{addr}; + my $vars = $target->{vars}; + my $mininterval = $vars->{mininterval}; + my $username = $vars->{username}; + my $secret = $self->secret($host); + if (defined $vars->{secret} and + $vars->{secret} ne ($self->{properties}{secret}||"")) { + $secret = $vars->{secret}; + } + $secret ||= $self->{properties}{secret}; + + my $timeout = $vars->{timeout}; + + $self->do_log("Missing RADIUS secret for $host"), return + unless defined $secret; + + $self->do_log("Missing RADIUS username for $host"), return + unless defined $username; + + my $password = $self->password($host, $username); + if (defined $vars->{password} and + $vars->{password} ne ($self->{properties}{password}||"")) { + $password = $vars->{password}; + } + $password ||= $self->{properties}{password}; + + $self->do_log("Missing RADIUS password for $host/$username"), return + unless defined $password; + + my $port = $vars->{port}; + $host .= ":$port" if defined $port; + + my @times; + my $elapsed; + for (1..$self->pings($target)) { + if (defined $elapsed) { + my $timeleft = $mininterval - $elapsed; + sleep $timeleft if $timeleft > 0; + } + my $r = new Authen::Radius(Host => $host, Secret => $secret, TimeOut => $timeout); + $r->add_attributes( + { Name => 1, Value => $username, Type => 'string' }, + { Name => 2, Value => $password, Type => 'string' }, + ); + $r->add_attributes( { Name => 4, Type => 'ipaddr', Value => $vars->{nas_ip_address} }) + if exists $vars->{nas_ip_address}; + my $c; + my $start = gettimeofday(); + $r->send_packet(ACCESS_REQUEST) and $c = $r->recv_packet; + my $end = gettimeofday(); + my $result; + if (defined $c) { + $result = $c; + $result = "OK" if $c == ACCESS_ACCEPT; + $result = "fail" if $c == ACCESS_REJECT; + } else { + if (defined $r->get_error) { + $result = "error: " . $r->strerror; + } else { + $result = "no reply"; + } + } + $elapsed = $end - $start; + $self->do_debug("$host: radius query $_: $result, $elapsed"); + push @times, $elapsed if (defined $c and $c == ACCESS_ACCEPT); + } + return sort { $a <=> $b } @times; +} + +sub probevars { + my $class = shift; + my $h = $class->SUPER::probevars; + delete $h->{timeout}; + return $class->_makevars($h, { + secretfile => { + _doc => <<DOC, +A file containing the RADIUS shared secrets for the targets. It should contain +whitespace-separated pairs of the form `<host> <secret>'. Comments and blank lines +are OK. +DOC + _example => '/another/place/secret', + _sub => sub { + my $val = shift; + -r $val or return "ERROR: secret file $val is not readable."; + return undef; + }, + }, + }); +} + +sub targetvars { + my $class = shift; + return $class->_makevars($class->SUPER::targetvars, { + _mandatory => [ 'username' ], + username => { + _doc => 'The username to be tested.', + _example => 'test-user', + }, + password => { + _doc => 'The password for the user, if not present in the password file.', + _example => 'test-password', + }, + secret => { + _doc => 'The RADIUS shared secret for the target, if not present in the secrets file.', + _example => 'test-secret', + }, + nas_ip_address => { + _doc => 'The NAS-IP-Address RADIUS attribute for the authentication requests. Not needed everywhere.', + _example => '10.1.2.3', + }, + mininterval => { + _default => $DEFAULTINTERVAL, + _doc => "The minimum interval between each authentication request sent, in (possibly fractional) seconds.", + _re => '(\d*\.)?\d+', + }, + timeout => { + _default => 5, + _doc => "Timeout in seconds for the RADIUS queries.", + _re => '\d+', + }, + port => { + _doc => 'The RADIUS port to be used', + _re => '\d+', + _example => 1645, + }, + }); +} + +1; diff --git a/lib/Smokeping/probes/RemoteFPing.pm b/lib/Smokeping/probes/RemoteFPing.pm new file mode 100644 index 0000000..c23591e --- /dev/null +++ b/lib/Smokeping/probes/RemoteFPing.pm @@ -0,0 +1,122 @@ +package Smokeping::probes::RemoteFPing; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::RemoteFPing> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::RemoteFPing> + +to generate the POD document. + +=cut + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::RemoteFPing - Remote FPing Probe for SmokePing +DOC + description => <<DOC, +Integrates the remote execution of FPing via ssh/rsh into smokeping. +The variable B<binary> must point to your copy of the ssh/rsh program. +The variable B<rbinary> must point to your copy of the fping program +at the remote end. +DOC + notes => <<'DOC', +It is important to make sure that you can access the remote machine +without a password prompt, otherwise this probe will not work properly. +To test just try something like this: + + $ ssh foo@HostA.foobar.com fping HostB.barfoo.com + +The next thing you see must be fping's output. + +The B<rhost>, B<ruser> and B<rbinary> variables used to be configured in +the Targets section of the first target or its parents They were moved +to the Probes section, because the variables aren't really target-specific +(all the targets are measured with the same parameters). The Targets +sections aren't recognized anymore. +DOC + authors => <<'DOC', + Luis F Balbinot <hades@inf.ufrgs.br> + + Niko Tyni <ntyni@iki.fi> + + derived from Smokeping::probes::FPing by + + Tobias Oetiker <tobi@oetiker.ch> +DOC + bugs => <<DOC +This functionality should be in a generic 'remote execution' module +so that it could be used for the other probes too. +DOC + } +} + +use strict; +use base qw(Smokeping::probes::FPing); + +sub ProbeDesc($) { + my $self = shift; + my $superdesc = $self->SUPER::ProbeDesc; + return "Remote $superdesc"; +} + +sub binary { + my $self = shift; + my @ret = ( $self->SUPER::binary ); + for my $what (qw(ruser rhost rbinary)) { + my $prefix = ($what eq 'ruser' ? "-l" : ""); + if (defined $self->{properties}{$what}) { + push @ret, $prefix . $self->{properties}{$what}; + } + } + return @ret; +} + +sub probevars { + my $class = shift; + my $h = $class->SUPER::probevars; + $h->{rbinary} = $h->{binary}; + delete $h->{binary}; + delete $h->{rbinary}{sub}; # we can't check the remote program's -x bit + @{$h->{_mandatory}} = map { $_ ne 'binary' ? $_ : 'rbinary' } @{$h->{_mandatory}}; + return $class->_makevars($h, { + _mandatory => [ 'binary', 'rhost' ], + binary => { + _doc => <<DOC, +This variable specifies the path of the remote shell program (usually ssh, +rsh or remsh). Any other script or binary that can be called as + +binary [ -l ruser ] rhost rbinary + +may be used. +DOC + _example => '/usr/bin/ssh', + _sub => sub { + my $val = shift; + -x $val or return "ERROR: binary '$val' is not executable"; + return undef; + }, + }, + rhost => { + _doc => <<DOC, +The B<rhost> option specifies the remote device from where fping will +be launched. +DOC + _example => 'my.pinger.host', + }, + ruser => { + _doc => <<DOC, +The (optional) B<ruser> option allows you to specify the remote user, +if different from the one running the smokeping daemon. +DOC + _example => 'foo', + }, + }); +} + +1; diff --git a/lib/Smokeping/probes/SSH.pm b/lib/Smokeping/probes/SSH.pm new file mode 100644 index 0000000..0f336d6 --- /dev/null +++ b/lib/Smokeping/probes/SSH.pm @@ -0,0 +1,124 @@ +package Smokeping::probes::SSH; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::SSH> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::SSH> + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::basefork); +use IPC::Open3; +use Symbol; +use Carp; +use POSIX; + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::SSH - Secure Shell Probe for SmokePing +DOC + description => <<DOC, +Integrates ssh-keyscan as a probe into smokeping. The variable B<binary> must +point to your copy of the ssh-keyscan program. If it is not installed on +your system yet, you should install openssh >= 3.8p1 + +The Probe asks the given host n-times for it's public key. Where n is +the amount specified in the config File. +DOC + authors => <<'DOC', +Christian Recktenwald <smokeping-contact@citecs.de> +DOC + } +} + +my $ssh_re=qr/^# \S+ SSH-/i; + +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} ) { + + my $call = "$self->{properties}{binary} -t rsa localhost"; + my $return = `$call 2>&1`; + if ($return =~ m/$ssh_re/s){ + $self->{pingfactor} = 10; + print "### parsing ssh-keyscan output...OK\n"; + } else { + croak "ERROR: output of '$call' does not match $ssh_re\n"; + } + }; + + return $self; +} + +sub ProbeDesc($){ + my $self = shift; + return "SSH requests"; +} + +sub pingone ($){ + my $self = shift; + my $target = shift; + + my $inh = gensym; + my $outh = gensym; + my $errh = gensym; + + my $host = $target->{addr}; + + my $query = "$self->{properties}{binary} -t rsa $host"; + my @times; + + # get the user and system times before and after the test + $self->do_debug("query=$query\n"); + for (my $run = 0; $run < $self->pings; $run++) { + my @times1 = POSIX::times; + my $pid = open3($inh,$outh,$errh, $query); + while (<$outh>) { + if (/$ssh_re/i) { + last; + } + } + waitpid $pid,0; + close $errh; + close $inh; + close $outh; + my @times2 = POSIX::times; + push @times, $times2[0]-$times1[0]; + } + @times = map {sprintf "%.10e", $_ / $self->{pingfactor}} sort {$a <=> $b} grep {$_ ne "-"} @times; + +# $self->do_debug("time=@times\n"); + return @times; +} + +sub probevars { + my $class = shift; + return $class->_makevars($class->SUPER::probevars, { + _mandatory => [ 'binary' ], + binary => { + _doc => "The location of your ssh-keyscan binary.", + _example => '/usr/bin/ssh-keyscan', + _sub => sub { + my $val = shift; + -x $val or return "ERROR: binary '$val' is not executable"; + return undef; + }, + }, + }) +} + +1; diff --git a/lib/Smokeping/probes/base.pm b/lib/Smokeping/probes/base.pm new file mode 100644 index 0000000..0309550 --- /dev/null +++ b/lib/Smokeping/probes/base.pm @@ -0,0 +1,400 @@ +package Smokeping::probes::base; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::base> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::base> + +to generate the POD document. + +=cut + +use vars qw($VERSION); +use Carp; +use lib qw(..); +use Smokeping; + +$VERSION = 1.0; + +use strict; + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::base - Base Class for implementing SmokePing Probes +DOC + overview => <<DOC, +For the time being, please use the Smokeping::probes::FPing for +inspiration when implementing your own probes. +DOC + authors => <<'DOC', +Tobias Oetiker <tobi@oetiker.ch> +DOC + }; +} + +sub pod { + my $class = shift; + my $pod = ""; + my $podhash = $class->pod_hash; + $podhash->{synopsys} = $class->pod_synopsys; + $podhash->{variables} = $class->pod_variables; + for my $what (qw(name overview synopsys description variables authors notes bugs see_also)) { + my $contents = $podhash->{$what}; + next if not defined $contents or $contents eq ""; + $pod .= "=head1 " . uc $what . "\n\n"; + $pod .= $contents; + chomp $pod; + $pod .= "\n\n"; + } + $pod .= "=cut"; + return $pod; +} + +sub new($$) +{ + my $this = shift; + my $class = ref($this) || $this; + my $self = { properties => shift, cfg => shift, + name => shift, + targets => {}, rtts => {}, addrlookup => {}}; + bless $self, $class; + return $self; +} + +sub add($$) +{ + my $self = shift; + my $tree = shift; + + $self->{targets}{$tree} = shift; +} + +sub ping($) +{ + croak "this must be overridden by the subclass"; +} + +sub round ($) { + return sprintf "%.0f", $_[0]; +} + +sub ProbeDesc ($) { + return "Probe which does not overrivd the ProbeDesc methode"; +} + +sub rrdupdate_string($$) +{ my $self = shift; + my $tree = shift; +# print "$tree -> ", join ",", @{$self->{rtts}{$tree}};print "\n"; + # skip invalid addresses + my $pings = $self->_pings($tree); + return "U:${pings}:".(join ":", map {"U"} 1..($pings+1)) + unless defined $self->{rtts}{$tree} and @{$self->{rtts}{$tree}} > 0; + my $entries = scalar @{$self->{rtts}{$tree}}; + my @times = @{$self->{rtts}{$tree}}; + my $loss = $pings - $entries; + my $median = $times[int($entries/2)] || 'U'; + # shift the data into the middle of the times array + my $lowerloss = int($loss/2); + my $upperloss = $loss - $lowerloss; + @times = ((map {'U'} 1..$lowerloss),@times, (map {'U'} 1..$upperloss)); + my $age; + if ( -f $self->{targets}{$tree}.".adr" ) { + $age = time - (stat($self->{targets}{$tree}.".adr"))[9]; + } else { + $age = 'U'; + } + if ( $entries == 0 ){ + $age = 'U'; + $loss = 'U'; + if ( -f $self->{targets}{$tree}.".adr" + and not -f $self->{targets}{$tree}.".snmp" ){ + unlink $self->{targets}{$tree}.".adr"; + } + } ; + return "${age}:${loss}:${median}:".(join ":", @times); +} + +sub addresses($) +{ + my $self = shift; + my $addresses = []; + $self->{addrlookup} = {}; + foreach my $tree (keys %{$self->{targets}}){ + my $target = $self->{targets}{$tree}; + if ($target =~ m|/|) { + if ( open D, "<$target.adr" ) { + my $ip; + chomp($ip = <D>); + close D; + + if ( open D, "<$target.snmp" ) { + my $snmp = <D>; + chomp($snmp); + if ($snmp ne Smokeping::snmpget_ident $ip) { + # something fishy snmp properties do not match, skip this address + next; + } + close D; + } + $target = $ip; + } else { + # can't read address file skip + next; + } + } + $self->{addrlookup}{$target} = () + unless defined $self->{addrlookup}{$target}; + push @{$self->{addrlookup}{$target}}, $tree; + push @{$addresses}, $target; + }; + return $addresses; +} + +sub debug { + my $self = shift; + my $newval = shift; + $self->{debug} = $newval if defined $newval; + return $self->{debug}; +} + +sub do_debug { + my $self = shift; + return unless $self->debug; + $self->do_log(@_); +} + +sub do_fatal { + my $self = shift; + $self->do_log("Fatal:", @_); + croak(@_); +} + +sub do_log { + my $self = shift; + Smokeping::do_log("$self->{name}:", @_); +} + +sub report { + my $self = shift; + my $count = $self->target_count; + my $offset = $self->offset_in_seconds; + my $step = $self->step; + $self->do_log("probing $count targets with step $step s and offset $offset s."); +} + +sub step { + my $self = shift; + my $rv = $self->{cfg}{Database}{step}; + unless (defined $self->{cfg}{General}{concurrentprobes} + and $self->{cfg}{General}{concurrentprobes} eq 'no') { + $rv = $self->{properties}{step} if defined $self->{properties}{step}; + } + return $rv; +} + +sub offset { + my $self = shift; + my $rv = $self->{cfg}{General}{offset}; + unless (defined $self->{cfg}{General}{concurrentprobes} + and $self->{cfg}{General}{concurrentprobes} eq 'no') { + $rv = $self->{properties}{offset} if defined $self->{properties}{offset}; + } + return $rv; +} + +sub offset_in_seconds { + # returns the offset in seconds rather than as a percentage + # this is filled in from the initialization in Smokeping::main + my $self = shift; + my $newval = shift; + $self->{offset_in_seconds} = $newval if defined $newval; + return $self->{offset_in_seconds}; +} + +# the "public" method that takes a "target" argument is used by the probes +# the "private" method that takes a "tree" argument is used by Smokeping.pm +# there's no difference between them here, but we have to provide both + +sub pings { + my $self = shift; + my $target = shift; + # $target is not used; basefork.pm overrides this method to provide a target-specific parameter + my $rv = $self->{cfg}{Database}{pings}; + $rv = $self->{properties}{pings} if defined $self->{properties}{pings}; + return $rv; +} + + +sub _pings { + my $self = shift; + my $tree = shift; + # $tree is not used; basefork.pm overrides this method to provide a target-specific parameter + my $rv = $self->{cfg}{Database}{pings}; + $rv = $self->{properties}{pings} if defined $self->{properties}{pings}; + return $rv; +} + +sub target_count { + my $self = shift; + return scalar keys %{$self->{targets}}; +} + +sub probevars { + return { + step => { + _re => '\d+', + _example => 300, + _doc => <<DOC, +Duration of the base interval that this probe should use, if different +from the one specified in the 'Database' section. Note that the step in +the RRD files is fixed when they are originally generated, and if you +change the step parameter afterwards, you'll have to delete the old RRD +files or somehow convert them. (This variable is only applicable if +the variable 'concurrentprobes' is set in the 'General' section.) +DOC + }, + offset => { + _re => '(\d+%|random)', + _re_error => + "Use offset either in % of operation interval or 'random'", + _example => '50%', + _doc => <<DOC, +If you run many probes concurrently you may want to prevent them from +hitting your network all at the same time. Using the probe-specific +offset parameter you can change the point in time when each probe will +be run. Offset is specified in % of total interval, or alternatively as +'random', and the offset from the 'General' section is used if nothing +is specified here. Note that this does NOT influence the rrds itself, +it is just a matter of when data acqusition is initiated. +(This variable is only applicable if the variable 'concurrentprobes' is set +in the 'General' section.) +DOC + }, + pings => { + _re => '\d+', + _example => 20, + _doc => <<DOC, +How many pings should be sent to each target, if different from the global +value specified in the Database section. Note that the number of pings in +the RRD files is fixed when they are originally generated, and if you +change this parameter afterwards, you'll have to delete the old RRD +files or somehow convert them. +DOC + }, + _mandatory => [], + }; +} + +sub targetvars { + return {_mandatory => []}; +} + +# a helper method that combines two var hash references +# and joins their '_mandatory' lists. +sub _makevars { + my ($class, $from, $to) = @_; + for (keys %$from) { + if ($_ eq '_mandatory') { + push @{$to->{_mandatory}}, @{$from->{$_}}; + next; + } + $to->{$_} = $from->{$_}; + } + return $to; +} + +sub pod_synopsys { + my $class = shift; + my $classname = ref $class||$class; + $classname =~ s/^Smokeping::probes:://; + + my $probevars = $class->probevars; + my $targetvars = $class->targetvars; + my $pod = <<DOC; + *** Probes *** + + +$classname + +DOC + $pod .= $class->_pod_synopsys($probevars); + my $targetpod = $class->_pod_synopsys($targetvars); + $pod .= "\n # The following variables can be overridden in each target section\n$targetpod" + if defined $targetpod and $targetpod ne ""; + $pod .= <<DOC; + + # [...] + + *** Targets *** + + probe = $classname # if this should be the default probe + + # [...] + + + mytarget + # probe = $classname # if the default probe is something else + host = my.host +DOC + $pod .= $targetpod + if defined $targetpod and $targetpod ne ""; + + return $pod; +} + +# synopsys for one hash ref +sub _pod_synopsys { + my $class = shift; + my $vars = shift; + my %mandatory; + $mandatory{$_} = 1 for (@{$vars->{_mandatory}}); + my $pod = ""; + for (sort keys %$vars) { + next if /^_mandatory$/; + my $val = $vars->{$_}{_example}; + $val = $vars->{$_}{_default} + if exists $vars->{$_}{_default} + and not defined $val; + $pod .= " $_ = $val"; + $pod .= " # mandatory" if $mandatory{$_}; + $pod .= "\n"; + } + return $pod; +} + +sub pod_variables { + my $class = shift; + my $probevars = $class->probevars; + my $pod = "Supported probe-specific variables:\n\n"; + $pod .= $class->_pod_variables($probevars); + return $pod; +} + +sub _pod_variables { + my $class = shift; + my $vars = shift; + my $pod = "=over\n\n"; + my %mandatory; + $mandatory{$_} = 1 for (@{$vars->{_mandatory}}); + for (sort keys %$vars) { + next if /^_mandatory$/; + $pod .= "=item $_\n\n"; + $pod .= $vars->{$_}{_doc}; + chomp $pod; + $pod .= "\n\n"; + $pod .= "Example value: " . $vars->{$_}{_example} . "\n\n" + if exists $vars->{$_}{_example}; + $pod .= "Default value: " . $vars->{$_}{_default} . "\n\n" + if exists $vars->{$_}{_default}; + $pod .= "This setting is mandatory.\n\n" + if $mandatory{$_}; + } + $pod .= "=back\n\n"; + return $pod; +} +1; diff --git a/lib/Smokeping/probes/basefork.pm b/lib/Smokeping/probes/basefork.pm new file mode 100644 index 0000000..4324e6d --- /dev/null +++ b/lib/Smokeping/probes/basefork.pm @@ -0,0 +1,266 @@ +package Smokeping::probes::basefork; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::basefork> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::basefork> + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::basevars); +use Symbol; +use Carp; +use IO::Select; +use POSIX; # for ceil() and floor() +use Config; # for signal names + +my $DEFAULTFORKS = 5; + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::basefork - Yet Another Base Class for implementing SmokePing Probes +DOC + overview => <<DOC, +Like Smokeping::probes::basevars, but supports the probe-specific property `forks' +to determine how many processes should be run concurrently. The +targets are pinged one at a time, and the number of pings sent can vary +between targets. +DOC + description => <<DOC, +Not all pinger programs support testing multiple hosts in a single go like +fping(1). If the measurement takes long enough, there may be not enough time +perform all the tests in the time available. For example, if the test takes +30 seconds, measuring ten hosts already fills up the SmokePing default +five minute step. + +Thus, it may be necessary to do some of the tests concurrently. This module +defines the B<ping> method that forks the requested number of concurrent +processes and calls the B<pingone> method that derived classes must provide. + +The B<pingone> method is called with one argument: a hash containing +the target that is to be measured. The contents of the hash are +described in I<Smokeping::probes::basevars>(3pm). + +The number of concurrent processes is determined by the probe-specific +variable `forks' and is $DEFAULTFORKS by default. If there are more +targets than this value, another round of forks is done after the first +processes are finished. This continues until all the targets have been +tested. + +The timeout in which each child has to finish is set to 5 seconds +multiplied by the maximum number of 'pings' of the targets. You can set +the base timeout differently if you want to, using the timeout property +of the probe in the master config file (this again will be multiplied +by the maximum number of pings). The probe itself can also provide +another default value if desired by modifying the _default value of +the timeout variable. + +If the child isn't finished when the timeout occurs, it +will be killed along with any processes it has started. + +The number of pings sent can be specified in the target-specific variable +'pings'. +DOC + authors => <<'DOC', +Niko Tyni <ntyni@iki.fi> +DOC + see_also => <<DOC, +Smokeping::probes::basevars(3pm), Smokeping::probes::EchoPing(3pm) +DOC + } +} + +my %signo; +my @signame; + +{ + # from perlipc man page + my $i = 0; + defined $Config{sig_name} || die "No sigs?"; + foreach my $name (split(' ', $Config{sig_name})) { + $signo{$name} = $i; + $signame[$i] = $name; + $i++; + } +} + +die("Missing TERM signal?") unless exists $signo{TERM}; +die("Missing KILL signal?") unless exists $signo{KILL}; + +sub pingone { + croak "pingone: this must be overridden by the subclass"; +} + +sub probevars { + my $class = shift; + my $h = $class->SUPER::probevars; + delete $h->{pings}; + return $class->_makevars($h, { + forks => { + _re => '\d+', + _example => 5, + _doc => "Run this many concurrent processes at maximum", + _default => $DEFAULTFORKS, + }, + timeout => { + _re => '\d+', + _example => 15, + _default => 5, + _doc => "How long a single 'ping' takes at maximum", + }, + }); +} + +sub targetvars { + my $class = shift; + return $class->_makevars($class->SUPER::targetvars, { + pings => { + _re => '\d+', + _example => 5, + _doc => <<DOC, +How many pings should be sent to each target, if different from the global +value specified in the Database section. Note that the number of pings in +the RRD files is fixed when they are originally generated, and if you +change this parameter afterwards, you'll have to delete the old RRD +files or somehow convert them. +DOC + }, + }); +} + +sub ping { + my $self = shift; + + my @targets = @{$self->targets}; + return unless @targets; + + my $forks = $self->{properties}{forks}; + + my $maxpings = 0; + my $maxtimeout = $self->{properties}{timeout}; + for (@targets) { + my $p = $self->pings($_); + $maxpings = $p if $p > $maxpings; + # some probes have a target-specific timeout variable + # dig out the maximum timeout + my $t = $_->{vars}{timeout}; + $maxtimeout = $t if $t > $maxtimeout; + } + + # we add 1 so that the probes doing their own timeout handling + # have time to do it even in the worst case + my $timeout = $maxpings * $maxtimeout + 1; + + $self->{rtts}={}; + $self->do_debug("forks $forks, timeout for each target $timeout"); + + while (@targets) { + my %targetlookup; + my %pidlookup; + my $s = IO::Select->new(); + my $starttime = time(); + for (1..$forks) { + last unless @targets; + my $t = pop @targets; + my $pid; + my $handle = gensym; + my $sleep_count = 0; + do { + $pid = open($handle, "-|"); + + unless (defined $pid) { + $self->do_log("cannot fork: $!"); + $self->fatal("bailing out") + if $sleep_count++ > 6; + sleep 10; + } + } until defined $pid; + if ($pid) { #parent + $s->add($handle); + $targetlookup{$handle} = $t; + $pidlookup{$handle} = $pid; + } else { #child + # we detach from the parent's process group + setpgrp(0, $$); + + my @times = $self->pingone($t); + print join(" ", @times), "\n"; + exit; + } + } + my $timeleft = $timeout - (time() - $starttime); + + while ($s->handles and $timeleft > 0) { + for my $ready ($s->can_read($timeleft)) { + $s->remove($ready); + my $response = <$ready>; + close $ready; + + chomp $response; + my @times = split(/ /, $response); + my $target = $targetlookup{$ready}; + my $tree = $target->{tree}; + $self->{rtts}{$tree} = \@times; + + $self->do_debug("$target->{addr}: got $response"); + } + $timeleft = $timeout - (time() - $starttime); + } + my @left = $s->handles; + for my $handle (@left) { + $self->do_log("$targetlookup{$handle}{addr}: timeout ($timeout s) reached, killing the probe."); + + # we kill the child's process group (negative signal) + # this should finish off the actual pinger process as well + + my $pid = $pidlookup{$handle}; + kill -$signo{TERM}, $pid; + sleep 1; + kill -$signo{KILL}, $pid; + + close $handle; + $s->remove($handle); + } + } +} + +# the "private" method that takes a "tree" argument is used by Smokeping.pm +sub _pings { + my $self = shift; + my $tree = shift; + my $vars = $self->vars($tree); + return $vars->{pings} if defined $vars->{pings}; + return $self->SUPER::pings(); +} + +# the "public" method that takes a "target" argument is used by the probes +sub pings { + my $self = shift; + my $target = shift; + return $self->SUPER::pings() unless ref $target; + return $self->_pings($target->{tree}); +} + +sub ProbeDesc { + return "Probe that can fork and doesn't override the ProbeDesc method"; +} + +sub pod_variables { + my $class = shift; + my $pod = $class->SUPER::pod_variables; + my $targetvars = $class->targetvars; + $pod .= "Supported target-specific variables:\n\n"; + $pod .= $class->_pod_variables($targetvars); + return $pod; +} + +1; diff --git a/lib/Smokeping/probes/basevars.pm b/lib/Smokeping/probes/basevars.pm new file mode 100644 index 0000000..26c0d85 --- /dev/null +++ b/lib/Smokeping/probes/basevars.pm @@ -0,0 +1,102 @@ +package Smokeping::probes::basevars; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::basevars> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::basevars> + +to generate the POD document. + +=cut + +use strict; +use Smokeping::probes::base; +use base qw(Smokeping::probes::base); + +my $e = "="; +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::basevars - Another Base Class for implementing SmokePing Probes +DOC + overview => <<DOC, +Like Smokeping::probes::base, but supports host-specific variables for the probe. +DOC + description => <<DOC, +Provides the method `targets' that returns a list of hashes. +The hashes contain the entries: + +${e}over + +${e}item addr + +The address of the target. + +${e}item vars + +A hash containing variables defined in the corresponding +config section. + +${e}item tree + +The unique index that `probe::base' uses for targets. + +There's also the method 'vars' that returns the abovementioned +hash corresponding to the 'tree' index parameter. + +${e}back +DOC + authors => <<'DOC', +Niko Tyni <ntyni@iki.fi> +DOC + bugs => <<DOC, +Uses `Smokeping::probes::base' internals too much to be a derived class, but +I didn't want to touch the base class directly. +DOC + see_also => <<DOC, +Smokeping::probes::base(3pm), Smokeping::probes::EchoPing(3pm) +DOC + } +} + +sub add($$) +{ + my $self = shift; + my $tree = shift; + + $self->{targets}{$tree} = shift; + $self->{vars}{$tree} = { %{$self->{properties}}, %$tree }; +} + +sub targets { + my $self = shift; + my $addr = $self->addresses; + my @targets; + + # copy the addrlookup lists to safely pop + my %copy; + + for (@$addr) { + @{$copy{$_}} = @{$self->{addrlookup}{$_}} unless exists $copy{$_}; + my $tree = pop @{$copy{$_}}; + push @targets, { addr => $_, vars => $self->{vars}{$tree}, tree => $tree }; + } + return \@targets; +} + +sub vars { + my $self = shift; + my $tree = shift; + return $self->{vars}{$tree}; +} + +sub ProbeDesc { + return "Probe that supports variables and doesn't override the ProbeDesc method"; +} + +return 1; diff --git a/lib/Smokeping/probes/passwordchecker.pm b/lib/Smokeping/probes/passwordchecker.pm new file mode 100644 index 0000000..cc4f59f --- /dev/null +++ b/lib/Smokeping/probes/passwordchecker.pm @@ -0,0 +1,148 @@ +package Smokeping::probes::passwordchecker; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::passwordchecker> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::passwordchecker> + +to generate the POD document. + +=cut + +use strict; +use Smokeping::probes::basefork; +use base qw(Smokeping::probes::basefork); +use Carp; + +my $e = "="; +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::passwordchecker - A Base Class for implementing SmokePing Probes +DOC + overview => <<DOC, +Like Smokeping::probes::basefork, but supports a probe-specific configuration file +for storing passwords and a method for accessing them. +DOC + + description => <<DOC, +${e}head2 synopsys with more detail + +SmokePing main configuration file: + + *** Probes *** + + MyPasswordChecker + # location of the file containing usernames and passwords + passwordfile = /usr/share/smokeping/etc/passwords + +The specified password file: + + # host:username:password + host1:joe:hardlyasecret + # comments and whitespace lines are allowed + + host2:sue:notasecreteither + +${e}head2 Actual description + +In implementing authentication probes, it might not be desirable to store +the necessary cleartext passwords in the SmokePing main configuration +file, since the latter must be readable both by the SmokePing daemon +performing the probes and the CGI that displays the results. If the +passwords are stored in a different file, this file can be made readable +by only the user the daemon runs as. This way we can be sure that nobody +can trick the CGI into displaying the passwords on the Web. + +This module reads the passwords in at startup from the file specified +in the probe-specific variable `passwordfile'. The passwords can later +be accessed and modified by the B<password> method, that needs the corresponding +host and username as arguments. + +${e}head2 Password file format + +The password file format is simply one line for each triplet of host, +username and password, separated from each other by colons (:). + +Comment lines, starting with the `#' sign, are ignored, as well as +empty lines. +DOC + authors => <<'DOC', +Niko Tyni <ntyni@iki.fi> +DOC + + bugs => <<DOC, +The need for storing cleartext passwords can be considered a bug in itself. +DOC + + see_also => <<DOC, +Smokeping::probes::basefork(3pm), Smokeping::probes::Radius(3pm), Smokeping::probes::LDAP(3pm) +DOC + } +} + +sub ProbeDesc { + return "probe that can fork, knows about passwords and doesn't override the ProbeDesc method"; +} + +sub probevars { + my $class = shift; + return $class->_makevars($class->SUPER::probevars, { + passwordfile => { + _doc => "Location of the file containing usernames and passwords.", + _example => '/some/place/secret', + _sub => sub { + my $val = shift; + -r $val or return "ERROR: password file $val is not readable."; + return undef; + }, + }, + }); +} + +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}) { + + if (defined $self->{properties}{passwordfile}) { + my @stat = stat($self->{properties}{passwordfile}); + my $mode = $stat[2]; + carp("Warning: password file $self->{properties}{passwordfile} is world-readable\n") + if defined $mode and $mode & 04; + + open(P, "<$self->{properties}{passwordfile}") + or croak("Error opening specified password file $self->{properties}{passwordfile}: $!"); + while (<P>) { + chomp; + next unless /\S/; + next if /^\s*#/; + my ($host, $username, $password) = split(/:/); + carp("Line $. in $self->{properties}{passwordfile} is invalid"), next unless defined $host and defined $username and defined $password; + $self->password($host, $username, $password); + } + close P; + } + } + + + return $self; +} + +sub password { + my $self = shift; + my $host = shift; + my $username = shift; + my $newval = shift; + $self->{password}{$host}{$username} = $newval if defined $newval; + return $self->{password}{$host}{$username}; +} + +1; diff --git a/lib/Smokeping/probes/skel.pm b/lib/Smokeping/probes/skel.pm new file mode 100644 index 0000000..fb7ade1 --- /dev/null +++ b/lib/Smokeping/probes/skel.pm @@ -0,0 +1,134 @@ +package Smokeping::probes::skel; + +=head1 301 Moved Permanently + +This is a Smokeping probe module. Please use the command + +C<smokeping -man Smokeping::probes::skel> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::skel> + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::basefork); +# or, alternatively +# use base qw(Smokeping::probes::base); +use Carp; + +sub pod_hash { + return { + name => <<DOC, +Smokeping::probes::skel - a skeleton for Smokeping Probes +DOC + description => <<DOC, +This is a non-functional module that is intended to act as a +basis for creation of new probes. See the L<smokeping_extend> +document for more information. +DOC + authors => <<'DOC', + Niko Tyni <ntyni@iki.fi>, +DOC + see_also => <<DOC +The L<smokeping_extend> document +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} ) { + # if you have to test the program output + # or something like that, do it here + # and bail out if necessary + }; + + return $self; +} + +# This is where you should declare your probe-specific variables. +# The example shows the common case of checking the availability of +# the specified binary. + +sub probevars { + my $class = shift; + return $class->_makevars($class->SUPER::probevars, { + #_mandatory => [ 'binary' ], + #binary => { + # _doc => "The location of your pingpong binary.", + # _example => '/usr/bin/pingpong', + # _sub => sub { + # my $val = shift; + # return "ERROR: pingpong 'binary' does not point to an executable" + # unless -f $val and -x _; + # return undef; + # }, + #}, + }); +} + +# Here's the place for target-specific variables + +sub targetvars { + my $class = shift; + return $class->_makevars($class->SUPER::targetvars, { + #weight => { _doc => "The weight of the pingpong ball in grams", + # _example => 15 + #}, + }); +} + +sub ProbeDesc($){ + my $self = shift; + return "pingpong points"; +} + +# this is where the actual stuff happens +# you can access the probe-specific variables +# via the $self->{properties} hash and the +# target-specific variables via $target->{vars} + +# If you based your class on 'Smokeping::probes::base', +# you'd have to provide a "ping" method instead +# of "pingone" + +sub pingone ($){ + my $self = shift; + my $target = shift; + + # my $binary = $self->{properties}{binary}; + # my $weight = $target->{vars}{weight} + # my $count = $self->pings($target); # the number of pings for this targets + + # ping one target + + # execute a command and parse its output + # you should return a sorted array of the measured latency times + # it could go something like this: + + my @times; + + #for (1..$count) { + # open(P, "$cmd 2>&1 |") or croak("fork: $!"); + # while (<P>) { + # /time: (\d+\.\d+)/ and push @times, $1; + # } + # close P; + #} + + + return @times; +} + +# That's all, folks! + +1; diff --git a/lib/Smokeping/probes/telnetIOSPing.pm b/lib/Smokeping/probes/telnetIOSPing.pm new file mode 100644 index 0000000..260cec7 --- /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<smokeping -man Smokeping::probes::telnetIOSPing> + +to view the documentation or the command + +C<smokeping -makepod Smokeping::probes::telnetIOSPing> + +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, +Smokeping::probes::telnetIOSPing - Cisco IOS Probe for SmokePing +DOC + description => <<DOC, +Integrates Cisco IOS as a probe into smokeping. Uses the telnet protocol +to run a ping from an IOS device (source) to another device (host). +This probe basically uses the "extended ping" of the Cisco IOS. You have +the option to specify which interface the ping is sourced from as well. +DOC + notes => <<DOC, +${e}head2 IOS configuration + +The IOS device should have a username/password configured, as well as +the ability to connect to the VTY(s). +eg: + + ! + username smokeping privilege 5 password 0 SmokepingPassword + ! + line vty 0 4 + login local + transport input telnet + ! + +Some IOS devices have a maximum of 5 VTYs available, so be careful not +to hit a limit with the 'forks' variable. + +${e}head2 Requirements + +This module requires the Net::Telnet module for perl. This is usually +included on most newer OSs which include perl. + +${e}head2 Debugging + +There is some VERY rudimentary debugging code built into this module (it's +based on the debugging code written into Net::Telnet). It will log +information into three files "TIPreturn", "TIPoutlog", and "TIPdump". +These files will be written out into your current working directory (CWD). +You can change the names of these files to something with more meaning to +you. + +${e}head2 Password authentication + +You should be advised that the authentication method of telnet uses +clear text transmissions...meaning that without proper network security +measures someone could sniff your username and password off the network. +I may attempt to incorporate SSH in a future version of this module, but +it is very doubtful. Right now SSH adds a LOT of processing overhead to +a router, and isn't incredibly easy to implement in perl. + +Having said this, don't be too scared of telnet. Remember, the +original IOSPing module used RSH, which is even more scary to use from +a security perspective. + +${e}head2 Ping packet size + +The FPing manpage has the following to say on the topic of ping packet +size: + +Number of bytes of ping data to send. The minimum size (normally 12) +allows room for the data that fping needs to do its work (sequence +number, timestamp). The reported received data size includes the IP +header (normally 20 bytes) and ICMP header (8 bytes), so the minimum +total size is 40 bytes. Default is 56, as in ping. Maximum is the +theoretical maximum IP datagram size (64K), though most systems limit +this to a smaller, system-dependent number. +DOC + authors => <<'DOC', +John A Jackson <geonjay@infoave.net> + +based HEAVILY on Smokeping::probes::IOSPing by + +Paul J Murphy <paul@murph.org> + +based on Smokeping::probes::FPing by + +Tobias Oetiker <tobi@oetiker.ch> +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 => <<DOC, +The (optional) packetsize option lets you configure the packetsize for +the pings sent. +DOC + _default => 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 => <<DOC, +The source option specifies the IOS device to which we telnet. This +is an IP address of an IOS Device that you/your server: + 1) Have the ability to telnet to + 2) Have a valid username and password for +DOC + _example => "192.168.2.1", + }, + psource => { + _doc => <<DOC, +The (optional) psource option specifies an alternate IP address or +Interface from which you wish to source your pings from. Routers +can have many many IP addresses, and interfaces. When you ping from a +router you have the ability to choose which interface and/or which IP +address the ping is sourced from. Specifying an IP/interface does not +necessarily specify the interface from which the ping will leave, but +will specify which address the packet(s) appear to come from. If this +option is left out the IOS Device will source the packet automatically +based on routing and/or metrics. If this doesn't make sense to you +then just leave it out. +DOC + _example => "192.168.2.129", + }, + iosuser => { + _doc => <<DOC, +The iosuser option allows you to specify a username that has ping +capability on the IOS Device. +DOC + _example => 'user', + }, + iospass => { + _doc => <<DOC, +The iospass option allows you to specify the password for the username +specified with the option iosuser. +DOC + _example => 'password', + }, + }); +} + +1; |