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     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_random_color
 520 {
 521   my ($r, $g, $b) = (rand (), rand ());
 522   my $min = 0.0;
 523   my $max = 1.0;
 524
 525   if (($r + $g) < 1.0)
 526   {
 527     $min = 1.0 - ($r + $g);
 528   }
 529   else
 530   {
 531     $max = 2.0 - ($r + $g);
 532   }
 533
 534   $b = $min + (rand () * ($max - $min));
 535
 536   return (_color_to_string ([$r, $g, $b]));
 537 } # get_random_color
 538
 539 sub get_faded_color
 540 {
 541   my $fg = shift;
 542   my $bg;
 543   my %opts = @_;
 544   my $ret = [undef, undef, undef];
 545
 546   $opts{'background'} ||= [1.0, 1.0, 1.0];
 547   $opts{'alpha'} ||= 0.25;
 548
 549   if (!ref ($fg))
 550   {
 551     $fg = _string_to_color ($fg)
 552       or confess ("Cannot parse foreground color $fg");
 553   }
 554
 555   if (!ref ($opts{'background'}))
 556   {
 557     $opts{'background'} = _string_to_color ($opts{'background'})
 558       or confess ("Cannot parse background color " . $opts{'background'});
 559   }
 560   $bg = $opts{'background'};
 561
 562   for (my $i = 0; $i < 3; $i++)
 563   {
 564     $ret->[$i] = ($opts{'alpha'} * $fg->[$i])
 565        + ((1.0 - $opts{'alpha'}) * $bg->[$i]);
 566   }
 567
 568   return (_color_to_string ($ret));
 569 } # get_faded_color
 570
 571 sub sort_idents_by_type_instance
 572 {
 573   my $idents = shift;
 574   my $array_sort = shift;
 575
 576   my %elements = map { $_->{'type_instance'} => $_ } (@$idents);
 577   splice (@$idents, 0);
 578
 579   for (@$array_sort)
 580   {
 581     next if (!exists ($elements{$_}));
 582     push (@$idents, $elements{$_});
 583     delete ($elements{$_});
 584   }
 585   push (@$idents, map { $elements{$_} } (sort (keys %elements)));
 586 } # sort_idents_by_type_instance
 587
 588 sub type_to_module_name
 589 {
 590   my $type = shift;
 591   my $ret;
 592
 593   $ret = ucfirst (lc ($type));
 594
 595   $ret =~ s/[^A-Za-z_]//g;
 596   $ret =~ s/_([A-Za-z])/\U$1\E/g;
 597
 598   return ("Collectd::Graph::Type::$ret");
 599 } # type_to_module_name
 600
 601 sub epoch_to_rfc1123
 602 {
 603   my @days = (qw(Sun Mon Tue Wed Thu Fri Sat));
 604   my @months = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec));
 605
 606   my $epoch = @_ ? shift : time ();
 607   my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime($epoch);
 608   my $string = sprintf ('%s, %02d %s %4d %02d:%02d:%02d GMT', $days[$wday], $mday,
 609       $months[$mon], 1900 + $year, $hour ,$min, $sec);
 610   return ($string);
 611 }
 612
 613 sub flush_files
 614 {
 615   my $all_files = shift;
 616   my %opts = @_;
 617
 618   my $begin;
 619   my $end;
 620   my $addr;
 621   my $interval;
 622   my $sock;
 623   my $now;
 624   my $files_to_flush = [];
 625   my $status;
 626
 627   if (!defined $opts{'begin'})
 628   {
 629     cluck ("begin is not defined");
 630     return;
 631   }
 632   $begin = $opts{'begin'};
 633
 634   if (!defined $opts{'end'})
 635   {
 636     cluck ("end is not defined");
 637     return;
 638   }
 639   $end = $opts{'end'};
 640
 641   if (!$opts{'addr'})
 642   {
 643     return (1);
 644   }
 645
 646   $interval = $opts{'interval'} || 10;
 647
 648   if (ref ($all_files) eq 'HASH')
 649   {
 650     my @tmp = ($all_files);
 651     $all_files = \@tmp;
 652   }
 653
 654   $now = time ();
 655   # Don't flush anything if the timespan is in the future.
 656   if (($end > $now) && ($begin > $now))
 657   {
 658     return (1);
 659   }
 660
 661   for (@$all_files)
 662   {
 663     my $file_orig = $_;
 664     my $file_name = ident_to_filename ($file_orig);
 665     my $file_copy = {};
 666     my @statbuf;
 667     my $mtime;
 668
 669     @statbuf = stat ($file_name);
 670     if (!@statbuf)
 671     {
 672       next;
 673     }
 674     $mtime = $statbuf[9];
 675
 676     # Skip if file is fresh
 677     if (($now - $mtime) <= $interval)
 678     {
 679       next;
 680     }
 681     # or $end is before $mtime
 682     elsif (($end != 0) && (($end - $mtime) <= 0))
 683     {
 684       next;
 685     }
 686
 687     $file_copy->{'host'} = $file_orig->{'hostname'};
 688     $file_copy->{'plugin'} = $file_orig->{'plugin'};
 689     if (exists $file_orig->{'plugin_instance'})
 690     {
 691       $file_copy->{'plugin_instance'} = $file_orig->{'plugin_instance'}
 692     }
 693     $file_copy->{'type'} = $file_orig->{'type'};
 694     if (exists $file_orig->{'type_instance'})
 695     {
 696       $file_copy->{'type_instance'} = $file_orig->{'type_instance'}
 697     }
 698
 699     push (@$files_to_flush, $file_copy);
 700   } # for (@$all_files)
 701
 702   if (!@$files_to_flush)
 703   {
 704     return (1);
 705   }
 706
 707   $sock = Collectd::Unixsock->new ($opts{'addr'});
 708   if (!$sock)
 709   {
 710     return;
 711   }
 712
 713   $status = $sock->flush (plugins => ['rrdtool'], identifier => $files_to_flush);
 714   if (!$status)
 715   {
 716     cluck ("FLUSH failed: " . $sock->{'error'});
 717     $sock->destroy ();
 718     return;
 719   }
 720
 721   $sock->destroy ();
 722   return (1);
 723 } # flush_files
 724
 725 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :