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_faded_color
40 sort_idents_by_type_instance
41 type_to_module_name
42 epoch_to_rfc1123
43 flush_files
44 ));
46 our $DefaultDataDir = '/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;
149 my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
151 my $ret = '';
153 if (defined ($ident->{'_prefix'}))
154 {
155 $ret .= $ident->{'_prefix'};
156 }
157 else
158 {
159 $ret .= "$data_dir/";
160 }
162 if (!$ident->{'hostname'})
163 {
164 cluck ("hostname is undefined")
165 }
166 if (!$ident->{'plugin'})
167 {
168 cluck ("plugin is undefined")
169 }
170 if (!$ident->{'type'})
171 {
172 cluck ("type is undefined")
173 }
175 $ret .= $ident->{'hostname'} . '/' . $ident->{'plugin'};
176 if (defined ($ident->{'plugin_instance'}))
177 {
178 $ret .= '-' . $ident->{'plugin_instance'};
179 }
181 $ret .= '/' . $ident->{'type'};
182 if (defined ($ident->{'type_instance'}))
183 {
184 $ret .= '-' . $ident->{'type_instance'};
185 }
186 $ret .= '.rrd';
188 return ($ret);
189 } # ident_to_filename
191 sub ident_to_string
192 {
193 my $ident = shift;
195 my $ret = '';
197 $ret .= $ident->{'hostname'} . '/' . $ident->{'plugin'};
198 if (defined ($ident->{'plugin_instance'}))
199 {
200 $ret .= '-' . $ident->{'plugin_instance'};
201 }
203 $ret .= '/' . $ident->{'type'};
204 if (defined ($ident->{'type_instance'}))
205 {
206 $ret .= '-' . $ident->{'type_instance'};
207 }
209 return ($ret);
210 } # ident_to_string
212 sub get_files_from_directory
213 {
214 my $dir = shift;
215 my $recursive = @_ ? shift : 0;
216 my $dh;
217 my @directories = ();
218 my $ret = [];
220 opendir ($dh, $dir) or die ("opendir ($dir): $!");
221 while (my $entry = readdir ($dh))
222 {
223 next if ($entry =~ m/^\./);
225 $entry = "$dir/$entry";
227 if (-d $entry)
228 {
229 push (@directories, $entry);
230 }
231 elsif (-f $entry)
232 {
233 my $ident = filename_to_ident ($entry);
234 if ($ident)
235 {
236 push (@$ret, $ident);
237 }
238 }
239 }
240 closedir ($dh);
242 if ($recursive > 0)
243 {
244 for (@directories)
245 {
246 my $temp = get_files_from_directory ($_, $recursive - 1);
247 if ($temp && @$temp)
248 {
249 push (@$ret, @$temp);
250 }
251 }
252 }
254 return ($ret);
255 } # get_files_from_directory
257 sub get_all_hosts
258 {
259 my $dh;
260 my @ret = ();
261 my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
263 opendir ($dh, "$data_dir") or confess ("opendir ($data_dir): $!");
264 while (my $entry = readdir ($dh))
265 {
266 next if ($entry =~ m/^\./);
267 next if (!-d "$data_dir/$entry");
268 push (@ret, sanitize_hostname ($entry));
269 }
270 closedir ($dh);
272 if (wantarray ())
273 {
274 return (@ret);
275 }
276 elsif (@ret)
277 {
278 return (\@ret);
279 }
280 else
281 {
282 return;
283 }
284 } # get_all_hosts
286 sub get_all_plugins
287 {
288 my @hosts = @_;
289 my $ret = {};
290 my $dh;
291 my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
293 if (!@hosts)
294 {
295 @hosts = get_all_hosts ();
296 }
298 for (@hosts)
299 {
300 my $host = $_;
301 opendir ($dh, "$data_dir/$host") or next;
302 while (my $entry = readdir ($dh))
303 {
304 my $plugin;
305 my $plugin_instance = '';
307 next if ($entry =~ m/^\./);
308 next if (!-d "$data_dir/$host/$entry");
310 if ($entry =~ m#^([^-]+)-(.+)$#)
311 {
312 $plugin = $1;
313 $plugin_instance = $2;
314 }
315 elsif ($entry =~ m#^([^-]+)$#)
316 {
317 $plugin = $1;
318 $plugin_instance = '';
319 }
320 else
321 {
322 next;
323 }
325 $ret->{$plugin} ||= {};
326 $ret->{$plugin}{$plugin_instance} = 1;
327 } # while (readdir)
328 closedir ($dh);
329 } # for (@hosts)
331 if (wantarray ())
332 {
333 return (sort (keys %$ret));
334 }
335 else
336 {
337 return ($ret);
338 }
339 } # get_all_plugins
341 sub get_files_for_host
342 {
343 my $host = sanitize_hostname (shift);
344 my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
345 return (get_files_from_directory ("$data_dir/$host", 2));
346 } # get_files_for_host
348 sub _filter_ident
349 {
350 my $filter = shift;
351 my $ident = shift;
353 for (qw(hostname plugin plugin_instance type type_instance))
354 {
355 my $part = $_;
356 my $tmp;
358 if (!defined ($filter->{$part}))
359 {
360 next;
361 }
362 if (!defined ($ident->{$part}))
363 {
364 return (1);
365 }
367 if (ref $filter->{$part})
368 {
369 if (!grep { $ident->{$part} eq $_ } (@{$filter->{$part}}))
370 {
371 return (1);
372 }
373 }
374 else
375 {
376 if ($ident->{$part} ne $filter->{$part})
377 {
378 return (1);
379 }
380 }
381 }
383 return (0);
384 } # _filter_ident
386 sub get_files_by_ident
387 {
388 my $ident = shift;
389 my $all_files;
390 my @ret = ();
391 my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
393 #if ($ident->{'hostname'})
394 #{
395 #$all_files = get_files_for_host ($ident->{'hostname'});
396 #}
397 #else
398 #{
399 $all_files = get_files_from_directory ($data_dir, 3);
400 #}
402 @ret = grep { _filter_ident ($ident, $_) == 0 } (@$all_files);
404 return (\@ret);
405 } # get_files_by_ident
407 sub get_selected_files
408 {
409 my $ident = {};
411 for (qw(hostname plugin plugin_instance type type_instance))
412 {
413 my $part = $_;
414 my @temp = param ($part);
415 if (!@temp)
416 {
417 next;
418 }
419 elsif (($part eq 'plugin') || ($part eq 'type'))
420 {
421 $ident->{$part} = [map { _sanitize_generic_no_minus ($_) } (@temp)];
422 }
423 else
424 {
425 $ident->{$part} = [map { _sanitize_generic_allow_minus ($_) } (@temp)];
426 }
427 }
429 return (get_files_by_ident ($ident));
430 } # get_selected_files
432 sub get_timespan_selection
433 {
434 my $ret = 86400;
435 if (param ('timespan'))
436 {
437 my $temp = int (param ('timespan'));
438 if ($temp && ($temp > 0))
439 {
440 $ret = $temp;
441 }
442 }
444 return ($ret);
445 } # get_timespan_selection
447 sub get_host_selection
448 {
449 my %ret = ();
451 for (get_all_hosts ())
452 {
453 $ret{$_} = 0;
454 }
456 for (param ('hostname'))
457 {
458 my $host = _sanitize_generic_allow_minus ($_);
459 if (defined ($ret{$host}))
460 {
461 $ret{$host} = 1;
462 }
463 }
465 if (wantarray ())
466 {
467 return (grep { $ret{$_} > 0 } (sort (keys %ret)));
468 }
469 else
470 {
471 return (\%ret);
472 }
473 } # get_host_selection
475 sub get_plugin_selection
476 {
477 my %ret = ();
478 my @hosts = get_host_selection ();
480 for (get_all_plugins (@hosts))
481 {
482 $ret{$_} = 0;
483 }
485 for (param ('plugin'))
486 {
487 if (defined ($ret{$_}))
488 {
489 $ret{$_} = 1;
490 }
491 }
493 if (wantarray ())
494 {
495 return (grep { $ret{$_} > 0 } (sort (keys %ret)));
496 }
497 else
498 {
499 return (\%ret);
500 }
501 } # get_plugin_selection
503 sub _string_to_color
504 {
505 my $color = shift;
506 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])/)
507 {
508 return ([hex ($1) / 255.0, hex ($2) / 255.0, hex ($3) / 255.0]);
509 }
510 return;
511 } # _string_to_color
513 sub _color_to_string
514 {
515 confess ("Wrong number of arguments") if (@_ != 1);
516 return (sprintf ('%02hx%02hx%02hx', map { int (255.0 * $_) } @{$_[0]}));
517 } # _color_to_string
519 sub get_faded_color
520 {
521 my $fg = shift;
522 my $bg;
523 my %opts = @_;
524 my $ret = [undef, undef, undef];
526 $opts{'background'} ||= [1.0, 1.0, 1.0];
527 $opts{'alpha'} ||= 0.25;
529 if (!ref ($fg))
530 {
531 $fg = _string_to_color ($fg)
532 or confess ("Cannot parse foreground color $fg");
533 }
535 if (!ref ($opts{'background'}))
536 {
537 $opts{'background'} = _string_to_color ($opts{'background'})
538 or confess ("Cannot parse background color " . $opts{'background'});
539 }
540 $bg = $opts{'background'};
542 for (my $i = 0; $i < 3; $i++)
543 {
544 $ret->[$i] = ($opts{'alpha'} * $fg->[$i])
545 + ((1.0 - $opts{'alpha'}) * $bg->[$i]);
546 }
548 return (_color_to_string ($ret));
549 } # get_faded_color
551 sub sort_idents_by_type_instance
552 {
553 my $idents = shift;
554 my $array_sort = shift;
556 my %elements = map { $_->{'type_instance'} => $_ } (@$idents);
557 splice (@$idents, 0);
559 for (@$array_sort)
560 {
561 next if (!exists ($elements{$_}));
562 push (@$idents, $elements{$_});
563 delete ($elements{$_});
564 }
565 push (@$idents, map { $elements{$_} } (sort (keys %elements)));
566 } # sort_idents_by_type_instance
568 sub type_to_module_name
569 {
570 my $type = shift;
571 my $ret;
573 $ret = ucfirst (lc ($type));
575 $ret =~ s/[^A-Za-z_]//g;
576 $ret =~ s/_([A-Za-z])/\U$1\E/g;
578 return ("Collectd::Graph::Type::$ret");
579 } # type_to_module_name
581 sub epoch_to_rfc1123
582 {
583 my @days = (qw(Sun Mon Tue Wed Thu Fri Sat));
584 my @months = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));
586 my $epoch = @_ ? shift : time ();
587 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
588 my $string = sprintf ('%s, %02d %s %4d %02d:%02d:%02d GMT', $days[$wday], $mday,
589 $months[$mon], 1900 + $year, $hour ,$min, $sec);
590 return ($string);
591 }
593 sub flush_files
594 {
595 my $all_files = shift;
596 my %opts = @_;
598 my $begin;
599 my $end;
600 my $addr;
601 my $interval;
602 my $sock;
603 my $now;
604 my $files_to_flush = [];
605 my $status;
607 if (!defined $opts{'begin'})
608 {
609 cluck ("begin is not defined");
610 return;
611 }
612 $begin = $opts{'begin'};
614 if (!defined $opts{'end'})
615 {
616 cluck ("end is not defined");
617 return;
618 }
619 $end = $opts{'end'};
621 if (!$opts{'addr'})
622 {
623 return (1);
624 }
626 $interval = $opts{'interval'} || 10;
628 if (ref ($all_files) eq 'HASH')
629 {
630 my @tmp = ($all_files);
631 $all_files = \@tmp;
632 }
634 $now = time ();
635 # Don't flush anything if the timespan is in the future.
636 if (($end > $now) && ($begin > $now))
637 {
638 return (1);
639 }
641 for (@$all_files)
642 {
643 my $file_orig = $_;
644 my $file_name = ident_to_filename ($file_orig);
645 my $file_copy = {};
646 my @statbuf;
647 my $mtime;
649 @statbuf = stat ($file_name);
650 if (!@statbuf)
651 {
652 next;
653 }
654 $mtime = $statbuf[9];
656 # Skip if file is fresh
657 if (($now - $mtime) <= $interval)
658 {
659 next;
660 }
661 # or $end is before $mtime
662 elsif (($end != 0) && (($end - $mtime) <= 0))
663 {
664 next;
665 }
667 $file_copy->{'host'} = $file_orig->{'hostname'};
668 $file_copy->{'plugin'} = $file_orig->{'plugin'};
669 if (exists $file_orig->{'plugin_instance'})
670 {
671 $file_copy->{'plugin_instance'} = $file_orig->{'plugin_instance'}
672 }
673 $file_copy->{'type'} = $file_orig->{'type'};
674 if (exists $file_orig->{'type_instance'})
675 {
676 $file_copy->{'type_instance'} = $file_orig->{'type_instance'}
677 }
679 push (@$files_to_flush, $file_copy);
680 } # for (@$all_files)
682 if (!@$files_to_flush)
683 {
684 return (1);
685 }
687 $sock = Collectd::Unixsock->new ($opts{'addr'});
688 if (!$sock)
689 {
690 return;
691 }
693 $status = $sock->flush (plugins => ['rrdtool'], identifier => $files_to_flush);
694 if (!$status)
695 {
696 cluck ("FLUSH failed: " . $sock->{'error'});
697 $sock->destroy ();
698 return;
699 }
701 $sock->destroy ();
702 return (1);
703 } # flush_files
705 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :