2 # fixscript will replace this line with require innshellvars.pl
4 # $Id: cnfsstat.in 7060 2004-12-19 21:36:38Z rra $
6 # Copyright Andreas Lamrecht 1998
7 # <Andreas.Lamprect@siemens.at>
9 # Modified by Kjetil T. Homme 1998, 2000
10 # <kjetilho@ifi.uio.no>
12 # Modified by Robert R. Collier 1998
15 # bigint support added by Duane Currie (sandman@hub.org) 1998
17 use vars qw($opt_l $opt_h $opt_a $opt_s);
23 my($conffile) = "$inn::pathetc/cycbuff.conf";
24 my($storageconf) = "$inn::pathetc/storage.conf";
31 $0 [-c CLASS] [-l [seconds]]
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
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
46 my(@line, %class, %buff, %stor, $c, @buffers);
48 my($gr, $cl, $min, $max, @storsort, $oclass, $header_printed);
50 Getopt::Long::config('no_ignore_case');
51 GetOptions("-a", "-c=s", \$oclass, "-h", "-l:i", "-s", "-m=s", \$obuffer,
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 };
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" }
66 Sys::Syslog::setlogsock('unix')
67 if $OSNAME =~ /linux|freebsd|dec_osf|darwin/;
69 openlog ('cnfsstat', 'pid', $inn::syslog_facility);
71 print STDERR "Syslog is not available. -s option is ignored.\n";
76 open(FILE, ">$inn::pathrun/cnfsstat.pid") && do {
82 my($sleeptime) = (defined($opt_l) && $opt_l > 0) ? $opt_l : 600;
84 unless (&read_cycbuffconf) {
85 print STDERR "Cannot open CycBuff Conffile $conffile ...\n";
89 unless (&read_storageconf) {
90 print STDERR "No valid $storageconf.\n";
95 &mrtg($obuffer) if $obuffer;
96 &mrtg_config if $opt_p;
98 #foreach $c (keys(%class)) {
99 # print "Class: $c, definition: $class{$c}\n";
101 #foreach $c (keys(%buff)) {
102 # print "Buff: $c, definition: $buff{$c}\n";
110 if ($class{$oclass}) {
111 if (!$header_printed) {
112 ($gr, $cl, $min, $max) = split(/:/, $stor{$oclass});
115 $logline = sprintf("Class %s for groups matching \"%s\" article size min/max: %d/%d", $oclass, $gr, $min, $max);
117 $logline = sprintf("Class %s for groups matching \"%s\"", $oclass, $gr);
120 print STDOUT "Class $oclass";
121 print STDOUT " for groups matching \"$gr\"";
123 print STDOUT ", article size min/max: $min/$max";
130 @buffers = split(/,/, $class{$oclass});
132 print STDERR "No buffers in Class $main::ARGV[0] ...\n";
136 foreach $b (@buffers) {
138 print STDERR "No buffer definition for buffer $b ...\n";
141 &print_cycbuff_head($buff{$b});
144 print STDERR "Class $ARGV[1] not found ...\n";
146 } else { # Print all Classes
148 foreach $c (@storsort) {
149 ($gr, $cl, $min, $max) = split(/:/, $stor{$c});
152 $logline = sprintf("Class %s for groups matching \"%s\" article size min/max: %d/%d", $c, $gr, $min, $max);
154 $logline = sprintf("Class %s for groups matching \"%s\"", $c, $gr);
157 print STDOUT "Class $c ";
158 print STDOUT " for groups matching \"$gr\"";
160 print STDOUT ", article size min/max: $min/$max";
164 @buffers = split(/,/, $class{$c});
166 print STDERR "No buffers in Class $c ...\n";
170 foreach $b (@buffers) {
172 print STDERR "No buffer definition for buffer $b ...\n";
175 &print_cycbuff_head($buff{$b});
177 if ($use_syslog == 0) {
183 if(defined($opt_l)) {
185 if ($use_syslog == 0) {
186 print STDOUT "$sleeptime seconds later:\n";
191 sub read_cycbuffconf {
192 return 0 unless open (CONFFILE, $conffile);
195 $_ =~ s/^\s*(.*?)\s*$/$1/;
196 # Here we handle continuation lines
198 $contline = <CONFFILE>;
199 $contline =~ s/^\s*(.*?)\s*$/$1/;
203 # \x23 below is #. Emacs perl-mode gets confused by the "comment"
204 next if($_ =~ /^\s*$/ || $_ =~ /^\x23/);
205 next if($_ =~ /^cycbuffupdate:/ || $_ =~ /^refreshinterval:/);
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";
214 $class{$line[1]} = $line[2];
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";
224 $buff{$line[1]} = $line[2];
228 print STDERR "Unknown config line \"$_\" in CycBuff Conffile $conffile ...\n";
234 sub read_storageconf {
236 return 0 unless open (STOR, $storageconf);
243 %key = ("NEWSGROUPS" => "*",
246 if (/method\s+cnfs\s+\{/) {
251 if (/(\w+):\s+(\S+)/i) {
255 unless (defined $key{'CLASS'} && defined $key{'OPTIONS'}) {
256 print STDERR "storage.conf:$line: ".
257 "Missing 'class' or 'options'\n";
261 $key{'SIZE'} .= ",0" unless $key{'SIZE'} =~ /,/;
262 $key{'SIZE'} =~ s/,/:/;
264 if (!defined $stor{$key{'OPTIONS'}}) {
265 $stor{$key{'OPTIONS'}} = "$key{'NEWSGROUPS'}:$key{'CLASS'}:" .
266 "$key{'SIZE'}:$key{'OPTIONS'}";
267 push(@storsort, $key{'OPTIONS'});
274 sub print_cycbuff_head {
275 my ($buffpath) = $_[0];
276 my ($name, $len, $free, $update, $cyclenum, $oldart) =
277 &get_cycbuff_info($buffpath);
280 ($name) = split(/\s/, $name);
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);
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";
297 my ($when, $ago) = &make_time($oldart);
298 print " Oldest: $when, $ago ago\n";
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));
312 $mday = int($t/86400); $t = $t % 86400;
313 $hour = int($t/3600); $t = $t % 3600;
314 $min = int($t/60); $t = $t % 60;
316 push (@ret, sprintf("%4d days, %2d:%02d:%02d",
317 $mday, $hour, $min, $t));
322 my ($val, $digits) = @_;
325 my @name = ("kBytes", "MBytes", "GBytes", "TBytes");
330 my $oldscaled = Math::BigFloat->new ($val) / $base;
331 my $scaled = $oldscaled;
332 while ( ( int($scaled) > 0 ) && ( $unit < $#name ) ) {
333 $oldscaled = $scaled;
337 $scaled = $oldscaled;
338 my $predigits = length (int($scaled));
339 my $postdigits = $digits - $predigits - 1;
340 $postdigits = 0 if $postdigits < 0;
343 return sprintf ("%${digits}.${postdigits}f %s", $scaled, $name[$unit]);
348 # print "Buffer = $buff{$buffer}\n";
349 @info = &get_cycbuff_info($buff{$buffer});
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);
369 my ($class,$buffer) = @_;
370 #my ($name, $num, $buff, $size) = @_;
371 $tag = 'cnfs-' . $buffer;
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";
386 my($handle, $offset) = @_;
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.
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.
398 while($offset > 2000000000) {
399 sysseek($handle, 2000000000, 1) || return 0;
400 $offset -= 2000000000;
402 sysseek($handle, $offset, 1) || return 0;
405 return sysseek($handle, $offset, 0);
409 sub check_read_return {
411 die "read: $!\n" unless defined($result);
412 die "read reached eof\n" unless $result;
416 sub get_cycbuff_info {
417 my($buffpath) = $_[0];
423 my($headerlength) = $CNFSMASIZ + $CNFSNASIZ + $CNFSPASIZ + (4 * $CNFSLASIZ);
425 my($buff, @entries, $e);
426 my($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma);
428 if(! open(BUFF, "< $buffpath") ) {
429 print STDERR "Cannot open Cycbuff $buffpath ...\n";
434 if(! read(BUFF, $buff, $headerlength) ) {
435 print STDERR "Cannot read $headerlength bytes from file $buffpath...\n";
439 ($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma) =
440 unpack("a8 a16 a64 a16 a16 a16 a16", $buff);
443 print STDERR "Error while unpacking header ...\n";
447 my($len) = bhex($lena);
448 my($free) = bhex($freea);
449 my($update) = hex($updatea);
450 my($cyclenum) = hex($cyclenuma) - 1;
454 my $pagesize = 16384;
455 my $minartoffset = int($len / (512 * 8)) + 512;
457 $minartoffset = ($minartoffset + $pagesize) & ~($pagesize - 1);
459 if ($cyclenum == 0 && $free == $minartoffset) {
460 # The cycbuff has no articles yet.
464 # Don't loop endlessly, set rough upper bound
465 my $sentinel = $cyclenum == 0 ? $free : $len;
466 my $offset = $cyclenum == 0 ? $minartoffset : $free + $pagesize;
468 bigsysseek (BUFF, $offset) || die "sysseek: $!\n";
469 check_read_return (sysread (BUFF, $buff, $pagesize));
471 check_read_return (sysread (BUFF, $chunk, $pagesize));
474 while ($buff =~ /^message-id:\s+(<.*?>)/mi) {
476 $oldart = &lookup_age ($1);
479 # Is the article newer than the last update?
480 if ($oldart >= $update) {
482 } elsif ($oldart < $update - 60) {
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);
490 } while ($sentinel -= $pagesize > 0);
495 return($name,$len,$free,$update,$cyclenum,$oldart);
501 my $history = &safe_run("grephistory", "-l", $msgid);
502 if ($history =~ /\t(\d+)~/) {
505 print " (Missing $msgid)\n";
512 my $pid = open(KID_TO_READ, "-|");
513 die "fork: $!\n" unless defined $pid;
515 while (<KID_TO_READ>) {
520 exec(@_) || die "can't exec $_[0]: $!";
526 # Hex to bigint conversion routine
527 # bhex(HEXSTRING) returns BIGINT (with leading + chopped off)
529 # In most languages, unlimited size integers are done using string math
530 # libraries usually called bigint. (Java, Perl, etc...)
532 # Bigint's are really just strings.
535 my $hexValue = shift;
536 $hexValue =~ s/^0x//;
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..
543 my $byte = substr($hexValue, $i, 2);
544 my $byteIntValue = hex($byte);
546 $integerValue = $integerValue * "256";
547 $integerValue = $integerValue + "$byteIntValue";
550 $integerValue =~ s/^\+//;
551 return $integerValue;