contrib/collection3/lib/Collectd/Graph/Common.pm

   1 package Collectd::Graph::Common;
   2
   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>
  21
  22 use strict;
  23 use warnings;
  24
  25 use vars (qw($ColorCanvas $ColorFullBlue $ColorHalfBlue));
  26
  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));
  32
  33 our $Cache = {};
  34
  35 $ColorCanvas   = 'FFFFFF';
  36 $ColorFullBlue = '0000FF';
  37 $ColorHalfBlue = 'B7B7F7';
  38
  39 @Collectd::Graph::Common::ISA = ('Exporter');
  40 @Collectd::Graph::Common::EXPORT_OK = (qw(
  41   $ColorCanvas
  42   $ColorFullBlue
  43   $ColorHalfBlue
  44
  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 ));
  67
  68 our $DefaultDataDir = '/var/lib/collectd/rrd';
  69
  70 return (1);
  71
  72 sub _sanitize_generic_allow_minus
  73 {
  74   my $str = "" . shift;
  75
  76   # remove all slashes
  77   $str =~ s#/##g;
  78
  79   # remove all dots and dashes at the beginning and at the end.
  80   $str =~ s#^[\.-]+##;
  81   $str =~ s#[\.-]+$##;
  82
  83   return ($str);
  84 }
  85
  86 sub _sanitize_generic_no_minus
  87 {
  88   # Do everything the allow-minus variant does..
  89   my $str = _sanitize_generic_allow_minus (@_);
  90
  91   # .. and remove the dashes, too
  92   $str =~ s#/##g;
  93
  94   return ($str);
  95 } # _sanitize_generic_no_minus
  96
  97 sub sanitize_hostname
  98 {
  99   return (_sanitize_generic_allow_minus (@_));
 100 }
 101
 102 sub sanitize_plugin
 103 {
 104   return (_sanitize_generic_no_minus (@_));
 105 }
 106
 107 sub sanitize_plugin_instance
 108 {
 109   return (_sanitize_generic_allow_minus (@_));
 110 }
 111
 112 sub sanitize_type
 113 {
 114   return (_sanitize_generic_no_minus (@_));
 115 }
 116
 117 sub sanitize_type_instance
 118 {
 119   return (_sanitize_generic_allow_minus (@_));
 120 }
 121
 122 sub group_files_by_plugin_instance
 123 {
 124   my @files = @_;
 125   my $data = {};
 126
 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";
 133
 134     $data->{$key} ||= [];
 135     push (@{$data->{$key}}, $file);
 136   }
 137
 138   return ($data);
 139 }
 140
 141 sub filename_to_ident
 142 {
 143   my $file = shift;
 144   my $ret;
 145
 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   }
 166
 167   return ($ret);
 168 } # filename_to_ident
 169
 170 sub ident_to_filename
 171 {
 172   my $ident = shift;
 173   my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
 174
 175   my $ret = '';
 176
 177   if (defined ($ident->{'_prefix'}))
 178   {
 179     $ret .= $ident->{'_prefix'};
 180   }
 181   else
 182   {
 183     $ret .= "$data_dir/";
 184   }
 185
 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   }
 198
 199   $ret .= $ident->{'hostname'} . '/' . $ident->{'plugin'};
 200   if (defined ($ident->{'plugin_instance'}))
 201   {
 202     $ret .= '-' . $ident->{'plugin_instance'};
 203   }
 204
 205   $ret .= '/' . $ident->{'type'};
 206   if (defined ($ident->{'type_instance'}))
 207   {
 208     $ret .= '-' . $ident->{'type_instance'};
 209   }
 210   $ret .= '.rrd';
 211
 212   return ($ret);
 213 } # ident_to_filename
 214
 215 sub _part_to_string
 216 {
 217   my $part = shift;
 218
 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
 239
 240 sub ident_to_string
 241 {
 242   my $ident = shift;
 243
 244   my $ret = '';
 245
 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   }
 252
 253   $ret .= '/' . _part_to_string ($ident->{'type'});
 254   if (defined ($ident->{'type_instance'}))
 255   {
 256     $ret .= '-' . _part_to_string ($ident->{'type_instance'});
 257   }
 258
 259   return ($ret);
 260 } # ident_to_string
 261
 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 = [];
 270
 271   opendir ($dh, $dir) or die ("opendir ($dir): $!");
 272   while (my $entry = readdir ($dh))
 273   {
 274     next if ($entry =~ m/^\./);
 275
 276     $entry = "$dir/$entry";
 277
 278     if (-d $entry)
 279     {
 280       push (@directories, $entry);
 281     }
 282     elsif (-f $entry)
 283     {
 284       push (@files, $entry);
 285     }
 286   }
 287   closedir ($dh);
 288
 289   push (@$ret, map { filename_to_ident ($_) } sort (@files));
 290
 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   }
 302
 303   return ($ret);
 304 } # get_files_from_directory
 305
 306 sub get_all_hosts
 307 {
 308   my $ret = [];
 309
 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);
 318
 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);
 327
 328     $Cache->{'get_all_hosts'} = $ret;
 329   }
 330
 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
 344
 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;
 352
 353   if (@hosts)
 354   {
 355     $cache_key = join (';', @hosts);
 356   }
 357   else
 358   {
 359     $cache_key = "/*/";
 360     @hosts = get_all_hosts ();
 361   }
 362
 363   if (defined ($Cache->{'get_all_plugins'}{$cache_key}))
 364   {
 365     $ret = $Cache->{'get_all_plugins'}{$cache_key};
 366
 367     if (wantarray ())
 368     {
 369       return (sort (keys %$ret));
 370     }
 371     else
 372     {
 373       return ($ret);
 374     }
 375   }
 376
 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 = '';
 385
 386       next if ($entry =~ m/^\./);
 387       next if (!-d "$data_dir/$host/$entry");
 388
 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       }
 403
 404       $ret->{$plugin} ||= {};
 405       $ret->{$plugin}{$plugin_instance} = 1;
 406     } # while (readdir)
 407     closedir ($dh);
 408   } # for (@hosts)
 409
 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
 420
 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
 427
 428 sub _filter_ident
 429 {
 430   my $filter = shift;
 431   my $ident = shift;
 432
 433   for (qw(hostname plugin plugin_instance type type_instance))
 434   {
 435     my $part = $_;
 436     my $tmp;
 437
 438     if (!defined ($filter->{$part}))
 439     {
 440       next;
 441     }
 442     if (!defined ($ident->{$part}))
 443     {
 444       return (1);
 445     }
 446
 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   }
 462
 463   return (0);
 464 } # _filter_ident
 465
 466 sub _get_all_files
 467 {
 468   my $ret;
 469
 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);
 477
 478     $ret = get_files_from_directory ($data_dir, 3);
 479     $Cache->{'_get_all_files'} = $ret;
 480   }
 481
 482   return ($ret);
 483 } # _get_all_files
 484
 485 sub get_files_by_ident
 486 {
 487   my $ident = shift;
 488   my $all_files;
 489   my @ret = ();
 490   my $temp;
 491   my $hosts;
 492
 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};
 497
 498     return ($ret)
 499   }
 500
 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   }
 515
 516   @ret = grep { _filter_ident ($ident, $_) == 0 } (@$all_files);
 517
 518   $Cache->{'get_files_by_ident'}{$cache_key} = \@ret;
 519   return (\@ret);
 520 } # get_files_by_ident
 521
 522 sub get_selected_files
 523 {
 524   my $ident = {};
 525
 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   }
 543
 544   return (get_files_by_ident ($ident));
 545 } # get_selected_files
 546
 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   }
 558
 559   return ($ret);
 560 } # get_timespan_selection
 561
 562 sub get_host_selection
 563 {
 564   my %ret = ();
 565
 566   for (get_all_hosts ())
 567   {
 568     $ret{$_} = 0;
 569   }
 570
 571   for (param ('hostname'))
 572   {
 573     my $host = _sanitize_generic_allow_minus ($_);
 574     if (defined ($ret{$host}))
 575     {
 576       $ret{$host} = 1;
 577     }
 578   }
 579
 580   if (wantarray ())
 581   {
 582     return (grep { $ret{$_} > 0 } (sort (keys %ret)));
 583   }
 584   else
 585   {
 586     return (\%ret);
 587   }
 588 } # get_host_selection
 589
 590 sub get_plugin_selection
 591 {
 592   my %ret = ();
 593   my @hosts = get_host_selection ();
 594
 595   for (get_all_plugins (@hosts))
 596   {
 597     $ret{$_} = 0;
 598   }
 599
 600   for (param ('plugin'))
 601   {
 602     if (defined ($ret{$_}))
 603     {
 604       $ret{$_} = 1;
 605     }
 606   }
 607
 608   if (wantarray ())
 609   {
 610     return (grep { $ret{$_} > 0 } (sort (keys %ret)));
 611   }
 612   else
 613   {
 614     return (\%ret);
 615   }
 616 } # get_plugin_selection
 617
 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
 627
 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
 633
 634 sub get_random_color
 635 {
 636   my ($r, $g, $b) = (rand (), rand ());
 637   my $min = 0.0;
 638   my $max = 1.0;
 639
 640   if (($r + $g) < 1.0)
 641   {
 642     $min = 1.0 - ($r + $g);
 643   }
 644   else
 645   {
 646     $max = 2.0 - ($r + $g);
 647   }
 648
 649   $b = $min + (rand () * ($max - $min));
 650
 651   return (_color_to_string ([$r, $g, $b]));
 652 } # get_random_color
 653
 654 sub get_faded_color
 655 {
 656   my $fg = shift;
 657   my $bg;
 658   my %opts = @_;
 659   my $ret = [undef, undef, undef];
 660
 661   $opts{'background'} ||= [1.0, 1.0, 1.0];
 662   $opts{'alpha'} ||= 0.25;
 663
 664   if (!ref ($fg))
 665   {
 666     $fg = _string_to_color ($fg)
 667       or confess ("Cannot parse foreground color $fg");
 668   }
 669
 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'};
 676
 677   for (my $i = 0; $i < 3; $i++)
 678   {
 679     $ret->[$i] = ($opts{'alpha'} * $fg->[$i])
 680        + ((1.0 - $opts{'alpha'}) * $bg->[$i]);
 681   }
 682
 683   return (_color_to_string ($ret));
 684 } # get_faded_color
 685
 686 sub sort_idents_by_type_instance
 687 {
 688   my $idents = shift;
 689   my $array_sort = shift;
 690
 691   my %elements = map { $_->{'type_instance'} => $_ } (@$idents);
 692   splice (@$idents, 0);
 693
 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
 702
 703 sub type_to_module_name
 704 {
 705   my $type = shift;
 706   my $ret;
 707
 708   $ret = ucfirst (lc ($type));
 709
 710   $ret =~ s/[^A-Za-z_]//g;
 711   $ret =~ s/_([A-Za-z])/\U$1\E/g;
 712
 713   return ("Collectd::Graph::Type::$ret");
 714 } # type_to_module_name
 715
 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));
 720
 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 }
 727
 728 sub flush_files
 729 {
 730   my $all_files = shift;
 731   my %opts = @_;
 732
 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;
 741
 742   if (!defined $opts{'begin'})
 743   {
 744     cluck ("begin is not defined");
 745     return;
 746   }
 747   $begin = $opts{'begin'};
 748
 749   if (!defined $opts{'end'})
 750   {
 751     cluck ("end is not defined");
 752     return;
 753   }
 754   $end = $opts{'end'};
 755
 756   if (!$opts{'addr'})
 757   {
 758     return (1);
 759   }
 760
 761   $interval = $opts{'interval'} || 10;
 762
 763   if (ref ($all_files) eq 'HASH')
 764   {
 765     my @tmp = ($all_files);
 766     $all_files = \@tmp;
 767   }
 768
 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   }
 775
 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;
 783
 784     @statbuf = stat ($file_name);
 785     if (!@statbuf)
 786     {
 787       next;
 788     }
 789     $mtime = $statbuf[9];
 790
 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     }
 801
 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     }
 813
 814     push (@$files_to_flush, $file_copy);
 815   } # for (@$all_files)
 816
 817   if (!@$files_to_flush)
 818   {
 819     return (1);
 820   }
 821
 822   $sock = Collectd::Unixsock->new ($opts{'addr'});
 823   if (!$sock)
 824   {
 825     return;
 826   }
 827
 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   }
 835
 836   $sock->destroy ();
 837   return (1);
 838 } # flush_files
 839
 840 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :