#! /usr/bin/perl -w # fixscript will replace this line with code to load INN::Config # Copyright Andreas Lamrecht 1998 # # # Modified by Kjetil T. Homme 1998, 2000 # # # Modified by Robert R. Collier 1998 # # # bigint support added by Duane Currie (sandman@hub.org) 1998 use strict; use Getopt::Long; use Math::BigInt; use Math::BigFloat; use English; my $conffile = "$INN::Config::pathetc/cycbuff.conf"; my $storageconf = "$INN::Config::pathetc/storage.conf"; my $lastconftime = 0; sub usage { print <<"_end_"; Summary tool for CNFS Usage: $0 [-ahpPsv] [-c class] [-i seconds] [-l [seconds]] [-m buffer] If called without args, does a one-time status of all CNFS buffers -a: print the age of the oldest article in the cycbuff -c class: print out status of CNFS buffers in that class -h: this information -i seconds: initial sleep of that many seconds at startup -l [seconds]: loop like vmstat, default seconds = 600 -m buffer: print out information suitable for MRTG -p: print out an MRTG config file -P: write PID into $INN::Config::pathrun/cnfsstat.pid -s: log through syslog -v: do consistency checks and print the result _end_ exit(1); } my (%class, %buff, %stor, @storsort); my (%prevclass, %prevbuff, %prevstor, @prevstorsort); my @buffers; my ($oclass, $obuffer); my %opt = (c=>\$oclass, m=>\$obuffer); Getopt::Long::config('no_ignore_case'); GetOptions(\%opt, "-a", "-c=s", "-h", "-i=i", "-l:i", "-m=s", "-p", "-P", "-s", "-v"); usage() if $opt{'h'}; my $use_syslog = 0; if ($opt{'s'}) { eval { require Sys::Syslog; import Sys::Syslog; $use_syslog = 1 }; if ($use_syslog) { if ($Sys::Syslog::VERSION lt 0.15) { eval "sub Sys::Syslog::_PATH_LOG { '/dev/log' }" if $^O eq 'dec_osf'; Sys::Syslog::setlogsock('unix') if $^O =~ /linux|dec_osf|freebsd|darwin/; } openlog('cnfsstat', 'pid', $INN::Config::syslog_facility); } else { print STDERR "Syslog is not available. -s option is ignored.\n"; } } if ($opt{'P'}) { if (open my $FILE, '>', "$INN::Config::pathrun/cnfsstat.pid") { print $FILE "$$\n"; close $FILE; }; } my $sleeptime = (defined($opt{'l'}) && $opt{'l'} > 0) ? $opt{'l'} : 600; unless (read_cycbuffconf()) { print STDERR "Invalid $conffile file.\n"; exit (1); } unless (read_storageconf()) { print STDERR "Invalid $storageconf file.\n"; exit (1); } mrtg($obuffer) if $obuffer; mrtg_config() if $opt{'p'}; # Initial sleep, before starting the work. if(defined($opt{'i'}) && $opt{'i'} > 0) { sleep($opt{'i'}); if (!$use_syslog) { print STDOUT "$opt{'i'} seconds later:\n"; } } START: # Check whether the configuration files need reloading. my $cycbufftime = (stat($conffile))[9] if (-r $conffile); my $storagetime = (stat($storageconf))[9] if (-r $storageconf); my $maxtime = ($cycbufftime < $storagetime) ? $storagetime : $cycbufftime; # Set $lastconftime for the first run of the comparison. $lastconftime = $maxtime if not $lastconftime; if ($lastconftime < $maxtime) { my $reloadok = 1; $lastconftime = $maxtime; # Save the previous configuration, in case reloading it fails. # Direct copies of the arrays and hashes works fine here. %prevclass = %class; undef %class; %prevbuff = %buff; undef %buff; %prevstor = %stor; undef %stor; @prevstorsort = @storsort; undef @storsort; unless (read_cycbuffconf()) { print STDERR "Invalid $conffile file.\n"; $reloadok = 0; } unless (read_storageconf()) { print STDERR "Invalid $storageconf file.\n"; $reloadok = 0; } # In case reloading configuration files fails, restore the # previous known configuration for this run of cnfsstat. if (!$reloadok) { %class = %prevclass; %buff = %prevbuff; %stor = %prevstor; @storsort = @prevstorsort; } } my $logline; my $header_printed = 0; my ($gr, $cl, $min, $max); if ($oclass) { if ($class{$oclass}) { if (!$header_printed) { if ($stor{$oclass}) { ($gr, $cl, $min, $max) = split(/:/, $stor{$oclass}); } else { ($gr, $cl, $min, $max) = ('', $oclass, 0, 0); } # Remove leading and trailing double quotes, if present. $gr =~ s/"?([^"]*)"?/$1/g; if ($use_syslog) { if ($min || $max) { $logline = sprintf("Class %s for groups matching \"%s\" article size min/max: %d/%d", $oclass, $gr, $min, $max); } else { $logline = sprintf("Class %s for groups matching \"%s\"", $oclass, $gr); } } else { print STDOUT "Class $oclass"; print STDOUT " for groups matching \"$gr\""; if ($min || $max) { print STDOUT ", article size min/max: $min/$max"; } print STDOUT "\n"; } $header_printed = 1; } @buffers = split(/,/, $class{$oclass}); if (! @buffers) { print STDERR "No buffers in Class $oclass ...\n"; next; } foreach my $b (@buffers) { if (! $buff{$b} ) { print STDERR "No buffer definition for buffer $b ...\n"; next; } print_cycbuff_head($buff{$b}); } } else { print STDERR "Class $oclass not found ...\n"; } } else { # Print all Classes my %buffDone; foreach my $c (@storsort) { ($gr, $cl, $min, $max) = split(/:/, $stor{$c}); # Remove leading and trailing double quotes, if present. $gr =~ s/"?([^"]*)"?/$1/g; if ($use_syslog) { if ($min || $max) { $logline = sprintf("Class %s for groups matching \"%s\" article size min/max: %d/%d", $c, $gr, $min, $max); } else { $logline = sprintf("Class %s for groups matching \"%s\"", $c, $gr); } } else { print STDOUT "Class $c"; print STDOUT " for groups matching \"$gr\""; if($min || $max) { print STDOUT ", article size min/max: $min/$max"; } print STDOUT "\n"; } @buffers = split(/,/, $class{$c}); if(! @buffers) { print STDERR "No buffers in Class $c ...\n"; next; } foreach my $b (@buffers) { if(! $buff{$b} ) { print STDERR "No buffer definition for buffer $b ...\n"; next; } print_cycbuff_head($buff{$b}); $buffDone{$b}++; } if (!$use_syslog) { print STDOUT "\n"; } } if (!$use_syslog) { # Finally, print all retired cyclic buffers, still active but no longer # mentioned in a class. my $buffRetired = 0; foreach my $b (sort keys(%buff)) { if(! exists($buffDone{$b})) { if (!$buffRetired) { print STDOUT "Retired cyclic buffers\n"; } print_cycbuff_head($buff{$b}); $buffRetired++; } } } } if(defined($opt{'l'})) { sleep($sleeptime); if (!$use_syslog) { print STDOUT "$sleeptime seconds later:\n"; } goto START; } sub read_cycbuffconf { my @line; return 0 unless open my $CONFFILE, '<', $conffile; while(<$CONFFILE>) { $_ =~ s/^\s*(.*?)\s*$/$1/; # Here we handle continuation lines while (m/\\$/) { my $contline = <$CONFFILE>; $contline =~ s/^\s*(.*?)\s*$/$1/; chop; $_ .= $contline; } # \x23 below is #. Emacs perl-mode gets confused by the "comment" next if ($_ =~ /^\s*$/ || $_ =~ /^\x23/); next if ($_ =~ /^cycbuffupdate:/ || $_ =~ /^refreshinterval:/); if($_ =~ /^metacycbuff:/) { @line = split(/:/, $_); if ($class{$line[1]}) { print STDERR "Class $line[1] more than one time in CycBuff Conffile $conffile ...\n"; return 0; } $class{$line[1]} = $line[2]; next; } if ($_ =~ /^cycbuff/) { @line = split(/:/, $_); if ($buff{$line[1]}) { print STDERR "Buff $line[1] more than one time in CycBuff Conffile $conffile ...\n"; return 0; } $buff{$line[1]} = $line[2]; next; } print STDERR "Unknown config line \"$_\" in CycBuff Conffile $conffile ...\n"; return 0; } close $CONFFILE; return 1; } sub read_storageconf { my $line = 0; return 0 unless open my $STOR, '<', $storageconf; while (<$STOR>) { ++$line; next if /^\s*#/; # defaults my %key = ("NEWSGROUPS" => "*", "SIZE" => "0,0"); if (/method\s+cnfs\s+\{/) { while (<$STOR>) { ++$line; next if /^\s*#/; last if /\}/; if (/(\w+):\s+(\S+)/i) { $key{uc($1)} = $2; } } unless (defined $key{'CLASS'} && defined $key{'OPTIONS'}) { print STDERR "storage.conf:$line: ". "Missing 'class' or 'options'\n"; return 0; } $key{'SIZE'} .= ",0" unless $key{'SIZE'} =~ /,/; $key{'SIZE'} =~ s/,/:/; if (!defined $stor{$key{'OPTIONS'}}) { $stor{$key{'OPTIONS'}} = "$key{'NEWSGROUPS'}:$key{'CLASS'}:" . "$key{'SIZE'}:$key{'OPTIONS'}"; push(@storsort, $key{'OPTIONS'}); } } } return 1; } sub print_cycbuff_head { my ($buffpath) = @_; my ($name, $len, $free, $update, $cyclenum, $oldart) = get_cycbuff_info($buffpath); if ($use_syslog) { ($name) = split(/\s/, $name); $name =~ s/\0//g; # Log only if the buffer is initialized (cyclenum is not -1). syslog ('notice', '%s Buffer %s, len: %.2f Mbytes, used: %.2f Mbytes (%4.1f%%) %3d cycles', $logline, $name, Math::BigFloat->new($len) / (1024 * 1024), Math::BigFloat->new($free) / (1024 * 1024), 100 * Math::BigFloat->new($free) / Math::BigFloat->new($len), $cyclenum) if $cyclenum >= 0; return 0; } $name =~ s/\0//g; print " Buffer $name, size: ", human_readable($len, 4); print ", position: ", human_readable($free, 4); printf " %.2f cycles\n", $cyclenum + Math::BigFloat->new($free) / Math::BigFloat->new($len); # The CNFS buffer may not have been initialized yet or received an article. # Take it into account because $oldart may be undefined. my ($when, $ago) = make_time($update); if (defined $oldart or not $opt{'a'}) { print " Newest: $when, $ago ago\n"; } else { print " Created: $when, $ago ago\n"; } if ($opt{'a'}) { if (defined $oldart) { my ($when, $ago) = make_time($oldart); print " Oldest: $when, $ago ago\n"; } else { print " No oldest article\n"; } } return; } sub make_time { my ($t) = @_; my (@ret); my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($t))[0..5]; push (@ret, sprintf("%04d-%02d-%02d %2d:%02d:%02d", $year + 1900, $mon + 1, $mday, $hour, $min, $sec)); $t = time - $t; $mday = int($t/86400); $t = $t % 86400; $hour = int($t/3600); $t = $t % 3600; $min = int($t/60); $t = $t % 60; push (@ret, sprintf("%4d days, %2d:%02d:%02d", $mday, $hour, $min, $t)); return @ret; } sub human_readable { my ($val, $digits) = @_; $val =~ s/\+//; my @name = ("kBytes", "MBytes", "GBytes", "TBytes"); my $base = 1024; my $factor = 1024; my $unit = -1; my $oldscaled = Math::BigFloat->new($val) / $base; my $scaled = $oldscaled; while ( ( int($scaled) > 0 ) && ( $unit < $#name ) ) { $oldscaled = $scaled; $scaled /= $factor; $unit++; } $scaled = $oldscaled; my $predigits = length (int($scaled)); my $postdigits = $digits - $predigits - 1; $postdigits = 0 if $postdigits < 0; ++$digits; return sprintf ("%${digits}.${postdigits}f %s", $scaled, $name[$unit]); } sub mrtg { my $buffer = shift; # print "Buffer = $buff{$buffer}\n"; my @info = get_cycbuff_info($buff{$buffer}); print "$info[1]\n"; print "$info[2]\n"; print "$info[4]\n"; print "$info[0]\n"; exit(0); } sub mrtg_config { print "Sub MRTG-CONFIG\n"; foreach my $class (sort(keys(%class))) { print "##\n## Class : $class\n## Wildmat: $stor{$class}\n##\n\n"; foreach my $buffer (split /\,/, $class{$class}) { mrtg_buffer($class, $buffer); } } exit(0); } sub mrtg_buffer { my ($class,$buffer) = @_; #my ($name, $num, $buff, $size) = @_; my $tag = 'cnfs-' . $buffer; print 'Target[', $tag, ']: `', "$INN::Config::pathbin/cnfsstat -m ", $buffer, '`', "\n"; print 'MaxBytes[', $tag, ']: ', (get_cycbuff_info($buff{$buffer}))[1], "\n"; print 'Title[', $tag, ']: ', "${buffer} Usage\n"; print 'Options[', $tag, ']: growright gauge', "\n"; print 'YLegend[', $tag, ']: ', "${buffer}\n"; print 'ShortLegend[', $tag, ']: MB', "\n"; print 'PageTop[', $tag, ']: ', "

