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

   1 package Collectd::Graph::Common;
   2
   3 use strict;
   4 use warnings;
   5
   6 use vars (qw($ColorCanvas $ColorFullBlue $ColorHalfBlue));
   7
   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));
  13
  14 $ColorCanvas   = 'FFFFFF';
  15 $ColorFullBlue = '0000FF';
  16 $ColorHalfBlue = 'B7B7F7';
  17
  18 @Collectd::Graph::Common::ISA = ('Exporter');
  19 @Collectd::Graph::Common::EXPORT_OK = (qw(
  20   $ColorCanvas
  21   $ColorFullBlue
  22   $ColorHalfBlue
  23
  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 ));
  45
  46 our $DefaultDataDir = '/var/lib/collectd/rrd';
  47
  48 return (1);
  49
  50 sub _sanitize_generic_allow_minus
  51 {
  52   my $str = "" . shift;
  53
  54   # remove all slashes
  55   $str =~ s#/##g;
  56
  57   # remove all dots and dashes at the beginning and at the end.
  58   $str =~ s#^[\.-]+##;
  59   $str =~ s#[\.-]+$##;
  60
  61   return ($str);
  62 }
  63
  64 sub _sanitize_generic_no_minus
  65 {
  66   # Do everything the allow-minus variant does..
  67   my $str = _sanitize_generic_allow_minus (@_);
  68
  69   # .. and remove the dashes, too
  70   $str =~ s#/##g;
  71
  72   return ($str);
  73 } # _sanitize_generic_no_minus
  74
  75 sub sanitize_hostname
  76 {
  77   return (_sanitize_generic_allow_minus (@_));
  78 }
  79
  80 sub sanitize_plugin
  81 {
  82   return (_sanitize_generic_no_minus (@_));
  83 }
  84
  85 sub sanitize_plugin_instance
  86 {
  87   return (_sanitize_generic_allow_minus (@_));
  88 }
  89
  90 sub sanitize_type
  91 {
  92   return (_sanitize_generic_no_minus (@_));
  93 }
  94
  95 sub sanitize_type_instance
  96 {
  97   return (_sanitize_generic_allow_minus (@_));
  98 }
  99
 100 sub group_files_by_plugin_instance
 101 {
 102   my @files = @_;
 103   my $data = {};
 104
 105   for (my $i = 0; $i < @files; $i++)
 106   {
 107     my $file = $files[$i];
 108     my $key = $file->{'plugin_instance'} || '';
 109
 110     $data->{$key} ||= [];
 111     push (@{$data->{$key}}, $file);
 112   }
 113
 114   return ($data);
 115 }
 116
 117 sub filename_to_ident
 118 {
 119   my $file = shift;
 120   my $ret;
 121
 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   }
 142
 143   return ($ret);
 144 } # filename_to_ident
 145
 146 sub ident_to_filename
 147 {
 148   my $ident = shift;
 149   my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
 150
 151   my $ret = '';
 152
 153   if (defined ($ident->{'_prefix'}))
 154   {
 155     $ret .= $ident->{'_prefix'};
 156   }
 157   else
 158   {
 159     $ret .= "$data_dir/";
 160   }
 161
 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   }
 174
 175   $ret .= $ident->{'hostname'} . '/' . $ident->{'plugin'};
 176   if (defined ($ident->{'plugin_instance'}))
 177   {
 178     $ret .= '-' . $ident->{'plugin_instance'};
 179   }
 180
 181   $ret .= '/' . $ident->{'type'};
 182   if (defined ($ident->{'type_instance'}))
 183   {
 184     $ret .= '-' . $ident->{'type_instance'};
 185   }
 186   $ret .= '.rrd';
 187
 188   return ($ret);
 189 } # ident_to_filename
 190
 191 sub ident_to_string
 192 {
 193   my $ident = shift;
 194
 195   my $ret = '';
 196
 197   $ret .= $ident->{'hostname'} . '/' . $ident->{'plugin'};
 198   if (defined ($ident->{'plugin_instance'}))
 199   {
 200     $ret .= '-' . $ident->{'plugin_instance'};
 201   }
 202
 203   $ret .= '/' . $ident->{'type'};
 204   if (defined ($ident->{'type_instance'}))
 205   {
 206     $ret .= '-' . $ident->{'type_instance'};
 207   }
 208
 209   return ($ret);
 210 } # ident_to_string
 211
 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 = [];
 219
 220   opendir ($dh, $dir) or die ("opendir ($dir): $!");
 221   while (my $entry = readdir ($dh))
 222   {
 223     next if ($entry =~ m/^\./);
 224
 225     $entry = "$dir/$entry";
 226
 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);
 241
 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   }
 253
 254   return ($ret);
 255 } # get_files_from_directory
 256
 257 sub get_all_hosts
 258 {
 259   my $dh;
 260   my @ret = ();
 261   my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
 262
 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);
 271
 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
 285
 286 sub get_all_plugins
 287 {
 288   my @hosts = @_;
 289   my $ret = {};
 290   my $dh;
 291   my $data_dir = gc_get_scalar ('DataDir', $DefaultDataDir);
 292
 293   if (!@hosts)
 294   {
 295     @hosts = get_all_hosts ();
 296   }
 297
 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 = '';
 306
 307       next if ($entry =~ m/^\./);
 308       next if (!-d "$data_dir/$host/$entry");
 309
 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       }
 324
 325       $ret->{$plugin} ||= {};
 326       $ret->{$plugin}{$plugin_instance} = 1;
 327     } # while (readdir)
 328     closedir ($dh);
 329   } # for (@hosts)
 330
 331   if (wantarray ())
 332   {
 333     return (sort (keys %$ret));
 334   }
 335   else
 336   {
 337     return ($ret);
 338   }
 339 } # get_all_plugins
 340
 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
 347
 348 sub _filter_ident
 349 {
 350   my $filter = shift;
 351   my $ident = shift;
 352
 353   for (qw(hostname plugin plugin_instance type type_instance))
 354   {
 355     my $part = $_;
 356     my $tmp;
 357
 358     if (!defined ($filter->{$part}))
 359     {
 360       next;
 361     }
 362     if (!defined ($ident->{$part}))
 363     {
 364       return (1);
 365     }
 366
 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   }
 382
 383   return (0);
 384 } # _filter_ident
 385
 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);
 392
 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     #}
 401
 402   @ret = grep { _filter_ident ($ident, $_) == 0 } (@$all_files);
 403
 404   return (\@ret);
 405 } # get_files_by_ident
 406
 407 sub get_selected_files
 408 {
 409   my $ident = {};
 410
 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   }
 428
 429   return (get_files_by_ident ($ident));
 430 } # get_selected_files
 431
 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   }
 443
 444   return ($ret);
 445 } # get_timespan_selection
 446
 447 sub get_host_selection
 448 {
 449   my %ret = ();
 450
 451   for (get_all_hosts ())
 452   {
 453     $ret{$_} = 0;
 454   }
 455
 456   for (param ('hostname'))
 457   {
 458     my $host = _sanitize_generic_allow_minus ($_);
 459     if (defined ($ret{$host}))
 460     {
 461       $ret{$host} = 1;
 462     }
 463   }
 464
 465   if (wantarray ())
 466   {
 467     return (grep { $ret{$_} > 0 } (sort (keys %ret)));
 468   }
 469   else
 470   {
 471     return (\%ret);
 472   }
 473 } # get_host_selection
 474
 475 sub get_plugin_selection
 476 {
 477   my %ret = ();
 478   my @hosts = get_host_selection ();
 479
 480   for (get_all_plugins (@hosts))
 481   {
 482     $ret{$_} = 0;
 483   }
 484
 485   for (param ('plugin'))
 486   {
 487     if (defined ($ret{$_}))
 488     {
 489       $ret{$_} = 1;
 490     }
 491   }
 492
 493   if (wantarray ())
 494   {
 495     return (grep { $ret{$_} > 0 } (sort (keys %ret)));
 496   }
 497   else
 498   {
 499     return (\%ret);
 500   }
 501 } # get_plugin_selection
 502
 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
 512
 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
 518
 519 sub get_faded_color
 520 {
 521   my $fg = shift;
 522   my $bg;
 523   my %opts = @_;
 524   my $ret = [undef, undef, undef];
 525
 526   $opts{'background'} ||= [1.0, 1.0, 1.0];
 527   $opts{'alpha'} ||= 0.25;
 528
 529   if (!ref ($fg))
 530   {
 531     $fg = _string_to_color ($fg)
 532       or confess ("Cannot parse foreground color $fg");
 533   }
 534
 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'};
 541
 542   for (my $i = 0; $i < 3; $i++)
 543   {
 544     $ret->[$i] = ($opts{'alpha'} * $fg->[$i])
 545        + ((1.0 - $opts{'alpha'}) * $bg->[$i]);
 546   }
 547
 548   return (_color_to_string ($ret));
 549 } # get_faded_color
 550
 551 sub sort_idents_by_type_instance
 552 {
 553   my $idents = shift;
 554   my $array_sort = shift;
 555
 556   my %elements = map { $_->{'type_instance'} => $_ } (@$idents);
 557   splice (@$idents, 0);
 558
 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
 567
 568 sub type_to_module_name
 569 {
 570   my $type = shift;
 571   my $ret;
 572
 573   $ret = ucfirst (lc ($type));
 574
 575   $ret =~ s/[^A-Za-z_]//g;
 576   $ret =~ s/_([A-Za-z])/\U$1\E/g;
 577
 578   return ("Collectd::Graph::Type::$ret");
 579 } # type_to_module_name
 580
 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));
 585
 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 }
 592
 593 sub flush_files
 594 {
 595   my $all_files = shift;
 596   my %opts = @_;
 597
 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;
 606
 607   if (!defined $opts{'begin'})
 608   {
 609     cluck ("begin is not defined");
 610     return;
 611   }
 612   $begin = $opts{'begin'};
 613
 614   if (!defined $opts{'end'})
 615   {
 616     cluck ("end is not defined");
 617     return;
 618   }
 619   $end = $opts{'end'};
 620
 621   if (!$opts{'addr'})
 622   {
 623     return (1);
 624   }
 625
 626   $interval = $opts{'interval'} || 10;
 627
 628   if (ref ($all_files) eq 'HASH')
 629   {
 630     my @tmp = ($all_files);
 631     $all_files = \@tmp;
 632   }
 633
 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   }
 640
 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;
 648
 649     @statbuf = stat ($file_name);
 650     if (!@statbuf)
 651     {
 652       next;
 653     }
 654     $mtime = $statbuf[9];
 655
 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     }
 666
 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     }
 678
 679     push (@$files_to_flush, $file_copy);
 680   } # for (@$all_files)
 681
 682   if (!@$files_to_flush)
 683   {
 684     return (1);
 685   }
 686
 687   $sock = Collectd::Unixsock->new ($opts{'addr'});
 688   if (!$sock)
 689   {
 690     return;
 691   }
 692
 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   }
 700
 701   $sock->destroy ();
 702   return (1);
 703 } # flush_files
 704
 705 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :