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 #-----------------------------------------------------------------------------