gru/smokeping_2.9.0
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

commit

Browse Source
This commit is contained in:
root
2025-11-07 11:31:06 +00:00
commit 2859f93882
407 changed files with 99769 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

148
debian/smokeping/usr/share/perl5/Smokeping/matchers/Avgratio.pm vendored Normal file
View File

@@ -0,0 +1,148 @@
package Smokeping::matchers::Avgratio;
=head1 NAME
Smokeping::matchers::Avgratio - detect changes in average median latency
=head1 OVERVIEW
The Avgratio matcher establishes a historic average median latency over
several measurement rounds. It compares this average, against a second
average latency value again build over several rounds of measurement.
=head1 DESCRIPTION
Call the matcher with the following sequence:
type = matcher
pattern = Avgratio(historic=>a,current=>b,comparator=>o,percentage=>p)
=over
=item historic
The number of median values to use for building the 'historic' average.
=item current
The number of median values to use for building the 'current' average.
=item comparator
Which comparison operator should be used to compare current/historic with percentage.
=item percentage
Right hand side of the comparison.
=back
old <--- historic ---><--- current ---> now
=head1 EXAMPLE
Take build the average median latency over 10 samples, use this to divide the
current average latency built over 2 samples and check if it is bigger than
150%.
Avgratio(historic=>10,current=>2,comparator=>'>',percentage=>150);
avg(current)/avg(historic) > 150/100
This means the matcher will activate when the current latency average is
more than 1.5 times the historic latency average established over the last
10 rounds of measurement.
=head1 COPYRIGHT
Copyright (c) 2004 by OETIKER+PARTNER AG. All rights reserved.
=head1 SPONSORSHIP
The development of this matcher has been sponsored by Virtela Communications, L<http://www.virtela.net/>.
=head1 LICENSE
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
=head1 AUTHOR
Tobias Oetiker <tobi@oetiker.ch>
=cut
use vars qw($VERSION);
$VERSION = 1.0;
use strict;
use base qw(Smokeping::matchers::base);
use Carp;
sub new(@)
{
my $class = shift;
my $rules = {
historic=>'\d+',
current=>'\d+',
comparator=>'(<|>|<=|>=|==)',
percentage=>'\d+(\.\d+)?' };
my $self = $class->SUPER::new($rules,@_);
$self->{param}{sub} = eval "sub {\$_[0] ".$self->{param}{comparator}." \$_[1]}";
croak "compiling comparator $self->{param}{comparator}: $@" if $@;
$self->{param}{value} = $self->{param}{percentage}/100;
return $self;
}
sub Length($)
{
my $self = shift;
return $self->{param}{historic} + $self->{param}{current};
}
sub Desc ($) {
croak "Detect changes in average median latency";
}
sub avg(@){
my $sum=0;
my $cnt=0;
for (@_){
next unless defined $_;
$sum += $_;
$cnt ++;
}
return $sum/$cnt if $cnt;
return undef;
}
sub Test($$)
{ my $self = shift;
my $data = shift; # @{$data->{rtt}} and @{$data->{loss}}
my $len = $self->Length;
my $rlen = scalar @{$data->{rtt}};
return undef
if $rlen < $len
or (defined $data->{rtt}[-$len] and $data->{rtt}[-$len] eq 'S');
my $ac = $self->{param}{historic};
my $bc = $self->{param}{current};
my $cc = $ac +$bc;
my $ha = avg(@{$data->{rtt}}[-$cc..-$bc-1]);
my $ca = avg(@{$data->{rtt}}[-$bc..-1]);
return undef unless $ha and $ca;
return &{$self->{param}{sub}}($ca/$ha,$self->{param}{value});
}

102
debian/smokeping/usr/share/perl5/Smokeping/matchers/CheckLatency.pm vendored Normal file
View File

