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