collectd.spec: add hugepages plugin
[collectd.git] / 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                 GETTHRESHOLD  => \&getthreshold,
64                 FLUSH   => \&flush,
65                 LISTVAL => \&listval,
66                 PUTNOTIF => \&putnotif,
67         };
68
69         if (! $sock) {
70                 print STDERR "Unable to connect to $path!\n";
71                 exit 1;
72         }
73
74         print "cussh version 0.2, Copyright (C) 2007-2008 Sebastian Harl\n"
75                 . "cussh comes with ABSOLUTELY NO WARRANTY. This is free software,\n"
76                 . "and you are welcome to redistribute it under certain conditions.\n"
77                 . "See the GNU General Public License 2 for more details.\n\n";
78
79         while (1) {
80                 print "cussh> ";
81                 my $line = <STDIN>;
82
83                 last if (! $line);
84
85                 chomp $line;
86
87                 last if ($line =~ m/^quit$/i);
88
89                 my ($cmd) = $line =~ m/^(\w+)\s*/;
90                 $line = $';
91
92                 next if (! $cmd);
93                 $cmd = uc $cmd;
94
95                 my $f = undef;
96                 if (defined $cmds->{$cmd}) {
97                         $f = $cmds->{$cmd};
98                 }
99                 else {
100                         print STDERR "ERROR: Unknown command $cmd!\n";
101                         next;
102                 }
103
104                 if (! $f->($sock, $line)) {
105                         print STDERR "ERROR: Command failed!\n";
106                         next;
107                 }
108         }
109
110         $sock->destroy();
111         exit 0;
112 }
113
114 sub tokenize {
115         my $line     = shift || return;
116         my $line_ptr = $line;
117         my @line     = ();
118
119         my $token_pattern = qr/[^"\s]+|"[^"]+"/;
120
121         while (my ($token) = $line_ptr =~ m/^($token_pattern)\s+/) {
122                 $line_ptr = $';
123                 push @line, $token;
124         }
125
126         if ($line_ptr =~ m/^$token_pattern$/) {
127                 push @line, $line_ptr;
128         }
129         else {
130                 my ($token) = split m/ /, $line_ptr, 1;
131                 print STDERR "Failed to parse line: $line\n";
132                 print STDERR "Parse error near token \"$token\".\n";
133                 return;
134         }
135
136         foreach my $l (@line) {
137                 if ($l =~ m/^"(.*)"$/) {
138                         $l = $1;
139                 }
140         }
141         return @line;
142 }
143
144 sub getid {
145         my $string = shift || return;
146
147         my ($h, $p, $pi, $t, $ti) =
148                 $string =~ m#^([^/]+)/([^/-]+)(?:-([^/]+))?/([^/-]+)(?:-([^/]+))?\s*#;
149         $string = $';
150
151         return if ((! $h) || (! $p) || (! $t));
152
153         my %id = ();
154
155         ($id{'host'}, $id{'plugin'}, $id{'type'}) = ($h, $p, $t);
156
157         $id{'plugin_instance'} = $pi if defined ($pi);
158         $id{'type_instance'} = $ti if defined ($ti);
159         return \%id;
160 }
161
162 sub putid {
163         my $ident = shift || return;
164
165         my $string;
166
167         $string = $ident->{'host'} . "/" . $ident->{'plugin'};
168
169         if (defined $ident->{'plugin_instance'}) {
170                 $string .= "-" . $ident->{'plugin_instance'};
171         }
172
173         $string .= "/" . $ident->{'type'};
174
175         if (defined $ident->{'type_instance'}) {
176                 $string .= "-" . $ident->{'type_instance'};
177         }
178         return $string;
179 }
180
181 =head1 COMMANDS
182
183 =over 4
184
185 =item B<HELP>
186
187 =cut
188
189 sub cmd_help {
190         my $sock = shift;
191         my $line = shift || '';
192
193         my @line = tokenize($line);
194         my $cmd = shift (@line);
195
196         my %text = (
197                 help => <<HELP,
198 Available commands:
199   HELP
200   PUTVAL
201   GETVAL
202   GETTHRESHOLD
203   FLUSH
204   LISTVAL
205   PUTNOTIF
206
207 See the embedded Perldoc documentation for details. To do that, run:
208   perldoc $0
209 HELP
210                 putval => <<HELP,
211 PUTVAL <id> <value0> [<value1> ...]
212
213 Submits a value to the daemon.
214 HELP
215                 getval => <<HELP,
216 GETVAL <id>
217
218 Retrieves the current value or values from the daemon.
219 HELP
220                 flush => <<HELP,
221 FLUSH [plugin=<plugin>] [timeout=<timeout>] [identifier=<id>] [...]
222
223 Sends a FLUSH command to the daemon.
224 HELP
225                 listval => <<HELP,
226 LISTVAL
227
228 Prints a list of available values.
229 HELP
230                 putnotif => <<HELP
231 PUTNOTIF severity=<severity> [...] message=<message>
232
233 Sends a notifications message to the daemon.
234 HELP
235         );
236
237         if (!$cmd)
238         {
239                 $cmd = 'help';
240         }
241         if (!exists ($text{$cmd}))
242         {
243                 print STDOUT "Unknown command: " . uc ($cmd) . "\n\n";
244                 $cmd = 'help';
245         }
246
247         print STDOUT $text{$cmd};
248
249         return 1;
250 } # cmd_help
251
252 =item B<PUTVAL> I<Identifier> I<Valuelist>
253
254 =cut
255
256 sub putval {
257         my $sock = shift || return;
258         my $line = shift || return;
259
260         my @line = tokenize($line);
261
262         my $id;
263         my $ret;
264
265         if (! @line) {
266                 return;
267         }
268
269         if (scalar(@line) < 2) {
270                 print STDERR "Synopsis: PUTVAL <id> <value0> [<value1> ...]" . $/;
271                 return;
272         }
273
274         $id = getid($line[0]);
275
276         if (! $id) {
277                 print STDERR "Invalid id \"$line[0]\"." . $/;
278                 return;
279         }
280
281         my ($time, @values) = split m/:/, $line;
282         $ret = $sock->putval(%$id, time => $time, values => \@values);
283
284         if (! $ret) {
285                 print STDERR "socket error: " . $sock->{'error'} . $/;
286         }
287         return $ret;
288 }
289
290 =item B<GETVAL> I<Identifier>
291
292 =cut
293
294 sub getval {
295         my $sock = shift || return;
296         my $line = shift || return;
297
298         my @line = tokenize($line);
299
300         my $id;
301         my $vals;
302
303         if (! @line) {
304                 return;
305         }
306
307         if (scalar(@line) < 1) {
308                 print STDERR "Synopsis: GETVAL <id>" . $/;
309                 return;
310         }
311
312         $id = getid($line[0]);
313
314         if (! $id) {
315                 print STDERR "Invalid id \"$line[0]\"." . $/;
316                 return;
317         }
318
319         $vals = $sock->getval(%$id);
320
321         if (! $vals) {
322                 print STDERR "socket error: " . $sock->{'error'} . $/;
323                 return;
324         }
325
326         foreach my $key (keys %$vals) {
327                 print "\t$key: $vals->{$key}\n";
328         }
329         return 1;
330 }
331
332 =item B<GETTHRESHOLD> I<Identifier>
333
334 =cut
335
336 sub getthreshold {
337         my $sock = shift || return;
338         my $line = shift || return;
339
340         my @line = tokenize($line);
341
342         my $id;
343         my $vals;
344
345         if (! @line) {
346                 return;
347         }
348
349         if (scalar(@line) < 1) {
350                 print STDERR "Synopsis: GETTHRESHOLD <id>" . $/;
351                 return;
352         }
353
354         $id = getid($line[0]);
355
356         if (! $id) {
357                 print STDERR "Invalid id \"$line[0]\"." . $/;
358                 return;
359         }
360
361         $vals = $sock->getthreshold(%$id);
362
363         if (! $vals) {
364                 print STDERR "socket error: " . $sock->{'error'} . $/;
365                 return;
366         }
367
368         foreach my $key (keys %$vals) {
369                 print "\t$key: $vals->{$key}\n";
370         }
371         return 1;
372 }
373
374 =item B<FLUSH> [B<timeout>=I<$timeout>] [B<plugin>=I<$plugin>[ ...]]
375
376 =cut
377
378 sub flush {
379         my $sock = shift || return;
380         my $line = shift;
381
382         my @line = tokenize($line);
383
384         my $res;
385
386         if (! $line) {
387                 $res = $sock->flush();
388         }
389         else {
390                 my %args = ();
391
392                 foreach my $i (@line) {
393                         my ($option, $value) = $i =~ m/^([^=]+)=(.+)$/;
394                         next if (! ($option && $value));
395
396                         if ($option eq "plugin") {
397                                 push @{$args{"plugins"}}, $value;
398                         }
399                         elsif ($option eq "timeout") {
400                                 $args{"timeout"} = $value;
401                         }
402                         elsif ($option eq "identifier") {
403                                 my $id = getid ($value);
404                                 if (!$id)
405                                 {
406                                         print STDERR "Not a valid identifier: \"$value\"\n";
407                                         next;
408                                 }
409                                 push @{$args{"identifier"}}, $id;
410                         }
411                         else {
412                                 print STDERR "Invalid option \"$option\".\n";
413                                 return;
414                         }
415                 }
416
417                 $res = $sock->flush(%args);
418         }
419
420         if (! $res) {
421                 print STDERR "socket error: " . $sock->{'error'} . $/;
422         }
423         return $res;
424 }
425
426 =item B<LISTVAL>
427
428 =cut
429
430 sub listval {
431         my $sock = shift || return;
432         my $line = shift;
433
434         my @res;
435
436         if ($line ne "") {
437                 print STDERR "Synopsis: LISTVAL" . $/;
438                 return;
439         }
440
441         @res = $sock->listval();
442
443         if (! @res) {
444                 print STDERR "socket error: " . $sock->{'error'} . $/;
445                 return;
446         }
447
448         foreach my $ident (@res) {
449                 print $ident->{'time'} . " " . putid($ident) . $/;
450         }
451         return 1;
452 }
453
454 =item B<PUTNOTIF> [[B<severity>=I<$severity>] [B<message>=I<$message>] [ ...]]
455
456 =cut
457
458 sub putnotif {
459         my $sock = shift || return;
460         my $line = shift || return;
461
462         my @line = tokenize($line);
463
464         my $ret;
465
466         my (%values) = ();
467         foreach my $i (@line) {
468                 my ($key, $val) = split m/=/, $i, 2;
469                 if ($key && $val) {
470                         $values{$key} = $val;
471                 }
472                 else {
473                         $values{'message'} = defined($values{'message'})
474                                 ? ($values{'message'} . ' ' . $key)
475                                 : $key;
476                 }
477         }
478         $values{'time'} ||= time();
479
480         $ret = $sock->putnotif(%values);
481         if (! $ret) {
482                 print STDERR "socket error: " . $sock->{'error'} . $/;
483         }
484         return $ret;
485 }
486
487 =back
488
489 These commands follow the exact same syntax as described in
490 L<collectd-unixsock(5)>.
491
492 =head1 SEE ALSO
493
494 L<collectd(1)>, L<collectd-unisock(5)>
495
496 =head1 AUTHOR
497
498 Written by Sebastian Harl E<lt>sh@tokkee.orgE<gt>.
499
500 B<collectd> has been written by Florian Forster and others.
501
502 =head1 COPYRIGHT
503
504 Copyright (C) 2007 Sebastian Harl.
505
506 This program is free software; you can redistribute it and/or modify it under
507 the terms of the GNU General Public License as published by the Free Software
508 Foundation; only version 2 of the License is applicable.
509
510 =cut
511
512 # vim: set sw=4 ts=4 tw=78 noexpandtab :