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