chiark / gitweb /
debugging for thing that crashed
[innduct.git] / contrib / thdexpire.in
1 #!/usr/bin/perl -w
2 # fixscript will replace this line with require innshellvars.pl
3 $ID='$Id: thdexpire.in 4572 2001-02-24 22:31:05Z rra $$';
4
5 use POSIX ":fcntl_h";
6 use SDBM_File;
7 use Getopt::Std;
8
9 # With the -M switch this program installs its own man page.
10 #-----------------------------------------------------------------------------
11
12 =head1 NAME
13
14 thdexpire - dynamic expire daemon for timehash and timecaf storage
15
16 =head1 SYNOPSIS
17
18 B<thdexpire>
19 [ B<-t> I<minutes> ]
20 [ B<-f> I<kilobytes> ]
21 [ B<-i> I<inodes> ]
22 [ B<-m> I<mindays> ]
23 [ B<-x> I<minseconds> ]
24 [ B<-N> ]
25 [ B<-v> I<level> ]
26
27 B<thdexpire -r>
28
29 =head1 DESCRIPTION
30
31 This is a daemon, to be started along with B<innd>, which periodically
32 looks if news spool space is getting tight, and frees space by removing
33 articles until enough is free. It is an adjunct (not a replacement) to
34 INNs B<expire> program.
35
36 =head2 Setting Up
37
38 =over 4
39
40 =item 1.
41
42 Configure your storage classes carefully. Let the default go in class
43 100 and choose the storage classes as relative (percent) retention
44 times. E.g. if you want to give C<alt.binaries.*> a fifth of the
45 default time, put them in class 20. Storage classes above 200 are
46 ignored by this program. 0 expires immediately. An example is given
47 in L<"EXAMPLES">.
48
49 =item 2.
50
51 Set up your F<expire.ctl> in a way that it puts only a maximum cap on
52 retention times. Run B<expire> from B<news.daily> as usual. However,
53 it should only expire articles which have an Expires line or are in
54 classes above 200. See L<"EXAMPLES">.
55
56 =item 3.
57
58 Ensure to start this daemon along with B<innd>.
59
60 =item 4.
61
62 To get information and statistics, run B<thdexpire -r> (in parallel to
63 a running daemon). This will show you the current actual retention
64 times.
65
66 =back
67
68 =head2 How It Works
69
70 B<thdexpire> works directly on the spool. It assumes the layout
71 described in the timehash and timecaf sections of L<storage.conf(5)> as of
72 INN-2.x-CURRENT (Dec. 5, 1998). For every storage class associated
73 with timehash/timecaf, B<thdexpire> keeps a I<work time> which is the
74 modification time of the oldest article/CAF file in this class. This
75 time is chosen so that the difference of the work time of class N to
76 now (i.e. the I<retention time> for class N) will be N/100 of the
77 retention time of class 100. The work time of all classes is
78 continuously adjusted as time goes by. Articles and CAF files which
79 are older than the work time are deleted.
80
81 =head1 OPTIONS
82
83 =over 8
84
85 =item B<-t> I<minutes>
86
87 Check for free space every I<minutes> minutes (default 30).
88
89 =item B<-f> I<kilobytes>
90
91 Leave I<kilobytes> kilobytes of free disk space on each spool
92 filesystem (default 50000).
93
94 =item B<-i> I<inodes>
95
96 Leave I<inodes> inodes free on each spool filesystem (default 5000).
97
98 =item B<-m> I<mindays>
99
100 Set the minimum normal holding time for class 100 to I<mindays> days
101 (default 7).
102
103 =item B<-x> I<minseconds>
104
105 Set the absolute minimum holding time for any article to I<minseconds>
106 seconds (default 86400, i.e. 1 day).
107
108 =item B<-N>
109
110 Do not delete any articles, just print what would be done.
111
112 =item B<-v> I<level>
113
114 Set the verbosity level. Values from 1 to 3 are meaningful, where
115 higher levels are mostly for debugging.
116
117 =item B<-r>
118
119 Do not run as a daemon, instead print a report from the database (see
120 L<FILES>) on the available storage classes, current expire times and
121 other stuff.
122
123 =back
124
125 =head1 EXAMPLES
126
127 Here is an example F<storage.conf> file:
128
129  # Large postings in binary groups are expired fast:
130  # 20% retention time
131  method timehash {
132    newsgroups: *.binaries.*,*.binaer.*,*.dateien.*,alt.mag.*
133    size: 30000
134    class: 20
135  }
136
137  # Local groups and *.answers groups don't expire at all with
138  # thdexpire. These are handled by Expires lines and a cutoff
139  # in expire.ctl.
140  method timehash {
141    newsgroups: *.answers,news.announce.*,local.*
142    class: 201
143  }
144
145  # Expires lines are honored if they dont exceed 90 days.
146  # Exempt those postings from thdexpire handling.
147  method timehash {
148    newsgroups: *
149    expires: 1d,90d
150    class: 202
151  }
152
153  # Default: should be class 100 because thdexpire bases its
154  # calculations thereupon.
155  method timecaf {
156    newsgroups: *
157    class: 100
158  }
159
160 And here is an F<expire.ctl> which fits:
161
162  # Our local groups are held 6 months
163  local.*:A:7:180:180
164  # Everything else is handled by thdexpire, or Expires lines
165  *:A:7:never:never
166
167 Note that B<thdexpire> does not actually use these files, they just
168 configure other parts of the news system in an appropriate way.
169
170 =head1 FILES
171
172 =over 4
173
174 =item F<E<lt>inn::pathdbE<gt>/thdexpstat.{dir,pag}>
175
176 Holds state information like classes, expire times, oldest articles.
177 When this file is missing, it will be rebuilt the next time the daemon
178 is started, which basically means scanning the spool directories to
179 find the oldest articles. With the B<-r> option, the contents of this
180 file are printed.
181
182 =item F<E<lt>inn::innddirE<gt>/thdexpire.pid>
183
184 Contains the PID of the running daemon.
185
186 =back
187
188 =head1 SIGNALS
189
190 I<SIGINT> or I<SIGTERM> can be sent to the daemon at any time, causing
191 it to gracefully exit immediately.
192
193 =head1 SEE ALSO
194
195 L<expire(8)>, L<news.daily(8)>, L<storage.conf(5)>
196
197 =head1 NOTES
198
199 This version needs the B<inndf> program supplied with newer releases of INN.
200
201 The filenames for timecaf were wrong in older versions of the INN
202 documentation. This program uses the true filenames, as found by
203 reading the INN source.
204
205 =head1 DIAGNOSTICS
206
207 Any error messages are printed on standard error. Normal progress
208 messages, as specified by the B<-v> option, are printed on standard
209 output.
210
211 =head1 BUGS
212
213 Storage classes which are in I<storage.conf> but not on disk (i.e.
214 which have never been filed into) when the daemon starts are ignored.
215
216 The code is ugly and uses too many global variables.
217 Should probably rewrite it in C.
218
219 =head1 RESTRICTIONS
220
221 Directories which are left empty are not removed.
222
223 The overview database is not affected by B<thdexpire>, it has to be
224 cleaned up by the daily regular B<news.daily> run. This may need a
225 patch to B<expire>.
226
227 =head1 AUTHOR
228
229 Olaf Titz <olaf@bigred.inka.de>. Use and distribution of this work is
230 permitted under the same terms as the B<INN> package.
231
232 =head1 HISTORY
233
234 Inspired by the old B<dexpire> program for the traditional spool.
235
236 June 1998: wrote the first version for timehash.
237
238 November 1998: added code for timecaf, works on multiple spool
239 filesystems, PODed documentation.
240
241 July 1999: bugfixes.
242
243 =cut
244
245 #-----------------------------------------------------------------------------
246
247 chdir $inn::spool || die "chdir $inn::spool: $!";
248 $opt_r=0;      # make a report
249 $opt_t=30;     # check interval in minutes
250 $opt_f=50000;  # required space in kilobytes
251 $opt_i=5000;   # required space in inodes
252 $opt_m=7;      # minimum normal (class 100) time in days
253 $opt_x=86400;  # absolute minimum hold time in seconds
254 $opt_N=0;      # dont actually delete articles
255 $opt_v=0;      # verbosity level
256 $opt_M=0;      # install man page
257 getopts("rt:f:i:m:x:Nv:M");
258
259 $_=$inn::pathdb; $_=$inn::pathnews; # shut up warning
260 $sfile="$inn::pathdb/thdexpstat";
261 $ID=~/ ([^,]+,v [^ ]+)/; $ID=$1;
262
263 if ($opt_M) {
264     print "Installing thdexpire(8) man page\n";
265     $0=~m:^(.*)/([^/]+)$:;
266     chdir $1 || die "chdir $1";
267     exec "pod2man --section=8 --center='Contributed News Software'" .
268       " --release='$ID' $2 >$inn::pathnews/man/man8/thdexpire.8";
269 }
270
271 if ($opt_r) {
272     tie(%S, SDBM_File, $sfile, O_RDONLY, 0664) || die "open $sfile: $!";
273     &report;
274     untie %S;
275     exit 0;
276 }
277
278 (system "shlock", "-p", $$, "-f", "$inn::innddir/thdexpire.pid")>>8==0
279   || die "Already running";
280 tie(%S, SDBM_File, $sfile, O_RDWR|O_CREAT, 0664) || die "open $sfile: $!";
281 $SIG{'TERM'}=$SIG{'INT'}='finish';
282 $|=1;
283 printf "%s starting at %s\n", $ID, &wtime(time) if ($opt_v>0);
284
285 undef @c;
286 $NOW=time; $ac=$cc=0;
287 opendir(CD, ".") || &err("opendir $inn::spool: $!");
288 while ($cd=readdir(CD), defined($cd)) {
289     $cd=~/^time(caf)?-([0-9a-f][0-9a-f])$/i || next;
290     $c{hex($2)}=1 unless hex($2)>200;
291 }
292 closedir CD;
293 @classes=sort {$a<=>$b} keys %c;
294 foreach $c (@classes) {
295     &initclass($c);
296     $S{"work$;$c"}=$S{"oldest$;$c"}&0xFFFFFF00;
297 }
298
299 $S{"classes"}=join(",", @classes);
300 $S{"inittime"}=time;
301 $S{"ID"}=$ID;
302 printf "Checked %d articles, %d CAFs in %d seconds\n", $ac, $cc, time-$NOW
303   if ($ac+$cc>0 && $opt_v>0);
304
305 chdir $inn::spool || die "chdir $inn::spool: $!";
306 while (1) {
307     $S{"lastrun"}=$NOW=time;
308     printf "%s\n", &wtime($NOW) if ($opt_v>0);
309     $nt=0;
310     foreach $c (@classes) {
311         $t=($NOW-$S{"work$;$c"})*100/$c;
312         $nt=$t if ($nt<$t);
313     }
314     printf "Normal time (class 100): %s\n", &xtime($NOW-$nt)
315         if ($opt_v>0);
316     if ($nt<$opt_m*24*60*60) {
317         printf " capped at minimum %d days\n", $opt_m
318           if ($opt_v>0);
319         $nt=$opt_m*24*60*60;
320     }
321     if ($nt>180*24*60*60) {
322         print " capped at maximum 180 days\n"
323           if ($opt_v>0);
324         $nt=180*24*60*60;
325     }
326     $S{"normaltime"}=$nt;
327     $decrement=$opt_t*60;
328     $pass=$need=0;
329     $x="/";
330     undef %needk; undef %needi;
331     foreach $c (@classes) {
332         $Dart{$c}=$Dcaf{$c}=$Dkb{$c}=$Dino{$c}=0;
333         $y=sprintf("time-%02x", $c);
334         if (-d $y) {
335             @S=stat(_);
336             if ($#S>=0) {
337                 $dev{$y}=$S[0];
338                 unless (defined($needk{$S[0]})) {
339                     $x.=" $y";
340                     $needk{$S[0]}=$needi{$S[0]}=-1;
341                 }
342             }
343         }
344         $y=sprintf("timecaf-%02x", $c);
345         if (-d $y) {
346             @S=stat(_);
347             if ($#S>=0) {
348                 $dev{$y}=$S[0];
349                 unless (defined($needk{$S[0]})) {
350                     $x.=" $y";
351                     $needk{$S[0]}=$needi{$S[0]}=-1;
352                 }
353             }
354         }
355     }
356     if (open(D, "inndf $x |")) {
357         while (<D>) {
358             @S=split(/\s+/, $_);
359             $needk{$dev{$S[0]}}=$opt_f-$S[1] unless ($S[0] eq "/");
360         }
361         close D;
362     }
363     if (open(D, "inndf -i $x |")) {
364         while (<D>) {
365             @S=split(/\s+/, $_);
366             $needi{$dev{$S[0]}}=$opt_i-$S[1] unless ($S[0] eq "/");
367         }
368         close D;
369     }
370     foreach $c (keys %needk) {
371         printf "Device %d needs to free %d kilobytes, %d inodes\n",
372                $c, $needk{$c}<0?0:$needk{$c}, $needi{$c}<0?0:$needi{$c}
373             if ($opt_v>0 && ($needk{$c}>0 || $needi{$c}>0));
374         if ($needk{$c}>0 || $needi{$c}>0) {
375             ++$need;
376         }
377     }
378     if ($opt_v>0 && $need<=0) {
379         print "  (nothing to do)\n";
380         $tt=0;
381     } else {
382         $error=0;
383         while (!$error && $need>0) {
384             if ($S{"normaltime"}-$decrement<$opt_m*24*60*60) {
385                 print "  Normal time hit minimum\n" if ($opt_v>0);
386                 last;
387             }
388             $S{"normaltime"}-=$decrement;
389             printf "  normal time (100) becomes %ld\n", $S{"normaltime"}
390             if ($opt_v>2);
391             ++$pass;
392             $Dart=$Dcaf=$Dkb=$Dino=$need=0;
393             foreach $c (keys %needk) {
394                 if ($needk{$c}>0 || $needi{$c}>0) {
395                     ++$need;
396                 }
397             }
398             if ($need) {
399                 foreach $c (@classes) {
400                     &worktime($c, $NOW-($S{"normaltime"}*$c/100));
401                     $Dart+=$dart; $Dcaf+=$dcaf; $Dkb+=$dbb>>10; $Dino+=$dino;
402                     $Dart{$c}+=$dart; $Dcaf{$c}+=$dcaf;
403                     $Dkb{$c}+=$dbb>>10; $Dino{$c}+=$dino;
404                     last if ($error);
405                 }
406             }
407             if ($Dart+$Dcaf) {
408                 printf "  pass %d deleted %d arts, %d CAFs, %d kb\n",
409                        $pass, $Dart, $Dcaf, $Dkb if ($opt_v>1);
410                 $decrement-=$decrement>>2 if ($decrement>10*60);
411             } else {
412                 $decrement+=$decrement>>1 if ($decrement<4*60*60);
413             }
414         }
415         $Dkb=$Dart=$Dcaf=$Dino=0;
416         foreach $c (@classes) {
417             printf "  class %3d: deleted %6d arts %6d CAFs %10d kb\n",
418                    $c, $Dart{$c}, $Dcaf{$c}, $Dkb{$c} if ($opt_v>1);
419             $Dkb+=$Dkb{$c}; $Dart+=$Dart{$c}; $Dcaf+=$Dcaf{$c};
420         }
421         $tt=time-$NOW;
422         printf " deleted %d articles, %d CAFs, %d kb in %d seconds\n",
423                $Dart, $Dcaf, $Dkb, time-$NOW if ($opt_v>0);
424         if ($tt>$opt_t*60) {
425             printf STDERR "Round needed %d seconds, interval is %d\n",
426             $tt, $opt_t*60;
427             $tt=$opt_t*60;
428         }
429     }
430     sleep $opt_t*60-$tt;
431 }
432 &finish(0);
433
434
435 sub initclass
436 {
437     my $C=shift;
438     if (!$S{"blocksize$;$C$;CAF"}) {
439         # Determine filesystem blocksize
440         # unfortunately no way in perl to statfs
441         my $x=sprintf("%s/timecaf-%02x/test%d", $inn::spool, $C, $$);
442         if (open(A, ">$x")) {
443             print A "X" x 4096;
444             close A;
445             @S=stat $x;
446             $#S>=12 || die "stat: $!";
447             if ($S[12]) {
448                 $S{"blocksize$;$C$;CAF"}=$S[7]/$S[12];
449             } else {
450                 $S{"blocksize$;$C$;CAF"}=512;
451                 warn "hack around broken stat blocksize";
452             }
453             unlink $x;
454         }
455     }
456     return if ($S{"oldest$;$C"});
457     my $oldest=time;
458     $S{"oldest$;$C"}=$oldest;
459     my $base=sprintf("%s/time-%02x", $inn::spool, $C);
460     my $count=0;
461     if (chdir $base) {
462         printf "Finding oldest in class %d (%s)\n", $C, $base if ($opt_v>0);
463         opendir(D0, ".");
464         while ($d1=readdir(D0), defined($d1)) {
465             $d1=~/^[0-9a-f][0-9a-f]$/ || next;
466             chdir $d1;
467             opendir(D1, ".") || next;
468             while ($d2=readdir(D1), defined($d2)) {
469                 $d2=~/^[0-9a-f][0-9a-f]$/ || next;
470                 chdir $d2;
471                 opendir(D2, ".") || next;
472                 while ($a=readdir(D2), defined($a)) {
473                     $a=~/^\./ && next;
474                     @S=stat($a);
475                     $oldest=$S[9] if ($S[9]<$oldest);
476                     ++$count;
477                 }
478                 closedir D2;
479                 chdir "..";
480             }
481             closedir D1;
482             chdir "..";
483         }
484         closedir D0;
485         $ac+=$count;
486     }
487     $base=sprintf("%s/timecaf-%02x", $inn::spool, $C);
488     if (chdir $base) {
489         printf "Finding oldest in class %d (%s)\n", $C, $base if ($opt_v>0);
490         opendir(D0, ".");
491         while ($d1=readdir(D0), defined($d1)) {
492             $d1=~/^[0-9a-f][0-9a-f]$/ || next;
493             chdir $d1;
494             opendir(D1, ".") || next;
495             while ($a=readdir(D1), defined($a)) {
496                 $a=~/^\./ && next;
497                 @S=stat($a);
498                 $oldest=$S[9] if ($S[9]<$oldest);
499                 ++$count;
500             }
501             closedir D1;
502             chdir "..";
503         }
504         closedir D0;
505         $cc+=$count;
506     }
507     $S{"count$;$C"}=$count;
508     $S{"oldest$;$C"}=$oldest;
509 }
510
511 sub worktime
512 {
513     my $C=shift;
514     my $goal=shift;
515     $goal&=0xFFFFFF00;
516     printf "  goal for class %d becomes %s\n", $C, &xtime($goal)
517       if ($opt_v>2);
518     if ($goal>$NOW-$opt_x) {
519         printf "  goal for class %d cut off\n", $C
520           if ($opt_v>1);
521         $error=1;
522         return;
523     }
524     $dart=$dcaf=$dbb=$dino=0;
525     $hdir=sprintf("time-%02x", $C);
526     $cdir=sprintf("timecaf-%02x", $C);
527     while (($_=$S{"work$;$C"})<$goal) {
528         printf "  running: %08x\n", $_ if ($opt_v>2);
529         ($aa,$bb,$cc) = (($_>>24)&0xFF, ($_>>16)&0xFF, ($_>>8)&0xFF);
530         $dir=sprintf("%s/%02x/%02x", $hdir, $bb, $cc);
531         $pat=sprintf("[0-9a-f]{4}-%02x[0-9a-f]{2}", $aa);
532         if (opendir(D, $dir)) {
533             while ($_=readdir(D), defined($_)) {
534                 /^$pat$/ || next;
535                 $art="$dir/$_";
536                 @S=stat($art);
537                 if ($#S>=7) {
538                     if ($opt_N) {
539                         print "   would delete $art" if ($opt_v>2);
540                     } else {
541                         print "   deleting $art" if ($opt_v>2);
542                         unlink $art;
543                     }
544                     ++$dart; ++$dino;
545                     printf " %d kb\n", $S[7]>>10 if ($opt_v>2);
546                     $dbb+=$S[7];
547                     $needk{$dev{$hdir}}-=$S[7]>>10;
548                     $needi{$dev{$hdir}}--;
549                 }
550             }
551         } else {
552             printf "  (no dir %s)\n", $dir if ($opt_v>2);
553         }
554         $caf=sprintf("%s/%02x/%02x%02x.CF", $cdir, $bb, $aa, $cc);
555         @S=stat($caf);
556         if ($#S>=12) {
557             if ($opt_N) {
558                 print "   would delete $caf" if ($opt_v>2);
559             } else {
560                 print "   deleting $caf" if ($opt_v>2);
561                 unlink $caf;
562             }
563             $y=0;
564             if (open(C, $caf)) {
565                 # try to find how much there is in the CAF
566                 sysread(C, $_, 16);
567                 @C=unpack("a4LLL", $_);
568                 if ($C[0] eq "CRMT") {
569                     $y=$C[3]-$C[1];
570                     $dart+=$y;
571                 }
572                 close C;
573             }
574             ++$dcaf; ++$dino;
575             if ($S[12]) {
576                 $x=$S[12]*$S{"blocksize$;$C$;CAF"};
577             } else {
578                 $x=$S[7];
579                 warn "hack around broken stat blocksize";
580             }
581             printf " %d arts %d kb\n", $y, $x>>10 if ($opt_v>2);
582             $dbb+=$x;
583             $needk{$dev{$cdir}}-=$x>>10;
584             $needi{$dev{$cdir}}--;
585         }
586         $S{"work$;$C"}+=0x100;
587         $S{"oldest$;$C"}=$S{"work$;$C"} unless ($opt_N);
588     }
589 }
590
591 sub report
592 {
593     $NOW=time;
594     my $cc=$S{"classes"};
595     my $nt=$S{"normaltime"};
596     unless ($cc && $nt) {
597         print "Not initialized.\n";
598         return;
599     }
600     printf "Version: %s (this: %s)\n", $S{"ID"}, $ID;
601     printf "Started at: %s\n", &xtime($S{"inittime"}) if ($S{"inittime"});
602     printf "Last run: %s\n", &xtime($S{"lastrun"}) if ($S{"lastrun"});
603     printf "Classes: %s\n", $cc;
604     foreach $c (split(/,/, $cc)) {
605         printf "Class %d:\n", $c;
606         #printf "  Initial count %d articles\n", $S{"count$;$c"};
607         printf "  Oldest article: %s\n", &xtime($S{"oldest$;$c"});
608         printf "  Expiring at:    %s\n", &xtime($S{"work$;$c"});
609         printf "  Normal time:    %s\n", &xtime($NOW-$nt*$c/100);
610         printf "  Filesystem block size (CAF): %d\n", $S{"blocksize$;$c$;CAF"};
611     }
612 }
613
614 sub wtime
615 {
616     my $t=shift;
617     my @T=localtime($t);
618     sprintf("%04d-%02d-%02d %02d:%02d",
619             $T[5]+1900, $T[4]+1, $T[3], $T[2], $T[1]);
620 }
621
622 sub xtime
623 {
624     my $t=shift;
625     if ($NOW-$t<0 || $NOW-$t>350*24*60*60) {
626         return &wtime($t);
627     }
628     my @T=localtime($t);
629     my @D=gmtime($NOW-$t);
630     sprintf("%04d-%02d-%02d %02d:%02d (%dd %dh %dm)",
631             $T[5]+1900, $T[4]+1, $T[3], $T[2], $T[1],
632             $D[7], $D[2], $D[1]);
633 }
634
635 sub err
636 {
637     printf STDERR "%s\n", shift;
638     &finish(0);
639 }
640
641 sub finish
642 {
643     untie(%S);
644     unlink "$inn::innddir/thdexpire.pid";
645     exit 0;
646 }
647 #-----------------------------------------------------------------------------