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