summaryrefslogtreecommitdiffstats
path: root/lib/probes/FPing6.pm
blob: 7a03b4890858385135eaa11f0dcca0d0f9b60492 (plain)
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
package probes::FPing6;

=head1 NAME

probes::FPing6 - FPing6 Probe for SmokePing

=head1 SYNOPSIS

 *** Probes ***
 + FPing6
 binary = /usr/sbin/fping6

=head1 DESCRIPTION

Integrates FPing6 as a probe into smokeping. The variable B<binary> must
point to your copy of the FPing6 program. If it is not installed on
your system yet, you can get it from http://www.fping.com/.

=head1 AUTHOR

Tobias Oetiker <tobi@oetiker.ch>

=cut

use strict;
use base qw(probes::base);
use IPC::Open3;
use Symbol;
use Carp;

sub new($$$)
{
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@_);

    croak "ERROR: FPing6 'binary' not defined in FPing6 probe definition"
        unless defined $self->{properties}{binary};

    croak "ERROR: FPing6 'binary' does not point to an executable"
        unless -f $self->{properties}{binary} and -x $self->{properties}{binary};
    
    $_ = `$self->{properties}{binary} -C 1 localhost 2>&1`;
    croak "ERROR: FPing6 must be installed setuid root or it will not work\n" if m/only.+root/;
    if (m/bytes, ([0-9.]+)\sms\s+.*\n.*\n.*:\s+([0-9.]+)/){
        $self->{pingfactor} = 1000 * $2/$1;
        print "### fping6 seems to report in ", $1/$2, " miliseconds\n" unless $ENV{SERVER_SOFTWARE};
    } else {
        $self->{pingfactor} = 1000; # Gives us a good-guess default
        print "### assuming you are using an fping6 copy reporting in miliseconds\n" unless $ENV{SERVER_SOFTWARE};
    };
    return $self;
}

sub ProbeDesc($){
    return "IPv6-ICMP Echo Pings";
}

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 @cmd = (
                    $self->{properties}{binary}, 
                    '-C', $self->pings, '-q',
                    @{$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 {$_ ne "-"} @times;
        map { $self->{rtts}{$_} = [@times] } @{$self->{addrlookup}{$ip}} ;
    }
    waitpid $pid,0;
    close $inh;
    close $outh;
    close $errh;
}

1;