This file is indexed.

/usr/share/perl5/Smokeping/matchers/ExpLoss.pm is in smokeping 2.6.11-3.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
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 =  CheckLoss(hist => <hist>, rising=><rising> \
                     [,falling => <falling>] [,skip=><stat>] [,fast=><fast>])

Arguments:
 hist    - number of samples to weight against; weight will be disposed with
           exponetial 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 lengh
    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 = (defined $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;