bindings/perl/Collectd.pm

   1 # collectd - Collectd.pm
   2 # Copyright (C) 2007, 2008  Sebastian Harl
   3 #
   4 # This program is free software; you can redistribute it and/or modify it
   5 # under the terms of the GNU General Public License as published by the
   6 # Free Software Foundation; only version 2 of the License is applicable.
   7 #
   8 # This program is distributed in the hope that it will be useful, but
   9 # WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11 # General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License along
  14 # with this program; if not, write to the Free Software Foundation, Inc.,
  15 # 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
  16 #
  17 # Author:
  18 #   Sebastian Harl <sh at tokkee.org>
  19
  20 package Collectd;
  21
  22 use strict;
  23 use warnings;
  24
  25 use Config;
  26
  27 use threads;
  28 use threads::shared;
  29
  30 BEGIN {
  31         if (! $Config{'useithreads'}) {
  32                 die "Perl does not support ithreads!";
  33         }
  34 }
  35
  36 require Exporter;
  37
  38 our @ISA = qw( Exporter );
  39
  40 our %EXPORT_TAGS = (
  41         'plugin' => [ qw(
  42                         plugin_register
  43                         plugin_unregister
  44                         plugin_dispatch_values
  45                         plugin_write
  46                         plugin_flush
  47                         plugin_flush_one
  48                         plugin_flush_all
  49                         plugin_dispatch_notification
  50                         plugin_log
  51         ) ],
  52         'types' => [ qw(
  53                         TYPE_INIT
  54                         TYPE_READ
  55                         TYPE_WRITE
  56                         TYPE_SHUTDOWN
  57                         TYPE_LOG
  58                         TYPE_NOTIF
  59                         TYPE_FLUSH
  60                         TYPE_CONFIG
  61                         TYPE_DATASET
  62         ) ],
  63         'ds_types' => [ qw(
  64                         DS_TYPE_COUNTER
  65                         DS_TYPE_GAUGE
  66         ) ],
  67         'log' => [ qw(
  68                         ERROR
  69                         WARNING
  70                         NOTICE
  71                         INFO
  72                         DEBUG
  73                         LOG_ERR
  74                         LOG_WARNING
  75                         LOG_NOTICE
  76                         LOG_INFO
  77                         LOG_DEBUG
  78         ) ],
  79         'notif' => [ qw(
  80                         NOTIF_FAILURE
  81                         NOTIF_WARNING
  82                         NOTIF_OKAY
  83         ) ],
  84         'globals' => [ qw(
  85                         $hostname_g
  86                         $interval_g
  87         ) ],
  88 );
  89
  90 {
  91         my %seen;
  92         push @{$EXPORT_TAGS{'all'}}, grep {! $seen{$_}++ } @{$EXPORT_TAGS{$_}}
  93                 foreach keys %EXPORT_TAGS;
  94 }
  95
  96 # global variables
  97 our $hostname_g;
  98 our $interval_g;
  99
 100 Exporter::export_ok_tags ('all');
 101
 102 my @plugins : shared = ();
 103 my %cf_callbacks : shared = ();
 104
 105 my %types = (
 106         TYPE_INIT,     "init",
 107         TYPE_READ,     "read",
 108         TYPE_WRITE,    "write",
 109         TYPE_SHUTDOWN, "shutdown",
 110         TYPE_LOG,      "log",
 111         TYPE_NOTIF,    "notify",
 112         TYPE_FLUSH,    "flush"
 113 );
 114
 115 foreach my $type (keys %types) {
 116         $plugins[$type] = &share ({});
 117 }
 118
 119 sub _log {
 120         my $caller = shift;
 121         my $lvl    = shift;
 122         my $msg    = shift;
 123
 124         if ("Collectd" eq $caller) {
 125                 $msg = "perl: $msg";
 126         }
 127         return plugin_log ($lvl, $msg);
 128 }
 129
 130 sub ERROR   { _log (scalar caller, LOG_ERR,     shift); }
 131 sub WARNING { _log (scalar caller, LOG_WARNING, shift); }
 132 sub NOTICE  { _log (scalar caller, LOG_NOTICE,  shift); }
 133 sub INFO    { _log (scalar caller, LOG_INFO,    shift); }
 134 sub DEBUG   { _log (scalar caller, LOG_DEBUG,   shift); }
 135
 136 sub plugin_call_all {
 137         my $type = shift;
 138
 139         my %plugins;
 140
 141         our $cb_name = undef;
 142
 143         if (! defined $type) {
 144                 return;
 145         }
 146
 147         if (TYPE_LOG != $type) {
 148                 DEBUG ("Collectd::plugin_call: type = \"$type\", args=\"@_\"");
 149         }
 150
 151         if (! defined $plugins[$type]) {
 152                 ERROR ("Collectd::plugin_call: unknown type \"$type\"");
 153                 return;
 154         }
 155
 156         {
 157                 lock %{$plugins[$type]};
 158                 %plugins = %{$plugins[$type]};
 159         }
 160
 161         foreach my $plugin (keys %plugins) {
 162                 my $p = $plugins{$plugin};
 163
 164                 my $status = 0;
 165
 166                 if ($p->{'wait_left'} > 0) {
 167                         $p->{'wait_left'} -= $interval_g;
 168                 }
 169
 170                 next if ($p->{'wait_left'} > 0);
 171
 172                 $cb_name = $p->{'cb_name'};
 173                 $status = call_by_name (@_);
 174
 175                 if (! $status) {
 176                         my $err = undef;
 177
 178                         if ($@) {
 179                                 $err = $@;
 180                         }
 181                         else {
 182                                 $err = "callback returned false";
 183                         }
 184
 185                         if (TYPE_LOG != $type) {
 186                                 ERROR ("Execution of callback \"$cb_name\" failed: $err");
 187                         }
 188
 189                         $status = 0;
 190                 }
 191
 192                 if ($status) {
 193                         $p->{'wait_left'} = 0;
 194                         $p->{'wait_time'} = $interval_g;
 195                 }
 196                 elsif (TYPE_READ == $type) {
 197                         if ($p->{'wait_time'} < $interval_g) {
 198                                 $p->{'wait_time'} = $interval_g;
 199                         }
 200
 201                         $p->{'wait_left'} = $p->{'wait_time'};
 202                         $p->{'wait_time'} *= 2;
 203
 204                         if ($p->{'wait_time'} > 86400) {
 205                                 $p->{'wait_time'} = 86400;
 206                         }
 207
 208                         WARNING ("${plugin}->read() failed with status $status. "
 209                                 . "Will suspend it for $p->{'wait_left'} seconds.");
 210                 }
 211                 elsif (TYPE_INIT == $type) {
 212                         ERROR ("${plugin}->init() failed with status $status. "
 213                                 . "Plugin will be disabled.");
 214
 215                         foreach my $type (keys %types) {
 216                                 plugin_unregister ($type, $plugin);
 217                         }
 218                 }
 219                 elsif (TYPE_LOG != $type) {
 220                         WARNING ("${plugin}->$types{$type}() failed with status $status.");
 221                 }
 222         }
 223         return 1;
 224 }
 225
 226 # Collectd::plugin_register (type, name, data).
 227 #
 228 # type:
 229 #   init, read, write, shutdown, data set
 230 #
 231 # name:
 232 #   name of the plugin
 233 #
 234 # data:
 235 #   reference to the plugin's subroutine that does the work or the data set
 236 #   definition
 237 sub plugin_register {
 238         my $type = shift;
 239         my $name = shift;
 240         my $data = shift;
 241
 242         DEBUG ("Collectd::plugin_register: "
 243                 . "type = \"$type\", name = \"$name\", data = \"$data\"");
 244
 245         if (! ((defined $type) && (defined $name) && (defined $data))) {
 246                 ERROR ("Usage: Collectd::plugin_register (type, name, data)");
 247                 return;
 248         }
 249
 250         if ((! defined $plugins[$type]) && (TYPE_DATASET != $type)
 251                         && (TYPE_CONFIG != $type)) {
 252                 ERROR ("Collectd::plugin_register: Invalid type \"$type\"");
 253                 return;
 254         }
 255
 256         if ((TYPE_DATASET == $type) && ("ARRAY" eq ref $data)) {
 257                 return plugin_register_data_set ($name, $data);
 258         }
 259         elsif ((TYPE_CONFIG == $type) && (! ref $data)) {
 260                 my $pkg = scalar caller;
 261
 262                 if ($data !~ m/^$pkg\:\:/) {
 263                         $data = $pkg . "::" . $data;
 264                 }
 265
 266                 lock %cf_callbacks;
 267                 $cf_callbacks{$name} = $data;
 268         }
 269         elsif ((TYPE_DATASET != $type) && (! ref $data)) {
 270                 my $pkg = scalar caller;
 271
 272                 my %p : shared;
 273
 274                 if ($data !~ m/^$pkg\:\:/) {
 275                         $data = $pkg . "::" . $data;
 276                 }
 277
 278                 %p = (
 279                         wait_time => $interval_g,
 280                         wait_left => 0,
 281                         cb_name   => $data,
 282                 );
 283
 284                 lock %{$plugins[$type]};
 285                 $plugins[$type]->{$name} = \%p;
 286         }
 287         else {
 288                 ERROR ("Collectd::plugin_register: Invalid data.");
 289                 return;
 290         }
 291         return 1;
 292 }
 293
 294 sub plugin_unregister {
 295         my $type = shift;
 296         my $name = shift;
 297
 298         DEBUG ("Collectd::plugin_unregister: type = \"$type\", name = \"$name\"");
 299
 300         if (! ((defined $type) && (defined $name))) {
 301                 ERROR ("Usage: Collectd::plugin_unregister (type, name)");
 302                 return;
 303         }
 304
 305         if (TYPE_DATASET == $type) {
 306                 return plugin_unregister_data_set ($name);
 307         }
 308         elsif (TYPE_CONFIG == $type) {
 309                 lock %cf_callbacks;
 310                 delete $cf_callbacks{$name};
 311         }
 312         elsif (defined $plugins[$type]) {
 313                 lock %{$plugins[$type]};
 314                 delete $plugins[$type]->{$name};
 315         }
 316         else {
 317                 ERROR ("Collectd::plugin_unregister: Invalid type.");
 318                 return;
 319         }
 320 }
 321
 322 sub plugin_write {
 323         my %args = @_;
 324
 325         my @plugins    = ();
 326         my @datasets   = ();
 327         my @valuelists = ();
 328
 329         if (! defined $args{'valuelists'}) {
 330                 ERROR ("Collectd::plugin_write: Missing 'valuelists' argument.");
 331                 return;
 332         }
 333
 334         DEBUG ("Collectd::plugin_write:"
 335                 . (defined ($args{'plugins'}) ? " plugins = $args{'plugins'}" : "")
 336                 . (defined ($args{'datasets'}) ? " datasets = $args{'datasets'}" : "")
 337                 . " valueslists = $args{'valuelists'}");
 338
 339         if (defined ($args{'plugins'})) {
 340                 if ("ARRAY" eq ref ($args{'plugins'})) {
 341                         @plugins = @{$args{'plugins'}};
 342                 }
 343                 else {
 344                         @plugins = ($args{'plugins'});
 345                 }
 346         }
 347         else {
 348                 @plugins = (undef);
 349         }
 350
 351         if ("ARRAY" eq ref ($args{'valuelists'})) {
 352                 @valuelists = @{$args{'valuelists'}};
 353         }
 354         else {
 355                 @valuelists = ($args{'valuelists'});
 356         }
 357
 358         if (defined ($args{'datasets'})) {
 359                 if ("ARRAY" eq ref ($args{'datasets'})) {
 360                         @datasets = @{$args{'datasets'}};
 361                 }
 362                 else {
 363                         @datasets = ($args{'datasets'});
 364                 }
 365         }
 366         else {
 367                 @datasets = (undef) x scalar (@valuelists);
 368         }
 369
 370         if ($#datasets != $#valuelists) {
 371                 ERROR ("Collectd::plugin_write: Invalid number of datasets.");
 372                 return;
 373         }
 374
 375         foreach my $plugin (@plugins) {
 376                 for (my $i = 0; $i < scalar (@valuelists); ++$i) {
 377                         _plugin_write ($plugin, $datasets[$i], $valuelists[$i]);
 378                 }
 379         }
 380 }
 381
 382 sub plugin_flush {
 383         my %args = @_;
 384
 385         my $timeout = -1;
 386         my @plugins = ();
 387         my @ids     = ();
 388
 389         DEBUG ("Collectd::plugin_flush:"
 390                 . (defined ($args{'timeout'}) ? " timeout = $args{'timeout'}" : "")
 391                 . (defined ($args{'plugins'}) ? " plugins = $args{'plugins'}" : "")
 392                 . (defined ($args{'identifiers'})
 393                         ? " identifiers = $args{'identifiers'}" : ""));
 394
 395         if (defined ($args{'timeout'}) && ($args{'timeout'} > 0)) {
 396                 $timeout = $args{'timeout'};
 397         }
 398
 399         if (defined ($args{'plugins'})) {
 400                 if ("ARRAY" eq ref ($args{'plugins'})) {
 401                         @plugins = @{$args{'plugins'}};
 402                 }
 403                 else {
 404                         @plugins = ($args{'plugins'});
 405                 }
 406         }
 407         else {
 408                 @plugins = (undef);
 409         }
 410
 411         if (defined ($args{'identifiers'})) {
 412                 if ("ARRAY" eq ref ($args{'identifiers'})) {
 413                         @ids = @{$args{'identifiers'}};
 414                 }
 415                 else {
 416                         @ids = ($args{'identifiers'});
 417                 }
 418         }
 419         else {
 420                 @ids = (undef);
 421         }
 422
 423         foreach my $plugin (@plugins) {
 424                 foreach my $id (@ids) {
 425                         _plugin_flush($plugin, $timeout, $id);
 426                 }
 427         }
 428 }
 429
 430 sub plugin_flush_one {
 431         my $timeout = shift;
 432         my $name    = shift;
 433
 434         WARNING ("Collectd::plugin_flush_one is deprecated - "
 435                 . "use Collectd::plugin_flush instead.");
 436
 437         if (! (defined ($timeout) && defined ($name))) {
 438                 ERROR ("Usage: Collectd::plugin_flush_one(timeout, name)");
 439                 return;
 440         }
 441
 442         plugin_flush (plugins => $name, timeout => $timeout);
 443 }
 444
 445 sub plugin_flush_all {
 446         my $timeout = shift;
 447
 448         WARNING ("Collectd::plugin_flush_all is deprecated - "
 449                 . "use Collectd::plugin_flush instead.");
 450
 451         if (! defined ($timeout)) {
 452                 ERROR ("Usage: Collectd::plugin_flush_all(timeout)");
 453                 return;
 454         }
 455
 456         plugin_flush (timeout => $timeout);
 457 }
 458
 459 sub _plugin_dispatch_config {
 460         my $plugin = shift;
 461         my $config = shift;
 462
 463         our $cb_name = undef;
 464
 465         if (! (defined ($plugin) && defined ($config))) {
 466                 return;
 467         }
 468
 469         if (! defined $cf_callbacks{$plugin}) {
 470                 WARNING ("Found a configuration for the \"$plugin\" plugin, but "
 471                         . "the plugin isn't loaded or didn't register "
 472                         . "a configuration callback.");
 473                 return;
 474         }
 475
 476         {
 477                 lock %cf_callbacks;
 478                 $cb_name = $cf_callbacks{$plugin};
 479         }
 480         call_by_name ($config);
 481 }
 482
 483 1;
 484
 485 # vim: set sw=4 ts=4 tw=78 noexpandtab :
 486