1 package Collectd::Graph::Common;
3 use strict;
4 use warnings;
6 use vars (qw($ColorCanvas $ColorFullBlue $ColorHalfBlue));
8 use Collectd::Unixsock ();
9 use Carp (qw(confess cluck));
10 use CGI (':cgi');
11 use Exporter;
12 use Collectd::Graph::Config (qw(gc_get_scalar));
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_random_color
40 get_faded_color
41 sort_idents_by_type_instance
42 type_to_module_name
43 epoch_to_rfc1123
44 flush_files
45 ));
47 our $DefaultDataDir = '/var/lib/collectd/rrd';
49 return (1);
51 sub _sanitize_generic_allow_minus
52 {
53 my $str = "" . shift;
55 # remove all slashes
56 $str =~ s#/##g;
58 # remove all dots and dashes at the beginning and at the end.
59 $str =~ s#^[\.-]+##;
60 $str =~ s#[\.-]+$##;
62 return ($str);
63 }
65 sub _sanitize_generic_no_minus
66 {
67 # Do everything the allow-minus variant does..
68 my $str = _sanitize_generic_allow_minus (@_);
70 # .. and remove the dashes, too
71 $str =~ s#/##g;
73 return ($str);
74 } # _sanitize_generic_no_minus
76 sub sanitize_hostname
77 {
78 return (_sanitize_generic_allow_minus (@_));
79 }
81 sub sanitize_plugin
82 {
83 return (_sanitize_generic_no_minus (@_));
84 }
86 sub sanitize_plugin_instance
87 {
88 return (_sanitize_generic_allow_minus (@_));
89 }
91 sub sanitize_type
92 {
93 return (_sanitize_generic_no_minus (@_));
94 }
96 sub sanitize_type_instance
97 {
98 return (_sanitize_generic_allow_minus (@_));
99 }
101 sub group_files_by_plugin_instance
102 {
103 my @files = @_;
104 my $data = {};
106 for (my $i = 0; $i < @files; $i++)
107 {
108 my $file = $files[$i];
109 my $key = $file->{'plugin_instance'} || '';
111 $data->{$key} ||= [];
112 push (@{$data->{$key}}, $file);
113 }
115 return ($data);
116 }
118 sub filename_to_ident
119 {
120 my $file = shift;
121 my $ret;
123 if ($file =~ m#([^/]+)/([^/\-]+)(?:-([^/]+))?/([^/\-]+)(?:-([^/]+))?\.rrd$#)
124 {
125 $ret = {hostname => $1, plugin => $2, type => $4};
126 if (defined ($3))
127 {
128 $ret->{'plugin_instance'} = $3;
129 }
130 if (defined ($5))
131 {
132 $ret->{'type_instance'} = $5;
133 }
134 if ($`)
135 {
136 $ret->{'_prefix'} = $`;
137 }
138 }
139 else
140 {
141 return;
142 }
144 return ($ret);
145 } # filename_to_ident
147 sub ident_to_filename
148 {
149 my $ident = shift;
150 my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
152 my $ret = '';
154 if (defined ($ident->{'_prefix'}))
155 {
156 $ret .= $ident->{'_prefix'};
157 }
158 else
159 {
160 $ret .= "$data_dir/";
161 }
163 if (!$ident->{'hostname'})
164 {
165 cluck ("hostname is undefined")
166 }
167 if (!$ident->{'plugin'})
168 {
169 cluck ("plugin is undefined")
170 }
171 if (!$ident->{'type'})
172 {
173 cluck ("type is undefined")
174 }
176 $ret .= $ident->{'hostname'} . '/' . $ident->{'plugin'};
177 if (defined ($ident->{'plugin_instance'}))
178 {
179 $ret .= '-' . $ident->{'plugin_instance'};
180 }
182 $ret .= '/' . $ident->{'type'};
183 if (defined ($ident->{'type_instance'}))
184 {
185 $ret .= '-' . $ident->{'type_instance'};
186 }
187 $ret .= '.rrd';
189 return ($ret);
190 } # ident_to_filename
192 sub ident_to_string
193 {
194 my $ident = shift;
196 my $ret = '';
198 $ret .= $ident->{'hostname'} . '/' . $ident->{'plugin'};
199 if (defined ($ident->{'plugin_instance'}))
200 {
201 $ret .= '-' . $ident->{'plugin_instance'};
202 }
204 $ret .= '/' . $ident->{'type'};
205 if (defined ($ident->{'type_instance'}))
206 {
207 $ret .= '-' . $ident->{'type_instance'};
208 }
210 return ($ret);
211 } # ident_to_string
213 sub get_files_from_directory
214 {
215 my $dir = shift;
216 my $recursive = @_ ? shift : 0;
217 my $dh;
218 my @directories = ();
219 my $ret = [];
221 opendir ($dh, $dir) or die ("opendir ($dir): $!");
222 while (my $entry = readdir ($dh))
223 {
224 next if ($entry =~ m/^\./);
226 $entry = "$dir/$entry";
228 if (-d $entry)
229 {
230 push (@directories, $entry);
231 }
232 elsif (-f $entry)
233 {
234 my $ident = filename_to_ident ($entry);
235 if ($ident)
236 {
237 push (@$ret, $ident);
238 }
239 }
240 }
241 closedir ($dh);
243 if ($recursive > 0)
244 {
245 for (@directories)
246 {
247 my $temp = get_files_from_directory ($_, $recursive - 1);
248 if ($temp && @$temp)
249 {
250 push (@$ret, @$temp);
251 }
252 }
253 }
255 return ($ret);
256 } # get_files_from_directory
258 sub get_all_hosts
259 {
260 my $dh;
261 my @ret = ();
262 my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
264 opendir ($dh, "$data_dir") or confess ("opendir ($data_dir): $!");
265 while (my $entry = readdir ($dh))
266 {
267 next if ($entry =~ m/^\./);
268 next if (!-d "$data_dir/$entry");
269 push (@ret, sanitize_hostname ($entry));
270 }
271 closedir ($dh);
273 if (wantarray ())
274 {
275 return (@ret);
276 }
277 elsif (@ret)
278 {
279 return (\@ret);
280 }
281 else
282 {
283 return;
284 }
285 } # get_all_hosts
287 sub get_all_plugins
288 {
289 my @hosts = @_;
290 my $ret = {};
291 my $dh;
292 my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
294 if (!@hosts)
295 {
296 @hosts = get_all_hosts ();
297 }
299 for (@hosts)
300 {
301 my $host = $_;
302 opendir ($dh, "$data_dir/$host") or next;
303 while (my $entry = readdir ($dh))
304 {
305 my $plugin;
306 my $plugin_instance = '';
308 next if ($entry =~ m/^\./);
309 next if (!-d "$data_dir/$host/$entry");
311 if ($entry =~ m#^([^-]+)-(.+)$#)
312 {
313 $plugin = $1;
314 $plugin_instance = $2;
315 }
316 elsif ($entry =~ m#^([^-]+)$#)
317 {
318 $plugin = $1;
319 $plugin_instance = '';
320 }
321 else
322 {
323 next;
324 }
326 $ret->{$plugin} ||= {};
327 $ret->{$plugin}{$plugin_instance} = 1;
328 } # while (readdir)
329 closedir ($dh);
330 } # for (@hosts)
332 if (wantarray ())
333 {
334 return (sort (keys %$ret));
335 }
336 else
337 {
338 return ($ret);
339 }
340 } # get_all_plugins
342 sub get_files_for_host
343 {
344 my $host = sanitize_hostname (shift);
345 my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
346 return (get_files_from_directory ("$data_dir/$host", 2));
347 } # get_files_for_host
349 sub _filter_ident
350 {
351 my $filter = shift;
352 my $ident = shift;
354 for (qw(hostname plugin plugin_instance type type_instance))
355 {
356 my $part = $_;
357 my $tmp;
359 if (!defined ($filter->{$part}))
360 {
361 next;
362 }
363 if (!defined ($ident->{$part}))
364 {
365 return (1);
366 }
368 if (ref $filter->{$part})
369 {
370 if (!grep { $ident->{$part} eq $_ } (@{$filter->{$part}}))
371 {
372 return (1);
373 }
374 }
375 else
376 {
377 if ($ident->{$part} ne $filter->{$part})
378 {
379 return (1);
380 }
381 }
382 }
384 return (0);
385 } # _filter_ident
387 sub get_files_by_ident
388 {
389 my $ident = shift;
390 my $all_files;
391 my @ret = ();
392 my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
394 #if ($ident->{'hostname'})
395 #{
396 #$all_files = get_files_for_host ($ident->{'hostname'});
397 #}
398 #else
399 #{
400 $all_files = get_files_from_directory ($data_dir, 3);
401 #}
403 @ret = grep { _filter_ident ($ident, $_) == 0 } (@$all_files);
405 return (\@ret);
406 } # get_files_by_ident
408 sub get_selected_files
409 {
410 my $ident = {};
412 for (qw(hostname plugin plugin_instance type type_instance))
413 {
414 my $part = $_;
415 my @temp = param ($part);
416 if (!@temp)
417 {
418 next;
419 }
420 elsif (($part eq 'plugin') || ($part eq 'type'))
421 {
422 $ident->{$part} = [map { _sanitize_generic_no_minus ($_) } (@temp)];
423 }
424 else
425 {
426 $ident->{$part} = [map { _sanitize_generic_allow_minus ($_) } (@temp)];
427 }
428 }
430 return (get_files_by_ident ($ident));
431 } # get_selected_files
433 sub get_timespan_selection
434 {
435 my $ret = 86400;
436 if (param ('timespan'))
437 {
438 my $temp = int (param ('timespan'));
439 if ($temp && ($temp > 0))
440 {
441 $ret = $temp;
442 }
443 }
445 return ($ret);
446 } # get_timespan_selection
448 sub get_host_selection
449 {
450 my %ret = ();
452 for (get_all_hosts ())
453 {
454 $ret{$_} = 0;
455 }
457 for (param ('hostname'))
458 {
459 my $host = _sanitize_generic_allow_minus ($_);
460 if (defined ($ret{$host}))
461 {
462 $ret{$host} = 1;
463 }
464 }
466 if (wantarray ())
467 {
468 return (grep { $ret{$_} > 0 } (sort (keys %ret)));
469 }
470 else
471 {
472 return (\%ret);
473 }
474 } # get_host_selection
476 sub get_plugin_selection
477 {
478 my %ret = ();
479 my @hosts = get_host_selection ();
481 for (get_all_plugins (@hosts))
482 {
483 $ret{$_} = 0;
484 }
486 for (param ('plugin'))
487 {
488 if (defined ($ret{$_}))
489 {
490 $ret{$_} = 1;
491 }
492 }
494 if (wantarray ())
495 {
496 return (grep { $ret{$_} > 0 } (sort (keys %ret)));
497 }
498 else
499 {
500 return (\%ret);
501 }
502 } # get_plugin_selection
504 sub _string_to_color
505 {
506 my $color = shift;
507 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])/)
508 {
509 return ([hex ($1) / 255.0, hex ($2) / 255.0, hex ($3) / 255.0]);
510 }
511 return;
512 } # _string_to_color
514 sub _color_to_string
515 {
516 confess ("Wrong number of arguments") if (@_ != 1);
517 return (sprintf ('%02hx%02hx%02hx', map { int (255.0 * $_) } @{$_[0]}));
518 } # _color_to_string
520 sub get_random_color
521 {
522 my ($r, $g, $b) = (rand (), rand ());
523 my $min = 0.0;
524 my $max = 1.0;
526 if (($r + $g) < 1.0)
527 {
528 $min = 1.0 - ($r + $g);
529 }
530 else
531 {
532 $max = 2.0 - ($r + $g);
533 }
535 $b = $min + (rand () * ($max - $min));
537 return (_color_to_string ([$r, $g, $b]));
538 } # get_random_color
540 sub get_faded_color
541 {
542 my $fg = shift;
543 my $bg;
544 my %opts = @_;
545 my $ret = [undef, undef, undef];
547 $opts{'background'} ||= [1.0, 1.0, 1.0];
548 $opts{'alpha'} ||= 0.25;
550 if (!ref ($fg))
551 {
552 $fg = _string_to_color ($fg)
553 or confess ("Cannot parse foreground color $fg");
554 }
556 if (!ref ($opts{'background'}))
557 {
558 $opts{'background'} = _string_to_color ($opts{'background'})
559 or confess ("Cannot parse background color " . $opts{'background'});
560 }
561 $bg = $opts{'background'};
563 for (my $i = 0; $i < 3; $i++)
564 {
565 $ret->[$i] = ($opts{'alpha'} * $fg->[$i])
566 + ((1.0 - $opts{'alpha'}) * $bg->[$i]);
567 }
569 return (_color_to_string ($ret));
570 } # get_faded_color
572 sub sort_idents_by_type_instance
573 {
574 my $idents = shift;
575 my $array_sort = shift;
577 my %elements = map { $_->{'type_instance'} => $_ } (@$idents);
578 splice (@$idents, 0);
580 for (@$array_sort)
581 {
582 next if (!exists ($elements{$_}));
583 push (@$idents, $elements{$_});
584 delete ($elements{$_});
585 }
586 push (@$idents, map { $elements{$_} } (sort (keys %elements)));
587 } # sort_idents_by_type_instance
589 sub type_to_module_name
590 {
591 my $type = shift;
592 my $ret;
594 $ret = ucfirst (lc ($type));
596 $ret =~ s/[^A-Za-z_]//g;
597 $ret =~ s/_([A-Za-z])/\U$1\E/g;
599 return ("Collectd::Graph::Type::$ret");
600 } # type_to_module_name
602 sub epoch_to_rfc1123
603 {
604 my @days = (qw(Sun Mon Tue Wed Thu Fri Sat));
605 my @months = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));
607 my $epoch = @_ ? shift : time ();
608 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
609 my $string = sprintf ('%s, %02d %s %4d %02d:%02d:%02d GMT', $days[$wday], $mday,
610 $months[$mon], 1900 + $year, $hour ,$min, $sec);
611 return ($string);
612 }
614 sub flush_files
615 {
616 my $all_files = shift;
617 my %opts = @_;
619 my $begin;
620 my $end;
621 my $addr;
622 my $interval;
623 my $sock;
624 my $now;
625 my $files_to_flush = [];
626 my $status;
628 if (!defined $opts{'begin'})
629 {
630 cluck ("begin is not defined");
631 return;
632 }
633 $begin = $opts{'begin'};
635 if (!defined $opts{'end'})
636 {
637 cluck ("end is not defined");
638 return;
639 }
640 $end = $opts{'end'};
642 if (!$opts{'addr'})
643 {
644 return (1);
645 }
647 $interval = $opts{'interval'} || 10;
649 if (ref ($all_files) eq 'HASH')
650 {
651 my @tmp = ($all_files);
652 $all_files = \@tmp;
653 }
655 $now = time ();
656 # Don't flush anything if the timespan is in the future.
657 if (($end > $now) && ($begin > $now))
658 {
659 return (1);
660 }
662 for (@$all_files)
663 {
664 my $file_orig = $_;
665 my $file_name = ident_to_filename ($file_orig);
666 my $file_copy = {};
667 my @statbuf;
668 my $mtime;
670 @statbuf = stat ($file_name);
671 if (!@statbuf)
672 {
673 next;
674 }
675 $mtime = $statbuf[9];
677 # Skip if file is fresh
678 if (($now - $mtime) <= $interval)
679 {
680 next;
681 }
682 # or $end is before $mtime
683 elsif (($end != 0) && (($end - $mtime) <= 0))
684 {
685 next;
686 }
688 $file_copy->{'host'} = $file_orig->{'hostname'};
689 $file_copy->{'plugin'} = $file_orig->{'plugin'};
690 if (exists $file_orig->{'plugin_instance'})
691 {
692 $file_copy->{'plugin_instance'} = $file_orig->{'plugin_instance'}
693 }
694 $file_copy->{'type'} = $file_orig->{'type'};
695 if (exists $file_orig->{'type_instance'})
696 {
697 $file_copy->{'type_instance'} = $file_orig->{'type_instance'}
698 }
700 push (@$files_to_flush, $file_copy);
701 } # for (@$all_files)
703 if (!@$files_to_flush)
704 {
705 return (1);
706 }
708 $sock = Collectd::Unixsock->new ($opts{'addr'});
709 if (!$sock)
710 {
711 return;
712 }
714 $status = $sock->flush (plugins => ['rrdtool'], identifier => $files_to_flush);
715 if (!$status)
716 {
717 cluck ("FLUSH failed: " . $sock->{'error'});
718 $sock->destroy ();
719 return;
720 }
722 $sock->destroy ();
723 return (1);
724 } # flush_files
726 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :