inn2 2.5.2+20110413-1build1 / usr / lib / news / bin / cnfsheadconf

#! /usr/bin/perl -w
use lib '/usr/share/perl5'; use INN::Config;

#  $Id: cnfsheadconf.in 9056 2010-05-08 11:10:47Z iulius $
#
#  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
#
#  cnfsheadconf is originally from cnfsstat 1999
#  <kondou@nec.co.jp>

use vars qw($opt_h $opt_w);
use Getopt::Long;

# Required for >32bit integers.
use Math::BigInt;
use Math::BigFloat;

my($conffile) = "$INN::Config::pathetc/cycbuff.conf";
my($storageconf) = "$INN::Config::pathetc/storage.conf";

# 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;
}

sub bint2hex {
    my $d = shift;
    my $o = "0";

    my $integerValue = Math::BigInt->new("$d");
    while ($integerValue->is_pos() and not $integerValue->is_zero()) {
        my $h = $integerValue->copy()->bmod('16')->bstr();
        $integerValue->bdiv('16');
        $h =~ s/^\+//;
        $h='a' if $h eq '10';
        $h='b' if $h eq '11';
        $h='c' if $h eq '12';
        $h='d' if $h eq '13';
        $h='e' if $h eq '14';
        $h='f' if $h eq '15';
        $o="$h$o";
    }

    # The result ends with a "0".
    return "$o";
}

sub usage {
    print <<_end_;
Summary tool for cycbuff header manipulation

Usage:
        $0 [-c CYCBUFF] [-h] [-w]

        If called without args, does a one-time status of all CNFS buffers.
        -c <cycbuff>:  print out status of cycbuff
        -h:            this information
        -w:            change header
_end_
    exit(1);
}

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

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

GetOptions("-c=s", \$cycbuff, "-w", "-h");

&usage if $opt_h;

unless (&read_cycbuffconf) {
    print STDERR "Cannot open CycBuff Conffile $conffile ...\n";
    exit (1);
}

unless (&read_storageconf) {
    print STDERR "No valid $storageconf.\n";
    exit (1);
}

sub read_cycbuffconf {
    return 0 unless open (CONFFILE, $conffile);

    while(<CONFFILE>) {
        $_ =~ s/^\s*(.*?)\s*$/$1/;

        # Read continuation lines.
        while(/\\$/) {
            chop;
            chop($next = <CONFFILE>);
            $next =~ s/^\s*(.*?)\s*$/$1/;
            $_ .= $next;
        }

	# \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];
	    if (scalar @line > 3 && $line[3] ne "") {
		$metamode{$line[1]} = $line[3];
	    } else {
		$metamode{$line[1]} = "INTERLEAVE";
	    }
	    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'}}) {
		print STDERR "storage.conf:$line: ".
			"Class $key{'CLASS'} has several criteria\n";
	    } else {
		$stor{$key{'OPTIONS'}} = "$key{'NEWSGROUPS'}:$key{'CLASS'}:" .
			"$key{'SIZE'}:$key{'OPTIONS'}";
		push(@storsort, $key{'OPTIONS'});
	    }
	}
    }
    return 1;
}

START:

# If no cycbuff is specified, we check all of them and exit.
if (not defined $cycbuff) {
    foreach (sort keys %buff) {
      &print_cycbuff_head($buff{$_});
    }
    exit(0);
}

if (not defined $buff{$cycbuff}) {
    print STDERR "No buffer definition for buffer $cycbuff...\n";
    exit(1);
}

&print_cycbuff_head($buff{$cycbuff});

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 print_cycbuff_head {
    my($buffpath) = $_[0];
    my($CNFSMASIZ)=8;
    my($CNFSNASIZ)=16;
    my($CNFSPASIZ)=64;
    my($CNFSLASIZ)=16;
    my($headerlength) = 2 * $CNFSMASIZ + 2 * $CNFSNASIZ + $CNFSPASIZ + (6 * $CNFSLASIZ);
    my($buff, @entries, $e);
    my($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname, $orderinmetaa, $currentbuff, $blksza);

    if ($opt_w) {
	if(! open(BUFF, "+< $buffpath") ) {
	    print STDERR "Cannot open Cycbuff $buffpath ...\n";
	    exit(1);
	}
    } else {
	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, $metaname, $orderinmetaa, $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($orderinmeta) = hex($orderinmetaa);
    my($blksz) = ($magic =~ m/^CBuf4/) ? hex($blksza) : 512;

    my ($nupdate_str, $nago_str) = &make_time ($update);

    $name =~ s/\0//g;
    print " Buffer $name, len: ";
    printf("%.2f", Math::BigFloat->new($len) / (1024 * 1024));
    print " Mbytes, used: ";
    printf("%.2f Mbytes", Math::BigFloat->new($free) / (1024 * 1024));
    printf(" (%4.1f%%) %3d cycles\n",
           100 * Math::BigFloat->new($free) / Math::BigFloat->new($len),
           $cyclenum);
    print("  Meta $metaname, order: ");
    printf("%d", $orderinmeta);
    print(", current: $currentbuff");
    print(", blocksize: $blksz");

    print "\n  Newest: $nupdate_str, $nago_str ago\n";

    if ($opt_w) {
	print "\nBuffer [$name] => ";
	$in = <>;
	chop $in;
	if ($in ne "") {
	    $name = sprintf("%0.9s\0", $in);
	}
	print "Path [$path] => ";
	$in = <>;
	chop $in;
	if ($in ne "") {
	    $path = sprintf("%0.65s\0", $in);
	}
        print "Length [$len ($lena)] => ";
        $in = <>;
        chop $in;
        if ($in ne "") {
            $in = bint2hex($in);
            $lena = sprintf("%017.17s\0", $in);
        }
	print "Free [$free ($freea)] => ";
	$in = <>;
	chop $in;
	if ($in ne "") {
            $in = bint2hex($in);
	    $freea = sprintf("%017.17s\0", $in);
	}
	print "Meta [$metaname] => ";
	$in = <>;
	chop $in;
	if ($in ne "") {
	    $metaname = sprintf("%0.17s\0", $in);
	}
        print "Order [$orderinmeta ($orderinmetaa)] => ";
        $in = <>;
        chop $in;
        if ($in ne "") {
            $in = bint2hex($in);
            $orderinmetaa = sprintf("%017.17s\0", $in);
        }
	print "Currentbuff [$currentbuff] => ";
	$in = <>;
	chop $in;
	if ($in eq "TRUE" || $in eq "FALSE") {
	    $currentbuff = sprintf("%0.8s", $in);
	}
        $buff = pack("a8 a16 a64 a16 a16 a16 a16 a16 a16 a8", $magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname, $orderinmetaa, $currentbuff);
        $buff .= pack("a16", $blksza) if ($magic =~ m/^CBuf4/);
	seek(BUFF, 0, 0);
	    if(! syswrite(BUFF, $buff, $headerlength) ) {
	    print STDERR "Cannot write $headerlength bytes to file $buffpath...\n";
	    exit(1);
	}
    }
    close(BUFF);
}