frontends/cnfsheadconf.in

   1 #! /usr/bin/perl
   2 # fixscript will replace this line with require innshellvars.pl
   3
   4 #  $Id: cnfsheadconf.in 6727 2004-05-16 21:21:14Z rra $
   5 #
   6 #  Copyright Andreas Lamrecht 1998
   7 #  <Andreas.Lamprect@siemens.at>
   8 #
   9 #  Modified by Kjetil T. Homme 1998
  10 #  <kjetilho@ifi.uio.no>
  11 #
  12 #  Modified by Robert R. Collier 1998
  13 #  <rob@lspace.org>
  14 #
  15 #  bigint support added by Duane Currie (sandman@hub.org) 1998
  16 #
  17 #  cnfsheadconf is originally from cnfsstat 1999
  18 #  <kondou@nec.co.jp>
  19
  20 use vars qw($opt_h $opt_w);
  21 use Getopt::Long;
  22
  23 # required for >32bit ints
  24 require 'bigint.pl';
  25
  26 my($conffile) = "$inn::pathetc/cycbuff.conf";
  27 my($storageconf) = "$inn::pathetc/storage.conf";
  28
  29 # Hex to bigint conversion routine
  30 # bhex(HEXSTRING) returns BIGINT  (with leading + chopped off)
  31 #
  32 # In most langauge, unlimited size integers are done using string math
  33 # libraries usually called bigint.  (Java, Perl, etc...)
  34
  35 # Bigint's are really just strings.
  36
  37 # Mathematics routines for bigint's:
  38
  39 #   bneg(BINT) return BINT              negation
  40 #   babs(BINT) return BINT              absolute value
  41 #   bcmp(BINT,BINT) return CODE         compare numbers (undef,<0,=0,>0)
  42 #   badd(BINT,BINT) return BINT         addition
  43 #   bsub(BINT,BINT) return BINT         subtraction
  44 #   bmul(BINT,BINT) return BINT         multiplication
  45 #   bdiv(BINT,BINT) return (BINT,BINT)  division (quo,rem) just quo if scalar
  46 #   bmod(BINT,BINT) return BINT         modulus
  47 #   bgcd(BINT,BINT) return BINT         greatest common divisor
  48 #   bnorm(BINT) return BINT             normalization
  49
  50 sub bhex {
  51     my $hexValue = shift;
  52     $hexValue =~ s/^0x//;
  53
  54     my $integerValue = '0';
  55     for (my $i = 0; $i < length($hexValue); $i+=2) {
  56         # Could be more efficient going at larger increments, but byte
  57         # by byte is safer for the case of 9 byte values, 11 bytes, etc..
  58
  59         my $byte = substr($hexValue,$i,2);
  60         my $byteIntValue = hex($byte);
  61
  62         $integerValue = bmul($integerValue,'256');
  63         $integerValue = badd($integerValue,"$byteIntValue");
  64         }
  65
  66     $integerValue =~ s/^\+//;
  67     return $integerValue;
  68     }
  69
  70 sub bint2hex {
  71     my $d = shift;
  72     my $o = 0;
  73
  74     while ($d > 0) {
  75         my $h = bmod("$d",'16');
  76         $d = bdiv("$d",'16');
  77         $h =~ s/^\+//;
  78         $h='a' if $h eq '10';
  79         $h='b' if $h eq '11';
  80         $h='c' if $h eq '12';
  81         $h='d' if $h eq '13';
  82         $h='e' if $h eq '14';
  83         $h='f' if $h eq '15';
  84         $h =~ s/^\+//;
  85         $o="$h$o";
  86     }
  87
  88     return "$o";
  89 }
  90
  91 sub usage {
  92     print <<_end_;
  93 Summary tool for cycbuff header manipulation
  94
  95 Usage:
  96         $0 [-c CYCBUFF] [-h] [-w]
  97
  98         If called without args, does a one-time status of all CNFS buffers
  99         -c <cycbuff>:  prints out status of cycbuff
 100         -w:            change header
 101         -h:            This information
 102 _end_
 103     exit(1);
 104 }
 105
 106 my(@line, %class, %metamode, %buff, %stor, $c, @buffers, $cycbuff);
 107
 108 my($gr, $cl, $min, $max, @storsort, $header_printed);
 109
 110 GetOptions("-c=s", \$cycbuff, "-w", "-h");
 111
 112 &usage if $opt_h;
 113
 114 unless (&read_cycbuffconf) {
 115     print STDERR "Cannot open CycBuff Conffile $conffile ...\n";
 116     exit (1);
 117 }
 118
 119 unless (&read_storageconf) {
 120     print STDERR "No valid $storageconf.\n";
 121     exit (1);
 122 }
 123
 124 sub read_cycbuffconf {
 125     return 0 unless open (CONFFILE, $conffile);
 126
 127     while(<CONFFILE>) {
 128         $_ =~ s/^\s*(.*?)\s*$/$1/;
 129         # \x23 below is #.  Emacs perl-mode gets confused by the "comment"
 130         next if($_ =~ /^\s*$/ || $_ =~ /^\x23/);
 131         next if($_ =~ /^cycbuffupdate:/ || $_ =~ /^refreshinterval:/);
 132
 133         if($_ =~ /^metacycbuff:/) {
 134             @line = split(/:/, $_);
 135             if($class{$line[1]}) {
 136                 print STDERR "Class $line[1] more than one time in CycBuff Conffile $conffile ...\n";
 137                 return 0;
 138             }
 139
 140             $class{$line[1]} = $line[2];
 141             if ($line[3] ne "") {
 142                 $metamode{$line[1]} = $line[3];
 143             } else {
 144                 $metamode{$line[1]} = "INTERLEAVE";
 145             }
 146             next;
 147         }
 148
 149         if ($_ =~ /^cycbuff/) {
 150             @line = split(/:/, $_);
 151             if($buff{$line[1]}) {
 152                 print STDERR "Buff $line[1] more than one time in CycBuff Conffile $conffile ...\n";
 153                 return 1;
 154             }
 155             $buff{$line[1]} = $line[2];
 156             next;
 157         }
 158
 159         print STDERR "Unknown config line \"$_\" in CycBuff Conffile $conffile ...\n";
 160     }
 161     close(CONFFILE);
 162     return 1;
 163 }
 164
 165 sub read_storageconf {
 166     my $line = 0;
 167     return 0 unless open (STOR, $storageconf);
 168
 169     while (<STOR>) {
 170         ++$line;
 171         next if /^\s*#/;
 172
 173         # defaults
 174         %key = ("NEWSGROUPS" => "*",
 175                 "SIZE" => "0,0");
 176
 177         if (/method\s+cnfs\s+\{/) {
 178             while (<STOR>) {
 179                 ++$line;
 180                 next if /^\s*#/;
 181                 last if /\}/;
 182                 if (/(\w+):\s+(\S+)/i) {
 183                     $key{uc($1)} = $2;
 184                 }
 185             }
 186             unless (defined $key{'CLASS'} && defined $key{'OPTIONS'}) {
 187                 print STDERR "storage.conf:$line: ".
 188                         "Missing 'class' or 'options'\n";
 189                 return 0;
 190             }
 191
 192             $key{'SIZE'} .= ",0" unless $key{'SIZE'} =~ /,/;
 193             $key{'SIZE'} =~ s/,/:/;
 194
 195             if (defined $stor{$key{'OPTIONS'}}) {
 196                 print STDERR "storage.conf:$line: ".
 197                         "Class $key{'CLASS'} has several criteria\n";
 198             } else {
 199                 $stor{$key{'OPTIONS'}} = "$key{'NEWSGROUPS'}:$key{'CLASS'}:" .
 200                         "$key{'SIZE'}:$key{'OPTIONS'}";
 201                 push(@storsort, $key{'OPTIONS'});
 202             }
 203         }
 204     }
 205     return 1;
 206 }
 207
 208 START:
 209
 210 if (! $buff{$cycbuff} ) {
 211         print STDERR "No buffer definition for buffer $cycbuff ...\n";
 212         exit(1);
 213 }
 214 &print_cycbuff_head($buff{$cycbuff});
 215
 216 sub make_time {
 217     my ($t) = @_;
 218     my (@ret);
 219
 220     my ($sec,$min,$hour,$mday,$mon,$year) =
 221             (localtime($t))[0..5];
 222     push (@ret, sprintf("%04d-%02d-%02d %2d:%02d:%02d",
 223                         $year + 1900, $mon + 1, $mday, $hour, $min, $sec));
 224     $t = time - $t;
 225
 226     $mday = int($t/86400); $t = $t % 86400;
 227     $hour = int($t/3600);  $t = $t % 3600;
 228     $min  = int($t/60);    $t = $t % 60;
 229
 230     push (@ret, sprintf("%4d days, %2d:%02d:%02d",
 231                         $mday, $hour, $min, $t));
 232     return @ret;
 233 }
 234
 235 sub print_cycbuff_head {
 236     my($buffpath) = $_[0];
 237     my($CNFSMASIZ)=8;
 238     my($CNFSNASIZ)=16;
 239     my($CNFSPASIZ)=64;
 240     my($CNFSLASIZ)=16;
 241     my($headerlength) = 2 * $CNFSMASIZ + 2 * $CNFSNASIZ + $CNFSPASIZ + (5 * $CNFSLASIZ);
 242     my($buff, @entries, $e);
 243     my($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname, $orderinmeta, $currentbuff);
 244
 245     if ($opt_w) {
 246         if(! open(BUFF, "+< $buffpath") ) {
 247             print STDERR "Cannot open Cycbuff $buffpath ...\n";
 248             exit(1);
 249         }
 250     } else {
 251         if(! open(BUFF, "< $buffpath") ) {
 252             print STDERR "Cannot open Cycbuff $buffpath ...\n";
 253             exit(1);
 254         }
 255     }
 256
 257     $buff = "";
 258     if(! read(BUFF, $buff, $headerlength) ) {
 259         print STDERR "Cannot read $headerlength bytes from file $buffpath...\n";
 260         exit(1);
 261     }
 262
 263     ($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname, $orderinmeta, $currentbuff)  = unpack("a8 a16 a64 a16 a16 a16 a16 a16 a16 a8", $buff);
 264
 265     if(!$magic) {
 266         print STDERR "Error while unpacking header ...\n";
 267         exit(1);
 268     }
 269
 270     my($len) = bhex($lena);
 271     my($free) = bhex($freea);
 272     my($update) = hex($updatea);
 273     my($cyclenum) = hex($cyclenuma) - 1;
 274
 275     my ($nupdate_str, $nago_str) = &make_time ($update);
 276
 277     $name =~ s/\0//g;
 278     print " Buffer $name, len: ";
 279     printf("%.2f", $len / (1024 * 1024));
 280     print " Mbytes, used: ";
 281     printf("%.2f Mbytes", $free / (1024 * 1024));
 282     printf(" (%4.1f%%) %3d cycles\n", 100 * $free/$len, $cyclenum);
 283     print(" Meta $metaname, order: ");
 284     printf("%d", $orderinmeta);
 285     print(", current: $currentbuff");
 286
 287     print "\n Newest: $nupdate_str, $nago_str ago\n";
 288
 289     if ($opt_w) {
 290         print "\nBuffer [$name] => ";
 291         $in = <>;
 292         chop $in;
 293         if ($in ne "") {
 294             $name = sprintf("%0.9s\0", $in);
 295         }
 296         print "Path [$path] => ";
 297         $in = <>;
 298         chop $in;
 299         if ($in ne "") {
 300             $path = sprintf("%0.65s\0", $in);
 301         }
 302         print "Length [$len ($lena)] => ";
 303         $in = <>;
 304         chop $in;
 305         if ($in ne "") {
 306             $in = bint2hex($in);
 307             $lena = sprintf("%017.17s\0", $in);
 308         }
 309         print "Free [$free ($freea)] => ";
 310         $in = <>;
 311         chop $in;
 312         if ($in ne "") {
 313             $in = bint2hex($in);
 314             $freea = sprintf("%017.17s\0", $in);
 315         }
 316         print "Meta [$metaname] => ";
 317         $in = <>;
 318         chop $in;
 319         if ($in ne "") {
 320             $metaname = sprintf("%0.17s\0", $in);
 321         }
 322         print "Order [$orderinmeta] => ";
 323         $in = <>;
 324         chop $in;
 325         if ($in ne "") {
 326             $orderinmeta = sprintf("%016d\0", $in);
 327         }
 328         print "Currentbuff [$currentbuff] => ";
 329         $in = <>;
 330         chop $in;
 331         if ($in eq "TRUE" || $in eq "FALSE") {
 332             $currentbuff = sprintf("%0.8s", $in);
 333         }
 334         $buff = pack("a8 a16 a64 a16 a16 a16 a16 a16 a16 a8", $magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname, $orderinmeta, $currentbuff);
 335         seek(BUFF, 0, 0);
 336             if(! syswrite(BUFF, $buff, $headerlength) ) {
 337             print STDERR "Cannot write $headerlength bytes to file $buffpath...\n";
 338             exit(1);
 339         }
 340     }
 341     close(BUFF);
 342 }