#! /local/bin/perl5.003
# (C) Copyright 1997 Rahul Dhesi, All rights reserved.
# Permission for copying and creation of derivative works is granted,
# provided this copyright notice is preserved, to anybody who
# does not discriminate against the copyright owner.

# Rewritten from scratch, but basic algorithm from:
#   history database sanity checker
#   David Barr <barr@math.psu.edu>
#   version 1.1+
# Why I rewrote this program:
# - More error-checking.
# - Automatic throttling of inn, only while makehistory runs.
# - My standard -t (trace) and -x (debug) flags.
# State of this program:
# - It has been briefly tested with perl 5.003 on SunOS 4.1.3_U1
#   machines only.  Check configuration section below before use.
#   Also search for XXX in the code for warnings.

use strict;

# $Source: /local/undoc/RCS/fixhist,v $
# $Id: fixhist,v 1.14 1998/02/07 18:14:47 rdroot Exp $
#
# Repair history file by deleting bad entries.

$::DEBUGGING = 0;

## CONFIGURATION SECTION

$::ctlinnd = '/news/inn/bin/Others/ctlinnd';	# ctlinnd pathname
$::makehistory = '/news/inn/bin/Others/makehistory'; # makehistory pathname

$::hist = '/news/lib/history';			# normal history file
$::newhist = '/news/lib/history.n';		# new (rebuilt) history file
$::LOG = '/news/lib/fixhist.log';		# fixhist log file
#$::LOG = undef;				# if no log needed

# sanity check, rebuilt history must have at least this many lines
$::CHECK_MIN_LINES = 100000;

if ($::DEBUGGING) {
   $::hist = '/tmp/history';			# normal history file
   $::newhist = '/tmp/history.n';		# new (rebuilt) history file
   $::LOG = '/tmp/fixhist.log';			# fixhist log file
   $::CHECK_MIN_LINES = 100;
}

## END CONFIGURATION SECTION

# other constants
$::phrase = 'fixing history';			# to reserve inn
$::myname = "fixhist";
$::RCSHEADER = '$Source: /local/undoc/RCS/fixhist,v $' . "\n" .
	'$Id: fixhist,v 1.14 1998/02/07 18:14:47 rdroot Exp $';

$::usage = "usage: $::myname -y [-vtx] 	(or -h for help)";
if (@ARGV && $ARGV[0] =~ "^-.+" ) {
   require "getopts.pl";
   &Getopts("vtxhnsfy");
}

$::debug = $::opt_x;
$::trace = $::opt_t;
$::verbose = $::debug || $::trace || $::opt_v;
$::nolock = $::opt_n;
$::save_output = $::opt_s;
$::force = $::opt_f;

# suppresss perl warnings
my($junk) = ($::debug && $::trace && $::verbose &&
		$::opt_h && $::opt_v && $::opt_t && $::opt_x &&
		$::opt_y &&
		$::opt_n && $::opt_s && $::opt_f);

if ($::opt_h) {
   &givehelp();
   exit(0);
}

$::opt_y || &usage_error;
## (@ARGV < 1) && &usage_error;

# count of lines in rebuilt history (needed later to rebuild database)
my $lines = 0;

($::nolock || -x $::ctlinnd) || 
   &abort("error: can't find executable $::ctlinnd");
-x $::makehistory || 
   &abort("error: can't find executable $::makehistory");

# don't accidentally overwrite unless -f flag is given
my $file;
for $file ($::newhist, "$::newhist.dir", "$::newhist.pag") {
   if ($::force) {
      &unlink($file);
   } else {
      -e $file && &abort("error: $file already exists");
   }
}

# open history input and log file
open(HIST, $::hist) ||
   &abort("error: can't open $::hist for input: $!");
if ($::trace) {
   $::LOG = '(stdout)';
   open(LOG, ">&STDOUT") || die;
   select LOG; $| = 1; select STDOUT;
} else {
   if ($::LOG) {
      open(LOG, ">$::LOG") || 
	 warn "$::myname: can't open $::LOG for output: $!\n";
      select LOG; $| = 1; select STDOUT;
   }
}

$::time = scalar localtime;
&log("$::myname: start run at $::time");

# reserve inn
if (! $::nolock) {
   if (&system("$::ctlinnd reserve '$::phrase'")) {
      $::reserved = 1;
   } else {
      &abort("error: can't reserve inn");
   }
}

# open history output
if ($::trace) {
   open(NEWHIST, ">/dev/null") || die;
} else {
   open(NEWHIST, ">$::newhist") ||
      &abort("error: can't open $::newhist for output: $!");
}

my $MAXKEYLEN = 254;			# max permitted key length

my ($msgid, $dates, $arts, $xtra);	# fields in a history line

# count of various types of bad history lines
my $count_toomany = 0;
my $count_toofew = 0;
my $count_toobig = 0;
my $count_format = 0;
my $count_controls = 0;


my $first_scan = 1;			# begin with scan 1

