contrib/cussh.pl

   1 #!/usr/bin/perl
   2 #
   3 # collectd - contrib/cussh.pl
   4 # Copyright (C) 2007-2009  Sebastian Harl
   5 #
   6 # This program is free software; you can redistribute it and/or modify it
   7 # under the terms of the GNU General Public License as published by the
   8 # Free Software Foundation; only version 2 of the License is applicable.
   9 #
  10 # This program is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 # General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License along
  16 # with this program; if not, write to the Free Software Foundation, Inc.,
  17 # 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
  18 #
  19 # Author:
  20 #   Sebastian Harl <sh at tokkee.org>
  21 #
  22
  23 =head1 NAME
  24
  25 cussh - collectd UNIX socket shell
  26
  27 =head1 SYNOPSIS
  28
  29 B<cussh> [I<E<lt>pathE<gt>>]
  30
  31 =head1 DESCRIPTION
  32
  33 B<collectd>'s unixsock plugin allows external programs to access the values it
  34 has collected or received and to submit own values. This is a little
  35 interactive frontend for this plugin.
  36
  37 =head1 OPTIONS
  38
  39 =over 4
  40
  41 =item I<E<lt>pathE<gt>>
  42
  43 The path to the UNIX socket provided by collectd's unixsock plugin. (Default:
  44 F</var/run/collectd-unixsock>)
  45
  46 =back
  47
  48 =cut
  49
  50 use strict;
  51 use warnings;
  52
  53 use Collectd::Unixsock();
  54
  55 { # main
  56         my $path = $ARGV[0] || "/var/run/collectd-unixsock";
  57         my $sock = Collectd::Unixsock->new($path);
  58
  59         my $cmds = {
  60                 HELP    => \&cmd_help,
  61                 PUTVAL  => \&putval,
  62                 GETVAL  => \&getval,
  63                 FLUSH   => \&flush,
  64                 LISTVAL => \&listval,
  65                 PUTNOTIF => \&putnotif,
  66         };
  67
  68         if (! $sock) {
  69                 print STDERR "Unable to connect to $path!\n";
  70                 exit 1;
  71         }
  72
  73         print "cussh version 0.2, Copyright (C) 2007-2008 Sebastian Harl\n"
  74                 . "cussh comes with ABSOLUTELY NO WARRANTY. This is free software,\n"
  75                 . "and you are welcome to redistribute it under certain conditions.\n"
  76                 . "See the GNU General Public License 2 for more details.\n\n";
  77
  78         while (1) {
  79                 print "cussh> ";
  80                 my $line = <STDIN>;
  81
  82                 last if (! $line);
  83
  84                 chomp $line;
  85
  86                 last if ($line =~ m/^quit$/i);
  87
  88                 my ($cmd) = $line =~ m/^(\w+)\s*/;
  89                 $line = $';
  90
  91                 next if (! $cmd);
  92                 $cmd = uc $cmd;
  93
  94                 my $f = undef;
  95                 if (defined $cmds->{$cmd}) {
  96                         $f = $cmds->{$cmd};
  97                 }
  98                 else {
  99                         print STDERR "ERROR: Unknown command $cmd!\n";
 100                         next;
 101                 }
 102
 103                 if (! $f->($sock, $line)) {
 104                         print STDERR "ERROR: Command failed!\n";
 105                         next;
 106                 }
 107         }
 108
 109         $sock->destroy();
 110         exit 0;
 111 }
 112
 113 sub tokenize {
 114         my $line     = shift || return;
 115         my $line_ptr = $line;
 116         my @line     = ();
 117
 118         my $token_pattern = qr/[^"\s]+|"[^"]+"/;
 119
 120         while (my ($token) = $line_ptr =~ m/^($token_pattern)\s+/) {
 121                 $line_ptr = $';
 122                 push @line, $token;
 123         }
 124
 125         if ($line_ptr =~ m/^$token_pattern$/) {
 126                 push @line, $line_ptr;
 127         }
 128         else {
 129                 my ($token) = split m/ /, $line_ptr, 1;
 130                 print STDERR "Failed to parse line: $line\n";
 131                 print STDERR "Parse error near token \"$token\".\n";
 132                 return;
 133         }
 134
 135         foreach my $l (@line) {
 136                 if ($l =~ m/^"(.*)"$/) {
 137                         $l = $1;
 138                 }
 139         }
 140         return @line;
 141 }
 142
 143 sub getid {
 144         my $string = shift || return;
 145
 146         my ($h, $p, $pi, $t, $ti) =
 147                 $string =~ m#^([^/]+)/([^/-]+)(?:-([^/]+))?/([^/-]+)(?:-([^/]+))?\s*#;
 148         $string = $';
 149
 150         return if ((! $h) || (! $p) || (! $t));
 151
 152         my %id = ();
 153
 154         ($id{'host'}, $id{'plugin'}, $id{'type'}) = ($h, $p, $t);
 155
 156         $id{'plugin_instance'} = $pi if defined ($pi);
 157         $id{'type_instance'} = $ti if defined ($ti);
 158         return \%id;
 159 }
 160
 161 sub putid {
 162         my $ident = shift || return;
 163
 164         my $string;
 165
 166         $string = $ident->{'host'} . "/" . $ident->{'plugin'};
 167
 168         if (defined $ident->{'plugin_instance'}) {
 169                 $string .= "-" . $ident->{'plugin_instance'};
 170         }
 171
 172         $string .= "/" . $ident->{'type'};
 173
 174         if (defined $ident->{'type_instance'}) {
 175                 $string .= "-" . $ident->{'type_instance'};
 176         }
 177         return $string;
 178 }
 179
 180 =head1 COMMANDS
 181
 182 =over 4
 183
 184 =item B<HELP>
 185
 186 =cut
 187
 188 sub cmd_help {
 189         my $sock = shift;
 190         my $line = shift || '';
 191
 192         my @line = tokenize($line);
 193         my $cmd = shift (@line);
 194
 195         my %text = (
 196                 help => <<HELP,
 197 Available commands:
 198   HELP
 199   PUTVAL
 200   GETVAL
 201   FLUSH
 202   LISTVAL
 203   PUTNOTIF
 204
 205 See the embedded Perldoc documentation for details. To do that, run:
 206   perldoc $0
 207 HELP
 208                 putval => <<HELP,
 209 PUTVAL <id> <value0> [<value1> ...]
 210
 211 Submits a value to the daemon.
 212 HELP
 213                 getval => <<HELP,
 214 GETVAL <id>
 215
 216 Retrieves the current value or values from the daemon.
 217 HELP
 218                 flush => <<HELP,
 219 FLUSH [plugin=<plugin>] [timeout=<timeout>] [identifier=<id>] [...]
 220
 221 Sends a FLUSH command to the daemon.
 222 HELP
 223                 listval => <<HELP,
 224 LISTVAL
 225
 226 Prints a list of available values.
 227 HELP
 228                 putnotif => <<HELP
 229 PUTNOTIF severity=<severity> [...] message=<message>
 230
 231 Sends a notifications message to the daemon.
 232 HELP
 233         );
 234
 235         if (!$cmd)
 236         {
 237                 $cmd = 'help';
 238         }
 239         if (!exists ($text{$cmd}))
 240         {
 241                 print STDOUT "Unknown command: " . uc ($cmd) . "\n\n";
 242                 $cmd = 'help';
 243         }
 244
 245         print STDOUT $text{$cmd};
 246
 247         return 1;
 248 } # cmd_help
 249
 250 =item B<PUTVAL> I<Identifier> I<Valuelist>
 251
 252 =cut
 253
 254 sub putval {
 255         my $sock = shift || return;
 256         my $line = shift || return;
 257
 258         my @line = tokenize($line);
 259
 260         my $id;
 261         my $ret;
 262
 263         if (! @line) {
 264                 return;
 265         }
 266
 267         if (scalar(@line) < 2) {
 268                 print STDERR "Synopsis: PUTVAL <id> <value0> [<value1> ...]" . $/;
 269                 return;
 270         }
 271
 272         $id = getid($line[0]);
 273
 274         if (! $id) {
 275                 print STDERR "Invalid id \"$line[0]\"." . $/;
 276                 return;
 277         }
 278
 279         my ($time, @values) = split m/:/, $line;
 280         $ret = $sock->putval(%$id, time => $time, values => \@values);
 281
 282         if (! $ret) {
 283                 print STDERR "socket error: " . $sock->{'error'} . $/;
 284         }
 285         return $ret;
 286 }
 287
 288 =item B<GETVAL> I<Identifier>
 289
 290 =cut
 291
 292 sub getval {
 293         my $sock = shift || return;
 294         my $line = shift || return;
 295
 296         my @line = tokenize($line);
 297
 298         my $id;
 299         my $vals;
 300
 301         if (! @line) {
 302                 return;
 303         }
 304
 305         if (scalar(@line) < 1) {
 306                 print STDERR "Synopsis: GETVAL <id>" . $/;
 307                 return;
 308         }
 309
 310         $id = getid($line[0]);
 311
 312         if (! $id) {
 313                 print STDERR "Invalid id \"$line[0]\"." . $/;
 314                 return;
 315         }
 316
 317         $vals = $sock->getval(%$id);
 318
 319         if (! $vals) {
 320                 print STDERR "socket error: " . $sock->{'error'} . $/;
 321                 return;
 322         }
 323
 324         foreach my $key (keys %$vals) {
 325                 print "\t$key: $vals->{$key}\n";
 326         }
 327         return 1;
 328 }
 329
 330 =item B<FLUSH> [B<timeout>=I<$timeout>] [B<plugin>=I<$plugin>[ ...]]
 331
 332 =cut
 333
 334 sub flush {
 335         my $sock = shift || return;
 336         my $line = shift;
 337
 338         my @line = tokenize($line);
 339
 340         my $res;
 341
 342         if (! $line) {
 343                 $res = $sock->flush();
 344         }
 345         else {
 346                 my %args = ();
 347
 348                 foreach my $i (@line) {
 349                         my ($option, $value) = $i =~ m/^([^=]+)=(.+)$/;
 350                         next if (! ($option && $value));
 351
 352                         if ($option eq "plugin") {
 353                                 push @{$args{"plugins"}}, $value;
 354                         }
 355                         elsif ($option eq "timeout") {
 356                                 $args{"timeout"} = $value;
 357                         }
 358                         elsif ($option eq "identifier") {
 359                                 my $id = getid ($value);
 360                                 if (!$id)
 361                                 {
 362                                         print STDERR "Not a valid identifier: \"$value\"\n";
 363                                         next;
 364                                 }
 365                                 push @{$args{"identifier"}}, $id;
 366                         }
 367                         else {
 368                                 print STDERR "Invalid option \"$option\".\n";
 369                                 return;
 370                         }
 371                 }
 372
 373                 $res = $sock->flush(%args);
 374         }
 375
 376         if (! $res) {
 377                 print STDERR "socket error: " . $sock->{'error'} . $/;
 378         }
 379         return $res;
 380 }
 381
 382 =item B<LISTVAL>
 383
 384 =cut
 385
 386 sub listval {
 387         my $sock = shift || return;
 388         my $line = shift;
 389
 390         my @res;
 391
 392         if ($line ne "") {
 393                 print STDERR "Synopsis: LISTVAL" . $/;
 394                 return;
 395         }
 396
 397         @res = $sock->listval();
 398
 399         if (! @res) {
 400                 print STDERR "socket error: " . $sock->{'error'} . $/;
 401                 return;
 402         }
 403
 404         foreach my $ident (@res) {
 405                 print $ident->{'time'} . " " . putid($ident) . $/;
 406         }
 407         return 1;
 408 }
 409
 410 =item B<PUTNOTIF> [[B<severity>=I<$severity>] [B<message>=I<$message>] [ ...]]
 411
 412 =cut
 413
 414 sub putnotif {
 415         my $sock = shift || return;
 416         my $line = shift || return;
 417
 418         my @line = tokenize($line);
 419
 420         my $ret;
 421
 422         my (%values) = ();
 423         foreach my $i (@line) {
 424                 my ($key, $val) = split m/=/, $i, 2;
 425                 if ($key && $val) {
 426                         $values{$key} = $val;
 427                 }
 428                 else {
 429                         $values{'message'} = defined($values{'message'})
 430                                 ? ($values{'message'} . ' ' . $key)
 431                                 : $key;
 432                 }
 433         }
 434         $values{'time'} ||= time();
 435
 436         $ret = $sock->putnotif(%values);
 437         if (! $ret) {
 438                 print STDERR "socket error: " . $sock->{'error'} . $/;
 439         }
 440         return $ret;
 441 }
 442
 443 =back
 444
 445 These commands follow the exact same syntax as described in
 446 L<collectd-unixsock(5)>.
 447
 448 =head1 SEE ALSO
 449
 450 L<collectd(1)>, L<collectd-unisock(5)>
 451
 452 =head1 AUTHOR
 453
 454 Written by Sebastian Harl E<lt>sh@tokkee.orgE<gt>.
 455
 456 B<collectd> has been written by Florian Forster and others.
 457
 458 =head1 COPYRIGHT
 459
 460 Copyright (C) 2007 Sebastian Harl.
 461
 462 This program is free software; you can redistribute it and/or modify it under
 463 the terms of the GNU General Public License as published by the Free Software
 464 Foundation; only version 2 of the License is applicable.
 465
 466 =cut
 467
 468 # vim: set sw=4 ts=4 tw=78 noexpandtab :