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