MAINLOOP: for ( ; ; ) {
   # This loop is derived from David Barr's code
   while (<HIST>) {
      chomp;
      ($msgid, $dates, $arts, $xtra) = split("\t");
      if (defined($xtra)) {		# too many fields
	 $count_toomany++;
	 &discard($_);
	 next;
      }
      if (! defined($msgid)) {		# too few fields
	 $count_toofew++;
	 &discard($_);
	 next;
      }
      if (length($msgid) > $MAXKEYLEN) {# too big for dbz key
	 $count_toobig++;
	 &discard($_);
	 next;
      }
      if ($msgid !~ /^<[^< ]*>/) {	# badly formed message-id
	 $count_format++;
	 &discard($_);
	 next;
      }
      # any control characters except tab
      if (/[\000-\010\012-\037\177-\377]/) {
	 $count_controls++;
	 &discard($_);
	 next;
      }

      # reach here if history line appears to be valid
      (print NEWHIST "$_\n") || do {
	 # abort loop on output error, usually filesystem full
	 $::error = 1;
	 $::output_error = 1;
	 last MAINLOOP;
      };
      $lines++;
   }

   if ($first_scan) {
      # reach here on EOF; now we will throttle innd and redo the scan
      # XXX
      # NOTE: On some systems, once EOF is seen on input, it won't be
      # automatically cleared even if the input file has grown.  This
      # should be considered a bug in such systems.  On such systems we
      # will miss any new lines that were appended to the history file
      # after we read the last one and before we completed throttling
      # inn.

      if (! $::nolock) {
	 if (&system("$::ctlinnd throttle '$::phrase'")) {
	    $::throttled = 1;
	 } else {
	    $::error = 1;
	    $::throttle_error = 1;
	 }
      }
      $first_scan = 0;		# next scan will be second scan
   } else {
      # second time that we hit EOF, just exit loop normally
      last;
   }
}

close(NEWHIST) || do {
   # error, usually filesystem full
   $::error = 1;
   $::output_error = 1;
};

# look for any error
if ($::error) {
   if ($::throttle_error) {
      warn "$::myname: can't throttle inn, aborting\n";
   }
   if ($::output_error) {
      warn "$::myname: error during output, aborting\n";
   }
   if ($::save_output) {
      warn "$::myname: new history output saved in $::newhist\n";
   } else {
      warn "$::myname: no output saved\n";
      unlink $::newhist;
   }
   $::throttle_error && &abort("$::myname: can't throttle inn, aborting");
   $::output_error && &abort("$::myname: error during output, aborting");
}

# reach here if new history file has been generated.  now do makehistory etc.

# log some statistics
my($stats, $var, $name);
for $name ('toomany', 'toofew', 'toobig', 'format', 'controls') {
   eval "\$var = \$count_$name";
   ($var > 0) && &log("$name = $var");
}

# sanity check -- if too few lines, maybe a serious bug??
if ($lines < $::CHECK_MIN_LINES) {
   &abort("$::myname: error: only $lines lines in new history, aborting, $::newhist intact");
}

&system("$::makehistory -r -s $lines -f $::newhist") || do {
   &unlink("$::newhist.dir", "$::newhist.pag");
   &abort("$::myname: error: makehistory failed, output saved in $::newhist");
};
&rename($::newhist, $::hist) ||
   &abort("SERIOUS ERROR: CAN'T RENAME $::newhist to $::hist: $!");
&rename("$::newhist.dir", "$::hist.dir") ||
   &abort("SERIOUS ERROR: CAN'T RENAME $::newhist.dir to $::hist.dir: $!");
&rename("$::newhist.pag", "$::hist.pag") ||
   &abort("SERIOUS ERROR: CAN'T RENAME $::newhist.pag to $::hist.pag: $!");
if ($::throttled) {
   &system("ctlinnd go '$::phrase'") ||
      &abort("error: can't unthrottle inn");
}

$::time = scalar localtime;
&log("$::myname: end run at $::time");
exit(0);

# send input to log
sub log {
   $::LOG && print LOG ">> @_\n";
}

# discard a line by logging it
sub discard {
   &log('discard: ', @_);
}

sub usage_error {
   my($msg) = @_;
   if ($msg) {
      die "$msg\n";
   } else {
      die "$::usage\n";
   }
}

sub givehelp {
   ## require 'local/page.pl';
   ## &page(<<EOF);
   print <<EOF;
$::usage

Repairs history file $::hist by deleting bad entries.

   -n		Don't throttle innd
   -s		In case of error, save temp output in $::newhist
   -f		Force rebuild even if $::newhist already exists
   -v		Be verbose
   -t		Trace only -- show what would be done but don't do it
   -x		Enable debugging -- for program maintainers

$::RCSHEADER
EOF
}


# do system() honoring verbose and trace flags
sub system {
   my($cmd) = @_;
   $::verbose && print "> $cmd\n";
   $::trace && return 1;
   return system($cmd) == 0;
}

# clean abort.  if reserved, unreserve; if throttled, unthrottle.
# print any message. make log entry.
sub abort {
   print STDERR @_, "\n";
   &log("$::myname: @_");
   my $time = scalar localtime;
   &log("$::myname: end run at $time");
   if ($::throttled) {
      &system("$::ctlinnd go '$::phrase'");
   } elsif ($::reserved) {
      &system("$::ctlinnd reserve ''");
   }
   exit(1);
}

sub unlink {
   $::verbose && print "unlink @_\n";
   $::trace && return 1;
   return unlink @_;
}

sub rename {
   my($from, $to) = @_;
   $::verbose && print "rename $from $to\n";
   $::trace && return 1;
   return rename($from, $to);
}