From 6d76521656e91daa160bc8019828f1b68d7aa5dc Mon Sep 17 00:00:00 2001 From: Niko Tyni Date: Sun, 13 Feb 2005 19:23:04 +0000 Subject: Moved probes, matchers and ciscoRttMonMIB modules to lib/Smokeping. --- lib/Smokeping/ciscoRttMonMIB.pm | 111 +++++++ lib/Smokeping/matchers/avgratio.pm | 148 ++++++++++ lib/Smokeping/matchers/base.pm | 127 ++++++++ lib/Smokeping/matchers/median.pm | 80 ++++++ lib/Smokeping/probes/AnotherDNS.pm | 157 ++++++++++ lib/Smokeping/probes/AnotherSSH.pm | 238 +++++++++++++++ lib/Smokeping/probes/CiscoRTTMonDNS.pm | 294 +++++++++++++++++++ lib/Smokeping/probes/CiscoRTTMonEchoICMP.pm | 322 +++++++++++++++++++++ lib/Smokeping/probes/CiscoRTTMonTcpConnect.pm | 305 ++++++++++++++++++++ lib/Smokeping/probes/Curl.pm | 218 ++++++++++++++ lib/Smokeping/probes/DNS.pm | 136 +++++++++ lib/Smokeping/probes/EchoPing.pm | 282 ++++++++++++++++++ lib/Smokeping/probes/EchoPingChargen.pm | 65 +++++ lib/Smokeping/probes/EchoPingDiscard.pm | 59 ++++ lib/Smokeping/probes/EchoPingHttp.pm | 143 +++++++++ lib/Smokeping/probes/EchoPingHttps.pm | 65 +++++ lib/Smokeping/probes/EchoPingIcp.pm | 88 ++++++ lib/Smokeping/probes/EchoPingSmtp.pm | 75 +++++ lib/Smokeping/probes/FPing.pm | 184 ++++++++++++ lib/Smokeping/probes/FPing6.pm | 58 ++++ lib/Smokeping/probes/IOSPing.pm | 262 +++++++++++++++++ lib/Smokeping/probes/LDAP.pm | 235 +++++++++++++++ lib/Smokeping/probes/Radius.pm | 248 ++++++++++++++++ lib/Smokeping/probes/RemoteFPing.pm | 122 ++++++++ lib/Smokeping/probes/SSH.pm | 124 ++++++++ lib/Smokeping/probes/base.pm | 400 ++++++++++++++++++++++++++ lib/Smokeping/probes/basefork.pm | 266 +++++++++++++++++ lib/Smokeping/probes/basevars.pm | 102 +++++++ lib/Smokeping/probes/passwordchecker.pm | 148 ++++++++++ lib/Smokeping/probes/skel.pm | 134 +++++++++ lib/Smokeping/probes/telnetIOSPing.pm | 283 ++++++++++++++++++ 31 files changed, 5479 insertions(+) create mode 100644 lib/Smokeping/ciscoRttMonMIB.pm create mode 100644 lib/Smokeping/matchers/avgratio.pm create mode 100644 lib/Smokeping/matchers/base.pm create mode 100644 lib/Smokeping/matchers/median.pm create mode 100644 lib/Smokeping/probes/AnotherDNS.pm create mode 100644 lib/Smokeping/probes/AnotherSSH.pm create mode 100644 lib/Smokeping/probes/CiscoRTTMonDNS.pm create mode 100644 lib/Smokeping/probes/CiscoRTTMonEchoICMP.pm create mode 100644 lib/Smokeping/probes/CiscoRTTMonTcpConnect.pm create mode 100644 lib/Smokeping/probes/Curl.pm create mode 100644 lib/Smokeping/probes/DNS.pm create mode 100644 lib/Smokeping/probes/EchoPing.pm create mode 100644 lib/Smokeping/probes/EchoPingChargen.pm create mode 100644 lib/Smokeping/probes/EchoPingDiscard.pm create mode 100644 lib/Smokeping/probes/EchoPingHttp.pm create mode 100644 lib/Smokeping/probes/EchoPingHttps.pm create mode 100644 lib/Smokeping/probes/EchoPingIcp.pm create mode 100644 lib/Smokeping/probes/EchoPingSmtp.pm create mode 100644 lib/Smokeping/probes/FPing.pm create mode 100644 lib/Smokeping/probes/FPing6.pm create mode 100644 lib/Smokeping/probes/IOSPing.pm create mode 100644 lib/Smokeping/probes/LDAP.pm create mode 100644 lib/Smokeping/probes/Radius.pm create mode 100644 lib/Smokeping/probes/RemoteFPing.pm create mode 100644 lib/Smokeping/probes/SSH.pm create mode 100644 lib/Smokeping/probes/base.pm create mode 100644 lib/Smokeping/probes/basefork.pm create mode 100644 lib/Smokeping/probes/basevars.pm create mode 100644 lib/Smokeping/probes/passwordchecker.pm create mode 100644 lib/Smokeping/probes/skel.pm create mode 100644 lib/Smokeping/probes/telnetIOSPing.pm (limited to 'lib/Smokeping') 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 + +=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 + +=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 + +=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 + +to view the documentation or the command + +C + +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', +Christoph Heine +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 => < 'www.example.org', + }, + mininterval => { + _doc => < .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 + +to view the documentation or the command + +C + +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', +Christoph Heine +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 => < "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 => < 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 + +to view the documentation or the command + +C + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::basefork); +use Symbol; +use Carp; +use BER; +use SNMP_Session; +use SNMP_util "0.97"; +use Smokeping::ciscoRttMonMIB "0.2"; + +my $e = "="; +sub pod_hash { + return { + name => < < < < < <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 => < 'RTTcommunity@Myrouter.foobar.com.au', + }, + name => { + _doc => "The (mandatory) name parameter is the DNS name to resolve.", + _example => 'www.foobar.com.au', + }, + iosint => { + _doc => < '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 + +to view the documentation or the command + +C + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::basefork); +use Symbol; +use Carp; +use BER; +use SNMP_Session; +use SNMP_util "0.97"; +use Smokeping::ciscoRttMonMIB "0.2"; + +sub pod_hash { + my $e = "="; + return { + name => < < < < < <SUPER::new(@_); + + # no need for this if we run as a cgi + unless ( $ENV{SERVER_SOFTWARE} ) { + $self->{pingfactor} = 1000; + }; + return $self; +} + +sub ProbeDesc($){ + my $self = shift; + my $bytes = $self->{properties}{packetsize}; + return "CiscoRTTMonEchoICMP ($bytes Bytes)"; +} + +sub pingone ($$) { + my $self = shift; + my $target = shift; + + my $pings = $self->pings($target) || 20; + my $tos = $target->{vars}{tos}; + my $bytes = $target->{properties}{packetsize}; + + # use the proces ID as as row number to make this poll distinct on the router; + my $row=$$; + + if (defined + StartRttMibEcho($target->{vars}{ioshost}.":::::2", $target->{addr}, + $bytes, $pings, $target->{vars}{iosint}, $tos, $row)) + { + # wait for the series to finish + sleep ($pings*$pingtimeout+5); + if (my @times=FillTimesFromHistoryTable($target->{vars}{ioshost}.":::::2", $pings, $row)){ + DestroyData ($target->{vars}{ioshost}.":::::2", $row); + return @times; + } + else { + return(); + } + } + else { + return (); + } +} + +sub StartRttMibEcho ($$$$$$){ + my ($host, $target, $size, $pings, $sourceip, $tos, $row) = @_; + + # resolve the target name and encode its IP address + $_=$target; + if (!/^([0-9]|\.)+/) { + (my $name, my $aliases, my $addrtype, my $length, my @addrs) = gethostbyname ($target); + $target=join('.',(unpack("C4",$addrs[0]))); + } + my @octets=split(/\./,$target); + my $encoded_target= pack ("CCCC", @octets); + + # resolve the source name and encode its IP address + my $encoded_source = undef; + if (defined $sourceip) { + $_=$sourceip; + if (!/^([0-9]|\.)+/) { + (my $name, my $aliases, my $addrtype, my $length, my @addrs) = gethostbyname ($sourceip); + $sourceip=join('.',(unpack("C4",$addrs[0]))); + } + my @octets=split(/\./,$sourceip); + $encoded_source= pack ("CCCC", @octets); + } + + ############################################################# + # rttMonCtrlAdminStatus - 1:active 2:notInService 3:notReady 4:createAndGo 5:createAndWait 6:destroy + #delete data from former measurements + #return undef unless defined + # &snmpset($host, "rttMonCtrlAdminStatus.$row",'integer', 6); + + ############################################################# + # Check RTTMon version and supported protocols + $SNMP_Session::suppress_warnings = 10; # be silent + (my $version)=&snmpget ($host, "rttMonApplVersion"); + if (! defined $version ) { + Smokeping::do_log ("$host doesn't support or allow RTTMon !\n"); + return undef; + } + Smokeping::do_log ("$host supports $version\n"); + $SNMP_Session::suppress_warnings = 0; # report errors + + # echo(1), pathEcho(2), fileIO(3), script(4), udpEcho(5), tcpConnect(6), http(7), + # dns(8), jitter(9), dlsw(10), dhcp(11), ftp(12) + my $udpEchoSupported=0==1; + snmpmaptable ($host, + sub () { + my ($proto, $supported) = @_; + # 1 is true , 2 is false + $udpEchoSupported=0==0 if ($proto==5 && $supported==1); + }, + "rttMonApplSupportedRttTypesValid"); + + ############################################################# + #setup the new data row + + my @params=(); + push @params, + "rttMonCtrlAdminStatus.$row", 'integer', 5, + "rttMonCtrlAdminRttType.$row", 'integer', 1, + "rttMonEchoAdminProtocol.$row", 'integer', 2, + "rttMonEchoAdminTargetAddress.$row", 'octetstring', $encoded_target, + "rttMonCtrlAdminTimeout.$row", 'integer', $pingtimeout*1000, + "rttMonCtrlAdminFrequency.$row", 'integer', $pingtimeout, + "rttMonHistoryAdminNumBuckets.$row", 'integer', $pings, + "rttMonHistoryAdminNumLives.$row", 'integer', 1, + "rttMonHistoryAdminFilter.$row", 'integer', 2, + "rttMonEchoAdminPktDataRequestSize.$row",'integer', $size-8, + "rttMonScheduleAdminRttStartTime.$row", 'timeticks', 1, + "rttMonScheduleAdminRttLife.$row", 'integer', $pings*$pingtimeout+3, + "rttMonScheduleAdminConceptRowAgeout.$row",'integer', 60; + + # with udpEcho support (>= 12.0(3)T ) the ICMP ping support was enhanced in the RTTMon SW - we are + # NOT using udpEcho, but echo (ICMP echo, ping) + if ($udpEchoSupported) { + push @params, "rttMonEchoAdminTOS.$row", 'integer', $tos; + push @params, "rttMonCtrlAdminNvgen.$row", 'integer', 2; + + # the router (or this script) doesn't check whether the IP address is one of + # the router's IP address, i.e. the router might send packets, but never + # gets ping replies.. + if (defined $sourceip) { + push @params, "rttMonEchoAdminSourceAddress.$row", 'octetstring', $encoded_source; + } + } + else { + Smokeping::do_log ("Warning this host does not support ToS or iosint\n"); + } + + return undef unless defined + &snmpset($host, @params); + + ############################################################# + # and go ! + return undef unless defined + &snmpset($host, "rttMonCtrlAdminStatus.$row",'integer',1); + + return 1; +} + + +# RttResponseSense values +# 1:ok 2:disconnected 3:overThreshold 4:timeout 5:busy 6:notConnected 7:dropped 8:sequenceError +# 9:verifyError 10:applicationSpecific 11:dnsServerTimeout 12:tcpConnectTimeout 13:httpTransactionTimeout +#14:dnsQueryError 15:httpError 16:error + +sub FillTimesFromHistoryTable($$$$) { + my ($host, $pings, $row) = @_; + my @times; + + # snmpmaptable walks two tables (of equal size) + # - "rttMonHistoryCollectionCompletionTime.$row", + # - "rttMonHistoryCollectionSense.$row" + # The code in the sub() argument is executed for each index value snmptable walks + snmpmaptable ($host, + sub () { + my ($index, $rtt, $status) = @_; + push @times, (sprintf ("%.10e", $rtt/1000)) + if ($status==1); + }, + "rttMonHistoryCollectionCompletionTime.$row", + "rttMonHistoryCollectionSense.$row"); + + return sort { $a <=> $b } @times; +} + +sub DestroyData ($$) { + my ($host, $row) = @_; + + &snmpset($host, "rttMonCtrlOperState.$row", 'integer', 3); + &snmpset($host, "rttMonCtrlAdminStatus.$row", 'integer', 2); + #delete any old config + &snmpset($host, "rttMonCtrlAdminStatus.$row", 'integer', 6); +} + +sub probevars { + my $class = shift; + return $class->_makevars($class->SUPER::probevars, { + packetsize => { + _doc => < 56, + _re => '\d+', + _sub => sub { + my $val = shift; + return "ERROR: packetsize must be between 8 and 16392" + unless $val >= 8 and $val <= 16392; + return undef; + }, + }, + }); +} + +sub targetvars { + my $class = shift; + return $class->_makevars($class->SUPER::targetvars, { + _mandatory => [ 'ioshost' ], + ioshost => { + _example => 'RTTcommunity@Myrouter.foobar.com.au', + _doc => < { + _example => '10.33.22.11', + _doc => < { + _example => 160, + _default => 0, + _doc => < + +to view the documentation or the command + +C + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::basefork); +use Symbol; +use Carp; +use BER; +use SNMP_Session; +use SNMP_util "0.97"; +use Smokeping::ciscoRttMonMIB "0.2"; + +sub pod_hash { + my $e = "="; + return { + name => < < < < < <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 => < { + _default => 80, + _re => '\d+', + _doc => < { + _example => '10.33.22.11', + _doc => < { + _default => 0, + _example => 160, + _re => '\d+', + _doc => < + +to view the documentation or the command + +C + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::basefork); +use Carp; + +my $DEFAULTBIN = "/usr/bin/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 + Niko Tyni +DOC + notes => < "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 => < '"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 => < 'eth0', + }, + ssl2 => { + _doc => qq{The "-2" curl(1) option. Force SSL2.}, + _example => 1, + }, + urlformat => { + _doc => < "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 (

) { + /^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 + +to view the documentation or the command + +C + +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 => < < 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 , + Carl Elkins , + Andre Stolze , + Niko Tyni , + Chris Poetzel +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 + +to view the documentation or the command + +C + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::basefork); +use Carp; + +my $DEFAULTBIN = "/usr/bin/echoping"; + +sub pod_hash { + return { + name => < < < < <<'DOC', +Niko Tyni +DOC + see_also => < "-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 (

) { + $echoret .= $_; + /^Elapsed time: (\d+\.\d+) seconds/ and push @times, $1; + } + close P; + $self->do_log("WARNING: $cmd was not happy: $echoret") if $?; + # carp("Got @times") if $self->debug; + return sort { $a <=> $b } @times; +} + +sub probevars { + my $class = shift; + my $h = $class->SUPER::probevars; + delete $h->{timeout}; + return $class->_makevars($h, { + binary => { + _doc => "The location of your echoping binary.", + _default => $DEFAULTBIN, + _sub => sub { + my $val = shift; + -x $val or return "ERROR: binary '$val' is not executable"; + return undef; + }, + }, + }); +} + +sub targetvars { + my $class = shift; + return $class->_makevars($class->SUPER::targetvars, { + timeout => { + _doc => 'The "-t" echoping(1) option.', + _example => 1, + _default => 5, + _re => '(\d*\.)?\d+', + }, + waittime => { + _doc => 'The "-w" echoping(1) option.', + _example => 1, + _re => '\d+', + }, + size => { + _doc => 'The "-s" echoping(1) option.', + _example => 510, + _re => '\d+', + }, + udp => { + _doc => q{The "-u" echoping(1) option. Values other than '0' and 'no' enable UDP.}, + _example => 'no', + }, + fill => { + _doc => 'The "-f" echoping(1) option.', + _example => 'A', + _re => '.', + }, + priority => { + _doc => 'The "-p" echoping(1) option.', + _example => 6, + _re => '\d+', + }, + tos => { + _doc => 'The "-P" echoping(1) option.', + _example => '0xa0', + }, + ipversion => { + _doc => < 4, + _re => '[46]' + }, + extraopts => { + _doc => 'Any extra options specified here will be passed unmodified to echoping(1).', + _example => '-some-letter-the-author-did-not-think-of', + }, + }); +} + +1; 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 + +to view the documentation or the command + +C + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::EchoPing); +use Carp; + +sub pod_hash { + return { + name => < < < variable is not supported. +DOC + authors => <<'DOC', +Niko Tyni +DOC + see_also => <{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 + +to view the documentation or the command + +C + +to generate the POD document. + +=cut + +sub pod_hash { + return { + name => < < <<'DOC', +Niko Tyni +DOC + see_also => <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 + +to view the documentation or the command + +C + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::EchoPing); +use Carp; + +sub pod_hash { + return { + name => < < <, I and I EchoPing variables are not valid for EchoPingHttp. +DOC + authors => <<'DOC', +Niko Tyni +DOC + see_also => <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 => < '/', + }, + port => { + _doc => 'The TCP port to use.', + _example => 80, + _re => '\d+', + }, + ignore_cache => { + _doc => < 'yes', + }, + revalidate_data => { + _doc => < '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 + +to view the documentation or the command + +C + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::EchoPingHttp); +use Carp; + +sub pod_hash { + return { + name => < < < <<'DOC', +Niko Tyni +DOC + see_also => <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 + +to view the documentation or the command + +C + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::EchoPing); +use Carp; + +sub pod_hash { + return { + name => < < <, I and I EchoPing variables are not valid. +DOC + authors => <<'DOC', +Niko Tyni +DOC + see_also => <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 + +to view the documentation or the command + +C + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::EchoPing); +use Carp; + +sub pod_hash { + return { + name => < < <, I and I EchoPing variables are not valid. +DOC + authors => <<'DOC', +Niko Tyni +DOC + see_also => <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 + +to view the documentation or the command + +C + +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 => < < 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 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 +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 => < { + _re => '(\d*\.)?\d+', + _example => 1, + _default => 10, + _doc => < + +to view the documentation or the command + +C + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::FPing); + +sub pod_hash { + return { + name => < < <<'DOC', +Tobias Oetiker + +Niko Tyni +DOC + see_also => <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 + +to view the documentation or the command + +C + +to generate the POD document. + +=cut + +use strict; +use base qw(Smokeping::probes::basefork); +use IPC::Open2; +use Symbol; +use Carp; + +my $e = "="; + +sub pod_hash { + return { + name => < < < <<'DOC', +Paul J Murphy + +based on Smokeping::probes::FPing by + +Tobias Oetiker +DOC + } +} + +sub new($$$) +{ + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(@_); + + # no need for this if we run as a cgi + unless ( $ENV{SERVER_SOFTWARE} ) { + $self->{pingfactor} = 1000; # Gives us a good-guess default + print "### assuming you are using an IOS reporting in miliseconds\n"; + }; + + return $self; +} + +sub ProbeDesc($){ + my $self = shift; + my $bytes = $self->{properties}{packetsize}; + return "Cisco IOS - ICMP Echo Pings ($bytes Bytes)"; +} + +sub pingone ($$){ + my $self = shift; + my $target = shift; + my $bytes = $self->{properties}{packetsize}; + # do NOT call superclass ... the ping method MUST be overwriten + my %upd; + my $inh = gensym; + my $outh = gensym; + my @args = (); + my $pings = $self->pings($target); + + push(@args,$self->{properties}{binary}); + push(@args,'-l',$target->{vars}{iosuser}) + if defined $target->{vars}{iosuser}; + push(@args,$target->{vars}{ioshost}); + push(@args,'ping'); + + my $pid = open2($outh,$inh,@args); + # + # The following comments are the dialog produced by + # "remsh ping" to a Cisco 800 series running IOS 12.2T + # + # Other hardware or versions of IOS may need adjustments here. + # + # Protocol [ip]: + print { $inh } "\n"; + # Target IP address: + print { $inh } $target->{addr},"\n"; + # Repeat count [5]: + print { $inh } $pings,"\n"; + # Datagram size [100]: + print { $inh } $bytes,"\n"; + # Timeout in seconds [2]: + print { $inh } "\n"; + # Extended commands [n]: + print { $inh } "y\n"; + # Source address or interface: + print { $inh } "".($target->{vars}{iosint} || "") ,"\n"; + # Added by Mars Wei to make + # Source address an option + # Type of service [0]: + print { $inh } "\n"; + # Set DF bit in IP header? [no]: + print { $inh } "\n"; + # Validate reply data? [no]: + print { $inh } "\n"; + # Data pattern [0xABCD]: + print { $inh } "\n"; + # Loose, Strict, Record, Timestamp, Verbose[none]: + print { $inh } "V\n"; + # Loose, Strict, Record, Timestamp, Verbose[V]: + print { $inh } "\n"; + # Sweep range of sizes [n]: + print { $inh } "\n"; + # + # Type escape sequence to abort. + # Sending 20, 56-byte ICMP Echos to 192.168.1.2, timeout is 2 seconds: + # Reply to request 0 (4 ms) + # Reply to request 1 (4 ms) + # Reply to request 2 (4 ms) + # Reply to request 3 (1 ms) + # Reply to request 4 (1 ms) + # Reply to request 5 (1 ms) + # Reply to request 6 (4 ms) + # Reply to request 7 (4 ms) + # Reply to request 8 (4 ms) + # Reply to request 9 (4 ms) + # Reply to request 10 (1 ms) + # Reply to request 11 (1 ms) + # Reply to request 12 (1 ms) + # Reply to request 13 (1 ms) + # Reply to request 14 (4 ms) + # Reply to request 15 (4 ms) + # Reply to request 16 (4 ms) + # Reply to request 17 (4 ms) + # Reply to request 18 (1 ms) + # Reply to request 19 (1 ms) + # Success rate is 100 percent (20/20), round-trip min/avg/max = 1/2/4 ms + + my @times = (); + while (<$outh>){ + chomp; + /^Reply to request \d+ \((\d+) ms\)/ && push(@times,$1); + } + @times = map {sprintf "%.10e", $_ / $self->{pingfactor}} sort {$a <=> $b} @times; + + waitpid $pid,0; + close $inh; + close $outh; + + return @times; +} + +sub probevars { + my $class = shift; + return $class->_makevars($class->SUPER::probevars, { + _mandatory => ['binary'], + binary => { + _doc => < '/usr/bin/rsh', + _sub => sub { + my $val = shift; + -x $val or return "ERROR: binary '$val' is not executable"; + return undef; + }, + }, + packetsize => { + _doc => < 56, + _re => '\d+', + _sub => sub { + my $val = shift; + return "ERROR: packetsize must be between 12 and 64000" + unless $val >= 12 and $val <= 64000; + return undef; + }, + }, + }); +} + +sub targetvars { + my $class = shift; + return $class->_makevars($class->SUPER::targetvars, { + _mandatory => [ 'ioshost' ], + ioshost => { + _doc => < 'my.cisco.router', + }, + iosuser => { + _doc => < 'admin', + }, + iosint => { + _doc => < 'Ethernet 1/0', + }, + }); +} + +1; 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 + +to view the documentation or the command + +C + +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 => < < <::') + +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 +DOC + bugs => <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 .", + _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 + +to view the documentation or the command + +C + +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 => < < <::') + +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 ` '. 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 +DOC + bugs => <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 () { + 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 => < '. 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 + +to view the documentation or the command + +C + +to generate the POD document. + +=cut + +sub pod_hash { + return { + name => < < must point to your copy of the ssh/rsh program. +The variable B 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, B and B 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 + + Niko Tyni + + derived from Smokeping::probes::FPing by + + Tobias Oetiker +DOC + bugs => <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 => < '/usr/bin/ssh', + _sub => sub { + my $val = shift; + -x $val or return "ERROR: binary '$val' is not executable"; + return undef; + }, + }, + rhost => { + _doc => < option specifies the remote device from where fping will +be launched. +DOC + _example => 'my.pinger.host', + }, + ruser => { + _doc => < 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 + +to view the documentation or the command + +C + +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 => < < 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 +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 + +to view the documentation or the command + +C + +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', +Tobias Oetiker +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 = ); + close D; + + if ( open D, "<$target.snmp" ) { + my $snmp = ; + 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 => < { + _re => '(\d+%|random)', + _re_error => + "Use offset either in % of operation interval or 'random'", + _example => '50%', + _doc => < { + _re => '\d+', + _example => 20, + _doc => < [], + }; +} + +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 = <_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 .= <{_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 + +to view the documentation or the command + +C + +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 => < < < method that forks the requested number of concurrent +processes and calls the B method that derived classes must provide. + +The B 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(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 +DOC + see_also => <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 => <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 + +to view the documentation or the command + +C + +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', +Niko Tyni +DOC + bugs => < <{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 + +to view the documentation or the command + +C + +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 => < < < 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 +DOC + + bugs => < <_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 (

) { + 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 + +to view the documentation or the command + +C + +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 => < < +document for more information. +DOC + authors => <<'DOC', + Niko Tyni , +DOC + see_also => < 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 (

) { + # /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 + +to view the documentation or the command + +C + +to generate the POD document. + +=cut + +use strict; + +use base qw(Smokeping::probes::basefork); +use Net::Telnet (); +use Carp; + +my $e = "="; +sub pod_hash { + return { + name => < < < <<'DOC', +John A Jackson + +based HEAVILY on Smokeping::probes::IOSPing by + +Paul J Murphy + +based on Smokeping::probes::FPing by + +Tobias Oetiker +DOC + } +} + +sub new($$$) +{ + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(@_); + + # no need for this if we run as a cgi + unless ( $ENV{SERVER_SOFTWARE} ) { + $self->{pingfactor} = 1000; # Gives us a good-guess default + print "### assuming you are using an IOS reporting in miliseconds\n"; + }; + + return $self; +} + +sub ProbeDesc($){ + my $self = shift; + my $bytes = $self->{properties}{packetsize}; + return "InfoAve Cisco IOS - ICMP Echo Pings ($bytes Bytes)"; +} + +sub pingone ($$){ + my $self = shift; + my $target = shift; + my $source = $target->{vars}{source}; + my $dest = $target->{vars}{host}; + my $psource = $target->{vars}{psource} || ""; + my $port = 23; + my @output = (); + my $login = $target->{vars}{iosuser}; + my $pssword = $target->{vars}{iospass}; + my $bytes = $self->{properties}{packetsize}; + my $pings = $self->pings($target); + + # do NOT call superclass ... the ping method MUST be overwriten + my %upd; + my @args = (); + + + my $telnet = new Net::Telnet; +# These are for debugging +# $telnet->errmode("TIPreturn"); +# $telnet->input_log("TIPinlog"); +# $telnet->dump_log("TIPdumplog"); + +#Open the Connection to the router +# open(OUTF,">outfile.IA") || die "Can't open OUTF: $!"; +# print OUTF "target => $dest\nsource => $source\nuser => $login\n"; + my $ok = $telnet->open(Host => $source, + Port => $port); +# print OUTF "Connection is a $ok\n"; + + #Authenticate + $telnet->waitfor('/(ogin|name|word):.*$/'); + $telnet->print("$login"); + $telnet->waitfor('/word:.*$/'); + $telnet->print("$pssword"); + #Do the work + $telnet->waitfor('/[\@\w\-\.]+[>#][ ]*$/'); + $telnet->print("terminal length 0"); + $telnet->waitfor('/[\@\w\-\.]+[>#][ ]*$/'); + $telnet->print("ping"); + $telnet->waitfor('/Protocol \[ip\]: $/'); + $telnet->print(""); + $telnet->waitfor('/Target IP address: $/'); + $telnet->print("$dest"); + $telnet->waitfor('/Repeat count \[5\]: $/'); + $telnet->print($pings); + $telnet->waitfor('/Datagram size \[100\]: $/'); + $telnet->print("$bytes"); + $telnet->waitfor('/Timeout in seconds \[2\]: $/'); + $telnet->print(""); + $telnet->waitfor('/Extended commands \[n\]: $/'); + $telnet->print("y"); + $telnet->waitfor('/Source address or interface: $/'); + $telnet->print("$psource"); + $telnet->waitfor('/Type of service \[0\]: $/'); + $telnet->print(""); + $telnet->waitfor('/Set DF bit in IP header\? \[no\]: $/'); + $telnet->print(""); + $telnet->waitfor('/Validate reply data\? \[no\]: $/'); + $telnet->print(""); + $telnet->waitfor('/Data pattern \[0xABCD\]: $/'); + $telnet->print(""); + $telnet->waitfor('/Loose, Strict, Record, Timestamp, Verbose\[none\]: $/'); + $telnet->print("v"); + $telnet->waitfor('/Loose, Strict, Record, Timestamp, Verbose\[V\]: $/'); + $telnet->print(""); + $telnet->waitfor('/Sweep range of sizes.+$/'); + + $telnet->prompt('/[\@\w\-\.]+[>#][ ]*$/'); + @output = $telnet->cmd("n"); + + #$telnet->waitfor('/[\@\w\-\.]+[>#][ ]*$/'); + $telnet->print("quit"); + $telnet->close; +# print OUTF "closed Telnet connection\n"; + + my @times = (); + while (@output) { + my $outputline = shift @output; + chomp($outputline); +# print OUTF "$outputline\n"; + $outputline =~ /^Reply to request \d+ \((\d+) ms\)/ && push(@times,$1); + #print OUTF "$outputline => $1\n"; + } + @times = map {sprintf "%.10e", $_ / $self->{pingfactor}} sort {$a <=> $b} @times; +# close(OUTF); + return @times; +} + +sub probevars { + my $class = shift; + return $class->_makevars($class->SUPER::probevars, { + packetsize => { + _doc => < 56, + _re => '\d+', + _sub => sub { + my $val = shift; + return "ERROR: packetsize must be between 12 and 64000" + unless $val >= 12 and $val <= 64000; + return undef; + }, + }, + }); +} + +sub targetvars { + my $class = shift; + return $class->_makevars($class->SUPER::targetvars, { + _mandatory => [ 'iosuser', 'iospass', 'source' ], + source => { + _doc => < "192.168.2.1", + }, + psource => { + _doc => < "192.168.2.129", + }, + iosuser => { + _doc => < 'user', + }, + iospass => { + _doc => < 'password', + }, + }); +} + +1; -- cgit v1.2.3-24-g4f1b