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 our $Debug = 0;
62 return (1);
64 sub _debug
65 {
66 if (!$Debug)
67 {
68 return;
69 }
70 print @_;
71 }
73 sub _create_socket
74 {
75 my $path = shift;
76 my $sock = IO::Socket::UNIX->new (Type => SOCK_STREAM, Peer => $path);
77 if (!$sock)
78 {
79 cluck ("Cannot open UNIX-socket $path: $!");
80 return;
81 }
82 return ($sock);
83 } # _create_socket
85 =head1 VALUE IDENTIFIERS
87 The values in the collectd are identified using an five-tuple (host, plugin,
88 plugin-instance, type, type-instance) where only plugin-instance and
89 type-instance may be NULL (or undefined). Many functions expect an
90 I<%identifier> hash that has at least the members B<host>, B<plugin>, and
91 B<type>, possibly completed by B<plugin_instance> and B<type_instance>.
93 Usually you can pass this hash as follows:
95 $obj->method (host => $host, plugin => $plugin, type => $type, %other_args);
97 =cut
99 sub _create_identifier
100 {
101 my $args = shift;
102 my $host;
103 my $plugin;
104 my $type;
106 if (!$args->{'host'} || !$args->{'plugin'} || !$args->{'type'})
107 {
108 cluck ("Need `host', `plugin' and `type'");
109 return;
110 }
112 $host = $args->{'host'};
113 $plugin = $args->{'plugin'};
114 $plugin .= '-' . $args->{'plugin_instance'} if (defined ($args->{'plugin_instance'}));
115 $type = $args->{'type'};
116 $type .= '-' . $args->{'type_instance'} if (defined ($args->{'type_instance'}));
118 return ("$host/$plugin/$type");
119 } # _create_identifier
121 sub _parse_identifier
122 {
123 my $string = shift;
124 my $host;
125 my $plugin;
126 my $plugin_instance;
127 my $type;
128 my $type_instance;
129 my $ident;
131 ($host, $plugin, $type) = split ('/', $string);
133 ($plugin, $plugin_instance) = split ('-', $plugin, 2);
134 ($type, $type_instance) = split ('-', $type, 2);
136 $ident =
137 {
138 host => $host,
139 plugin => $plugin,
140 type => $type
141 };
142 $ident->{'plugin_instance'} = $plugin_instance if (defined ($plugin_instance));
143 $ident->{'type_instance'} = $type_instance if (defined ($type_instance));
145 return ($ident);
146 } # _parse_identifier
148 sub _escape_argument
149 {
150 my $string = shift;
152 if ($string =~ m/^\w+$/)
153 {
154 return ("$string");
155 }
157 $string =~ s#\\#\\\\#g;
158 $string =~ s#"#\\"#g;
159 $string = "\"$string\"";
161 return ($string);
162 }
164 =head1 PUBLIC METHODS
166 =over 4
168 =item I<$obj> = Collectd::Unixsock->B<new> ([I<$path>]);
170 Creates a new connection to the daemon. The optional I<$path> argument gives
171 the path to the UNIX socket of the C<unixsock plugin> and defaults to
172 F</var/run/collectd-unixsock>. Returns the newly created object on success and
173 false on error.
175 =cut
177 sub new
178 {
179 my $pkg = shift;
180 my $path = @_ ? shift : '/var/run/collectd-unixsock';
181 my $sock = _create_socket ($path) or return;
182 my $obj = bless (
183 {
184 path => $path,
185 sock => $sock,
186 error => 'No error'
187 }, $pkg);
188 return ($obj);
189 } # new
191 =item I<$res> = I<$obj>-E<gt>B<getval> (I<%identifier>);
193 Requests a value-list from the daemon. On success a hash-ref is returned with
194 the name of each data-source as the key and the according value as, well, the
195 value. On error false is returned.
197 =cut
199 sub getval # {{{
200 {
201 my $obj = shift;
202 my %args = @_;
204 my $status;
205 my $fh = $obj->{'sock'} or confess ('object has no filehandle');
206 my $msg;
207 my $identifier;
209 my $ret = {};
211 $identifier = _create_identifier (\%args) or return;
213 $msg = 'GETVAL ' . _escape_argument ($identifier) . "\n";
214 _debug "-> $msg";
215 print $fh $msg;
217 $msg = <$fh>;
218 chomp ($msg);
219 _debug "<- $msg\n";
221 ($status, $msg) = split (' ', $msg, 2);
222 if ($status <= 0)
223 {
224 $obj->{'error'} = $msg;
225 return;
226 }
228 for (my $i = 0; $i < $status; $i++)
229 {
230 my $entry = <$fh>;
231 chomp ($entry);
232 _debug "<- $entry\n";
234 if ($entry =~ m/^(\w+)=NaN$/)
235 {
236 $ret->{$1} = undef;
237 }
238 elsif ($entry =~ m/^(\w+)=($RE{num}{real})$/)
239 {
240 $ret->{$1} = 0.0 + $2;
241 }
242 }
244 return ($ret);
245 } # }}} sub getval
247 =item I<$res> = I<$obj>-E<gt>B<getthreshold> (I<%identifier>);
249 Requests a threshold from the daemon. On success a hash-ref is returned with
250 the threshold data. On error false is returned.
252 =cut
254 sub getthreshold # {{{
255 {
256 my $obj = shift;
257 my %args = @_;
259 my $status;
260 my $fh = $obj->{'sock'} or confess ('object has no filehandle');
261 my $msg;
262 my $identifier;
264 my $ret = {};
266 $identifier = _create_identifier (\%args) or return;
268 $msg = 'GETTHRESHOLD ' . _escape_argument ($identifier) . "\n";
269 _debug "-> $msg";
270 print $fh $msg;
272 $msg = <$fh>;
273 chomp ($msg);
274 _debug "<- $msg\n";
276 ($status, $msg) = split (' ', $msg, 2);
277 if ($status <= 0)
278 {
279 $obj->{'error'} = $msg;
280 return;
281 }
283 for (my $i = 0; $i < $status; $i++)
284 {
285 my $entry = <$fh>;
286 chomp ($entry);
287 _debug "<- $entry\n";
289 if ($entry =~ m/^([^:]+):\s*(\S.*)$/)
290 {
291 my $key = $1;
292 my $value = $2;
294 $key =~ s/^\s+//;
295 $key =~ s/\s+$//;
297 $ret->{$key} = $value;
298 }
299 }
301 return ($ret);
302 } # }}} sub getthreshold
304 =item I<$obj>-E<gt>B<putval> (I<%identifier>, B<time> =E<gt> I<$time>, B<values> =E<gt> [...]);
306 Submits a value-list to the daemon. If the B<time> argument is omitted
307 C<time()> is used. The required argument B<values> is a reference to an array
308 of values that is to be submitted. The number of values must match the number
309 of values expected for the given B<type> (see L<VALUE IDENTIFIERS>), though
310 this is checked by the daemon, not the Perl module. Also, gauge data-sources
311 (e.E<nbsp>g. system-load) may be C<undef>. Returns true upon success and false
312 otherwise.
314 =cut
316 sub putval
317 {
318 my $obj = shift;
319 my %args = @_;
321 my $status;
322 my $fh = $obj->{'sock'} or confess;
323 my $msg;
324 my $identifier;
325 my $values;
326 my $interval = "";
328 if (defined $args{'interval'})
329 {
330 $interval = ' interval='
331 . _escape_argument ($args{'interval'});
332 }
334 $identifier = _create_identifier (\%args) or return;
335 if (!$args{'values'})
336 {
337 cluck ("Need argument `values'");
338 return;
339 }
341 if (!ref ($args{'values'}))
342 {
343 $values = $args{'values'};
344 }
345 else
346 {
347 my $time;
349 if ("ARRAY" ne ref ($args{'values'}))
350 {
351 cluck ("Invalid `values' argument (expected an array ref)");
352 return;
353 }
355 if (! scalar @{$args{'values'}})
356 {
357 cluck ("Empty `values' array");
358 return;
359 }
361 $time = $args{'time'} ? $args{'time'} : time ();
362 $values = join (':', $time, map { defined ($_) ? $_ : 'U' } (@{$args{'values'}}));
363 }
365 $msg = 'PUTVAL '
366 . _escape_argument ($identifier)
367 . $interval
368 . ' ' . _escape_argument ($values) . "\n";
369 _debug "-> $msg";
370 print $fh $msg;
372 $msg = <$fh>;
373 chomp ($msg);
374 _debug "<- $msg\n";
376 ($status, $msg) = split (' ', $msg, 2);
377 return (1) if ($status == 0);
379 $obj->{'error'} = $msg;
380 return;
381 } # putval
383 =item I<$res> = I<$obj>-E<gt>B<listval> ()
385 Queries a list of values from the daemon. The list is returned as an array of
386 hash references, where each hash reference is a valid identifier. The C<time>
387 member of each hash holds the epoch value of the last update of that value.
389 =cut
391 sub listval
392 {
393 my $obj = shift;
394 my $msg;
395 my @ret = ();
396 my $status;
397 my $fh = $obj->{'sock'} or confess;
399 _debug "LISTVAL\n";
400 print $fh "LISTVAL\n";
402 $msg = <$fh>;
403 chomp ($msg);
404 _debug "<- $msg\n";
405 ($status, $msg) = split (' ', $msg, 2);
406 if ($status < 0)
407 {
408 $obj->{'error'} = $msg;
409 return;
410 }
412 for (my $i = 0; $i < $status; $i++)
413 {
414 my $time;
415 my $ident;
417 $msg = <$fh>;
418 chomp ($msg);
419 _debug "<- $msg\n";
421 ($time, $ident) = split (' ', $msg, 2);
423 $ident = _parse_identifier ($ident);
424 $ident->{'time'} = int ($time);
426 push (@ret, $ident);
427 } # for (i = 0 .. $status)
429 return (@ret);
430 } # listval
432 =item I<$res> = I<$obj>-E<gt>B<putnotif> (B<severity> =E<gt> I<$severity>, B<message> =E<gt> I<$message>, ...);
434 Submits a notification to the daemon.
436 Valid options are:
438 =over 4
440 =item B<severity>
442 Sets the severity of the notification. The value must be one of the following
443 strings: C<failure>, C<warning>, or C<okay>. Case does not matter. This option
444 is mandatory.
446 =item B<message>
448 Sets the message of the notification. This option is mandatory.
450 =item B<time>
452 Sets the time. If omitted, C<time()> is used.
454 =item I<Value identifier>
456 All the other fields of the value identifiers, B<host>, B<plugin>,
457 B<plugin_instance>, B<type>, and B<type_instance>, are optional. When given,
458 the notification is associated with the performance data of that identifier.
459 For more details, please see L<collectd-unixsock(5)>.
461 =back
463 =cut
465 sub putnotif
466 {
467 my $obj = shift;
468 my %args = @_;
470 my $status;
471 my $fh = $obj->{'sock'} or confess;
473 my $msg; # message sent to the socket
475 if (!$args{'message'})
476 {
477 cluck ("Need argument `message'");
478 return;
479 }
480 if (!$args{'severity'})
481 {
482 cluck ("Need argument `severity'");
483 return;
484 }
485 $args{'severity'} = lc ($args{'severity'});
486 if (($args{'severity'} ne 'failure')
487 && ($args{'severity'} ne 'warning')
488 && ($args{'severity'} ne 'okay'))
489 {
490 cluck ("Invalid `severity: " . $args{'severity'});
491 return;
492 }
494 if (!$args{'time'})
495 {
496 $args{'time'} = time ();
497 }
499 $msg = 'PUTNOTIF '
500 . join (' ', map { $_ . '=' . _escape_argument ($args{$_}) } (keys %args))
501 . "\n";
503 _debug "-> $msg";
504 print $fh $msg;
506 $msg = <$fh>;
507 chomp ($msg);
508 _debug "<- $msg\n";
510 ($status, $msg) = split (' ', $msg, 2);
511 return (1) if ($status == 0);
513 $obj->{'error'} = $msg;
514 return;
515 } # putnotif
517 =item I<$obj>-E<gt>B<flush> (B<timeout> =E<gt> I<$timeout>, B<plugins> =E<gt> [...], B<identifier> =E<gt> [...]);
519 Flush cached data.
521 Valid options are:
523 =over 4
525 =item B<timeout>
527 If this option is specified, only data older than I<$timeout> seconds is
528 flushed.
530 =item B<plugins>
532 If this option is specified, only the selected plugins will be flushed. The
533 argument is a reference to an array of strings.
535 =item B<identifier>
537 If this option is specified, only the given identifier(s) will be flushed. The
538 argument is a reference to an array of identifiers. Identifiers, in this case,
539 are hash references and have the members as outlined in L<VALUE IDENTIFIERS>.
541 =back
543 =cut
545 sub flush
546 {
547 my $obj = shift;
548 my %args = @_;
550 my $fh = $obj->{'sock'} or confess;
552 my $status = 0;
553 my $msg = "FLUSH";
555 if (defined ($args{'timeout'}))
556 {
557 $msg .= " timeout=" . $args{'timeout'};
558 }
560 if ($args{'plugins'})
561 {
562 foreach my $plugin (@{$args{'plugins'}})
563 {
564 $msg .= " plugin=" . $plugin;
565 }
566 }
568 if ($args{'identifier'})
569 {
570 for (@{$args{'identifier'}})
571 {
572 my $identifier = $_;
573 my $ident_str;
575 if (ref ($identifier) ne 'HASH')
576 {
577 cluck ("The argument of the `identifier' "
578 . "option must be an array reference "
579 . "of hash references.");
580 return;
581 }
583 $ident_str = _create_identifier ($identifier);
584 if (!$ident_str)
585 {
586 return;
587 }
589 $msg .= ' identifier=' . _escape_argument ($ident_str);
590 }
591 }
593 $msg .= "\n";
595 _debug "-> $msg";
596 print $fh $msg;
598 $msg = <$fh>;
599 chomp ($msg);
600 _debug "<- $msg\n";
602 ($status, $msg) = split (' ', $msg, 2);
603 return (1) if ($status == 0);
605 $obj->{'error'} = $msg;
606 return;
607 }
609 sub error
610 {
611 my $obj = shift;
612 if ($obj->{'error'})
613 {
614 return ($obj->{'error'});
615 }
616 return;
617 }
619 =item I<$obj>-E<gt>destroy ();
621 Closes the socket before the object is destroyed. This function is also
622 automatically called then the object goes out of scope.
624 =back
626 =cut
628 sub destroy
629 {
630 my $obj = shift;
631 if ($obj->{'sock'})
632 {
633 close ($obj->{'sock'});
634 delete ($obj->{'sock'});
635 }
636 }
638 sub DESTROY
639 {
640 my $obj = shift;
641 $obj->destroy ();
642 }
644 =head1 SEE ALSO
646 L<collectd(1)>,
647 L<collectd.conf(5)>,
648 L<collectd-unixsock(5)>
650 =head1 AUTHOR
652 Florian octo Forster E<lt>octo@verplant.orgE<gt>
654 =cut
656 # vim: set fdm=marker :