#!/usr/bin/perl
#  $Id: cnfsstat.in,v 1.3.2.7 1999/08/25 07:50:40 rra Exp $
# 
#  Copyright Andreas Lamrecht 1998
#  <Andreas.Lamprect@siemens.at>
#
#  Modified by Kjetil T. Homme 1998
#  <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;

# Set common paths (actually just $pathetc ...)
require '/usr/lib/news/lib/innshellvars.pl';

# required for >32bit ints
require 'bigint.pl';

my($conffile) = "$inn::pathetc/cycbuff.conf";
my($storagectl) = "$inn::pathetc/storage.ctl";
my($storageconf) = "$inn::pathetc/storage.conf";

# Hex to bigint conversion routine
# bhex(HEXSTRING) returns BIGINT  (with leading + chopped off)
#
# In most langauge, unlimited size integers are done using string math
# libraries usually called bigint.  (Java, Perl, etc...)

# Bigint's are really just strings.

# Mathematics routines for bigint's:

#   bneg(BINT) return BINT              negation
#   babs(BINT) return BINT              absolute value
#   bcmp(BINT,BINT) return CODE         compare numbers (undef,<0,=0,>0)
#   badd(BINT,BINT) return BINT         addition
#   bsub(BINT,BINT) return BINT         subtraction
#   bmul(BINT,BINT) return BINT         multiplication
#   bdiv(BINT,BINT) return (BINT,BINT)  division (quo,rem) just quo if scalar
#   bmod(BINT,BINT) return BINT         modulus
#   bgcd(BINT,BINT) return BINT         greatest common divisor
#   bnorm(BINT) return BINT             normalization

sub bhex {
    my $hexValue = shift;
    $hexValue =~ s/^0x//;
    
    my $integerValue = '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 = bmul($integerValue,'256');        
        $integerValue = badd($integerValue,"$byteIntValue");
        }

    $integerValue =~ s/^\+//;
    return $integerValue;
    }

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 
_end_
    exit(1);
}

my(@line, %class, %buff, %stor, $c, @buffers);

my($gr, $cl, $min, $max, @storsort, $oclass, $header_printed);

GetOptions("-a", "-c=s", \$oclass, "-h", "-l:i", "-s", "-m=s", \$obuffer, "-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) {
	openlog ('cnfsstat', 'pid', 'news');
    } else {
	print STDERR "Syslog is not available.  -s option is ignored.\n";
    }
}

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 || &read_storagectl) {
    print STDERR "No valid $storageconf or $storagectl.\n";
    exit (1);
}

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_storagectl {
    return 0 unless open (STOR, $storagectl);

    while (<STOR>) {
	$_ =~ s/^\s*(.*?)\s*$/$1/;
	next if $_ =~ /^\s*$/ || $_ =~ /^#/;

	if ($_ =~ /^cnfs:/) {
	    @line = split(/:/, $_);
	    if($#line != 5) {
		print STDERR "Wrong Storage Control Line \"$_\" in $storagectl ...\n";
		return 0;
	    }
	    
	    if($stor{$line[5]}) {
		print STDERR "CNFS Storage Line \"$_\" more than one time in $storagectl ...\n";
		return 0;
	    }
	    $stor{$line[5]} = join(":", @line[1 .. 4]);
	    push(@storsort, $line[5]);
	}
    }
    close(STOR);
    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;
}

&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 print_cycbuff_head {
    my($buffpath) = $_[0];
    my($name,$len,$free,$update,$cyclenum,$nupdate_str,$nago_str,$oupdate_str,$oago_str) = &get_cycbuff_info($buffpath);
    
    if ($use_syslog) {
	($name) = split(/\b/, $name);
	$name =~ s/\0//g;
	syslog ('notice', '%s Buffer %s, len: %d  Mbytes, used: %.2f Mbytes (%4.1f%%) %3d cycles', $logline, $name, $len / (1024 * 1024), $free / (1024 * 1024), 100 * $free/$len, $cyclenum);
	return 0;
    } else {
        $name =~ s/\0//g;
	print " Buffer $name, len: ";
	printf("%.2f", $len / (1024 * 1024));
	print " Mbytes, used: ";
	printf("%.2f Mbytes", $free / (1024 * 1024));
	printf(" (%4.1f%%) %3d cycles", 100 * $free/$len, $cyclenum);
    }
    
    print "\n  Newest: $nupdate_str, $nago_str ago\n";
    
    if ($opt_a) {
	print "  Oldest: $oupdate_str, $oago_str ago\n";
    }
}

sub lookup_age {
    my ($msgid) = @_;

    # This isn't really sufficient; we should use a safe fork.
    $msgid =~ s/\\/\\\\/;
    $msgid =~ s/\'/\'\\\'\'/;

    my $history = `grephistory -l '$msgid' 2>&1`;
    if ($history =~ /\t(\d+)~/) {
	return $1;
    }
    print "  (Missing $msgid)\n";
    return 0;
}

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 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 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) {
	
	# The 16384 is a fuzz factor.  New articles are actually
	# written a little past free.
	
	$offset = 0;
  do_seek:
	while (1) {
	    $offset += 16384;
	    seek (BUFF, $cyclenum ? $free + $offset : 0, 0);

	    $num_tries = 0;
	    while (<BUFF>) {
		next unless /^message-id:\s+(<.*>)/i;
		$num_tries++;
		
		# We give up if the article is missing in history, or else
		# we stand a high risk of checking the whole cycbuff...
		
		$time = &lookup_age ($1);
 		if (!$time) {
		    if ($num_tries > 10) {
			$oupdate_str = "beats me";
			$oago_str = "who knows how long";
			last do_seek; # give up
		    } else {
			next;	# try again
		    }
		}

		# Is the article newer than the last update?
		if ($time >= $update) {
		    $update = $time;
		    next do_seek;
		}
	  
		($oupdate_str, $oago_str) = &make_time ($time);
		last do_seek;
	    }
	}
    }
    
    my ($nupdate_str, $nago_str) = &make_time ($update);

    close(BUFF);
    return($name,$len,$free,$update,$cyclenum,$nupdate_str,$nago_str,$oupdate_str,$oago_str);
}

