frontends/cnfsstat.in

   1 #! /usr/bin/perl
   2 # fixscript will replace this line with require innshellvars.pl
   3
   4 #  $Id: cnfsstat.in 7060 2004-12-19 21:36:38Z rra $
   5 #
   6 #  Copyright Andreas Lamrecht 1998
   7 #  <Andreas.Lamprect@siemens.at>
   8 #
   9 #  Modified by Kjetil T. Homme 1998, 2000
  10 #  <kjetilho@ifi.uio.no>
  11 #
  12 #  Modified by Robert R. Collier 1998
  13 #  <rob@lspace.org>
  14 #
  15 #  bigint support added by Duane Currie (sandman@hub.org) 1998
  16
  17 use vars qw($opt_l $opt_h $opt_a $opt_s);
  18 use Getopt::Long;
  19 use Math::BigInt;
  20 use Math::BigFloat;
  21 use English;
  22
  23 my($conffile) = "$inn::pathetc/cycbuff.conf";
  24 my($storageconf) = "$inn::pathetc/storage.conf";
  25
  26 sub usage {
  27     print <<_end_;
  28 Summary tool for CNFS
  29
  30 Usage:
  31         $0 [-c CLASS] [-l [seconds]]
  32
  33         If called without args, does a one-time status of all CNFS buffers
  34         -a:          print the age of the oldest article in the cycbuff
  35         -c <CLASS>:  prints out status of CNFS buffers in class CLASS
  36         -l seconds:  loops like vmstat, default seconds = 600
  37         -s:          logs through syslog
  38         -h:          This information
  39         -m <BUFFER>: prints out information suitable for mrtg
  40         -p:          prints out an mrtg config file
  41         -P:          write PID into $inn::pathrun/cnfsstat.pid
  42 _end_
  43     exit(1);
  44 }
  45
  46 my(@line, %class, %buff, %stor, $c, @buffers);
  47
  48 my($gr, $cl, $min, $max, @storsort, $oclass, $header_printed);
  49
  50 Getopt::Long::config('no_ignore_case');
  51 GetOptions("-a", "-c=s", \$oclass, "-h", "-l:i", "-s", "-m=s", \$obuffer,
  52            "-p", "-P");
  53
  54 &usage if $opt_h;
  55
  56 if ($opt_s) {
  57     $use_syslog = 0;
  58     ## Comment out this eval line if you don't want to try to syslog
  59     eval { require Sys::Syslog; import Sys::Syslog; $use_syslog = 1 };
  60     if ($use_syslog) {
  61         if (defined &Sys::Syslog::setlogsock && $] >= 5.00403) {
  62             # we really need a common module to work all this junk out
  63             if ($OSNAME eq "dec_osf") {
  64                 sub Sys::Syslog::_PATH_LOG { "/dev/log" }
  65             }
  66             Sys::Syslog::setlogsock('unix')
  67                 if $OSNAME =~ /linux|freebsd|dec_osf|darwin/;
  68         }
  69         openlog ('cnfsstat', 'pid', $inn::syslog_facility);
  70     } else {
  71         print STDERR "Syslog is not available.  -s option is ignored.\n";
  72     }
  73 }
  74
  75 if ($opt_P) {
  76     open(FILE, ">$inn::pathrun/cnfsstat.pid") && do {
  77         print FILE "$$\n";
  78         close FILE;
  79     };
  80 }
  81
  82 my($sleeptime) = (defined($opt_l) && $opt_l > 0) ? $opt_l : 600;
  83
  84 unless (&read_cycbuffconf) {
  85     print STDERR "Cannot open CycBuff Conffile $conffile ...\n";
  86     exit (1);
  87 }
  88
  89 unless (&read_storageconf) {
  90     print STDERR "No valid $storageconf.\n";
  91     exit (1);
  92 }
  93
  94
  95 &mrtg($obuffer) if $obuffer;
  96 &mrtg_config if $opt_p;
  97
  98 #foreach $c (keys(%class)) {
  99 #  print "Class: $c, definition: $class{$c}\n";
 100 #}
 101 #foreach $c (keys(%buff)) {
 102 #  print "Buff: $c, definition: $buff{$c}\n";
 103 #}
 104 # exit(0);
 105
 106 START:
 107
 108 undef($logline);
 109 if ($oclass) {
 110     if ($class{$oclass}) {
 111         if (!$header_printed) {
 112             ($gr, $cl, $min, $max) = split(/:/, $stor{$oclass});
 113             if ($use_syslog) {
 114                 if ($min || $max) {
 115                     $logline = sprintf("Class %s for groups matching \"%s\" article size min/max: %d/%d", $oclass, $gr, $min, $max);
 116                 } else {
 117                     $logline = sprintf("Class %s for groups matching \"%s\"", $oclass, $gr);
 118                 }
 119             } else {
 120                 print STDOUT "Class $oclass";
 121                 print STDOUT " for groups matching \"$gr\"";
 122                 if ($min || $max) {
 123                     print STDOUT ", article size min/max: $min/$max";
 124                 }
 125                 print STDOUT "\n";
 126             }
 127             $header_printed = 1;
 128         }
 129
 130         @buffers = split(/,/, $class{$oclass});
 131         if (! @buffers) {
 132             print STDERR "No buffers in Class $main::ARGV[0] ...\n";
 133             next;
 134         }
 135
 136         foreach $b (@buffers) {
 137             if (! $buff{$b} ) {
 138                 print STDERR "No buffer definition for buffer $b ...\n";
 139                 next;
 140             }
 141             &print_cycbuff_head($buff{$b});
 142         }
 143     } else {
 144         print STDERR "Class $ARGV[1] not found ...\n";
 145     }
 146 } else { # Print all Classes
 147
 148     foreach $c (@storsort) {
 149         ($gr, $cl, $min, $max) = split(/:/, $stor{$c});
 150         if ($use_syslog) {
 151             if ($min || $max) {
 152                 $logline = sprintf("Class %s for groups matching \"%s\" article size min/max: %d/%d", $c, $gr, $min, $max);
 153             } else {
 154                 $logline = sprintf("Class %s for groups matching \"%s\"", $c, $gr);
 155             }
 156         } else {
 157             print STDOUT "Class $c ";
 158             print STDOUT " for groups matching \"$gr\"";
 159             if($min || $max) {
 160                 print STDOUT ", article size min/max: $min/$max";
 161             }
 162             print STDOUT "\n";
 163         }
 164         @buffers = split(/,/, $class{$c});
 165         if(! @buffers) {
 166             print STDERR "No buffers in Class $c ...\n";
 167             next;
 168         }
 169
 170         foreach $b (@buffers) {
 171             if(! $buff{$b} ) {
 172                 print STDERR "No buffer definition for buffer $b ...\n";
 173                 next;
 174             }
 175             &print_cycbuff_head($buff{$b});
 176         }
 177         if ($use_syslog == 0) {
 178             print STDOUT "\n";
 179         }
 180     }
 181 }
 182
 183 if(defined($opt_l)) {
 184     sleep($sleeptime);
 185     if ($use_syslog == 0) {
 186         print STDOUT "$sleeptime seconds later:\n";
 187     }
 188     goto START;
 189 }
 190
 191 sub read_cycbuffconf {
 192     return 0 unless open (CONFFILE, $conffile);
 193
 194     while(<CONFFILE>) {
 195         $_ =~ s/^\s*(.*?)\s*$/$1/;
 196         # Here we handle continuation lines
 197         while (m/\\$/) {
 198             $contline = <CONFFILE>;
 199             $contline =~ s/^\s*(.*?)\s*$/$1/;
 200             chop;
 201             $_ .= $contline;
 202         }
 203         # \x23 below is #.  Emacs perl-mode gets confused by the "comment"
 204         next if($_ =~ /^\s*$/ || $_ =~ /^\x23/);
 205         next if($_ =~ /^cycbuffupdate:/ || $_ =~ /^refreshinterval:/);
 206
 207         if($_ =~ /^metacycbuff:/) {
 208             @line = split(/:/, $_);
 209             if($class{$line[1]}) {
 210                 print STDERR "Class $line[1] more than one time in CycBuff Conffile $conffile ...\n";
 211                 return 0;
 212             }
 213
 214             $class{$line[1]} = $line[2];
 215             next;
 216         }
 217
 218         if ($_ =~ /^cycbuff/) {
 219             @line = split(/:/, $_);
 220             if($buff{$line[1]}) {
 221                 print STDERR "Buff $line[1] more than one time in CycBuff Conffile $conffile ...\n";
 222                 return 1;
 223             }
 224             $buff{$line[1]} = $line[2];
 225             next;
 226         }
 227
 228         print STDERR "Unknown config line \"$_\" in CycBuff Conffile $conffile ...\n";
 229     }
 230     close(CONFFILE);
 231     return 1;
 232 }
 233
 234 sub read_storageconf {
 235     my $line = 0;
 236     return 0 unless open (STOR, $storageconf);
 237
 238     while (<STOR>) {
 239         ++$line;
 240         next if /^\s*#/;
 241
 242         # defaults
 243         %key = ("NEWSGROUPS" => "*",
 244                 "SIZE" => "0,0");
 245
 246         if (/method\s+cnfs\s+\{/) {
 247             while (<STOR>) {
 248                 ++$line;
 249                 next if /^\s*#/;
 250                 last if /\}/;
 251                 if (/(\w+):\s+(\S+)/i) {
 252                     $key{uc($1)} = $2;
 253                 }
 254             }
 255             unless (defined $key{'CLASS'} && defined $key{'OPTIONS'}) {
 256                 print STDERR "storage.conf:$line: ".
 257                         "Missing 'class' or 'options'\n";
 258                 return 0;
 259             }
 260
 261             $key{'SIZE'} .= ",0" unless $key{'SIZE'} =~ /,/;
 262             $key{'SIZE'} =~ s/,/:/;
 263
 264             if (!defined $stor{$key{'OPTIONS'}}) {
 265                 $stor{$key{'OPTIONS'}} = "$key{'NEWSGROUPS'}:$key{'CLASS'}:" .
 266                         "$key{'SIZE'}:$key{'OPTIONS'}";
 267                 push(@storsort, $key{'OPTIONS'});
 268             }
 269         }
 270     }
 271     return 1;
 272 }
 273
 274 sub print_cycbuff_head {
 275     my ($buffpath) = $_[0];
 276     my ($name, $len, $free, $update, $cyclenum, $oldart) =
 277             &get_cycbuff_info($buffpath);
 278
 279     if ($use_syslog) {
 280         ($name) = split(/\s/, $name);
 281         $name =~ s/\0//g;
 282         syslog ('notice', '%s Buffer %s, len: %.2f  Mbytes, used: %.2f Mbytes (%4.1f%%) %3d cycles',
 283                 $logline, $name, $len / (1024 * 1024),
 284                 Math::BigFloat->new ($free) / (1024 * 1024),
 285                 100 * Math::BigFloat->new ($free) / $len, $cyclenum);
 286         return 0;
 287     }
 288
 289     $name =~ s/\0//g;
 290     print " Buffer $name, size: ", &human_readable($len, 4);
 291     print ", position: ", &human_readable($free, 4);
 292     printf("  %.2f cycles\n", $cyclenum + Math::BigFloat->new ($free) / $len);
 293     my ($when, $ago) = &make_time($update);
 294     print "  Newest: $when, $ago ago\n";
 295
 296     if ($opt_a) {
 297         my ($when, $ago) = &make_time($oldart);
 298         print "  Oldest: $when, $ago ago\n";
 299     }
 300 }
 301
 302 sub make_time {
 303     my ($t) = @_;
 304     my (@ret);
 305
 306     my ($sec,$min,$hour,$mday,$mon,$year) =
 307             (localtime($t))[0..5];
 308     push (@ret, sprintf("%04d-%02d-%02d %2d:%02d:%02d",
 309                         $year + 1900, $mon + 1, $mday, $hour, $min, $sec));
 310     $t = time - $t;
 311
 312     $mday = int($t/86400); $t = $t % 86400;
 313     $hour = int($t/3600);  $t = $t % 3600;
 314     $min  = int($t/60);    $t = $t % 60;
 315
 316     push (@ret, sprintf("%4d days, %2d:%02d:%02d",
 317                         $mday, $hour, $min, $t));
 318     return @ret;
 319 }
 320
 321 sub human_readable {
 322     my ($val, $digits) = @_;
 323     $val =~ s/\+//;
 324
 325     my @name = ("kBytes", "MBytes", "GBytes", "TBytes");
 326     my $base = 1024;
 327     my $factor = 1024;
 328
 329     my $unit = -1;
 330     my $oldscaled = Math::BigFloat->new ($val) / $base;
 331     my $scaled = $oldscaled;
 332     while ( ( int($scaled) > 0 ) && ( $unit < $#name ) ) {
 333         $oldscaled = $scaled;
 334         $scaled /= $factor;
 335         $unit++;
 336     }
 337     $scaled = $oldscaled;
 338     my $predigits = length (int($scaled));
 339     my $postdigits = $digits - $predigits - 1;
 340     $postdigits = 0 if $postdigits < 0;
 341     ++$digits;
 342
 343     return sprintf ("%${digits}.${postdigits}f %s", $scaled, $name[$unit]);
 344 }
 345
 346 sub mrtg {
 347         my $buffer = shift;
 348         # print "Buffer = $buff{$buffer}\n";
 349         @info = &get_cycbuff_info($buff{$buffer});
 350         print "$info[1]\n";
 351         print "$info[2]\n";
 352         print "$info[4]\n";
 353         print "$info[0]\n";
 354         exit(0);
 355 }
 356
 357 sub mrtg_config {
 358         print "Sub MRTG-CONFIG\n";
 359         foreach $class (sort(keys(%class))) {
 360                 print "##\n## Class  : $class\n## Wildmat: $stor{$class}\n##\n\n";
 361                 foreach $buffer (split /\,/,$class{$class}) {
 362                         &mrtg_buffer($class,$buffer);
 363                 }
 364         }
 365         exit(0);
 366 }
 367
 368 sub mrtg_buffer {
 369         my ($class,$buffer) = @_;
 370         #my ($name, $num, $buff, $size) = @_;
 371         $tag = 'cnfs-' . $buffer;
 372
 373         print 'Target[', $tag, ']: `', "$inn::pathbin/cnfsstat -m ", $buffer, '`', "\n";
 374         print 'MaxBytes[', $tag, ']: ', (&get_cycbuff_info($buff{$buffer}))[1], "\n";
 375         print 'Title[', $tag, ']: ', "${buffer} Usage\n";
 376         print 'Options[', $tag, ']: growright gauge', "\n";
 377         print 'YLegend[', $tag, ']: ', "${buffer}\n";
 378         print 'ShortLegend[', $tag, ']: MB', "\n";
 379         print 'PageTop[', $tag, ']: ', "<H1>Usage of ${buffer}</H1>\n";
 380         print "<BR><TT>$stor{$class}</TT>\n";
 381         print "\n";
 382         1;
 383 }
 384
 385 sub bigsysseek {
 386     my($handle, $offset) = @_;
 387
 388     # $offset may be a bigint; and have a value that doesn't fit in a signed long.
 389     # Even with largefiles enabled, perl will still truncate the argument to lseek64
 390     # to 32 bits.  So we seek multiple times, <2G at a time.
 391
 392     if($offset > 2147483647) {
 393         # Since perl truncates the return value of lseek64 to 32 bits, it might
 394         # see a successful return value as negative, and return FALSE (undef).
 395         # So we must ignore the return value of sysseek and assume that it worked.
 396
 397         seek($handle, 0, 0);
 398         while($offset > 2000000000) {
 399             sysseek($handle, 2000000000, 1) || return 0;
 400             $offset -= 2000000000;
 401         }
 402         sysseek($handle, $offset, 1) || return 0;
 403         return 1;
 404     } else {
 405         return sysseek($handle, $offset, 0);
 406     }
 407 }
 408
 409 sub check_read_return {
 410   my $result = shift;
 411   die "read: $!\n" unless defined($result);
 412   die "read reached eof\n" unless $result;
 413   return $result;
 414 }
 415
 416 sub get_cycbuff_info {
 417     my($buffpath) = $_[0];
 418
 419     my($CNFSMASIZ)=8;
 420     my($CNFSNASIZ)=16;
 421     my($CNFSPASIZ)=64;
 422     my($CNFSLASIZ)=16;
 423     my($headerlength) = $CNFSMASIZ + $CNFSNASIZ + $CNFSPASIZ + (4 * $CNFSLASIZ);
 424
 425     my($buff, @entries, $e);
 426     my($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma);
 427
 428     if(! open(BUFF, "< $buffpath") ) {
 429         print STDERR "Cannot open Cycbuff $buffpath ...\n";
 430         exit(1);
 431     }
 432
 433     $buff = "";
 434     if(! read(BUFF, $buff, $headerlength) ) {
 435         print STDERR "Cannot read $headerlength bytes from file $buffpath...\n";
 436         exit(1);
 437     }
 438
 439     ($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma) =
 440             unpack("a8 a16 a64 a16 a16 a16 a16", $buff);
 441
 442     if(!$magic) {
 443         print STDERR "Error while unpacking header ...\n";
 444         exit(1);
 445     }
 446
 447     my($len) = bhex($lena);
 448     my($free) = bhex($freea);
 449     my($update) = hex($updatea);
 450     my($cyclenum) = hex($cyclenuma) - 1;
 451
 452     if ($opt_a) {
 453
 454         my $pagesize = 16384;
 455         my $minartoffset = int($len / (512 * 8)) + 512;
 456         # Align upwards:
 457         $minartoffset = ($minartoffset + $pagesize) & ~($pagesize - 1);
 458
 459         if ($cyclenum == 0 && $free == $minartoffset) {
 460             # The cycbuff has no articles yet.
 461             goto done;
 462         }
 463
 464         # Don't loop endlessly, set rough upper bound
 465         my $sentinel = $cyclenum == 0 ? $free : $len;
 466         my $offset = $cyclenum == 0 ? $minartoffset : $free + $pagesize;
 467
 468         bigsysseek (BUFF, $offset) || die "sysseek: $!\n";
 469         check_read_return (sysread (BUFF, $buff, $pagesize));
 470         do {
 471             check_read_return (sysread (BUFF, $chunk, $pagesize));
 472
 473             $buff .= $chunk;
 474             while ($buff =~ /^message-id:\s+(<.*?>)/mi) {
 475                 $buff = $POSTMATCH;
 476                 $oldart = &lookup_age ($1);
 477                 next unless $oldart;
 478
 479                 # Is the article newer than the last update?
 480                 if ($oldart >= $update) {
 481                     $update = $oldart;
 482                 } elsif ($oldart < $update - 60) {
 483                     goto done;
 484                 }
 485             }
 486             # Just in case we chopped Message-ID in two, use the end
 487             # at the front in next iteration.
 488             $buff = substr ($buff, -512);
 489
 490         } while ($sentinel -= $pagesize > 0);
 491     }
 492
 493 done:
 494     close(BUFF);
 495     return($name,$len,$free,$update,$cyclenum,$oldart);
 496 }
 497
 498 sub lookup_age {
 499     my ($msgid) = @_;
 500
 501     my $history = &safe_run("grephistory", "-l", $msgid);
 502     if ($history =~ /\t(\d+)~/) {
 503         return $1;
 504     }
 505     print "  (Missing $msgid)\n";
 506     return 0;
 507 }
 508
 509 sub safe_run {
 510     my $output = "";
 511
 512     my $pid = open(KID_TO_READ, "-|");
 513     die "fork: $!\n" unless defined $pid;
 514     if ($pid) {
 515         while (<KID_TO_READ>) {
 516             $output .= $_;
 517         }
 518         close(KID_TO_READ);
 519     } else {
 520         exec(@_) || die "can't exec $_[0]: $!";
 521         # NOTREACHED
 522     }
 523     return $output;
 524 }
 525
 526 # Hex to bigint conversion routine
 527 # bhex(HEXSTRING) returns BIGINT  (with leading + chopped off)
 528 #
 529 # In most languages, unlimited size integers are done using string math
 530 # libraries usually called bigint.  (Java, Perl, etc...)
 531
 532 # Bigint's are really just strings.
 533
 534 sub bhex {
 535     my $hexValue = shift;
 536     $hexValue =~ s/^0x//;
 537
 538     my $integerValue = new Math::BigInt '0';
 539     for (my $i = 0; $i < length($hexValue); $i += 2) {
 540         # Could be more efficient going at larger increments, but byte
 541         # by byte is safer for the case of 9 byte values, 11 bytes, etc..
 542
 543         my $byte = substr($hexValue, $i, 2);
 544         my $byteIntValue = hex($byte);
 545
 546         $integerValue = $integerValue * "256";
 547         $integerValue = $integerValue + "$byteIntValue";
 548     }
 549
 550     $integerValue =~ s/^\+//;
 551     return $integerValue;
 552 }