1#!/usr/local/bin/perl
2package Munin::Plugin::Multiping::Async;
3use 5.10.0;
4use MooseX::POE;
5use MooseX::POE::SweetArgs qw(event);
6use POE::Quickie;
7use Munin::Plugin;
8use Storable;
9use Digest;
10
11=head1 NAME
12
13multiping_async - Like the multiping plugin but runs asynchronously
14
15=head1 SYNOPSIS
16
17    munin-run multiping_async
18
19=head1 CONFIGURATION
20
21The following environment variables are used:
22
23    host     - Whitespace-separated list of hosts to ping
24    times    - How many times to ping the hosts, 3 by default
25    timeout  - The ping timeout (ping -W), 1 by default (ignored on Solaris)
26    title    - The graph_title to use for the munin RRD graph
27    category - What category the graph should be in, network by default
28
29Configuration example, ping all the Linode clusters:
30
31    # An optional custom category
32    [multiping_async_*]
33    env.category ping
34
35    [multiping_async_linode]
36    # From http://www.linode.com/speedtest/
37    env.title Ping times to all the Linode clusters
38    env.host  london1.linode.com newark1.linode.com atlanta1.linode.com dallas1.linode.com fremont1.linode.com
39
40=head1 DESCRIPTION
41
42Like the L<munin
43multiping|http://munin-monitoring.org/browser/people/janl/src/node/node.d/multiping>
44plugin except that it runs L<ping(1)> asynchronously with POE, and you
45can add/remove hosts later on without screwing up your RRD files
46(multiping reports statistics based on the order of hosts in
47C<hosts=>).
48
49This plugin used to use L<POE::Component::Client::Ping> but I switched
50away from it due to having odd timing issues with it, and it had to
51run as root.
52
53This plugin requires the L<MooseX::POE> and L<POE::Quickie> modules
54from CPAN. It has been tested with the Linux, FreeBSD and Solaris
55L<ping(1)> implementations.
56
57=head1 AUTHOR
58
59Ævar Arnfjörð Bjarmason <avar@cpan.org>
60
61=head1 LICENSE
62
63This program is in the public domain.
64
65=head1 MAGIC MARKERS
66
67 #%# family=manual
68
69=cut
70
71has graph_title => (
72    isa => 'Str',
73    is  => 'ro',
74    default => $ENV{title} // 'Ping times',
75    documentation => 'The munin graph_title',
76);
77
78has hosts => (
79    isa        => 'ArrayRef',
80    is         => 'ro',
81    auto_deref => 1,
82    default    => sub {
83        my $host = $ENV{host} // '';
84        return [ split /\s+/, $host ]
85    },
86    documentation => "Hosts we're going to ping",
87);
88
89has times => (
90    isa           => 'Int',
91    is            => 'ro',
92    default       => $ENV{times} // 3,
93    documentation => "How many times we ping each host (ping -c)",
94);
95
96has timeout => (
97    isa           => 'Int',
98    is            => 'ro',
99    default       => $ENV{timeout} // 1,
100    documentation => "How long until ping timeouts (ping -W)",
101);
102
103has category => (
104    isa           => 'Str',
105    is            => 'ro',
106    default       => $ENV{category} // 'network',
107    documentation => "What munin category we should appear in",
108);
109
110has should_config => (
111    isa => 'Bool',
112    is => 'ro',
113    default => sub { defined $ARGV[0] and $ARGV[0] eq "config" },
114    documentation => 'Spew out config section?',
115);
116
117has response => (
118    isa        => 'HashRef',
119    is         => 'ro',
120    auto_deref => 0,
121    default    => sub { +{} },
122    documentation => 'To store ping responses',
123);
124
125has statefile => (
126    isa           => 'Str',
127    is            => 'ro',
128    default       => $ENV{MUNIN_STATEFILE},
129    documentation => 'Where we store state between invocations',
130);
131
132sub START {
133    my ($self) = @_;
134
135    die "You must supply some hosts" unless @{ $self->hosts } > 0;
136
137    if ($self->should_config) {
138        $self->print_config;
139        return;
140    }
141
142    for my $host ($self->hosts) {
143        POE::Quickie->new->run(
144            Program     => [ $self->ping_arguments($host) ],
145            StdoutEvent => 'stdout',
146            ExitEvent   => 'exit',
147            Context     => $host,
148        );
149    }
150}
151
152sub ping_arguments {
153    my ($self, $host) = @_;
154
155    given ($^O) {
156        when ('solaris') {
157            return ('ping', '-s', $host, '64', $self->times);
158        }
159        default {
160            # Linux and FreeBSD
161            return ('ping', '-c', $self->times, '-W', $self->timeout, => $host);
162        }
163    }
164}
165
166event stdout => sub {
167    my ($self, $output, undef, $context) = @_;
168
169    given ($output) {
170        my $noslash = qr{[^/]+};
171        # Linux output: rtt min/avg/max/mdev = 7.218/7.255/7.293/0.030 ms
172        # BSD output  : round-trip min/avg/max/stddev = 34.935/35.665/36.684/0.743 ms
173        # Solaris     : round-trip (ms)  min/avg/max/stddev = 5.82/5.95/6.01/0.11
174        when (m[= (?<min>$noslash)/(?<avg>$noslash)/(?<max>$noslash)/]) {
175            $self->response->{ $context } = $+{avg};
176        }
177    }
178};
179
180event exit => sub {
181    my ($self, $code, $x, $context) = @_;
182
183    given ($code) {
184        when (0) {
185            die "Got no response from $context" unless exists $self->response->{ $context };
186            $self->yield( print_host => $context => $self->response->{ $context } );
187        }
188        default {
189            # Host down, probably
190            $self->yield( print_host => $context => 0 );
191        }
192    }
193
194    return;
195};
196
197sub STOP {
198    my ($self) = @_;
199
200    if (not $self->should_config and my $file = $self->statefile) {
201        my $res = $self->response;
202        my $ret = store($res, $file);
203        # use Data::Dumper;
204        # say Dumper { gonna_store => $res, ret => $ret, file => $file };
205    }
206}
207
208sub print_config {
209    my ($self) = @_;
210    my $title = $self->graph_title;
211    my $times = $self->times;
212    my $category = $self->category;
213    print <<GRAPH;
214graph_title $title
215graph_args --base 1000 -l 0
216graph_vlabel milliseconds
217graph_category $category
218graph_info Average ping times (over $times pings)
219GRAPH
220    for my $host ($self->sorted_hosts) {
221        my $fieldname = $self->fieldname($host);
222        print <<HOST;
223$fieldname.label $host
224$fieldname.info Average ping time over $times pings for $host
225$fieldname.draw LINE2
226HOST
227    }
228};
229
230sub sorted_hosts {
231    my ($self) = @_;
232
233    my @hosts = $self->hosts;
234    my $state = $self->statefile;
235
236    given ($self->statefile) {
237        when (-e and -r) {
238            my $last_res = retrieve($_);
239            my @sorted = sort { $last_res->{$b} <=> $last_res->{$a} } keys %$last_res;
240            if ($last_res and @hosts == @sorted) {
241                return @sorted;
242            }
243        }
244    }
245
246    return @hosts;
247}
248
249event print_host => sub {
250    my ($self, $context, $time) = @_;
251
252    my $fieldname = $self->fieldname($context);
253    my $value = sprintf "%6.6f", $time;
254
255    say "$fieldname.value $value";
256};
257
258sub fieldname {
259    my ($self, $name) = @_;
260    my $sha1 = substr Digest->new("SHA-1")->add($name)->hexdigest, 0, 10;
261    return clean_fieldname($name) . '_' . $sha1;
262}
263
264no MooseX::POE;
265Munin::Plugin::Multiping::Async->new;
266POE::Kernel->run;
267