bindings/perl/Collectd/Unixsock.pm

   1 package Collectd::Unixsock;
   2
   3 =head1 NAME
   4
   5 Collectd::Unixsock - Abstraction layer for accessing the functionality by
   6 collectd's unixsock plugin.
   7
   8 =head1 SYNOPSIS
   9
  10   use Collectd::Unixsock ();
  11
  12   my $sock = Collectd::Unixsock->new ($path);
  13
  14   my $value = $sock->getval (%identifier);
  15   $sock->putval (%identifier,
  16                  time => time (),
  17                  values => [123, 234, 345]);
  18
  19   $sock->destroy ();
  20
  21 =head1 DESCRIPTION
  22
  23 collectd's unixsock plugin allows external programs to access the values it has
  24 collected or received and to submit own values. This Perl-module is simply a
  25 little abstraction layer over this interface to make it even easier for
  26 programmers to interact with the daemon.
  27
  28 =cut
  29
  30 use strict;
  31 use warnings;
  32
  33 #use constant { NOTIF_FAILURE => 1, NOTIF_WARNING => 2, NOTIF_OKAY => 4 };
  34
  35 use Carp (qw(cluck confess));
  36 use IO::Socket::UNIX;
  37 use Regexp::Common (qw(number));
  38
  39 return (1);
  40
  41 sub _create_socket
  42 {
  43         my $path = shift;
  44         my $sock = IO::Socket::UNIX->new (Type => SOCK_STREAM, Peer => $path);
  45         if (!$sock)
  46         {
  47                 cluck ("Cannot open UNIX-socket $path: $!");
  48                 return;
  49         }
  50         return ($sock);
  51 } # _create_socket
  52
  53 =head1 VALUE IDENTIFIER
  54
  55 The values in the collectd are identified using an five-tupel (host, plugin,
  56 plugin-instance, type, type-instance) where only plugin-instance and
  57 type-instance may be NULL (or undefined). Many functions expect an
  58 I<%identifier> hash that has at least the members B<host>, B<plugin>, and
  59 B<type>, possibly completed by B<plugin_instance> and B<type_instance>.
  60
  61 Usually you can pass this hash as follows:
  62
  63   $obj->method (host => $host, plugin => $plugin, type => $type, %other_args);
  64
  65 =cut
  66
  67 sub _create_identifier
  68 {
  69         my $args = shift;
  70         my $host;
  71         my $plugin;
  72         my $type;
  73
  74         if (!$args->{'host'} || !$args->{'plugin'} || !$args->{'type'})
  75         {
  76                 cluck ("Need `host', `plugin' and `type'");
  77                 return;
  78         }
  79
  80         $host = $args->{'host'};
  81         $plugin = $args->{'plugin'};
  82         $plugin .= '-' . $args->{'plugin_instance'} if (defined ($args->{'plugin_instance'}));
  83         $type = $args->{'type'};
  84         $type .= '-' . $args->{'type_instance'} if (defined ($args->{'type_instance'}));
  85
  86         return ("$host/$plugin/$type");
  87 } # _create_identifier
  88
  89 sub _parse_identifier
  90 {
  91         my $string = shift;
  92         my $host;
  93         my $plugin;
  94         my $plugin_instance;
  95         my $type;
  96         my $type_instance;
  97         my $ident;
  98
  99         ($host, $plugin, $type) = split ('/', $string);
 100
 101         ($plugin, $plugin_instance) = split ('-', $plugin, 2);
 102         ($type, $type_instance) = split ('-', $type, 2);
 103
 104         $ident =
 105         {
 106                 host => $host,
 107                 plugin => $plugin,
 108                 type => $type
 109         };
 110         $ident->{'plugin_instance'} = $plugin_instance if (defined ($plugin_instance));
 111         $ident->{'type_instance'} = $type_instance if (defined ($type_instance));
 112
 113         return ($ident);
 114 } # _parse_identifier
 115
 116 =head1 PUBLIC METHODS
 117
 118 =over 4
 119
 120 =item I<$obj> = Collectd::Unixsock->B<new> ([I<$path>]);
 121
 122 Creates a new connection to the daemon. The optional I<$path> argument gives
 123 the path to the UNIX socket of the C<unixsock plugin> and defaults to
 124 F</var/run/collectd-unixsock>. Returns the newly created object on success and
 125 false on error.
 126
 127 =cut
 128
 129 sub new
 130 {
 131         my $pkg = shift;
 132         my $path = @_ ? shift : '/var/run/collectd-unixsock';
 133         my $sock = _create_socket ($path) or return;
 134         my $obj = bless (
 135                 {
 136                         path => $path,
 137                         sock => $sock,
 138                         error => 'No error'
 139                 }, $pkg);
 140         return ($obj);
 141 } # new
 142
 143 =item I<$res> = I<$obj>-E<gt>B<getval> (I<%identifier>);
 144
 145 Requests a value-list from the daemon. On success a hash-ref is returned with
 146 the name of each data-source as the key and the according value as, well, the
 147 value. On error false is returned.
 148
 149 =cut
 150
 151 sub getval
 152 {
 153         my $obj = shift;
 154         my %args = @_;
 155
 156         my $status;
 157         my $fh = $obj->{'sock'} or confess;
 158         my $msg;
 159         my $identifier;
 160
 161         my $ret = {};
 162
 163         $identifier = _create_identifier (\%args) or return;
 164
 165         $msg = "GETVAL $identifier\n";
 166         #print "-> $msg";
 167         send ($fh, $msg, 0) or confess ("send: $!");
 168
 169         $msg = undef;
 170         recv ($fh, $msg, 1024, 0) or confess ("recv: $!");
 171         #print "<- $msg";
 172
 173         ($status, $msg) = split (' ', $msg, 2);
 174         if ($status <= 0)
 175         {
 176                 $obj->{'error'} = $msg;
 177                 return;
 178         }
 179
 180         for (split (' ', $msg))
 181         {
 182                 my $entry = $_;
 183                 if ($entry =~ m/^(\w+)=NaN$/)
 184                 {
 185                         $ret->{$1} = undef;
 186                 }
 187                 elsif ($entry =~ m/^(\w+)=($RE{num}{real})$/)
 188                 {
 189                         $ret->{$1} = 0.0 + $2;
 190                 }
 191         }
 192
 193         return ($ret);
 194 } # getval
 195
 196 =item I<$obj>-E<gt>B<putval> (I<%identifier>, B<time> =E<gt> I<$time>, B<values> =E<gt> [...]);
 197
 198 Submits a value-list to the daemon. If the B<time> argument is omitted
 199 C<time()> is used. The requierd argument B<values> is a reference to an array
 200 of values that is to be submitted. The number of values must match the number
 201 of values expected for the given B<type> (see L<VALUE IDENTIFIER>), though this
 202 is checked by the daemon, not the Perl module. Also, gauge data-sources
 203 (e.E<nbsp>g. system-load) may be C<undef>. Returns true upon success and false
 204 otherwise.
 205
 206 =cut
 207
 208 sub putval
 209 {
 210         my $obj = shift;
 211         my %args = @_;
 212
 213         my $status;
 214         my $fh = $obj->{'sock'} or confess;
 215         my $msg;
 216         my $identifier;
 217         my $values;
 218
 219         $identifier = _create_identifier (\%args) or return;
 220         if (!$args{'values'})
 221         {
 222                 cluck ("Need argument `values'");
 223                 return;
 224         }
 225
 226         if (!ref ($args{'values'}))
 227         {
 228                 $values = $args{'values'};
 229         }
 230         else
 231         {
 232                 my $time = $args{'time'} ? $args{'time'} : time ();
 233                 $values = join (':', $time, map { defined ($_) ? $_ : 'U' } (@{$args{'values'}}));
 234         }
 235
 236         $msg = "PUTVAL $identifier $values\n";
 237         #print "-> $msg";
 238         send ($fh, $msg, 0) or confess ("send: $!");
 239         $msg = undef;
 240         recv ($fh, $msg, 1024, 0) or confess ("recv: $!");
 241         #print "<- $msg";
 242
 243         ($status, $msg) = split (' ', $msg, 2);
 244         return (1) if ($status == 0);
 245
 246         $obj->{'error'} = $msg;
 247         return;
 248 } # putval
 249
 250 =item I<$res> = I<$obj>-E<gt>B<listval> ()
 251
 252 Queries a list of values from the daemon. The list is returned as an array of
 253 hash references, where each hash reference is a valid identifier. The C<time>
 254 member of each hash holds the epoch value of the last update of that value.
 255
 256 =cut
 257
 258 sub listval
 259 {
 260         my $obj = shift;
 261         my $msg;
 262         my @ret = ();
 263         my $status;
 264         my $fh = $obj->{'sock'} or confess;
 265
 266         $msg = "LISTVAL\n";
 267         send ($fh, $msg, 0) or confess ("send: $!");
 268
 269         $msg = <$fh>;
 270         ($status, $msg) = split (' ', $msg, 2);
 271         if ($status < 0)
 272         {
 273                 $obj->{'error'} = $msg;
 274                 return;
 275         }
 276
 277         for (my $i = 0; $i < $status; $i++)
 278         {
 279                 my $time;
 280                 my $ident;
 281
 282                 $msg = <$fh>;
 283                 chomp ($msg);
 284
 285                 ($time, $ident) = split (' ', $msg, 2);
 286
 287                 $ident = _parse_identifier ($ident);
 288                 $ident->{'time'} = int ($time);
 289
 290                 push (@ret, $ident);
 291         } # for (i = 0 .. $status)
 292
 293         return (@ret);
 294 } # listval
 295
 296 =item I<$res> = I<$obj>-E<gt>B<putnotif> (B<severity> =E<gt> I<$severity>, B<message> =E<gt> I<$message>, ...);
 297
 298 Submits a notification to the daemon.
 299
 300 Valid options are:
 301
 302 =over 4
 303
 304 =item B<severity>
 305
 306 Sets the severity of the notification. The value must be one of the following
 307 strings: C<failure>, C<warning>, or C<okay>. Case does not matter. This option
 308 is mandatory.
 309
 310 =item B<message>
 311
 312 Sets the message of the notification. This option is mandatory.
 313
 314 =item B<time>
 315
 316 Sets the time. If omitted, C<time()> is used.
 317
 318 =item I<Value identifier>
 319
 320 All the other fields of the value identifiers, B<host>, B<plugin>,
 321 B<plugin_instance>, B<type>, and B<type_instance>, are optional. When given,
 322 the notification is associated with the performance data of that identifier.
 323 For more details, please see L<collectd-unixsock(5)>.
 324
 325 =back
 326
 327 =cut
 328
 329 sub putnotif
 330 {
 331         my $obj = shift;
 332         my %args = @_;
 333
 334         my $status;
 335         my $fh = $obj->{'sock'} or confess;
 336
 337         my $msg; # message sent to the socket
 338         my $opt_msg; # message of the notification
 339
 340         if (!$args{'message'})
 341         {
 342                 cluck ("Need argument `message'");
 343                 return;
 344         }
 345         if (!$args{'severity'})
 346         {
 347                 cluck ("Need argument `severity'");
 348                 return;
 349         }
 350         $args{'severity'} = lc ($args{'severity'});
 351         if (($args{'severity'} ne 'failure')
 352                 && ($args{'severity'} ne 'warning')
 353                 && ($args{'severity'} ne 'okay'))
 354         {
 355                 cluck ("Invalid `severity: " . $args{'severity'});
 356                 return;
 357         }
 358
 359         if (!$args{'time'})
 360         {
 361                 $args{'time'} = time ();
 362         }
 363
 364         $opt_msg = $args{'message'};
 365         delete ($args{'message'});
 366
 367         $msg = 'PUTNOTIF '
 368         . join (' ', map { $_ . '=' . $args{$_} } (keys %args))
 369         . " message=$opt_msg\n";
 370
 371         send ($fh, $msg, 0) or confess ("send: $!");
 372         $msg = undef;
 373         recv ($fh, $msg, 1024, 0) or confess ("recv: $!");
 374
 375         ($status, $msg) = split (' ', $msg, 2);
 376         return (1) if ($status == 0);
 377
 378         $obj->{'error'} = $msg;
 379         return;
 380 } # putnotif
 381
 382 =item I<$obj>-E<gt>destroy ();
 383
 384 Closes the socket before the object is destroyed. This function is also
 385 automatically called then the object goes out of scope.
 386
 387 =back
 388
 389 =cut
 390
 391 sub destroy
 392 {
 393         my $obj = shift;
 394         if ($obj->{'sock'})
 395         {
 396                 close ($obj->{'sock'});
 397                 delete ($obj->{'sock'});
 398         }
 399 }
 400
 401 sub DESTROY
 402 {
 403         my $obj = shift;
 404         $obj->destroy ();
 405 }
 406
 407 =head1 SEE ALSO
 408
 409 L<collectd(1)>,
 410 L<collectd.conf(5)>,
 411 L<collectd-unixsock(5)>
 412
 413 =head1 AUTHOR
 414
 415 Florian octo Forster E<lt>octo@verplant.orgE<gt>
 416
 417 =cut