chiark / gitweb /
break out allow_connect_start
[inn-innduct.git] / 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 }