Merge branch 'collectd-4.5' into collectd-4.6
[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                 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         print <<HELP;
190 Available commands:
191   HELP
192   PUTVAL
193   GETVAL
194   FLUSH
195   LISTVAL
196   PUTNOTIF
197
198 See the embedded Perldoc documentation for details. To do that, run:
199   perldoc $0
200 HELP
201         return 1;
202 } # cmd_help
203
204 =item B<PUTVAL> I<Identifier> I<Valuelist>
205
206 =cut
207
208 sub putval {
209         my $sock = shift || return;
210         my $line = shift || return;
211
212         my @line = tokenize($line);
213
214         my $id;
215         my $ret;
216
217         if (! @line) {
218                 return;
219         }
220
221         if (scalar(@line) < 2) {
222                 print STDERR "Synopsis: PUTVAL <id> <value0> [<value1> ...]" . $/;
223                 return;
224         }
225
226         $id = getid($line[0]);
227
228         if (! $id) {
229                 print STDERR "Invalid id \"$line[0]\"." . $/;
230                 return;
231         }
232
233         my ($time, @values) = split m/:/, $line;
234         $ret = $sock->putval(%$id, time => $time, values => \@values);
235
236         if (! $ret) {
237                 print STDERR "socket error: " . $sock->{'error'} . $/;
238         }
239         return $ret;
240 }
241
242 =item B<GETVAL> I<Identifier>
243
244 =cut
245
246 sub getval {
247         my $sock = shift || return;
248         my $line = shift || return;
249
250         my @line = tokenize($line);
251
252         my $id;
253         my $vals;
254
255         if (! @line) {
256                 return;
257         }
258
259         if (scalar(@line) < 1) {
260                 print STDERR "Synopsis: GETVAL <id>" . $/;
261                 return;
262         }
263
264         $id = getid($line[0]);
265
266         if (! $id) {
267                 print STDERR "Invalid id \"$line[0]\"." . $/;
268                 return;
269         }
270
271         $vals = $sock->getval(%$id);
272
273         if (! $vals) {
274                 print STDERR "socket error: " . $sock->{'error'} . $/;
275                 return;
276         }
277
278         foreach my $key (keys %$vals) {
279                 print "\t$key: $vals->{$key}\n";
280         }
281         return 1;
282 }
283
284 =item B<FLUSH> [B<timeout>=I<$timeout>] [B<plugin>=I<$plugin>[ ...]]
285
286 =cut
287
288 sub flush {
289         my $sock = shift || return;
290         my $line = shift;
291
292         my @line = tokenize($line);
293
294         my $res;
295
296         if (! $line) {
297                 $res = $sock->flush();
298         }
299         else {
300                 my %args = ();
301
302                 foreach my $i (@line) {
303                         my ($option, $value) = $i =~ m/^([^=]+)=(.+)$/;
304                         next if (! ($option && $value));
305
306                         if ($option eq "plugin") {
307                                 push @{$args{"plugins"}}, $value;
308                         }
309                         elsif ($option eq "timeout") {
310                                 $args{"timeout"} = $value;
311                         }
312                         elsif ($option eq "identifier") {
313                                 my $id = getid (\$value);
314                                 if (!$id)
315                                 {
316                                         print STDERR "Not a valid identifier: \"$value\"\n";
317                                         next;
318                                 }
319                                 push @{$args{"identifier"}}, $id;
320                         }
321                         else {
322                                 print STDERR "Invalid option \"$option\".\n";
323                                 return;
324                         }
325                 }
326
327                 $res = $sock->flush(%args);
328         }
329
330         if (! $res) {
331                 print STDERR "socket error: " . $sock->{'error'} . $/;
332         }
333         return $res;
334 }
335
336 =item B<LISTVAL>
337
338 =cut
339
340 sub listval {
341         my $sock = shift || return;
342         my $line = shift;
343
344         my @res;
345
346         if ($line ne "") {
347                 print STDERR "Synopsis: LISTVAL" . $/;
348                 return;
349         }
350
351         @res = $sock->listval();
352
353         if (! @res) {
354                 print STDERR "socket error: " . $sock->{'error'} . $/;
355                 return;
356         }
357
358         foreach my $ident (@res) {
359                 print $ident->{'time'} . " " . putid($ident) . $/;
360         }
361         return 1;
362 }
363
364 =item B<PUTNOTIF> [[B<severity>=I<$severity>] [B<message>=I<$message>] [ ...]]
365
366 =cut
367
368 sub putnotif {
369         my $sock = shift || return;
370         my $line = shift || return;
371
372         my @line = tokenize($line);
373
374         my $ret;
375
376         my (%values) = ();
377         foreach my $i (@line) {
378                 my ($key, $val) = split m/=/, $i, 2;
379                 if ($key && $val) {
380                         $values{$key} = $val;
381                 }
382                 else {
383                         $values{'message'} = defined($values{'message'})
384                                 ? ($values{'message'} . ' ' . $key)
385                                 : $key;
386                 }
387         }
388         $values{'time'} ||= time();
389
390         $ret = $sock->putnotif(%values);
391         if (! $ret) {
392                 print STDERR "socket error: " . $sock->{'error'} . $/;
393         }
394         return $ret;
395 }
396
397 =back
398
399 These commands follow the exact same syntax as described in
400 L<collectd-unixsock(5)>.
401
402 =head1 SEE ALSO
403
404 L<collectd(1)>, L<collectd-unisock(5)>
405
406 =head1 AUTHOR
407
408 Written by Sebastian Harl E<lt>sh@tokkee.orgE<gt>.
409
410 B<collectd> has been written by Florian Forster and others.
411
412 =head1 COPYRIGHT
413
414 Copyright (C) 2007 Sebastian Harl.
415
416 This program is free software; you can redistribute it and/or modify it under
417 the terms of the GNU General Public License as published by the Free Software
418 Foundation; only version 2 of the License is applicable.
419
420 =cut
421
422 # vim: set sw=4 ts=4 tw=78 noexpandtab :