Usage of ${buffer}

\n"; print "
$stor{$class}\n"; print "\n"; return 1; } sub bigsysseek { my ($handle, $offset) = @_; # $offset may be a bigint; and have a value that doesn't fit in a signed long. # Even with largefiles enabled, perl will still truncate the argument to lseek64 # to 32 bits. So we seek multiple times, <2G at a time. if ($offset > 2147483647) { # Since perl truncates the return value of lseek64 to 32 bits, it might # see a successful return value as negative, and return FALSE (undef). # So we must ignore the return value of sysseek and assume that it worked. seek($handle, 0, 0); while ($offset > 2000000000) { sysseek($handle, 2000000000, 1) || return 0; $offset -= 2000000000; } sysseek($handle, $offset, 1) || return 0; return 1; } else { return sysseek($handle, $offset, 0); } } sub check_read_return { my $result = shift; die "read: $!\n" unless defined($result); die "read reached eof\n" unless $result; return $result; } sub get_cycbuff_info { my ($buffpath) = @_; my $oldart; my $CNFSMASIZ = 8; my $CNFSNASIZ = 16; my $CNFSPASIZ = 64; my $CNFSLASIZ = 16; my $headerlength = 2 * $CNFSMASIZ + 2 * $CNFSNASIZ + $CNFSPASIZ + (6 * $CNFSLASIZ); my ($BUFF, $buff); if ( !open $BUFF, '<', $buffpath ) { print STDERR "Cannot open Cycbuff $buffpath ...\n"; exit(1); } $buff = ""; if ( !read $BUFF, $buff, $headerlength ) { print STDERR "Cannot read $headerlength bytes from file $buffpath...\n"; exit(1); } my ($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname, $orderinmeta, $currentbuff, $blksza) = unpack("a8 a16 a64 a16 a16 a16 a16 a16 a16 a8 a16", $buff); if (!$magic) { print STDERR "Error while unpacking header ...\n"; exit(1); } my $len = bhex($lena); my $free = bhex($freea); my $update = hex($updatea); my $cyclenum = hex($cyclenuma) - 1; my $blksz = ($magic =~ m/^CBuf4/) ? hex($blksza) : 512; if ($opt{'a'}) { my $pagesize = 16384; my $minartoffset = int($len / ($blksz * 8)) + 512; # Align upwards: $minartoffset = ($minartoffset + $pagesize) & ~($pagesize - 1); if ($cyclenum == 0 && $free == $minartoffset) { # The cycbuff has no articles yet. goto done; } # Don't loop endlessly, set rough upper bound my $sentinel = $cyclenum == 0 ? $free : $len; my $offset = $cyclenum == 0 ? $minartoffset : $free + $pagesize; bigsysseek($BUFF, $offset) || die "sysseek: $!\n"; check_read_return (sysread ($BUFF, $buff, $pagesize)); do { my $chunk; check_read_return (sysread ($BUFF, $chunk, $pagesize)); $buff .= $chunk; while ($buff =~ /^message-id:\s+(<.*?>)/mi) { $buff = $POSTMATCH; $oldart = lookup_age($1); next unless $oldart; # Is the article newer than the last update of the cycbuff? if ($oldart >= $update) { $update = $oldart; } elsif ($oldart < $update - 60) { goto done; } } # Just in case we chopped Message-ID in two, use the end # at the front in next iteration. $buff = substr ($buff, -$blksz); } while ($sentinel -= $pagesize > 0); } done: close $BUFF; return($name,$len,$free,$update,$cyclenum,$oldart); } sub lookup_age { my ($msgid) = @_; my $history = safe_run("$INN::Config::newsbin/grephistory", "-l", $msgid); if ($history =~ /\t(\d+)~/) { return $1; } if ($opt{'v'}) { print " (Missing $msgid)\n"; } return 0; } sub safe_run { my $output = ""; my $pid = open my $KID_TO_READ, "-|"; die "fork: $!\n" unless defined $pid; if ($pid) { while (<$KID_TO_READ>) { $output .= $_; } close $KID_TO_READ; } else { exec(@_) || die "can't exec $_[0]: $!"; # NOTREACHED } return $output; } # Hex to bigint conversion routine. # bhex(HEXSTRING) returns BIGINT (with leading + chopped off). # # In most languages, unlimited size integers are done using string math # libraries usually called bigint. (Java, Perl, etc.) # # Bigint's are really just strings. sub bhex { my $hexValue = shift; $hexValue =~ s/^0x//; my $integerValue = Math::BigInt->new('0'); for (my $i = 0; $i < length($hexValue); $i += 2) { # Could be more efficient going at larger increments, but byte # by byte is safer for the case of 9 byte values, 11 bytes, etc. my $byte = substr($hexValue, $i, 2); my $byteIntValue = hex($byte); # bmuladd() is only in Perl >= 5.10.0. $integerValue->bmul('256'); $integerValue->badd("$byteIntValue"); } my $result = $integerValue->bstr(); $result =~ s/^\+//; return $result; }