+++ /dev/null
-#! /usr/bin/perl
-# fixscript will replace this line with require innshellvars.pl
-
-# $Id: cnfsstat.in 7060 2004-12-19 21:36:38Z rra $
-#
-# Copyright Andreas Lamrecht 1998
-# <Andreas.Lamprect@siemens.at>
-#
-# Modified by Kjetil T. Homme 1998, 2000
-# <kjetilho@ifi.uio.no>
-#
-# Modified by Robert R. Collier 1998
-# <rob@lspace.org>
-#
-# bigint support added by Duane Currie (sandman@hub.org) 1998
-
-use vars qw($opt_l $opt_h $opt_a $opt_s);
-use Getopt::Long;
-use Math::BigInt;
-use Math::BigFloat;
-use English;
-
-my($conffile) = "$inn::pathetc/cycbuff.conf";
-my($storageconf) = "$inn::pathetc/storage.conf";
-
-sub usage {
- print <<_end_;
-Summary tool for CNFS
-
-Usage:
- $0 [-c CLASS] [-l [seconds]]
-
- 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>: prints out status of CNFS buffers in class CLASS
- -l seconds: loops like vmstat, default seconds = 600
- -s: logs through syslog
- -h: This information
- -m <BUFFER>: prints out information suitable for mrtg
- -p: prints out an mrtg config file
- -P: write PID into $inn::pathrun/cnfsstat.pid
-_end_
- exit(1);
-}
-
-my(@line, %class, %buff, %stor, $c, @buffers);
-
-my($gr, $cl, $min, $max, @storsort, $oclass, $header_printed);
-
-Getopt::Long::config('no_ignore_case');
-GetOptions("-a", "-c=s", \$oclass, "-h", "-l:i", "-s", "-m=s", \$obuffer,
- "-p", "-P");
-
-&usage if $opt_h;
-
-if ($opt_s) {
- $use_syslog = 0;
- ## Comment out this eval line if you don't want to try to syslog
- eval { require Sys::Syslog; import Sys::Syslog; $use_syslog = 1 };
- if ($use_syslog) {
- if (defined &Sys::Syslog::setlogsock && $] >= 5.00403) {
- # we really need a common module to work all this junk out
- if ($OSNAME eq "dec_osf") {
- sub Sys::Syslog::_PATH_LOG { "/dev/log" }
- }
- Sys::Syslog::setlogsock('unix')
- if $OSNAME =~ /linux|freebsd|dec_osf|darwin/;
- }
- openlog ('cnfsstat', 'pid', $inn::syslog_facility);
- } else {
- print STDERR "Syslog is not available. -s option is ignored.\n";
- }
-}
-
-if ($opt_P) {
- open(FILE, ">$inn::pathrun/cnfsstat.pid") && do {
- print FILE "$$\n";
- close FILE;
- };
-}
-
-my($sleeptime) = (defined($opt_l) && $opt_l > 0) ? $opt_l : 600;
-
-unless (&read_cycbuffconf) {
- print STDERR "Cannot open CycBuff Conffile $conffile ...\n";
- exit (1);
-}
-
-unless (&read_storageconf) {
- print STDERR "No valid $storageconf.\n";
- exit (1);
-}
-
-
-&mrtg($obuffer) if $obuffer;
-&mrtg_config if $opt_p;
-
-#foreach $c (keys(%class)) {
-# print "Class: $c, definition: $class{$c}\n";
-#}
-#foreach $c (keys(%buff)) {
-# print "Buff: $c, definition: $buff{$c}\n";
-#}
-# exit(0);
-
-START:
-
-undef($logline);
-if ($oclass) {
- if ($class{$oclass}) {
- if (!$header_printed) {
- ($gr, $cl, $min, $max) = split(/:/, $stor{$oclass});
- 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 $main::ARGV[0] ...\n";
- next;
- }
-
- foreach $b (@buffers) {
- if (! $buff{$b} ) {
- print STDERR "No buffer definition for buffer $b ...\n";
- next;
- }
- &print_cycbuff_head($buff{$b});
- }
- } else {
- print STDERR "Class $ARGV[1] not found ...\n";
- }
-} else { # Print all Classes
-
- foreach $c (@storsort) {
- ($gr, $cl, $min, $max) = split(/:/, $stor{$c});
- 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 $b (@buffers) {
- if(! $buff{$b} ) {
- print STDERR "No buffer definition for buffer $b ...\n";
- next;
- }
- &print_cycbuff_head($buff{$b});
- }
- if ($use_syslog == 0) {
- print STDOUT "\n";
- }
- }
-}
-
-if(defined($opt_l)) {
- sleep($sleeptime);
- if ($use_syslog == 0) {
- print STDOUT "$sleeptime seconds later:\n";
- }
- goto START;
-}
-
-sub read_cycbuffconf {
- return 0 unless open (CONFFILE, $conffile);
-
- while(<CONFFILE>) {
- $_ =~ s/^\s*(.*?)\s*$/$1/;
- # Here we handle continuation lines
- while (m/\\$/) {
- $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 1;
- }
- $buff{$line[1]} = $line[2];
- next;
- }
-
- print STDERR "Unknown config line \"$_\" in CycBuff Conffile $conffile ...\n";
- }
- close(CONFFILE);
- return 1;
-}
-
-sub read_storageconf {
- my $line = 0;
- return 0 unless open (STOR, $storageconf);
-
- while (<STOR>) {
- ++$line;
- next if /^\s*#/;
-
- # defaults
- %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) = $_[0];
- my ($name, $len, $free, $update, $cyclenum, $oldart) =
- &get_cycbuff_info($buffpath);
-
- if ($use_syslog) {
- ($name) = split(/\s/, $name);
- $name =~ s/\0//g;
- syslog ('notice', '%s Buffer %s, len: %.2f Mbytes, used: %.2f Mbytes (%4.1f%%) %3d cycles',
- $logline, $name, $len / (1024 * 1024),
- Math::BigFloat->new ($free) / (1024 * 1024),
- 100 * Math::BigFloat->new ($free) / $len, $cyclenum);
- 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) / $len);
- my ($when, $ago) = &make_time($update);
- print " Newest: $when, $ago ago\n";
-
- if ($opt_a) {
- my ($when, $ago) = &make_time($oldart);
- print " Oldest: $when, $ago ago\n";
- }
-}
-
-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";
- @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 $class (sort(keys(%class))) {
- print "##\n## Class : $class\n## Wildmat: $stor{$class}\n##\n\n";
- foreach $buffer (split /\,/,$class{$class}) {
- &mrtg_buffer($class,$buffer);
- }
- }
- exit(0);
-}
-
-sub mrtg_buffer {
- my ($class,$buffer) = @_;
- #my ($name, $num, $buff, $size) = @_;
- $tag = 'cnfs-' . $buffer;
-
- print 'Target[', $tag, ']: `', "$inn::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, ']: ', "<H1>Usage of ${buffer}</H1>\n";
- print "<BR><TT>$stor{$class}</TT>\n";
- print "\n";
- 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) = $_[0];
-
- my($CNFSMASIZ)=8;
- my($CNFSNASIZ)=16;
- my($CNFSPASIZ)=64;
- my($CNFSLASIZ)=16;
- my($headerlength) = $CNFSMASIZ + $CNFSNASIZ + $CNFSPASIZ + (4 * $CNFSLASIZ);
-
- my($buff, @entries, $e);
- my($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma);
-
- 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);
- }
-
- ($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma) =
- unpack("a8 a16 a64 a16 a16 a16 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;
-
- if ($opt_a) {
-
- my $pagesize = 16384;
- my $minartoffset = int($len / (512 * 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 {
- 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?
- 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, -512);
-
- } while ($sentinel -= $pagesize > 0);
- }
-
-done:
- close(BUFF);
- return($name,$len,$free,$update,$cyclenum,$oldart);
-}
-
-sub lookup_age {
- my ($msgid) = @_;
-
- my $history = &safe_run("grephistory", "-l", $msgid);
- if ($history =~ /\t(\d+)~/) {
- return $1;
- }
- print " (Missing $msgid)\n";
- return 0;
-}
-
-sub safe_run {
- my $output = "";
-
- my $pid = open(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 = new Math::BigInt '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);
-
- $integerValue = $integerValue * "256";
- $integerValue = $integerValue + "$byteIntValue";
- }
-
- $integerValue =~ s/^\+//;
- return $integerValue;
-}
~ian / inn-innduct.git / blobdiff