1 package Collectd::Graph::Common;
3 # Copyright (C) 2008-2011 Florian Forster
4 # Copyright (C) 2011 noris network AG
5 #
6 # This program is free software; you can redistribute it and/or modify it under
7 # the terms of the GNU General Public License as published by the Free Software
8 # Foundation; only version 2 of the License is applicable.
9 #
10 # This program is distributed in the hope that it will be useful, but WITHOUT
11 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
13 # details.
14 #
15 # You should have received a copy of the GNU General Public License along with
16 # this program; if not, write to the Free Software Foundation, Inc.,
17 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
18 #
19 # Authors:
20 # Florian "octo" Forster <octo at collectd.org>
22 use strict;
23 use warnings;
25 use vars (qw($ColorCanvas $ColorFullBlue $ColorHalfBlue));
27 use Collectd::Unixsock ();
28 use Carp (qw(confess cluck));
29 use CGI (':cgi');
30 use Exporter;
31 use Collectd::Graph::Config (qw(gc_get_scalar));
33 our $Cache = {};
35 $ColorCanvas = 'FFFFFF';
36 $ColorFullBlue = '0000FF';
37 $ColorHalfBlue = 'B7B7F7';
39 @Collectd::Graph::Common::ISA = ('Exporter');
40 @Collectd::Graph::Common::EXPORT_OK = (qw(
41 $ColorCanvas
42 $ColorFullBlue
43 $ColorHalfBlue
45 sanitize_hostname
46 sanitize_plugin sanitize_plugin_instance
47 sanitize_type sanitize_type_instance
48 group_files_by_plugin_instance
49 get_files_from_directory
50 filename_to_ident
51 ident_to_filename
52 ident_to_string
53 get_all_hosts
54 get_files_for_host
55 get_files_by_ident
56 get_selected_files
57 get_timespan_selection
58 get_host_selection
59 get_plugin_selection
60 get_random_color
61 get_faded_color
62 sort_idents_by_type_instance
63 type_to_module_name
64 epoch_to_rfc1123
65 flush_files
66 ));
68 our $DefaultDataDir = '/var/lib/collectd/rrd';
70 return (1);
72 sub _sanitize_generic_allow_minus
73 {
74 my $str = "" . shift;
76 # remove all slashes
77 $str =~ s#/##g;
79 # remove all dots and dashes at the beginning and at the end.
80 $str =~ s#^[\.-]+##;
81 $str =~ s#[\.-]+$##;
83 return ($str);
84 }
86 sub _sanitize_generic_no_minus
87 {
88 # Do everything the allow-minus variant does..
89 my $str = _sanitize_generic_allow_minus (@_);
91 # .. and remove the dashes, too
92 $str =~ s#/##g;
94 return ($str);
95 } # _sanitize_generic_no_minus
97 sub sanitize_hostname
98 {
99 return (_sanitize_generic_allow_minus (@_));
100 }
102 sub sanitize_plugin
103 {
104 return (_sanitize_generic_no_minus (@_));
105 }
107 sub sanitize_plugin_instance
108 {
109 return (_sanitize_generic_allow_minus (@_));
110 }
112 sub sanitize_type
113 {
114 return (_sanitize_generic_no_minus (@_));
115 }
117 sub sanitize_type_instance
118 {
119 return (_sanitize_generic_allow_minus (@_));
120 }
122 sub group_files_by_plugin_instance
123 {
124 my @files = @_;
125 my $data = {};
127 for (my $i = 0; $i < @files; $i++)
128 {
129 my $file = $files[$i];
130 my $key1 = $file->{'hostname'} || '';
131 my $key2 = $file->{'plugin_instance'} || '';
132 my $key = "$key1-$key2";
134 $data->{$key} ||= [];
135 push (@{$data->{$key}}, $file);
136 }
138 return ($data);
139 }
141 sub filename_to_ident
142 {
143 my $file = shift;
144 my $ret;
146 if ($file =~ m#([^/]+)/([^/\-]+)(?:-([^/]+))?/([^/\-]+)(?:-([^/]+))?\.rrd$#)
147 {
148 $ret = {hostname => $1, plugin => $2, type => $4};
149 if (defined ($3))
150 {
151 $ret->{'plugin_instance'} = $3;
152 }
153 if (defined ($5))
154 {
155 $ret->{'type_instance'} = $5;
156 }
157 if ($`)
158 {
159 $ret->{'_prefix'} = $`;
160 }
161 }
162 else
163 {
164 return;
165 }
167 return ($ret);
168 } # filename_to_ident
170 sub ident_to_filename
171 {
172 my $ident = shift;
173 my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
175 my $ret = '';
177 if (defined ($ident->{'_prefix'}))
178 {
179 $ret .= $ident->{'_prefix'};
180 }
181 else
182 {
183 $ret .= "$data_dir/";
184 }
186 if (!$ident->{'hostname'})
187 {
188 cluck ("hostname is undefined")
189 }
190 if (!$ident->{'plugin'})
191 {
192 cluck ("plugin is undefined")
193 }
194 if (!$ident->{'type'})
195 {
196 cluck ("type is undefined")
197 }
199 $ret .= $ident->{'hostname'} . '/' . $ident->{'plugin'};
200 if (defined ($ident->{'plugin_instance'}))
201 {
202 $ret .= '-' . $ident->{'plugin_instance'};
203 }
205 $ret .= '/' . $ident->{'type'};
206 if (defined ($ident->{'type_instance'}))
207 {
208 $ret .= '-' . $ident->{'type_instance'};
209 }
210 $ret .= '.rrd';
212 return ($ret);
213 } # ident_to_filename
215 sub _part_to_string
216 {
217 my $part = shift;
219 if (!defined ($part))
220 {
221 return ("(UNDEF)");
222 }
223 if (ref ($part) eq 'ARRAY')
224 {
225 if (1 == @$part)
226 {
227 return ($part->[0]);
228 }
229 else
230 {
231 return ('(' . join (',', @$part) . ')');
232 }
233 }
234 else
235 {
236 return ($part);
237 }
238 } # _part_to_string
240 sub ident_to_string
241 {
242 my $ident = shift;
244 my $ret = '';
246 $ret .= _part_to_string ($ident->{'hostname'})
247 . '/' . _part_to_string ($ident->{'plugin'});
248 if (defined ($ident->{'plugin_instance'}))
249 {
250 $ret .= '-' . _part_to_string ($ident->{'plugin_instance'});
251 }
253 $ret .= '/' . _part_to_string ($ident->{'type'});
254 if (defined ($ident->{'type_instance'}))
255 {
256 $ret .= '-' . _part_to_string ($ident->{'type_instance'});
257 }
259 return ($ret);
260 } # ident_to_string
262 sub get_files_from_directory
263 {
264 my $dir = shift;
265 my $recursive = @_ ? shift : 0;
266 my $dh;
267 my @directories = ();
268 my @files = ();
269 my $ret = [];
271 opendir ($dh, $dir) or die ("opendir ($dir): $!");
272 while (my $entry = readdir ($dh))
273 {
274 next if ($entry =~ m/^\./);
276 $entry = "$dir/$entry";
278 if (-d $entry)
279 {
280 push (@directories, $entry);
281 }
282 elsif (-f $entry)
283 {
284 push (@files, $entry);
285 }
286 }
287 closedir ($dh);
289 push (@$ret, map { filename_to_ident ($_) } sort (@files));
291 if ($recursive > 0)
292 {
293 for (@directories)
294 {
295 my $temp = get_files_from_directory ($_, $recursive - 1);
296 if ($temp && @$temp)
297 {
298 push (@$ret, @$temp);
299 }
300 }
301 }
303 return ($ret);
304 } # get_files_from_directory
306 sub get_all_hosts
307 {
308 my $ret = [];
310 if (defined ($Cache->{'get_all_hosts'}))
311 {
312 $ret = $Cache->{'get_all_hosts'};
313 }
314 else
315 {
316 my $dh;
317 my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
319 opendir ($dh, "$data_dir") or confess ("opendir ($data_dir): $!");
320 while (my $entry = readdir ($dh))
321 {
322 next if ($entry =~ m/^\./);
323 next if (!-d "$data_dir/$entry");
324 push (@$ret, sanitize_hostname ($entry));
325 }
326 closedir ($dh);
328 $Cache->{'get_all_hosts'} = $ret;
329 }
331 if (wantarray ())
332 {
333 return (@$ret);
334 }
335 elsif (@$ret)
336 {
337 return ($ret);
338 }
339 else
340 {
341 return;
342 }
343 } # get_all_hosts
345 sub get_all_plugins
346 {
347 my @hosts = @_;
348 my $ret = {};
349 my $dh;
350 my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
351 my $cache_key;
353 if (@hosts)
354 {
355 $cache_key = join (';', @hosts);
356 }
357 else
358 {
359 $cache_key = "/*/";
360 @hosts = get_all_hosts ();
361 }
363 if (defined ($Cache->{'get_all_plugins'}{$cache_key}))
364 {
365 $ret = $Cache->{'get_all_plugins'}{$cache_key};
367 if (wantarray ())
368 {
369 return (sort (keys %$ret));
370 }
371 else
372 {
373 return ($ret);
374 }
375 }
377 for (@hosts)
378 {
379 my $host = $_;
380 opendir ($dh, "$data_dir/$host") or next;
381 while (my $entry = readdir ($dh))
382 {
383 my $plugin;
384 my $plugin_instance = '';
386 next if ($entry =~ m/^\./);
387 next if (!-d "$data_dir/$host/$entry");
389 if ($entry =~ m#^([^-]+)-(.+)$#)
390 {
391 $plugin = $1;
392 $plugin_instance = $2;
393 }
394 elsif ($entry =~ m#^([^-]+)$#)
395 {
396 $plugin = $1;
397 $plugin_instance = '';
398 }
399 else
400 {
401 next;
402 }
404 $ret->{$plugin} ||= {};
405 $ret->{$plugin}{$plugin_instance} = 1;
406 } # while (readdir)
407 closedir ($dh);
408 } # for (@hosts)
410 $Cache->{'get_all_plugins'}{$cache_key} = $ret;
411 if (wantarray ())
412 {
413 return (sort (keys %$ret));
414 }
415 else
416 {
417 return ($ret);
418 }
419 } # get_all_plugins
421 sub get_files_for_host
422 {
423 my $host = sanitize_hostname (shift);
424 my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
425 return (get_files_from_directory ("$data_dir/$host", 2));
426 } # get_files_for_host
428 sub _filter_ident
429 {
430 my $filter = shift;
431 my $ident = shift;
433 for (qw(hostname plugin plugin_instance type type_instance))
434 {
435 my $part = $_;
436 my $tmp;
438 if (!defined ($filter->{$part}))
439 {
440 next;
441 }
442 if (!defined ($ident->{$part}))
443 {
444 return (1);
445 }
447 if (ref $filter->{$part})
448 {
449 if (!grep { $ident->{$part} eq $_ } (@{$filter->{$part}}))
450 {
451 return (1);
452 }
453 }
454 else
455 {
456 if ($ident->{$part} ne $filter->{$part})
457 {
458 return (1);
459 }
460 }
461 }
463 return (0);
464 } # _filter_ident
466 sub _get_all_files
467 {
468 my $ret;
470 if (defined ($Cache->{'_get_all_files'}))
471 {
472 $ret = $Cache->{'_get_all_files'};
473 }
474 else
475 {
476 my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
478 $ret = get_files_from_directory ($data_dir, 3);
479 $Cache->{'_get_all_files'} = $ret;
480 }
482 return ($ret);
483 } # _get_all_files
485 sub get_files_by_ident
486 {
487 my $ident = shift;
488 my $all_files;
489 my @ret = ();
490 my $temp;
491 my $hosts;
493 my $cache_key = ident_to_string ($ident);
494 if (defined ($Cache->{'get_files_by_ident'}{$cache_key}))
495 {
496 my $ret = $Cache->{'get_files_by_ident'}{$cache_key};
498 return ($ret)
499 }
501 if ($ident->{'hostname'})
502 {
503 $all_files = [];
504 $hosts = $ident->{'hostname'};
505 foreach (@$hosts)
506 {
507 $temp = get_files_for_host ($_);
508 push (@$all_files, @$temp);
509 }
510 }
511 else
512 {
513 $all_files = _get_all_files ();
514 }
516 @ret = grep { _filter_ident ($ident, $_) == 0 } (@$all_files);
518 $Cache->{'get_files_by_ident'}{$cache_key} = \@ret;
519 return (\@ret);
520 } # get_files_by_ident
522 sub get_selected_files
523 {
524 my $ident = {};
526 for (qw(hostname plugin plugin_instance type type_instance))
527 {
528 my $part = $_;
529 my @temp = param ($part);
530 if (!@temp)
531 {
532 next;
533 }
534 elsif (($part eq 'plugin') || ($part eq 'type'))
535 {
536 $ident->{$part} = [map { _sanitize_generic_no_minus ($_) } (@temp)];
537 }
538 else
539 {
540 $ident->{$part} = [map { _sanitize_generic_allow_minus ($_) } (@temp)];
541 }
542 }
544 return (get_files_by_ident ($ident));
545 } # get_selected_files
547 sub get_timespan_selection
548 {
549 my $ret = 86400;
550 if (param ('timespan'))
551 {
552 my $temp = int (param ('timespan'));
553 if ($temp && ($temp > 0))
554 {
555 $ret = $temp;
556 }
557 }
559 return ($ret);
560 } # get_timespan_selection
562 sub get_host_selection
563 {
564 my %ret = ();
566 for (get_all_hosts ())
567 {
568 $ret{$_} = 0;
569 }
571 for (param ('hostname'))
572 {
573 my $host = _sanitize_generic_allow_minus ($_);
574 if (defined ($ret{$host}))
575 {
576 $ret{$host} = 1;
577 }
578 }
580 if (wantarray ())
581 {
582 return (grep { $ret{$_} > 0 } (sort (keys %ret)));
583 }
584 else
585 {
586 return (\%ret);
587 }
588 } # get_host_selection
590 sub get_plugin_selection
591 {
592 my %ret = ();
593 my @hosts = get_host_selection ();
595 for (get_all_plugins (@hosts))
596 {
597 $ret{$_} = 0;
598 }
600 for (param ('plugin'))
601 {
602 if (defined ($ret{$_}))
603 {
604 $ret{$_} = 1;
605 }
606 }
608 if (wantarray ())
609 {
610 return (grep { $ret{$_} > 0 } (sort (keys %ret)));
611 }
612 else
613 {
614 return (\%ret);
615 }
616 } # get_plugin_selection
618 sub _string_to_color
619 {
620 my $color = shift;
621 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])/)
622 {
623 return ([hex ($1) / 255.0, hex ($2) / 255.0, hex ($3) / 255.0]);
624 }
625 return;
626 } # _string_to_color
628 sub _color_to_string
629 {
630 confess ("Wrong number of arguments") if (@_ != 1);
631 return (sprintf ('%02hx%02hx%02hx', map { int (255.0 * $_) } @{$_[0]}));
632 } # _color_to_string
634 sub get_random_color
635 {
636 my ($r, $g, $b) = (rand (), rand ());
637 my $min = 0.0;
638 my $max = 1.0;
640 if (($r + $g) < 1.0)
641 {
642 $min = 1.0 - ($r + $g);
643 }
644 else
645 {
646 $max = 2.0 - ($r + $g);
647 }
649 $b = $min + (rand () * ($max - $min));
651 return (_color_to_string ([$r, $g, $b]));
652 } # get_random_color
654 sub get_faded_color
655 {
656 my $fg = shift;
657 my $bg;
658 my %opts = @_;
659 my $ret = [undef, undef, undef];
661 $opts{'background'} ||= [1.0, 1.0, 1.0];
662 $opts{'alpha'} ||= 0.25;
664 if (!ref ($fg))
665 {
666 $fg = _string_to_color ($fg)
667 or confess ("Cannot parse foreground color $fg");
668 }
670 if (!ref ($opts{'background'}))
671 {
672 $opts{'background'} = _string_to_color ($opts{'background'})
673 or confess ("Cannot parse background color " . $opts{'background'});
674 }
675 $bg = $opts{'background'};
677 for (my $i = 0; $i < 3; $i++)
678 {
679 $ret->[$i] = ($opts{'alpha'} * $fg->[$i])
680 + ((1.0 - $opts{'alpha'}) * $bg->[$i]);
681 }
683 return (_color_to_string ($ret));
684 } # get_faded_color
686 sub sort_idents_by_type_instance
687 {
688 my $idents = shift;
689 my $array_sort = shift;
691 my %elements = map { $_->{'type_instance'} => $_ } (@$idents);
692 splice (@$idents, 0);
694 for (@$array_sort)
695 {
696 next if (!exists ($elements{$_}));
697 push (@$idents, $elements{$_});
698 delete ($elements{$_});
699 }
700 push (@$idents, map { $elements{$_} } (sort (keys %elements)));
701 } # sort_idents_by_type_instance
703 sub type_to_module_name
704 {
705 my $type = shift;
706 my $ret;
708 $ret = ucfirst (lc ($type));
710 $ret =~ s/[^A-Za-z_]//g;
711 $ret =~ s/_([A-Za-z])/\U$1\E/g;
713 return ("Collectd::Graph::Type::$ret");
714 } # type_to_module_name
716 sub epoch_to_rfc1123
717 {
718 my @days = (qw(Sun Mon Tue Wed Thu Fri Sat));
719 my @months = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));
721 my $epoch = @_ ? shift : time ();
722 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
723 my $string = sprintf ('%s, %02d %s %4d %02d:%02d:%02d GMT', $days[$wday], $mday,
724 $months[$mon], 1900 + $year, $hour ,$min, $sec);
725 return ($string);
726 }
728 sub flush_files
729 {
730 my $all_files = shift;
731 my %opts = @_;
733 my $begin;
734 my $end;
735 my $addr;
736 my $interval;
737 my $sock;
738 my $now;
739 my $files_to_flush = [];
740 my $status;
742 if (!defined $opts{'begin'})
743 {
744 cluck ("begin is not defined");
745 return;
746 }
747 $begin = $opts{'begin'};
749 if (!defined $opts{'end'})
750 {
751 cluck ("end is not defined");
752 return;
753 }
754 $end = $opts{'end'};
756 if (!$opts{'addr'})
757 {
758 return (1);
759 }
761 $interval = $opts{'interval'} || 10;
763 if (ref ($all_files) eq 'HASH')
764 {
765 my @tmp = ($all_files);
766 $all_files = \@tmp;
767 }
769 $now = time ();
770 # Don't flush anything if the timespan is in the future.
771 if (($end > $now) && ($begin > $now))
772 {
773 return (1);
774 }
776 for (@$all_files)
777 {
778 my $file_orig = $_;
779 my $file_name = ident_to_filename ($file_orig);
780 my $file_copy = {};
781 my @statbuf;
782 my $mtime;
784 @statbuf = stat ($file_name);
785 if (!@statbuf)
786 {
787 next;
788 }
789 $mtime = $statbuf[9];
791 # Skip if file is fresh
792 if (($now - $mtime) <= $interval)
793 {
794 next;
795 }
796 # or $end is before $mtime
797 elsif (($end != 0) && (($end - $mtime) <= 0))
798 {
799 next;
800 }
802 $file_copy->{'host'} = $file_orig->{'hostname'};
803 $file_copy->{'plugin'} = $file_orig->{'plugin'};
804 if (exists $file_orig->{'plugin_instance'})
805 {
806 $file_copy->{'plugin_instance'} = $file_orig->{'plugin_instance'}
807 }
808 $file_copy->{'type'} = $file_orig->{'type'};
809 if (exists $file_orig->{'type_instance'})
810 {
811 $file_copy->{'type_instance'} = $file_orig->{'type_instance'}
812 }
814 push (@$files_to_flush, $file_copy);
815 } # for (@$all_files)
817 if (!@$files_to_flush)
818 {
819 return (1);
820 }
822 $sock = Collectd::Unixsock->new ($opts{'addr'});
823 if (!$sock)
824 {
825 return;
826 }
828 $status = $sock->flush (plugins => ['rrdtool'], identifier => $files_to_flush);
829 if (!$status)
830 {
831 cluck ("FLUSH failed: " . $sock->{'error'});
832 $sock->destroy ();
833 return;
834 }
836 $sock->destroy ();
837 return (1);
838 } # flush_files
840 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :