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
 491   my $cache_key = ident_to_string ($ident);
 492   if (defined ($Cache->{'get_files_by_ident'}{$cache_key}))
 493   {
 494     my $ret = $Cache->{'get_files_by_ident'}{$cache_key};
 495
 496     return ($ret)
 497   }
 498
 499   $all_files = _get_all_files ();
 500
 501   @ret = grep { _filter_ident ($ident, $_) == 0 } (@$all_files);
 502
 503   $Cache->{'get_files_by_ident'}{$cache_key} = \@ret;
 504   return (\@ret);
 505 } # get_files_by_ident
 506
 507 sub get_selected_files
 508 {
 509   my $ident = {};
 510
 511   for (qw(hostname plugin plugin_instance type type_instance))
 512   {
 513     my $part = $_;
 514     my @temp = param ($part);
 515     if (!@temp)
 516     {
 517       next;
 518     }
 519     elsif (($part eq 'plugin') || ($part eq 'type'))
 520     {
 521       $ident->{$part} = [map { _sanitize_generic_no_minus ($_) } (@temp)];
 522     }
 523     else
 524     {
 525       $ident->{$part} = [map { _sanitize_generic_allow_minus ($_) } (@temp)];
 526     }
 527   }
 528
 529   return (get_files_by_ident ($ident));
 530 } # get_selected_files
 531
 532 sub get_timespan_selection
 533 {
 534   my $ret = 86400;
 535   if (param ('timespan'))
 536   {
 537     my $temp = int (param ('timespan'));
 538     if ($temp && ($temp > 0))
 539     {
 540       $ret = $temp;
 541     }
 542   }
 543
 544   return ($ret);
 545 } # get_timespan_selection
 546
 547 sub get_host_selection
 548 {
 549   my %ret = ();
 550
 551   for (get_all_hosts ())
 552   {
 553     $ret{$_} = 0;
 554   }
 555
 556   for (param ('hostname'))
 557   {
 558     my $host = _sanitize_generic_allow_minus ($_);
 559     if (defined ($ret{$host}))
 560     {
 561       $ret{$host} = 1;
 562     }
 563   }
 564
 565   if (wantarray ())
 566   {
 567     return (grep { $ret{$_} > 0 } (sort (keys %ret)));
 568   }
 569   else
 570   {
 571     return (\%ret);
 572   }
 573 } # get_host_selection
 574
 575 sub get_plugin_selection
 576 {
 577   my %ret = ();
 578   my @hosts = get_host_selection ();
 579
 580   for (get_all_plugins (@hosts))
 581   {
 582     $ret{$_} = 0;
 583   }
 584
 585   for (param ('plugin'))
 586   {
 587     if (defined ($ret{$_}))
 588     {
 589       $ret{$_} = 1;
 590     }
 591   }
 592
 593   if (wantarray ())
 594   {
 595     return (grep { $ret{$_} > 0 } (sort (keys %ret)));
 596   }
 597   else
 598   {
 599     return (\%ret);
 600   }
 601 } # get_plugin_selection
 602
 603 sub _string_to_color
 604 {
 605   my $color = shift;
 606   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])/)
 607   {
 608     return ([hex ($1) / 255.0, hex ($2) / 255.0, hex ($3) / 255.0]);
 609   }
 610   return;
 611 } # _string_to_color
 612
 613 sub _color_to_string
 614 {
 615   confess ("Wrong number of arguments") if (@_ != 1);
 616   return (sprintf ('%02hx%02hx%02hx', map { int (255.0 * $_) } @{$_[0]}));
 617 } # _color_to_string
 618
 619 sub get_random_color
 620 {
 621   my ($r, $g, $b) = (rand (), rand ());
 622   my $min = 0.0;
 623   my $max = 1.0;
 624
 625   if (($r + $g) < 1.0)
 626   {
 627     $min = 1.0 - ($r + $g);
 628   }
 629   else
 630   {
 631     $max = 2.0 - ($r + $g);
 632   }
 633
 634   $b = $min + (rand () * ($max - $min));
 635
 636   return (_color_to_string ([$r, $g, $b]));
 637 } # get_random_color
 638
 639 sub get_faded_color
 640 {
 641   my $fg = shift;
 642   my $bg;
 643   my %opts = @_;
 644   my $ret = [undef, undef, undef];
 645
 646   $opts{'background'} ||= [1.0, 1.0, 1.0];
 647   $opts{'alpha'} ||= 0.25;
 648
 649   if (!ref ($fg))
 650   {
 651     $fg = _string_to_color ($fg)
 652       or confess ("Cannot parse foreground color $fg");
 653   }
 654
 655   if (!ref ($opts{'background'}))
 656   {
 657     $opts{'background'} = _string_to_color ($opts{'background'})
 658       or confess ("Cannot parse background color " . $opts{'background'});
 659   }
 660   $bg = $opts{'background'};
 661
 662   for (my $i = 0; $i < 3; $i++)
 663   {
 664     $ret->[$i] = ($opts{'alpha'} * $fg->[$i])
 665        + ((1.0 - $opts{'alpha'}) * $bg->[$i]);
 666   }
 667
 668   return (_color_to_string ($ret));
 669 } # get_faded_color
 670
 671 sub sort_idents_by_type_instance
 672 {
 673   my $idents = shift;
 674   my $array_sort = shift;
 675
 676   my %elements = map { $_->{'type_instance'} => $_ } (@$idents);
 677   splice (@$idents, 0);
 678
 679   for (@$array_sort)
 680   {
 681     next if (!exists ($elements{$_}));
 682     push (@$idents, $elements{$_});
 683     delete ($elements{$_});
 684   }
 685   push (@$idents, map { $elements{$_} } (sort (keys %elements)));
 686 } # sort_idents_by_type_instance
 687
 688 sub type_to_module_name
 689 {
 690   my $type = shift;
 691   my $ret;
 692
 693   $ret = ucfirst (lc ($type));
 694
 695   $ret =~ s/[^A-Za-z_]//g;
 696   $ret =~ s/_([A-Za-z])/\U$1\E/g;
 697
 698   return ("Collectd::Graph::Type::$ret");
 699 } # type_to_module_name
 700
 701 sub epoch_to_rfc1123
 702 {
 703   my @days = (qw(Sun Mon Tue Wed Thu Fri Sat));
 704   my @months = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));
 705
 706   my $epoch = @_ ? shift : time ();
 707   my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
 708   my $string = sprintf ('%s, %02d %s %4d %02d:%02d:%02d GMT', $days[$wday], $mday,
 709       $months[$mon], 1900 + $year, $hour ,$min, $sec);
 710   return ($string);
 711 }
 712
 713 sub flush_files
 714 {
 715   my $all_files = shift;
 716   my %opts = @_;
 717
 718   my $begin;
 719   my $end;
 720   my $addr;
 721   my $interval;
 722   my $sock;
 723   my $now;
 724   my $files_to_flush = [];
 725   my $status;
 726
 727   if (!defined $opts{'begin'})
 728   {
 729     cluck ("begin is not defined");
 730     return;
 731   }
 732   $begin = $opts{'begin'};
 733
 734   if (!defined $opts{'end'})
 735   {
 736     cluck ("end is not defined");
 737     return;
 738   }
 739   $end = $opts{'end'};
 740
 741   if (!$opts{'addr'})
 742   {
 743     return (1);
 744   }
 745
 746   $interval = $opts{'interval'} || 10;
 747
 748   if (ref ($all_files) eq 'HASH')
 749   {
 750     my @tmp = ($all_files);
 751     $all_files = \@tmp;
 752   }
 753
 754   $now = time ();
 755   # Don't flush anything if the timespan is in the future.
 756   if (($end > $now) && ($begin > $now))
 757   {
 758     return (1);
 759   }
 760
 761   for (@$all_files)
 762   {
 763     my $file_orig = $_;
 764     my $file_name = ident_to_filename ($file_orig);
 765     my $file_copy = {};
 766     my @statbuf;
 767     my $mtime;
 768
 769     @statbuf = stat ($file_name);
 770     if (!@statbuf)
 771     {
 772       next;
 773     }
 774     $mtime = $statbuf[9];
 775
 776     # Skip if file is fresh
 777     if (($now - $mtime) <= $interval)
 778     {
 779       next;
 780     }
 781     # or $end is before $mtime
 782     elsif (($end != 0) && (($end - $mtime) <= 0))
 783     {
 784       next;
 785     }
 786
 787     $file_copy->{'host'} = $file_orig->{'hostname'};
 788     $file_copy->{'plugin'} = $file_orig->{'plugin'};
 789     if (exists $file_orig->{'plugin_instance'})
 790     {
 791       $file_copy->{'plugin_instance'} = $file_orig->{'plugin_instance'}
 792     }
 793     $file_copy->{'type'} = $file_orig->{'type'};
 794     if (exists $file_orig->{'type_instance'})
 795     {
 796       $file_copy->{'type_instance'} = $file_orig->{'type_instance'}
 797     }
 798
 799     push (@$files_to_flush, $file_copy);
 800   } # for (@$all_files)
 801
 802   if (!@$files_to_flush)
 803   {
 804     return (1);
 805   }
 806
 807   $sock = Collectd::Unixsock->new ($opts{'addr'});
 808   if (!$sock)
 809   {
 810     return;
 811   }
 812
 813   $status = $sock->flush (plugins => ['rrdtool'], identifier => $files_to_flush);
 814   if (!$status)
 815   {
 816     cluck ("FLUSH failed: " . $sock->{'error'});
 817     $sock->destroy ();
 818     return;
 819   }
 820
 821   $sock->destroy ();
 822   return (1);
 823 } # flush_files
 824
 825 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :