1 package Collectd::Graph::Common;
3 use strict;
4 use warnings;
6 use vars (qw($ColorCanvas $ColorFullBlue $ColorHalfBlue));
8 use Collectd::Unixsock;
10 use Carp (qw(confess cluck));
11 use CGI (':cgi');
12 use Exporter;
14 $ColorCanvas = 'FFFFFF';
15 $ColorFullBlue = '0000FF';
16 $ColorHalfBlue = 'B7B7F7';
18 @Collectd::Graph::Common::ISA = ('Exporter');
19 @Collectd::Graph::Common::EXPORT_OK = (qw(
20 $ColorCanvas
21 $ColorFullBlue
22 $ColorHalfBlue
24 sanitize_hostname
25 sanitize_plugin sanitize_plugin_instance
26 sanitize_type sanitize_type_instance
27 group_files_by_plugin_instance
28 get_files_from_directory
29 filename_to_ident
30 ident_to_filename
31 ident_to_string
32 get_all_hosts
33 get_files_for_host
34 get_files_by_ident
35 get_selected_files
36 get_timespan_selection
37 get_host_selection
38 get_plugin_selection
39 get_faded_color
40 sort_idents_by_type_instance
41 type_to_module_name
42 epoch_to_rfc1123
43 flush_files
44 ));
46 our $DataDir = '/var/lib/collectd/rrd';
48 return (1);
50 sub _sanitize_generic_allow_minus
51 {
52 my $str = "" . shift;
54 # remove all slashes
55 $str =~ s#/##g;
57 # remove all dots and dashes at the beginning and at the end.
58 $str =~ s#^[\.-]+##;
59 $str =~ s#[\.-]+$##;
61 return ($str);
62 }
64 sub _sanitize_generic_no_minus
65 {
66 # Do everything the allow-minus variant does..
67 my $str = _sanitize_generic_allow_minus (@_);
69 # .. and remove the dashes, too
70 $str =~ s#/##g;
72 return ($str);
73 } # _sanitize_generic_no_minus
75 sub sanitize_hostname
76 {
77 return (_sanitize_generic_allow_minus (@_));
78 }
80 sub sanitize_plugin
81 {
82 return (_sanitize_generic_no_minus (@_));
83 }
85 sub sanitize_plugin_instance
86 {
87 return (_sanitize_generic_allow_minus (@_));
88 }
90 sub sanitize_type
91 {
92 return (_sanitize_generic_no_minus (@_));
93 }
95 sub sanitize_type_instance
96 {
97 return (_sanitize_generic_allow_minus (@_));
98 }
100 sub group_files_by_plugin_instance
101 {
102 my @files = @_;
103 my $data = {};
105 for (my $i = 0; $i < @files; $i++)
106 {
107 my $file = $files[$i];
108 my $key = $file->{'plugin_instance'} || '';
110 $data->{$key} ||= [];
111 push (@{$data->{$key}}, $file);
112 }
114 return ($data);
115 }
117 sub filename_to_ident
118 {
119 my $file = shift;
120 my $ret;
122 if ($file =~ m#([^/]+)/([^/\-]+)(?:-([^/]+))?/([^/\-]+)(?:-([^/]+))?\.rrd$#)
123 {
124 $ret = {hostname => $1, plugin => $2, type => $4};
125 if (defined ($3))
126 {
127 $ret->{'plugin_instance'} = $3;
128 }
129 if (defined ($5))
130 {
131 $ret->{'type_instance'} = $5;
132 }
133 if ($`)
134 {
135 $ret->{'_prefix'} = $`;
136 }
137 }
138 else
139 {
140 return;
141 }
143 return ($ret);
144 } # filename_to_ident
146 sub ident_to_filename
147 {
148 my $ident = shift;
150 my $ret = '';
152 if (defined ($ident->{'_prefix'}))
153 {
154 $ret .= $ident->{'_prefix'};
155 }
156 else
157 {
158 $ret .= "$DataDir/";
159 }
161 if (!$ident->{'hostname'})
162 {
163 cluck ("hostname is undefined")
164 }
165 if (!$ident->{'plugin'})
166 {
167 cluck ("plugin is undefined")
168 }
169 if (!$ident->{'type'})
170 {
171 cluck ("type is undefined")
172 }
174 $ret .= $ident->{'hostname'} . '/' . $ident->{'plugin'};
175 if (defined ($ident->{'plugin_instance'}))
176 {
177 $ret .= '-' . $ident->{'plugin_instance'};
178 }
180 $ret .= '/' . $ident->{'type'};
181 if (defined ($ident->{'type_instance'}))
182 {
183 $ret .= '-' . $ident->{'type_instance'};
184 }
185 $ret .= '.rrd';
187 return ($ret);
188 } # ident_to_filename
190 sub ident_to_string
191 {
192 my $ident = shift;
194 my $ret = '';
196 $ret .= $ident->{'hostname'} . '/' . $ident->{'plugin'};
197 if (defined ($ident->{'plugin_instance'}))
198 {
199 $ret .= '-' . $ident->{'plugin_instance'};
200 }
202 $ret .= '/' . $ident->{'type'};
203 if (defined ($ident->{'type_instance'}))
204 {
205 $ret .= '-' . $ident->{'type_instance'};
206 }
208 return ($ret);
209 } # ident_to_string
211 sub get_files_from_directory
212 {
213 my $dir = shift;
214 my $recursive = @_ ? shift : 0;
215 my $dh;
216 my @directories = ();
217 my $ret = [];
219 opendir ($dh, $dir) or die ("opendir ($dir): $!");
220 while (my $entry = readdir ($dh))
221 {
222 next if ($entry =~ m/^\./);
224 $entry = "$dir/$entry";
226 if (-d $entry)
227 {
228 push (@directories, $entry);
229 }
230 elsif (-f $entry)
231 {
232 my $ident = filename_to_ident ($entry);
233 if ($ident)
234 {
235 push (@$ret, $ident);
236 }
237 }
238 }
239 closedir ($dh);
241 if ($recursive > 0)
242 {
243 for (@directories)
244 {
245 my $temp = get_files_from_directory ($_, $recursive - 1);
246 if ($temp && @$temp)
247 {
248 push (@$ret, @$temp);
249 }
250 }
251 }
253 return ($ret);
254 } # get_files_from_directory
256 sub get_all_hosts
257 {
258 my $dh;
259 my @ret = ();
261 opendir ($dh, "$DataDir") or confess ("opendir ($DataDir): $!");
262 while (my $entry = readdir ($dh))
263 {
264 next if ($entry =~ m/^\./);
265 next if (!-d "$DataDir/$entry");
266 push (@ret, sanitize_hostname ($entry));
267 }
268 closedir ($dh);
270 if (wantarray ())
271 {
272 return (@ret);
273 }
274 elsif (@ret)
275 {
276 return (\@ret);
277 }
278 else
279 {
280 return;
281 }
282 } # get_all_hosts
284 sub get_all_plugins
285 {
286 my @hosts = @_;
287 my $ret = {};
288 my $dh;
290 if (!@hosts)
291 {
292 @hosts = get_all_hosts ();
293 }
295 for (@hosts)
296 {
297 my $host = $_;
298 opendir ($dh, "$DataDir/$host") or next;
299 while (my $entry = readdir ($dh))
300 {
301 my $plugin;
302 my $plugin_instance = '';
304 next if ($entry =~ m/^\./);
305 next if (!-d "$DataDir/$host/$entry");
307 if ($entry =~ m#^([^-]+)-(.+)$#)
308 {
309 $plugin = $1;
310 $plugin_instance = $2;
311 }
312 elsif ($entry =~ m#^([^-]+)$#)
313 {
314 $plugin = $1;
315 $plugin_instance = '';
316 }
317 else
318 {
319 next;
320 }
322 $ret->{$plugin} ||= {};
323 $ret->{$plugin}{$plugin_instance} = 1;
324 } # while (readdir)
325 closedir ($dh);
326 } # for (@hosts)
328 if (wantarray ())
329 {
330 return (sort (keys %$ret));
331 }
332 else
333 {
334 return ($ret);
335 }
336 } # get_all_plugins
338 sub get_files_for_host
339 {
340 my $host = sanitize_hostname (shift);
341 return (get_files_from_directory ("$DataDir/$host", 2));
342 } # get_files_for_host
344 sub _filter_ident
345 {
346 my $filter = shift;
347 my $ident = shift;
349 for (qw(hostname plugin plugin_instance type type_instance))
350 {
351 my $part = $_;
352 my $tmp;
354 if (!defined ($filter->{$part}))
355 {
356 next;
357 }
358 if (!defined ($ident->{$part}))
359 {
360 return (1);
361 }
363 if (ref $filter->{$part})
364 {
365 if (!grep { $ident->{$part} eq $_ } (@{$filter->{$part}}))
366 {
367 return (1);
368 }
369 }
370 else
371 {
372 if ($ident->{$part} ne $filter->{$part})
373 {
374 return (1);
375 }
376 }
377 }
379 return (0);
380 } # _filter_ident
382 sub get_files_by_ident
383 {
384 my $ident = shift;
385 my $all_files;
386 my @ret = ();
388 #if ($ident->{'hostname'})
389 #{
390 #$all_files = get_files_for_host ($ident->{'hostname'});
391 #}
392 #else
393 #{
394 $all_files = get_files_from_directory ($DataDir, 3);
395 #}
397 @ret = grep { _filter_ident ($ident, $_) == 0 } (@$all_files);
399 return (\@ret);
400 } # get_files_by_ident
402 sub get_selected_files
403 {
404 my $ident = {};
406 for (qw(hostname plugin plugin_instance type type_instance))
407 {
408 my $part = $_;
409 my @temp = param ($part);
410 if (!@temp)
411 {
412 next;
413 }
414 elsif (($part eq 'plugin') || ($part eq 'type'))
415 {
416 $ident->{$part} = [map { _sanitize_generic_no_minus ($_) } (@temp)];
417 }
418 else
419 {
420 $ident->{$part} = [map { _sanitize_generic_allow_minus ($_) } (@temp)];
421 }
422 }
424 return (get_files_by_ident ($ident));
425 } # get_selected_files
427 sub get_timespan_selection
428 {
429 my $ret = 86400;
430 if (param ('timespan'))
431 {
432 my $temp = int (param ('timespan'));
433 if ($temp && ($temp > 0))
434 {
435 $ret = $temp;
436 }
437 }
439 return ($ret);
440 } # get_timespan_selection
442 sub get_host_selection
443 {
444 my %ret = ();
446 for (get_all_hosts ())
447 {
448 $ret{$_} = 0;
449 }
451 for (param ('hostname'))
452 {
453 my $host = _sanitize_generic_allow_minus ($_);
454 if (defined ($ret{$host}))
455 {
456 $ret{$host} = 1;
457 }
458 }
460 if (wantarray ())
461 {
462 return (grep { $ret{$_} > 0 } (sort (keys %ret)));
463 }
464 else
465 {
466 return (\%ret);
467 }
468 } # get_host_selection
470 sub get_plugin_selection
471 {
472 my %ret = ();
473 my @hosts = get_host_selection ();
475 for (get_all_plugins (@hosts))
476 {
477 $ret{$_} = 0;
478 }
480 for (param ('plugin'))
481 {
482 if (defined ($ret{$_}))
483 {
484 $ret{$_} = 1;
485 }
486 }
488 if (wantarray ())
489 {
490 return (grep { $ret{$_} > 0 } (sort (keys %ret)));
491 }
492 else
493 {
494 return (\%ret);
495 }
496 } # get_plugin_selection
498 sub _string_to_color
499 {
500 my $color = shift;
501 if ($color =~ m/([0-9A-Fa-f][0-9A-Fa-f])([0-9A-Fa-f][0-9A-Fa-f])([0-9A-Fa-f][0-9A-Fa-f])/)
502 {
503 return ([hex ($1) / 255.0, hex ($2) / 255.0, hex ($3) / 255.0]);
504 }
505 return;
506 } # _string_to_color
508 sub _color_to_string
509 {
510 confess ("Wrong number of arguments") if (@_ != 1);
511 return (sprintf ('%02hx%02hx%02hx', map { int (255.0 * $_) } @{$_[0]}));
512 } # _color_to_string
514 sub get_faded_color
515 {
516 my $fg = shift;
517 my $bg;
518 my %opts = @_;
519 my $ret = [undef, undef, undef];
521 $opts{'background'} ||= [1.0, 1.0, 1.0];
522 $opts{'alpha'} ||= 0.25;
524 if (!ref ($fg))
525 {
526 $fg = _string_to_color ($fg)
527 or confess ("Cannot parse foreground color $fg");
528 }
530 if (!ref ($opts{'background'}))
531 {
532 $opts{'background'} = _string_to_color ($opts{'background'})
533 or confess ("Cannot parse background color " . $opts{'background'});
534 }
535 $bg = $opts{'background'};
537 for (my $i = 0; $i < 3; $i++)
538 {
539 $ret->[$i] = ($opts{'alpha'} * $fg->[$i])
540 + ((1.0 - $opts{'alpha'}) * $bg->[$i]);
541 }
543 return (_color_to_string ($ret));
544 } # get_faded_color
546 sub sort_idents_by_type_instance
547 {
548 my $idents = shift;
549 my $array_sort = shift;
551 my %elements = map { $_->{'type_instance'} => $_ } (@$idents);
552 splice (@$idents, 0);
554 for (@$array_sort)
555 {
556 next if (!exists ($elements{$_}));
557 push (@$idents, $elements{$_});
558 delete ($elements{$_});
559 }
560 push (@$idents, map { $elements{$_} } (sort (keys %elements)));
561 } # sort_idents_by_type_instance
563 sub type_to_module_name
564 {
565 my $type = shift;
566 my $ret;
568 $ret = ucfirst (lc ($type));
570 $ret =~ s/[^A-Za-z_]//g;
571 $ret =~ s/_([A-Za-z])/\U$1\E/g;
573 return ("Collectd::Graph::Type::$ret");
574 } # type_to_module_name
576 sub epoch_to_rfc1123
577 {
578 my @days = (qw(Sun Mon Tue Wed Thu Fri Sat));
579 my @months = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));
581 my $epoch = @_ ? shift : time ();
582 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
583 my $string = sprintf ('%s, %02d %s %4d %02d:%02d:%02d GMT', $days[$wday], $mday,
584 $months[$mon], 1900 + $year, $hour ,$min, $sec);
585 return ($string);
586 }
588 sub flush_files
589 {
590 my $all_files = shift;
591 my %opts = @_;
593 my $begin;
594 my $end;
595 my $addr;
596 my $interval;
597 my $sock;
598 my $now;
599 my $files_to_flush = [];
600 my $status;
602 if (!defined $opts{'begin'})
603 {
604 cluck ("begin is not defined");
605 return;
606 }
607 $begin = $opts{'begin'};
609 if (!defined $opts{'end'})
610 {
611 cluck ("end is not defined");
612 return;
613 }
614 $end = $opts{'end'};
616 if (!$opts{'addr'})
617 {
618 return (1);
619 }
621 $interval = $opts{'interval'} || 10;
623 if (ref ($all_files) eq 'HASH')
624 {
625 my @tmp = ($all_files);
626 $all_files = \@tmp;
627 }
629 $now = time ();
630 # Don't flush anything if the timespan is in the future.
631 if (($end > $now) && ($begin > $now))
632 {
633 return (1);
634 }
636 for (@$all_files)
637 {
638 my $file_orig = $_;
639 my $file_name = ident_to_filename ($file_orig);
640 my $file_copy = {};
641 my @statbuf;
642 my $mtime;
644 @statbuf = stat ($file_name);
645 if (!@statbuf)
646 {
647 next;
648 }
649 $mtime = $statbuf[9];
651 # Skip if file is fresh
652 if (($now - $mtime) <= $interval)
653 {
654 next;
655 }
656 # or $end is before $mtime
657 elsif (($end != 0) && (($end - $mtime) <= 0))
658 {
659 next;
660 }
662 $file_copy->{'host'} = $file_orig->{'hostname'};
663 $file_copy->{'plugin'} = $file_orig->{'plugin'};
664 if (exists $file_orig->{'plugin_instance'})
665 {
666 $file_copy->{'plugin_instance'} = $file_orig->{'plugin_instance'}
667 }
668 $file_copy->{'type'} = $file_orig->{'type'};
669 if (exists $file_orig->{'type_instance'})
670 {
671 $file_copy->{'type_instance'} = $file_orig->{'type_instance'}
672 }
674 push (@$files_to_flush, $file_copy);
675 } # for (@$all_files)
677 if (!@$files_to_flush)
678 {
679 return (1);
680 }
682 $sock = Collectd::Unixsock->new ($opts{'addr'});
683 if (!$sock)
684 {
685 return;
686 }
688 $status = $sock->flush (plugins => ['rrdtool'], identifier => $files_to_flush);
689 if (!$status)
690 {
691 cluck ("FLUSH failed: " . $sock->{'error'});
692 $sock->destroy ();
693 return;
694 }
696 $sock->destroy ();
697 return (1);
698 } # flush_files
700 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :