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