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 Carp (qw(confess cluck));
   9 use CGI (':cgi');
  10 use Exporter;
  11
  12 $ColorCanvas   = 'FFFFFF';
  13 $ColorFullBlue = '0000FF';
  14 $ColorHalfBlue = 'B7B7F7';
  15
  16 @Collectd::Graph::Common::ISA = ('Exporter');
  17 @Collectd::Graph::Common::EXPORT_OK = (qw(
  18   $ColorCanvas
  19   $ColorFullBlue
  20   $ColorHalfBlue
  21
  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 ));
  43
  44 our $DataDir = '/var/lib/collectd/rrd';
  45
  46 return (1);
  47
  48 sub _sanitize_generic_allow_minus
  49 {
  50   my $str = "" . shift;
  51
  52   # remove all slashes
  53   $str =~ s#/##g;
  54
  55   # remove all dots and dashes at the beginning and at the end.
  56   $str =~ s#^[\.-]+##;
  57   $str =~ s#[\.-]+$##;
  58
  59   return ($str);
  60 }
  61
  62 sub _sanitize_generic_no_minus
  63 {
  64   # Do everything the allow-minus variant does..
  65   my $str = _sanitize_generic_allow_minus (@_);
  66
  67   # .. and remove the dashes, too
  68   $str =~ s#/##g;
  69
  70   return ($str);
  71 } # _sanitize_generic_no_minus
  72
  73 sub sanitize_hostname
  74 {
  75   return (_sanitize_generic_allow_minus (@_));
  76 }
  77
  78 sub sanitize_plugin
  79 {
  80   return (_sanitize_generic_no_minus (@_));
  81 }
  82
  83 sub sanitize_plugin_instance
  84 {
  85   return (_sanitize_generic_allow_minus (@_));
  86 }
  87
  88 sub sanitize_type
  89 {
  90   return (_sanitize_generic_no_minus (@_));
  91 }
  92
  93 sub sanitize_type_instance
  94 {
  95   return (_sanitize_generic_allow_minus (@_));
  96 }
  97
  98 sub group_files_by_plugin_instance
  99 {
 100   my @files = @_;
 101   my $data = {};
 102
 103   for (my $i = 0; $i < @files; $i++)
 104   {
 105     my $file = $files[$i];
 106     my $key = $file->{'plugin_instance'} || '';
 107
 108     $data->{$key} ||= [];
 109     push (@{$data->{$key}}, $file);
 110   }
 111
 112   return ($data);
 113 }
 114
 115 sub filename_to_ident
 116 {
 117   my $file = shift;
 118   my $ret;
 119
 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   }
 140
 141   return ($ret);
 142 } # filename_to_ident
 143
 144 sub ident_to_filename
 145 {
 146   my $ident = shift;
 147
 148   my $ret = '';
 149
 150   if (defined ($ident->{'_prefix'}))
 151   {
 152     $ret .= $ident->{'_prefix'};
 153   }
 154   else
 155   {
 156     $ret .= "$DataDir/";
 157   }
 158
 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   }
 171
 172   $ret .= $ident->{'hostname'} . '/' . $ident->{'plugin'};
 173   if (defined ($ident->{'plugin_instance'}))
 174   {
 175     $ret .= '-' . $ident->{'plugin_instance'};
 176   }
 177
 178   $ret .= '/' . $ident->{'type'};
 179   if (defined ($ident->{'type_instance'}))
 180   {
 181     $ret .= '-' . $ident->{'type_instance'};
 182   }
 183   $ret .= '.rrd';
 184
 185   return ($ret);
 186 } # ident_to_filename
 187
 188 sub ident_to_string
 189 {
 190   my $ident = shift;
 191
 192   my $ret = '';
 193
 194   $ret .= $ident->{'hostname'} . '/' . $ident->{'plugin'};
 195   if (defined ($ident->{'plugin_instance'}))
 196   {
 197     $ret .= '-' . $ident->{'plugin_instance'};
 198   }
 199
 200   $ret .= '/' . $ident->{'type'};
 201   if (defined ($ident->{'type_instance'}))
 202   {
 203     $ret .= '-' . $ident->{'type_instance'};
 204   }
 205
 206   return ($ret);
 207 } # ident_to_string
 208
 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 = [];
 216
 217   opendir ($dh, $dir) or die ("opendir ($dir): $!");
 218   while (my $entry = readdir ($dh))
 219   {
 220     next if ($entry =~ m/^\./);
 221
 222     $entry = "$dir/$entry";
 223
 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);
 238
 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   }
 250
 251   return ($ret);
 252 } # get_files_from_directory
 253
 254 sub get_all_hosts
 255 {
 256   my $dh;
 257   my @ret = ();
 258
 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);
 267
 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
 281
 282 sub get_all_plugins
 283 {
 284   my @hosts = @_;
 285   my $ret = {};
 286   my $dh;
 287
 288   if (!@hosts)
 289   {
 290     @hosts = get_all_hosts ();
 291   }
 292
 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 = '';
 301
 302       next if ($entry =~ m/^\./);
 303       next if (!-d "$DataDir/$host/$entry");
 304
 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       }
 319
 320       $ret->{$plugin} ||= {};
 321       $ret->{$plugin}{$plugin_instance} = 1;
 322     } # while (readdir)
 323     closedir ($dh);
 324   } # for (@hosts)
 325
 326   if (wantarray ())
 327   {
 328     return (sort (keys %$ret));
 329   }
 330   else
 331   {
 332     return ($ret);
 333   }
 334 } # get_all_plugins
 335
 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
 341
 342 sub _filter_ident
 343 {
 344   my $filter = shift;
 345   my $ident = shift;
 346
 347   for (qw(hostname plugin plugin_instance type type_instance))
 348   {
 349     my $part = $_;
 350     my $tmp;
 351
 352     if (!defined ($filter->{$part}))
 353     {
 354       next;
 355     }
 356     if (!defined ($ident->{$part}))
 357     {
 358       return (1);
 359     }
 360
 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   }
 376
 377   return (0);
 378 } # _filter_ident
 379
 380 sub get_files_by_ident
 381 {
 382   my $ident = shift;
 383   my $all_files;
 384   my @ret = ();
 385
 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     #}
 394
 395   @ret = grep { _filter_ident ($ident, $_) == 0 } (@$all_files);
 396
 397   return (\@ret);
 398 } # get_files_by_ident
 399
 400 sub get_selected_files
 401 {
 402   my $ident = {};
 403
 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   }
 421
 422   return (get_files_by_ident ($ident));
 423 } # get_selected_files
 424
 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   }
 436
 437   return ($ret);
 438 } # get_timespan_selection
 439
 440 sub get_host_selection
 441 {
 442   my %ret = ();
 443
 444   for (get_all_hosts ())
 445   {
 446     $ret{$_} = 0;
 447   }
 448
 449   for (param ('hostname'))
 450   {
 451     my $host = _sanitize_generic_allow_minus ($_);
 452     if (defined ($ret{$host}))
 453     {
 454       $ret{$host} = 1;
 455     }
 456   }
 457
 458   if (wantarray ())
 459   {
 460     return (grep { $ret{$_} > 0 } (sort (keys %ret)));
 461   }
 462   else
 463   {
 464     return (\%ret);
 465   }
 466 } # get_host_selection
 467
 468 sub get_plugin_selection
 469 {
 470   my %ret = ();
 471   my @hosts = get_host_selection ();
 472
 473   for (get_all_plugins (@hosts))
 474   {
 475     $ret{$_} = 0;
 476   }
 477
 478   for (param ('plugin'))
 479   {
 480     if (defined ($ret{$_}))
 481     {
 482       $ret{$_} = 1;
 483     }
 484   }
 485
 486   if (wantarray ())
 487   {
 488     return (grep { $ret{$_} > 0 } (sort (keys %ret)));
 489   }
 490   else
 491   {
 492     return (\%ret);
 493   }
 494 } # get_plugin_selection
 495
 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
 505
 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
 511
 512 sub get_faded_color
 513 {
 514   my $fg = shift;
 515   my $bg;
 516   my %opts = @_;
 517   my $ret = [undef, undef, undef];
 518
 519   $opts{'background'} ||= [1.0, 1.0, 1.0];
 520   $opts{'alpha'} ||= 0.25;
 521
 522   if (!ref ($fg))
 523   {
 524     $fg = _string_to_color ($fg)
 525       or confess ("Cannot parse foreground color $fg");
 526   }
 527
 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'};
 534
 535   for (my $i = 0; $i < 3; $i++)
 536   {
 537     $ret->[$i] = ($opts{'alpha'} * $fg->[$i])
 538        + ((1.0 - $opts{'alpha'}) * $bg->[$i]);
 539   }
 540
 541   return (_color_to_string ($ret));
 542 } # get_faded_color
 543
 544 sub sort_idents_by_type_instance
 545 {
 546   my $idents = shift;
 547   my $array_sort = shift;
 548
 549   my %elements = map { $_->{'type_instance'} => $_ } (@$idents);
 550   splice (@$idents, 0);
 551
 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
 560
 561 sub type_to_module_name
 562 {
 563   my $type = shift;
 564   my $ret;
 565
 566   $ret = ucfirst (lc ($type));
 567
 568   $ret =~ s/[^A-Za-z_]//g;
 569   $ret =~ s/_([A-Za-z])/\U$1\E/g;
 570
 571   return ("Collectd::Graph::Type::$ret");
 572 } # type_to_module_name
 573
 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));
 578
 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 }
 585
 586 sub flush_files
 587 {
 588   my $all_files = shift;
 589   my %opts = @_;
 590
 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;
 599
 600   if (!defined $opts{'begin'})
 601   {
 602     cluck ("begin is not defined");
 603     return;
 604   }
 605   $begin = $opts{'begin'};
 606
 607   if (!defined $opts{'end'})
 608   {
 609     cluck ("end is not defined");
 610     return;
 611   }
 612   $end = $opts{'end'};
 613
 614   if (!$opts{'addr'})
 615   {
 616     return (1);
 617   }
 618
 619   $interval = $opts{'interval'} || 10;
 620
 621   if (ref ($all_files) eq 'HASH')
 622   {
 623     my @tmp = ($all_files);
 624     $all_files = \@tmp;
 625   }
 626
 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   }
 633
 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;
 641
 642     @statbuf = stat ($file_name);
 643     if (!@statbuf)
 644     {
 645       next;
 646     }
 647     $mtime = $statbuf[9];
 648
 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     }
 659
 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     }
 671
 672     push (@$files_to_flush, $file_copy);
 673   } # for (@$all_files)
 674
 675   if (!@$files_to_flush)
 676   {
 677     return (1);
 678   }
 679
 680   $sock = Collectd::Unixsock->new ($opts{'addr'});
 681   if (!$sock)
 682   {
 683     return;
 684   }
 685
 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   }
 693
 694   $sock->destroy ();
 695   return (1);
 696 } # flush_files
 697
 698 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :