1 #
2 # collectd - Collectd::Unixsock
3 # Copyright (C) 2007,2008 Florian octo Forster
4 #
5 # This program is free software; you can redistribute it and/or modify it
6 # under the terms of the GNU General Public License as published by the
7 # Free Software Foundation; only version 2 of the License is applicable.
8 #
9 # This program is distributed in the hope that it will be useful, but
10 # WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 # General Public License for more details.
13 #
14 # You should have received a copy of the GNU General Public License along
15 # with this program; if not, write to the Free Software Foundation, Inc.,
16 # 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
17 #
18 # Author:
19 # Florian octo Forster <octo at verplant.org>
20 #
22 package Collectd::Unixsock;
24 =head1 NAME
26 Collectd::Unixsock - Abstraction layer for accessing the functionality by
27 collectd's unixsock plugin.
29 =head1 SYNOPSIS
31 use Collectd::Unixsock ();
33 my $sock = Collectd::Unixsock->new ($path);
35 my $value = $sock->getval (%identifier);
36 $sock->putval (%identifier,
37 time => time (),
38 values => [123, 234, 345]);
40 $sock->destroy ();
42 =head1 DESCRIPTION
44 collectd's unixsock plugin allows external programs to access the values it has
45 collected or received and to submit own values. This Perl-module is simply a
46 little abstraction layer over this interface to make it even easier for
47 programmers to interact with the daemon.
49 =cut
51 use strict;
52 use warnings;
54 #use constant { NOTIF_FAILURE => 1, NOTIF_WARNING => 2, NOTIF_OKAY => 4 };
56 use Carp (qw(cluck confess));
57 use IO::Socket::UNIX;
58 use Regexp::Common (qw(number));
60 return (1);
62 sub _create_socket
63 {
64 my $path = shift;
65 my $sock = IO::Socket::UNIX->new (Type => SOCK_STREAM, Peer => $path);
66 if (!$sock)
67 {
68 cluck ("Cannot open UNIX-socket $path: $!");
69 return;
70 }
71 return ($sock);
72 } # _create_socket
74 =head1 VALUE IDENTIFIERS
76 The values in the collectd are identified using an five-tuple (host, plugin,
77 plugin-instance, type, type-instance) where only plugin-instance and
78 type-instance may be NULL (or undefined). Many functions expect an
79 I<%identifier> hash that has at least the members B<host>, B<plugin>, and
80 B<type>, possibly completed by B<plugin_instance> and B<type_instance>.
82 Usually you can pass this hash as follows:
84 $obj->method (host => $host, plugin => $plugin, type => $type, %other_args);
86 =cut
88 sub _create_identifier
89 {
90 my $args = shift;
91 my $host;
92 my $plugin;
93 my $type;
95 if (!$args->{'host'} || !$args->{'plugin'} || !$args->{'type'})
96 {
97 cluck ("Need `host', `plugin' and `type'");
98 return;
99 }
101 $host = $args->{'host'};
102 $plugin = $args->{'plugin'};
103 $plugin .= '-' . $args->{'plugin_instance'} if (defined ($args->{'plugin_instance'}));
104 $type = $args->{'type'};
105 $type .= '-' . $args->{'type_instance'} if (defined ($args->{'type_instance'}));
107 return ("$host/$plugin/$type");
108 } # _create_identifier
110 sub _parse_identifier
111 {
112 my $string = shift;
113 my $host;
114 my $plugin;
115 my $plugin_instance;
116 my $type;
117 my $type_instance;
118 my $ident;
120 ($host, $plugin, $type) = split ('/', $string);
122 ($plugin, $plugin_instance) = split ('-', $plugin, 2);
123 ($type, $type_instance) = split ('-', $type, 2);
125 $ident =
126 {
127 host => $host,
128 plugin => $plugin,
129 type => $type
130 };
131 $ident->{'plugin_instance'} = $plugin_instance if (defined ($plugin_instance));
132 $ident->{'type_instance'} = $type_instance if (defined ($type_instance));
134 return ($ident);
135 } # _parse_identifier
137 =head1 PUBLIC METHODS
139 =over 4
141 =item I<$obj> = Collectd::Unixsock->B<new> ([I<$path>]);
143 Creates a new connection to the daemon. The optional I<$path> argument gives
144 the path to the UNIX socket of the C<unixsock plugin> and defaults to
145 F</var/run/collectd-unixsock>. Returns the newly created object on success and
146 false on error.
148 =cut
150 sub new
151 {
152 my $pkg = shift;
153 my $path = @_ ? shift : '/var/run/collectd-unixsock';
154 my $sock = _create_socket ($path) or return;
155 my $obj = bless (
156 {
157 path => $path,
158 sock => $sock,
159 error => 'No error'
160 }, $pkg);
161 return ($obj);
162 } # new
164 =item I<$res> = I<$obj>-E<gt>B<getval> (I<%identifier>);
166 Requests a value-list from the daemon. On success a hash-ref is returned with
167 the name of each data-source as the key and the according value as, well, the
168 value. On error false is returned.
170 =cut
172 sub getval
173 {
174 my $obj = shift;
175 my %args = @_;
177 my $status;
178 my $fh = $obj->{'sock'} or confess;
179 my $msg;
180 my $identifier;
182 my $ret = {};
184 $identifier = _create_identifier (\%args) or return;
186 $msg = "GETVAL $identifier\n";
187 #print "-> $msg";
188 send ($fh, $msg, 0) or confess ("send: $!");
190 $msg = undef;
191 recv ($fh, $msg, 1024, 0) or confess ("recv: $!");
192 #print "<- $msg";
194 ($status, $msg) = split (' ', $msg, 2);
195 if ($status <= 0)
196 {
197 $obj->{'error'} = $msg;
198 return;
199 }
201 for (split (' ', $msg))
202 {
203 my $entry = $_;
204 if ($entry =~ m/^(\w+)=NaN$/)
205 {
206 $ret->{$1} = undef;
207 }
208 elsif ($entry =~ m/^(\w+)=($RE{num}{real})$/)
209 {
210 $ret->{$1} = 0.0 + $2;
211 }
212 }
214 return ($ret);
215 } # getval
217 =item I<$obj>-E<gt>B<putval> (I<%identifier>, B<time> =E<gt> I<$time>, B<values> =E<gt> [...]);
219 Submits a value-list to the daemon. If the B<time> argument is omitted
220 C<time()> is used. The required argument B<values> is a reference to an array
221 of values that is to be submitted. The number of values must match the number
222 of values expected for the given B<type> (see L<VALUE IDENTIFIERS>), though
223 this is checked by the daemon, not the Perl module. Also, gauge data-sources
224 (e.E<nbsp>g. system-load) may be C<undef>. Returns true upon success and false
225 otherwise.
227 =cut
229 sub putval
230 {
231 my $obj = shift;
232 my %args = @_;
234 my $status;
235 my $fh = $obj->{'sock'} or confess;
236 my $msg;
237 my $identifier;
238 my $values;
239 my $interval = "";
241 if (defined $args{'interval'})
242 {
243 $interval = ' interval=' . $args{'interval'};
244 }
246 $identifier = _create_identifier (\%args) or return;
247 if (!$args{'values'})
248 {
249 cluck ("Need argument `values'");
250 return;
251 }
253 if (!ref ($args{'values'}))
254 {
255 $values = $args{'values'};
256 }
257 else
258 {
259 my $time = $args{'time'} ? $args{'time'} : time ();
260 $values = join (':', $time, map { defined ($_) ? $_ : 'U' } (@{$args{'values'}}));
261 }
263 $msg = "PUTVAL $identifier$interval $values\n";
264 #print "-> $msg";
265 send ($fh, $msg, 0) or confess ("send: $!");
266 $msg = undef;
267 recv ($fh, $msg, 1024, 0) or confess ("recv: $!");
268 #print "<- $msg";
270 ($status, $msg) = split (' ', $msg, 2);
271 return (1) if ($status == 0);
273 $obj->{'error'} = $msg;
274 return;
275 } # putval
277 =item I<$res> = I<$obj>-E<gt>B<listval> ()
279 Queries a list of values from the daemon. The list is returned as an array of
280 hash references, where each hash reference is a valid identifier. The C<time>
281 member of each hash holds the epoch value of the last update of that value.
283 =cut
285 sub listval
286 {
287 my $obj = shift;
288 my $msg;
289 my @ret = ();
290 my $status;
291 my $fh = $obj->{'sock'} or confess;
293 $msg = "LISTVAL\n";
294 send ($fh, $msg, 0) or confess ("send: $!");
296 $msg = <$fh>;
297 ($status, $msg) = split (' ', $msg, 2);
298 if ($status < 0)
299 {
300 $obj->{'error'} = $msg;
301 return;
302 }
304 for (my $i = 0; $i < $status; $i++)
305 {
306 my $time;
307 my $ident;
309 $msg = <$fh>;
310 chomp ($msg);
312 ($time, $ident) = split (' ', $msg, 2);
314 $ident = _parse_identifier ($ident);
315 $ident->{'time'} = int ($time);
317 push (@ret, $ident);
318 } # for (i = 0 .. $status)
320 return (@ret);
321 } # listval
323 =item I<$res> = I<$obj>-E<gt>B<putnotif> (B<severity> =E<gt> I<$severity>, B<message> =E<gt> I<$message>, ...);
325 Submits a notification to the daemon.
327 Valid options are:
329 =over 4
331 =item B<severity>
333 Sets the severity of the notification. The value must be one of the following
334 strings: C<failure>, C<warning>, or C<okay>. Case does not matter. This option
335 is mandatory.
337 =item B<message>
339 Sets the message of the notification. This option is mandatory.
341 =item B<time>
343 Sets the time. If omitted, C<time()> is used.
345 =item I<Value identifier>
347 All the other fields of the value identifiers, B<host>, B<plugin>,
348 B<plugin_instance>, B<type>, and B<type_instance>, are optional. When given,
349 the notification is associated with the performance data of that identifier.
350 For more details, please see L<collectd-unixsock(5)>.
352 =back
354 =cut
356 sub putnotif
357 {
358 my $obj = shift;
359 my %args = @_;
361 my $status;
362 my $fh = $obj->{'sock'} or confess;
364 my $msg; # message sent to the socket
365 my $opt_msg; # message of the notification
367 if (!$args{'message'})
368 {
369 cluck ("Need argument `message'");
370 return;
371 }
372 if (!$args{'severity'})
373 {
374 cluck ("Need argument `severity'");
375 return;
376 }
377 $args{'severity'} = lc ($args{'severity'});
378 if (($args{'severity'} ne 'failure')
379 && ($args{'severity'} ne 'warning')
380 && ($args{'severity'} ne 'okay'))
381 {
382 cluck ("Invalid `severity: " . $args{'severity'});
383 return;
384 }
386 if (!$args{'time'})
387 {
388 $args{'time'} = time ();
389 }
391 $opt_msg = $args{'message'};
392 delete ($args{'message'});
394 $msg = 'PUTNOTIF '
395 . join (' ', map { $_ . '=' . $args{$_} } (keys %args))
396 . " message=$opt_msg\n";
398 send ($fh, $msg, 0) or confess ("send: $!");
399 $msg = undef;
400 recv ($fh, $msg, 1024, 0) or confess ("recv: $!");
402 ($status, $msg) = split (' ', $msg, 2);
403 return (1) if ($status == 0);
405 $obj->{'error'} = $msg;
406 return;
407 } # putnotif
409 =item I<$obj>-E<gt>B<flush> (B<timeout> =E<gt> I<$timeout>, B<plugins> =E<gt> [...], B<identifier> =E<gt> [...]);
411 Flush cached data.
413 Valid options are:
415 =over 4
417 =item B<timeout>
419 If this option is specified, only data older than I<$timeout> seconds is
420 flushed.
422 =item B<plugins>
424 If this option is specified, only the selected plugins will be flushed. The
425 argument is a reference to an array of strings.
427 =item B<identifier>
429 If this option is specified, only the given identifier(s) will be flushed. The
430 argument is a reference to an array of identifiers. Identifiers, in this case,
431 are hash references and have the members as outlined in L<VALUE IDENTIFIERS>.
433 =back
435 =cut
437 sub flush
438 {
439 my $obj = shift;
440 my %args = @_;
442 my $fh = $obj->{'sock'} or confess;
444 my $status = 0;
445 my $msg = "FLUSH";
447 if (defined ($args{'timeout'}))
448 {
449 $msg .= " timeout=" . $args{'timeout'};
450 }
452 if ($args{'plugins'})
453 {
454 foreach my $plugin (@{$args{'plugins'}})
455 {
456 $msg .= " plugin=" . $plugin;
457 }
458 }
460 if ($args{'identifier'})
461 {
462 for (@{$args{'identifier'}})
463 {
464 my $identifier = $_;
465 my $ident_str;
467 if (ref ($identifier) ne 'HASH')
468 {
469 cluck ("The argument of the `identifier' "
470 . "option must be an array reference "
471 . "of hash references.");
472 return;
473 }
475 $ident_str = _create_identifier ($identifier);
476 if (!$ident_str)
477 {
478 return;
479 }
480 if ($ident_str =~ m/ /)
481 {
482 $ident_str =~ s#\\#\\\\#g;
483 $ident_str =~ s#"#\\"#g;
484 $ident_str = "\"$ident_str\"";
485 }
487 $msg .= " identifier=$ident_str";
488 }
489 }
491 $msg .= "\n";
493 send ($fh, $msg, 0) or confess ("send: $!");
494 $msg = undef;
495 recv ($fh, $msg, 1024, 0) or confess ("recv: $!");
497 ($status, $msg) = split (' ', $msg, 2);
498 return (1) if ($status == 0);
500 $obj->{'error'} = $msg;
501 return;
502 }
504 =item I<$obj>-E<gt>destroy ();
506 Closes the socket before the object is destroyed. This function is also
507 automatically called then the object goes out of scope.
509 =back
511 =cut
513 sub destroy
514 {
515 my $obj = shift;
516 if ($obj->{'sock'})
517 {
518 close ($obj->{'sock'});
519 delete ($obj->{'sock'});
520 }
521 }
523 sub DESTROY
524 {
525 my $obj = shift;
526 $obj->destroy ();
527 }
529 =head1 SEE ALSO
531 L<collectd(1)>,
532 L<collectd.conf(5)>,
533 L<collectd-unixsock(5)>
535 =head1 AUTHOR
537 Florian octo Forster E<lt>octo@verplant.orgE<gt>
539 =cut