This file is indexed.

/usr/share/perl5/Smokeping/matchers/CheckLoss.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
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;

# 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;
    foreach $loss ( @{ $data->{loss} } ) {

        # 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.  Check to make sure ALL latencies in RTT are less than the target
            if ( $loss < $target ) { $count++; }
        } else {

            # Alert is not raised.  If all values are over the alert threshold OR unreachable, raise the alert
            if ( $loss >= $target ) { $count++; }
        }
    }
    if ( $count >= $self->{param}{x} ) {
        return !$data->{prevmatch};
    }

    return $data->{prevmatch};
}