1 package Collectd::Graph::Common;
3 use strict;
4 use warnings;
6 use vars (qw($ColorCanvas $ColorFullBlue $ColorHalfBlue));
8 use Carp (qw(confess cluck));
9 use CGI (':cgi');
10 use Exporter;
12 $ColorCanvas = 'FFFFFF';
13 $ColorFullBlue = '0000FF';
14 $ColorHalfBlue = 'B7B7F7';
16 @Collectd::Graph::Common::ISA = ('Exporter');
17 @Collectd::Graph::Common::EXPORT_OK = (qw(
18 $ColorCanvas
19 $ColorFullBlue
20 $ColorHalfBlue
22 sanitize_hostname
23 sanitize_plugin sanitize_plugin_instance
24 sanitize_type sanitize_type_instance
25 group_files_by_plugin_instance
26 get_files_from_directory
27 filename_to_ident
28 ident_to_filename
29 ident_to_string
30 get_all_hosts
31 get_files_for_host
32 get_files_by_ident
33 get_selected_files
34 get_timespan_selection
35 get_host_selection
36 get_plugin_selection
37 get_faded_color
38 sort_idents_by_type_instance
39 type_to_module_name
40 epoch_to_rfc1123
41 flush_files
42 ));
44 our $DataDir = '/var/lib/collectd/rrd';
46 return (1);
48 sub _sanitize_generic_allow_minus
49 {
50 my $str = "" . shift;
52 # remove all slashes
53 $str =~ s#/##g;
55 # remove all dots and dashes at the beginning and at the end.
56 $str =~ s#^[\.-]+##;
57 $str =~ s#[\.-]+$##;
59 return ($str);
60 }
62 sub _sanitize_generic_no_minus
63 {
64 # Do everything the allow-minus variant does..
65 my $str = _sanitize_generic_allow_minus (@_);
67 # .. and remove the dashes, too
68 $str =~ s#/##g;
70 return ($str);
71 } # _sanitize_generic_no_minus
73 sub sanitize_hostname
74 {
75 return (_sanitize_generic_allow_minus (@_));
76 }
78 sub sanitize_plugin
79 {
80 return (_sanitize_generic_no_minus (@_));
81 }
83 sub sanitize_plugin_instance
84 {
85 return (_sanitize_generic_allow_minus (@_));
86 }
88 sub sanitize_type
89 {
90 return (_sanitize_generic_no_minus (@_));
91 }
93 sub sanitize_type_instance
94 {
95 return (_sanitize_generic_allow_minus (@_));
96 }
98 sub group_files_by_plugin_instance
99 {
100 my @files = @_;
101 my $data = {};
103 for (my $i = 0; $i < @files; $i++)
104 {
105 my $file = $files[$i];
106 my $key = $file->{'plugin_instance'} || '';
108 $data->{$key} ||= [];
109 push (@{$data->{$key}}, $file);
110 }
112 return ($data);
113 }
115 sub filename_to_ident
116 {
117 my $file = shift;
118 my $ret;
120 if ($file =~ m#([^/]+)/([^/\-]+)(?:-([^/]+))?/([^/\-]+)(?:-([^/]+))?\.rrd$#)
121 {
122 $ret = {hostname => $1, plugin => $2, type => $4};
123 if (defined ($3))
124 {
125 $ret->{'plugin_instance'} = $3;
126 }
127 if (defined ($5))
128 {
129 $ret->{'type_instance'} = $5;
130 }
131 if ($`)
132 {
133 $ret->{'_prefix'} = $`;
134 }
135 }
136 else
137 {
138 return;
139 }
141 return ($ret);
142 } # filename_to_ident
144 sub ident_to_filename
145 {
146 my $ident = shift;
148 my $ret = '';
150 if (defined ($ident->{'_prefix'}))
151 {
152 $ret .= $ident->{'_prefix'};
153 }
154 else
155 {
156 $ret .= "$DataDir/";
157 }
159 if (!$ident->{'hostname'})
160 {
161 cluck ("hostname is undefined")
162 }
163 if (!$ident->{'plugin'})
164 {
165 cluck ("plugin is undefined")
166 }
167 if (!$ident->{'type'})
168 {
169 cluck ("type is undefined")
170 }
172 $ret .= $ident->{'hostname'} . '/' . $ident->{'plugin'};
173 if (defined ($ident->{'plugin_instance'}))
174 {
175 $ret .= '-' . $ident->{'plugin_instance'};
176 }
178 $ret .= '/' . $ident->{'type'};
179 if (defined ($ident->{'type_instance'}))
180 {
181 $ret .= '-' . $ident->{'type_instance'};
182 }
183 $ret .= '.rrd';
185 return ($ret);
186 } # ident_to_filename
188 sub ident_to_string
189 {
190 my $ident = shift;
192 my $ret = '';
194 $ret .= $ident->{'hostname'} . '/' . $ident->{'plugin'};
195 if (defined ($ident->{'plugin_instance'}))
196 {
197 $ret .= '-' . $ident->{'plugin_instance'};
198 }
200 $ret .= '/' . $ident->{'type'};
201 if (defined ($ident->{'type_instance'}))
202 {
203 $ret .= '-' . $ident->{'type_instance'};
204 }
206 return ($ret);
207 } # ident_to_string
209 sub get_files_from_directory
210 {
211 my $dir = shift;
212 my $recursive = @_ ? shift : 0;
213 my $dh;
214 my @directories = ();
215 my $ret = [];
217 opendir ($dh, $dir) or die ("opendir ($dir): $!");
218 while (my $entry = readdir ($dh))
219 {
220 next if ($entry =~ m/^\./);
222 $entry = "$dir/$entry";
224 if (-d $entry)
225 {
226 push (@directories, $entry);
227 }
228 elsif (-f $entry)
229 {
230 my $ident = filename_to_ident ($entry);
231 if ($ident)
232 {
233 push (@$ret, $ident);
234 }
235 }
236 }
237 closedir ($dh);
239 if ($recursive > 0)
240 {
241 for (@directories)
242 {
243 my $temp = get_files_from_directory ($_, $recursive - 1);
244 if ($temp && @$temp)
245 {
246 push (@$ret, @$temp);
247 }
248 }
249 }
251 return ($ret);
252 } # get_files_from_directory
254 sub get_all_hosts
255 {
256 my $dh;
257 my @ret = ();
259 opendir ($dh, "$DataDir") or confess ("opendir ($DataDir): $!");
260 while (my $entry = readdir ($dh))
261 {
262 next if ($entry =~ m/^\./);
263 next if (!-d "$DataDir/$entry");
264 push (@ret, sanitize_hostname ($entry));
265 }
266 closedir ($dh);
268 if (wantarray ())
269 {
270 return (@ret);
271 }
272 elsif (@ret)
273 {
274 return (\@ret);
275 }
276 else
277 {
278 return;
279 }
280 } # get_all_hosts
282 sub get_all_plugins
283 {
284 my @hosts = @_;
285 my $ret = {};
286 my $dh;
288 if (!@hosts)
289 {
290 @hosts = get_all_hosts ();
291 }
293 for (@hosts)
294 {
295 my $host = $_;
296 opendir ($dh, "$DataDir/$host") or next;
297 while (my $entry = readdir ($dh))
298 {
299 my $plugin;
300 my $plugin_instance = '';
302 next if ($entry =~ m/^\./);
303 next if (!-d "$DataDir/$host/$entry");
305 if ($entry =~ m#^([^-]+)-(.+)$#)
306 {
307 $plugin = $1;
308 $plugin_instance = $2;
309 }
310 elsif ($entry =~ m#^([^-]+)$#)
311 {
312 $plugin = $1;
313 $plugin_instance = '';
314 }
315 else
316 {
317 next;
318 }
320 $ret->{$plugin} ||= {};
321 $ret->{$plugin}{$plugin_instance} = 1;
322 } # while (readdir)
323 closedir ($dh);
324 } # for (@hosts)
326 if (wantarray ())
327 {
328 return (sort (keys %$ret));
329 }
330 else
331 {
332 return ($ret);
333 }
334 } # get_all_plugins
336 sub get_files_for_host
337 {
338 my $host = sanitize_hostname (shift);
339 return (get_files_from_directory ("$DataDir/$host", 2));
340 } # get_files_for_host
342 sub _filter_ident
343 {
344 my $filter = shift;
345 my $ident = shift;
347 for (qw(hostname plugin plugin_instance type type_instance))
348 {
349 my $part = $_;
350 my $tmp;
352 if (!defined ($filter->{$part}))
353 {
354 next;
355 }
356 if (!defined ($ident->{$part}))
357 {
358 return (1);
359 }
361 if (ref $filter->{$part})
362 {
363 if (!grep { $ident->{$part} eq $_ } (@{$filter->{$part}}))
364 {
365 return (1);
366 }
367 }
368 else
369 {
370 if ($ident->{$part} ne $filter->{$part})
371 {
372 return (1);
373 }
374 }
375 }
377 return (0);
378 } # _filter_ident
380 sub get_files_by_ident
381 {
382 my $ident = shift;
383 my $all_files;
384 my @ret = ();
386 #if ($ident->{'hostname'})
387 #{
388 #$all_files = get_files_for_host ($ident->{'hostname'});
389 #}
390 #else
391 #{
392 $all_files = get_files_from_directory ($DataDir, 3);
393 #}
395 @ret = grep { _filter_ident ($ident, $_) == 0 } (@$all_files);
397 return (\@ret);
398 } # get_files_by_ident
400 sub get_selected_files
401 {
402 my $ident = {};
404 for (qw(hostname plugin plugin_instance type type_instance))
405 {
406 my $part = $_;
407 my @temp = param ($part);
408 if (!@temp)
409 {
410 next;
411 }
412 elsif (($part eq 'plugin') || ($part eq 'type'))
413 {
414 $ident->{$part} = [map { _sanitize_generic_no_minus ($_) } (@temp)];
415 }
416 else
417 {
418 $ident->{$part} = [map { _sanitize_generic_allow_minus ($_) } (@temp)];
419 }
420 }
422 return (get_files_by_ident ($ident));
423 } # get_selected_files
425 sub get_timespan_selection
426 {
427 my $ret = 86400;
428 if (param ('timespan'))
429 {
430 my $temp = int (param ('timespan'));
431 if ($temp && ($temp > 0))
432 {
433 $ret = $temp;
434 }
435 }
437 return ($ret);
438 } # get_timespan_selection
440 sub get_host_selection
441 {
442 my %ret = ();
444 for (get_all_hosts ())
445 {
446 $ret{$_} = 0;
447 }
449 for (param ('hostname'))
450 {
451 my $host = _sanitize_generic_allow_minus ($_);
452 if (defined ($ret{$host}))
453 {
454 $ret{$host} = 1;
455 }
456 }
458 if (wantarray ())
459 {
460 return (grep { $ret{$_} > 0 } (sort (keys %ret)));
461 }
462 else
463 {
464 return (\%ret);
465 }
466 } # get_host_selection
468 sub get_plugin_selection
469 {
470 my %ret = ();
471 my @hosts = get_host_selection ();
473 for (get_all_plugins (@hosts))
474 {
475 $ret{$_} = 0;
476 }
478 for (param ('plugin'))
479 {
480 if (defined ($ret{$_}))
481 {
482 $ret{$_} = 1;
483 }
484 }
486 if (wantarray ())
487 {
488 return (grep { $ret{$_} > 0 } (sort (keys %ret)));
489 }
490 else
491 {
492 return (\%ret);
493 }
494 } # get_plugin_selection
496 sub _string_to_color
497 {
498 my $color = shift;
499 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])/)
500 {
501 return ([hex ($1) / 255.0, hex ($2) / 255.0, hex ($3) / 255.0]);
502 }
503 return;
504 } # _string_to_color
506 sub _color_to_string
507 {
508 confess ("Wrong number of arguments") if (@_ != 1);
509 return (sprintf ('%02hx%02hx%02hx', map { int (255.0 * $_) } @{$_[0]}));
510 } # _color_to_string
512 sub get_faded_color
513 {
514 my $fg = shift;
515 my $bg;
516 my %opts = @_;
517 my $ret = [undef, undef, undef];
519 $opts{'background'} ||= [1.0, 1.0, 1.0];
520 $opts{'alpha'} ||= 0.25;
522 if (!ref ($fg))
523 {
524 $fg = _string_to_color ($fg)
525 or confess ("Cannot parse foreground color $fg");
526 }
528 if (!ref ($opts{'background'}))
529 {
530 $opts{'background'} = _string_to_color ($opts{'background'})
531 or confess ("Cannot parse background color " . $opts{'background'});
532 }
533 $bg = $opts{'background'};
535 for (my $i = 0; $i < 3; $i++)
536 {
537 $ret->[$i] = ($opts{'alpha'} * $fg->[$i])
538 + ((1.0 - $opts{'alpha'}) * $bg->[$i]);
539 }
541 return (_color_to_string ($ret));
542 } # get_faded_color
544 sub sort_idents_by_type_instance
545 {
546 my $idents = shift;
547 my $array_sort = shift;
549 my %elements = map { $_->{'type_instance'} => $_ } (@$idents);
550 splice (@$idents, 0);
552 for (@$array_sort)
553 {
554 next if (!exists ($elements{$_}));
555 push (@$idents, $elements{$_});
556 delete ($elements{$_});
557 }
558 push (@$idents, map { $elements{$_} } (sort (keys %elements)));
559 } # sort_idents_by_type_instance
561 sub type_to_module_name
562 {
563 my $type = shift;
564 my $ret;
566 $ret = ucfirst (lc ($type));
568 $ret =~ s/[^A-Za-z_]//g;
569 $ret =~ s/_([A-Za-z])/\U$1\E/g;
571 return ("Collectd::Graph::Type::$ret");
572 } # type_to_module_name
574 sub epoch_to_rfc1123
575 {
576 my @days = (qw(Sun Mon Tue Wed Thu Fri Sat));
577 my @months = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));
579 my $epoch = @_ ? shift : time ();
580 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
581 my $string = sprintf ('%s, %02d %s %4d %02d:%02d:%02d GMT', $days[$wday], $mday,
582 $months[$mon], 1900 + $year, $hour ,$min, $sec);
583 return ($string);
584 }
586 sub flush_files
587 {
588 my $all_files = shift;
589 my %opts = @_;
591 my $begin;
592 my $end;
593 my $addr;
594 my $interval;
595 my $sock;
596 my $now;
597 my $files_to_flush = [];
598 my $status;
600 if (!defined $opts{'begin'})
601 {
602 cluck ("begin is not defined");
603 return;
604 }
605 $begin = $opts{'begin'};
607 if (!defined $opts{'end'})
608 {
609 cluck ("end is not defined");
610 return;
611 }
612 $end = $opts{'end'};
614 if (!$opts{'addr'})
615 {
616 return (1);
617 }
619 $interval = $opts{'interval'} || 10;
621 if (ref ($all_files) eq 'HASH')
622 {
623 my @tmp = ($all_files);
624 $all_files = \@tmp;
625 }
627 $now = time ();
628 # Don't flush anything if the timespan is in the future.
629 if (($end > $now) && ($begin > $now))
630 {
631 return (1);
632 }
634 for (@$all_files)
635 {
636 my $file_orig = $_;
637 my $file_name = ident_to_filename ($file_orig);
638 my $file_copy = {};
639 my @statbuf;
640 my $mtime;
642 @statbuf = stat ($file_name);
643 if (!@statbuf)
644 {
645 next;
646 }
647 $mtime = $statbuf[9];
649 # Skip if file is fresh
650 if (($now - $mtime) <= $interval)
651 {
652 next;
653 }
654 # or $end is before $mtime
655 elsif (($end != 0) && (($end - $mtime) <= 0))
656 {
657 next;
658 }
660 $file_copy->{'host'} = $file_orig->{'hostname'};
661 $file_copy->{'plugin'} = $file_orig->{'plugin'};
662 if (exists $file_orig->{'plugin_instance'})
663 {
664 $file_copy->{'plugin_instance'} = $file_orig->{'plugin_instance'}
665 }
666 $file_copy->{'type'} = $file_orig->{'type'};
667 if (exists $file_orig->{'type_instance'})
668 {
669 $file_copy->{'type_instance'} = $file_orig->{'type_instance'}
670 }
672 push (@$files_to_flush, $file_copy);
673 } # for (@$all_files)
675 if (!@$files_to_flush)
676 {
677 return (1);
678 }
680 $sock = Collectd::Unixsock->new ($opts{'addr'});
681 if (!$sock)
682 {
683 return;
684 }
686 $status = $sock->flush (plugins => ['rrdtool'], identifier => $files_to_flush);
687 if (!$status)
688 {
689 cluck ("FLUSH failed: " . $sock->{'error'});
690 $sock->destroy ();
691 return;
692 }
694 $sock->destroy ();
695 return (1);
696 } # flush_files
698 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :