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