@@ -0,0 +1,102 @@
package Smokeping::matchers::CheckLatency;
=head1 NAME
Smokeping::matchers::CheckLatency - Edge triggered alert to check latency is under a value for x number of samples
=head1 DESCRIPTION
Call the matcher with the following sequence:
type = matcher
edgetrigger = yes
pattern = CheckLatency(l=>latency to check against,x=>num samples required for a match)
This will create a matcher which checks for "l" latency or greater over "x" samples before raising,
and will hold the alert until "x" samples under "l" before clearing
=head1 COPYRIGHT
Copyright (c) 2006 Dylan C Vanderhoof, Semaphore Corporation
=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
Dylan Vanderhoof <dylanv@semaphore.com>
=cut
use strict;
use base qw(Smokeping::matchers::base);
use vars qw($VERSION);
$VERSION = 1.0;
use Carp;
use List::Util qw(min max);
# I never checked why Median works, but for some reason the first part of the hash was being passed as the rules instead
sub new(@) {
my $class = shift;
my $rules = {
l => '\d+',
x => '\d+'
};
my $self = $class->SUPER::new( $rules, @_ );
return $self;
}
# how many values should we require before raising?
sub Length($) {
my $self = shift;
return $self->{param}{x}; # Because we're edge triggered, we don't need any more than the required samples
}
sub Desc ($) {
croak "Monitor latency with a cooldown period for clearing the alert";
}
sub Test($$) {
my $self = shift;
my $data = shift; # @{$data->{rtt}} and @{$data->{loss}}
my $target = $self->{param}{l} / 1000; # Smokeping reports in seconds
my $count = 0;
my $rtt;
my @rtts = @{ $data->{rtt} };
my $x = min($self->{param}{x}, scalar @{ $data->{rtt} });
#Iterate thru last x number of samples, starting with the most recent
for (my $i=1;$i<=$x;$i++) {
$rtt = $data->{rtt}[$_-$i];
# If there's an S in the array anywhere, return prevmatch
if ( $rtt =~ /S/ ) { return $data->{prevmatch}; }
if ( $data->{prevmatch} ) {
# Alert has already been raised. Evaluate and count consecutive rtt values that are below threshold.
if ( $rtt < $target ) { $count++; }
} else {
# Alert is not raised. Evaluate and count consecutive rtt values that are above threshold.
if ( $rtt >= $target ) { $count++; }
}
}
if ( $count >= $self->{param}{x} ) {
return !$data->{prevmatch};
}
return $data->{prevmatch};
}

100
debian/smokeping/usr/share/perl5/Smokeping/matchers/CheckLoss.pm vendored Normal file
View File

@@ -0,0 +1,100 @@
package Smokeping::matchers::CheckLoss;
=head1 NAME
Smokeping::matchers::CheckLoss - Edge triggered alert to check loss is under a value for x number of samples
=head1 DESCRIPTION
Call the matcher with the following sequence:
type = matcher
edgetrigger = yes
pattern = CheckLoss(l=>loss to check against,x=>num samples required for a match)
This will create a matcher which checks for "l" loss or greater over "x" samples before raising,
and will hold the alert until "x" samples under "l" before clearing
=head1 COPYRIGHT
Copyright (c) 2006 Dylan C Vanderhoof, Semaphore Corporation
=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
Dylan Vanderhoof <dylanv@semaphore.com>
=cut
use strict;
use base qw(Smokeping::matchers::base);
use vars qw($VERSION);
$VERSION = 1.0;
use Carp;
use List::Util qw(min max);
# I never checked why Median works, but for some reason the first part of the hash was being passed as the rules instead
sub new(@) {
my $class = shift;
my $rules = {
l => '\d+',
x => '\d+'
};
my $self = $class->SUPER::new( $rules, @_ );
return $self;
}
# how many values should we require before raising?
sub Length($) {
my $self = shift;
return $self->{param}{x}; # Because we're edge triggered, we don't need any more than the required samples
}
sub Desc ($) {
croak "Monitor loss with a cooldown period for clearing the alert";
}
sub Test($$) {
my $self = shift;
my $data = shift; # @{$data->{rtt}} and @{$data->{loss}}
my $target = $self->{param}{l};
my $count = 0;
my $loss;
my $x = min($self->{param}{x}, scalar @{ $data->{loss} });
#Iterate thru last x number of samples, starting with the most recent
for (my $i=1;$i<=$x;$i++) {
$loss = $data->{loss}[$_-$i];
# If there's an S in the array anywhere, return prevmatch
if ( $loss =~ /S/ ) { return $data->{prevmatch}; }
if ( $data->{prevmatch} ) {
# Alert has already been raised. Evaluate and count consecutive loss values that are below threshold.
if ( $loss < $target ) { $count++; }
} else {
# Alert is not raised. Evaluate and count consecutive loss values that are above threshold.
if ( $loss >= $target ) { $count++; }
}
}
if ( $count >= $self->{param}{x} ) {
return !$data->{prevmatch};
}
return $data->{prevmatch};
}

158
debian/smokeping/usr/share/perl5/Smokeping/matchers/ConsecutiveLoss.pm vendored Normal file
View File

@@ -0,0 +1,158 @@
package Smokeping::matchers::ConsecutiveLoss;
=head1 NAME
Smokeping::matchers::ConsecutiveLoss - Raise/clear alerts according to your choice of threshold and consecutive values
=head1 DESCRIPTION
Use this matcher to raise and clear alerts according to your choice of threshold and consecutive values.
As an example, you can raise an alert on first occurrence of 50% packet loss, but choose to hold the alert
active until packet loss stays below 10% for 5 consecutive measurements.
Add the matcher to your config file using below syntax:
type = matcher
edgetrigger = yes
pattern = ConsecutiveLoss(pctlossraise=>##,stepsraise=>##,pctlossclear=>##,stepsclear=>##)
Replace the ## with integers of your choice, see below for reference:
pctlossraise - Loss values at or above this percentage will raise an alert when...
stepsraise - ... number of consecutive values have been collected
pctlossclear - Loss values below this percentage will clear an alert when...
stepsclear - ... number of consecutive values have been collected
In my environment, I define four alerts for levels like:
+packetloss_significant_instantalert
type = matcher
pattern = ConsecutiveLoss(pctlossraise=>10,stepsraise=>1,pctlossclear=>3,stepsclear=>3)
comment = Instant alert - Significant packet loss detected (At least 10% over 1 cycle). Alert will clear when loss stays at max 2% for 3 cycles
priority = 30
+packetloss_major_instantalert
type = matcher
pattern = ConsecutiveLoss(pctlossraise=>25,stepsraise=>1,pctlossclear=>3,stepsclear=>3)
comment = Instant alert - Major packet loss detected (At least 25% over 1 cycle). Alert will clear when loss stays at max 2% for 3 cycles
priority = 20
+packetloss_significant_consecutivealert
type = matcher
pattern = ConsecutiveLoss(pctlossraise=>10,stepsraise=>3,pctlossclear=>3,stepsclear=>5)
comment = Consecutive occurrence of significant packet loss detected (At least 10% over 3 cycles). Alert will clear when loss stays at max 2% for 5 cycles.
priority = 10
+packetloss_major_consecutivealert
type = matcher
pattern = ConsecutiveLoss(pctlossraise=>25,stepsraise=>3,pctlossclear=>3,stepsclear=>5)
comment = Consecutive occurrence of significant packet loss detected (At least 25% over 3 cycles). Alert will clear when loss stays at max 2% for 5 cycles.
priority = 5
=head1 COPYRIGHT
Copyright (c) 2017 Rickard Borgmaster
=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
Rickard Borgmaster. 2017.
Based on the CheckLoss/Checklatency matchers by Dylan Vanderhoof 2006.
=cut
use strict;
use base qw(Smokeping::matchers::base);
use vars qw($VERSION);
$VERSION = 1.0;
use Carp;
use List::Util qw(min max);
# I never checked why Median works, but for some reason the first part of the hash was being passed as the rules instead
sub new(@) {
my $class = shift;
my $rules = {
pctlossraise => '\d+',
stepsraise => '\d+',
pctlossclear => '\d+',
stepsclear => '\d+'
};
my $self = $class->SUPER::new( $rules, @_ );
return $self;
}
# how many values should we require before raising?
sub Length($) {
my $self = shift;
return max($self->{param}{stepsraise},$self->{param}{stepsclear}); # Minimum number of samples required is the greater of stepsraise/stepsclear
}
sub Desc ($) {
croak "Monitor loss with a cooldown period for clearing the alert";
}
sub Test($$) {
my $self = shift;
my $data = shift; # @{$data->{rtt}} and @{$data->{loss}}
my $count = 0;
my $loss;
my $x;
my $debug = 0; # 0 will suppress debug messages
if ($debug) { print "------------------------------------------------------------------------------------------\n"; }
# Determine number of iterations for the for-loop. if we at all have enough values yet.
if ( $data->{prevmatch} ) {
# Alert state true
if (scalar @{ $data->{loss} } < $self->{param}{stepsclear}) { return $data->{prevmatch}; } # Cannot consider $stepsclear values unless so many values actually exist in array
$x = $self->{param}{stepsclear};
} else {
# Alert state false
if (scalar @{ $data->{loss} } < $self->{param}{stepsraise}) { return $data->{prevmatch}; } # Cannot consider $stepsraise values unless so many values actually exist in array
$x = $self->{param}{stepsraise};
}
if ($debug) { print "Will evaluate $x values because previous alert state= $data->{prevmatch}\n"; }
## Start iterating thru the array
for (my $i=1;$i<=$x;$i++) {
$loss = $data->{loss}[$_-$i];
# If there's an S in the array anywhere, return prevmatch. We do not have enough values yet.
if ( $loss =~ /S/ ) { return $data->{prevmatch}; }
if ( $data->{prevmatch} ) {
# Alert has already been raised. Evaluate and count consecutive loss values that are below threshold.
if ( $loss < $self->{param}{pctlossclear} ) { $count++; }
} else {
# Alert is not raised. Evaluate and count consecutive loss values that are above threshold.
if ( $loss >= $self->{param}{pctlossraise} ) { $count++; }
}
if ($debug) { print "i: $i x: $x count: $count loss: $loss previous alarm state: $data->{prevmatch}\n"; }
}
if ( $count >= $x ) { return !$data->{prevmatch} };
return $data->{prevmatch};
}

152
debian/smokeping/usr/share/perl5/Smokeping/matchers/ExpLoss.pm vendored Normal file
View File

@@ -0,0 +1,152 @@
package Smokeping::matchers::ExpLoss;
=head1 NAME
Smokeping::matchers::ExpLoss - exponential weighting matcher for packet loss
with RMON-like thresholds
=head1 DESCRIPTION
Match against exponential weighted average of last samples, thus new values
are more valuable as old ones. Two thresholds - rising and falling - produce
hysteresis loop like in RMON alert subsystem. If the average reaches the
"rising" threshold, matcher go to the "match" state and hold It until the
average drops under the "falling" threshold.
Call the matcher with the following sequence:
type = matcher
pattern = ExpLoss(hist => <hist>, rising=><rising> \
[,falling => <falling>] [,skip=><stat>] [,fast=><fast>])
Arguments:
hist - number of samples to weight against; weight will be disposed with
exponential decreasing manner from newest to oldest, so that the
oldest sample would have 1% significance;
rising - rising threshold for packet loss, 0-100%
falling - falling threshold for packet loss, default is <rising>
skip - skip <skip> number of samples after startup before "fire" alerts.
fast - use <fast> samples for fast transition: if the values of last <fast>
samples more then <rising> - take "match" state, if less then
<falling> - take "no match" state.
Note:
If the actual history is less then <hist> value then this value is taken
as the actual history.
=head1 COPYRIGHT
Copyright (c) 2008 Veniamin Konoplev
Developed in cooperation with EU EGEE project
=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
Veniamin Konoplev E<lt>vkonoplev@acm.orgE<gt>
=cut
use strict;
use base qw(Smokeping::matchers::base);
use vars qw($VERSION);
$VERSION = 1.0;
use Carp;
sub new(@) {
my $class = shift;
my $rules = {
hist => '\d+',
rising => '\d+(\.\d+)?',
falling => '\d+(\.\d+)?',
skip => '\d+',
fast => '\d+',
};
my $self = $class->SUPER::new( $rules, @_ );
return $self;
}
# how many values should we require before raising?
sub Length($) {
my $self = shift;
return $self->{param}{hist}; #
}
sub Desc ($) {
croak "Monitor if exponential weighted loss is in interval";
}
sub Test($$) {
my $self = shift;
my $data = shift; # @{$data->{rtt}} and @{$data->{loss}}
my $hist = $self->{param}{hist}; # history length
my $skip = ($self->{param}{skip} || 0); # skip <skip> samples before start
my $fast = ($self->{param}{fast} || 0); # use last <fast> samples for fast alerts
return undef if scalar(@{ $data->{loss}}) <= $skip+1;
# calculate alpha factor to obtain 1% significance
# of the old probes at the <hist> boundary
my $alfa = 1-0.01**(1/$hist);
my $rising = $self->{param}{rising};
my $falling = $self->{param}{falling} // $rising;
my $result = 0; # initialize the filter as zero;
my $loss;
my $sum = 0;
my $num = 0;
my $rising_cnt = 0;
my $falling_cnt = 0;
foreach $loss ( @{ $data->{loss} } ) {
# If there's an S in the array anywhere, return prevmatch
next if ( $loss =~ /S/ or $loss =~ /U/);
# update the filter
$result = (1-$alfa)*$result+$alfa*$loss;
$sum += $loss;
$num++;
if ($fast) {
$rising_cnt = ($loss >= $rising) ? $rising_cnt + 1 : 0;
$falling_cnt = ($loss <= $falling) ? $falling_cnt + 1 : 0;
}
}
return undef if $num == 0;
#
if ($fast) {
return 1 if $rising_cnt >= $fast;
return "" if $falling_cnt >= $fast;
}
# correct filter result as if it was initialized with "average"
$result += ($sum/$num)*((1-$alfa)**$num);
my $res = (($result >= $rising) or ($data->{prevmatch} and $result >= $falling));
# some debug stuff
if (0) {
my $d = `date`;
chomp $d;
my $array = join ":", @{ $data->{loss}};
`echo $d $data->{target} $array $result. >> /tmp/matcher.log` if $rising == 0;
}
return $res;
}
1;

101
debian/smokeping/usr/share/perl5/Smokeping/matchers/Median.pm vendored Normal file
View File

@@ -0,0 +1,101 @@
package Smokeping::matchers::Median;
=head1 NAME
Smokeping::matchers::Median - Find persistent changes in latency
=head1 OVERVIEW
The idea behind this matcher is to find sustained changes in latency.
The median matcher takes a number of past median latencies. It splits the latencies into
two groups (old and new) and again finds the median for each groups. If the
difference between the two medians is bigger than a certain value, it will
give a match.
=head1 DESCRIPTION
Call the matcher with the following sequence:
type = matcher
pattern = Median(old=>x,new=>y,diff=>z)
This will create a matcher which consumes x+y latency-datapoints, builds the
two medians and the matches if the difference between the median latency is
larger than z seconds.
=head1 COPYRIGHT
Copyright (c) 2004 by OETIKER+PARTNER AG. All rights reserved.
=head1 LICENSE
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
=head1 AUTHOR
Tobias Oetiker <tobi@oetiker.ch>
=cut
use strict;
use base qw(Smokeping::matchers::base);
use vars qw($VERSION);
$VERSION = 1.0;
use Carp;
sub new(@)
{
my $class = shift;
my $rules = {
old=>'\d+',
new=>'\d+',
diff=>'\d+(\.\d+)?' };
my $self = $class->SUPER::new($rules,@_);
return $self;
}
# how many values does the matcher need to do it's magic
sub Length($)
{
my $self = shift;
return $self->{param}{old} + $self->{param}{new};
}
sub Desc ($) {
croak "Find changes in median latency";
}
sub Test($$)
{ my $self = shift;
my $data = shift; # @{$data->{rtt}} and @{$data->{loss}}
my $ac = $self->{param}{old};
my $bc = $self->{param}{new};
my $cc = $ac +$bc;
my $count = scalar @{$data->{rtt}};
$cc = $count if $count < $cc;
$bc = $count if $count < $bc;
my $oldm = robust_median(@{$data->{rtt}}[-$cc..-$bc-1]);
my $newm = robust_median(@{$data->{rtt}}[-$bc..-1]);
return abs($oldm-$newm) > $self->{param}{diff};
}
sub robust_median(@){
my @numbers = sort {$a <=> $b} grep { defined $_ and $_ =~ /\d/ } @_;
my $count = $#numbers;
return 0 if $count < 0;
return ($count / 2 == int($count/2)) ? $numbers[$count/2] : ($numbers[$count/2+0.5] + $numbers[$count/2-0.5])/2;
}

118
debian/smokeping/usr/share/perl5/Smokeping/matchers/Medratio.pm vendored Normal file
View File

@@ -0,0 +1,118 @@
package Smokeping::matchers::Medratio;
=head1 NAME
Smokeping::matchers::Medratio - detect changes in the latency median
=head1 OVERVIEW
The Medratio matcher establishes a historic median latency over
several measurement rounds. It compares this median, against a second
median latency value again build over several rounds of measurement.
By looking at the median value this matcher is largely immune against spikes
and will only react to long term developments.
=head1 DESCRIPTION
Call the matcher with the following sequence:
type = matcher
pattern = Medratio(historic=>a,current=>b,comparator=>o,percentage=>p)
=over
=item historic
The number of values to use for building the 'historic' median.
=item current
The number of values to use for building the 'current' median.
=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 the 12 last median values. Build the median out of the first 10
and the median from the other 2 values. Divide the results and decide
if it is bigger than 150 percent.
Medratio(historic=>10,current=>2,comparator=>'>',percentage=>150);
med(current)/med(historic) > 150/100
This means the matcher will activate when the current latency median is
more than 1.5 times the historic latency median established over the last
10 rounds of measurement.
=head1 COPYRIGHT
Copyright (c) 2006 by OETIKER+PARTNER AG. All rights reserved.
=head1 SPONSORSHIP
The development of this matcher has been paid for by Virtela
Communications, L<http://www.virtela.net/>.
=head1 LICENSE
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
=head1 AUTHOR
Tobias Oetiker <tobi@oetiker.ch>
=cut
use vars qw($VERSION);
$VERSION = 1.0;
use strict;
use base qw(Smokeping::matchers::Avgratio);
use Carp;
sub Desc ($) {
croak "Detect changes in median latency";
}
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 $hm = (sort {$a <=> $b} @{$data->{rtt}}[-$cc..-$bc-1])[int($ac/2)];
my $cm = (sort {$a <=> $b} @{$data->{rtt}}[-$bc..-1])[int($bc/2)];
return undef unless $hm and $cm;
return &{$self->{param}{sub}}($cm/$hm,$self->{param}{value});
}

135
debian/smokeping/usr/share/perl5/Smokeping/matchers/base.pm vendored Normal file
View File

@@ -0,0 +1,135 @@
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 'business'
logic.
Note that the actual matchers must have at least one capital letter in their
name, to differentiate them from the base class(es).
=head1 DESCRIPTION
Every matcher must provide the following methods:
=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 parent 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 by this matcher" unless defined $rules->{$key};
croak "key '$key' contains invalid data: '$self->{param}{$key}'" unless $self->{param}{$key} =~ m/^$regex$/;
}
bless $self, $class;
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 containing 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].
There's also a key called 'prevmatch' in the hash. It contains the
value returned by the previous call of the 'Test' method. This allows
for somewhat more intelligent alerting due to state awareness.
my $prevmatch = $data->{prevmatch};
=cut
sub Test($$)
{ my $self = shift;
my $data = shift; # @{$data->{rtt}} and @{$data->{loss}}
croak "Match must be overridden by the subclass";
}
=head1 COPYRIGHT
Copyright (c) 2004 by OETIKER+PARTNER AG. All rights reserved.
=head1 LICENSE
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
=head1 AUTHOR
Tobias Oetiker <tobi@oetiker.ch>
=cut