#!/usr/athena/bin/perl -w
# $Header: /afs/.sipb.mit.edu/machine/charon3/src/RCS/autoexpunge.pl,v 1.2 2004/09/08 22:07:26 jweiss Exp $
#
# For a given list of discuss meetings, delete all transactions more
# than one month old, and expunge the meeting.
#
# Garry Zacheiss, March 2004.
# Inspired by Mark Eichin's dscpurge.perl.
# getOutput()/sendCmd() borrowed liberally from Ted McCabe's tapes.pl.
#
# Stolen from /mit/ops/services/discuss/varops/bin/autoexpunge.pl rev 1.4

use IPC::Open2;
use Symbol;

$ENV{'PATH'} = "/var/ops/bin:/bin/athena:/usr/athena/bin:/usr/bin:/usr/sbin";

my ($mon, $mday, $year, $maxdate);
my ($tnum, $aflag, $lines, $date, $time);

$configfile = "/usr/local/etc/autoexpunge-meetings";
$logfile = "/var/adm/autoexpunge.log";
$discuss = "/usr/athena/bin/discuss";
$expunge = "/usr/local/bin/expunge.discuss";

chomp($hostname = `hostname`);

open(LOG, ">>$logfile");
select((select(LOG), $| = 1)[$[]);
$now = localtime;
print LOG "autoexpunge beginning at $now.\n";

if ( ! -f $configfile) {
    print LOG "$configfile does not exist.\n";
    &bombout();
}

# Figure out date we care about; transactions older than this will be deleted.
($mday, $mon, $year) = (localtime)[3..5];
# We want last month, and $mon is zero-indexed, so leave it is as it is 
# unless it's "0", which means it's January and we want it to be December.
# This is gross.
if ($mon eq "0") {
    $mon = 12;
    $year--;
}
$maxdate = sprintf "%d%02d%02d", $year+1900, $mon, $mday;

# Set up discuss client so we can read and write to it.
$rdr = gensym();
$wtr= gensym();
# Throw away stderr because libreadline complains a lot.
$pid = open2($rdr, $wtr, "$discuss 2>/dev/null");
select((select($wtr), $| = 1)[$[]);
if (!$pid) {
    print LOG "Can't run $discuss\n";
    &bombout();
}
select((select($rdr), $| = 1)[$[]);
select((select(STDOUT), $| = 1)[$[]);
if (!$rdr) {
    print LOG "Can't read from $discuss\n";
    &bombout();
}
@out = &getOutput($rdr);

open(CONFIG, "$configfile");
while (<CONFIG>) {
    $_ =~ s/^\s+|\s+$//g;
    push @meetings, $_;
}

foreach $meeting (@meetings) {
    undef @transactions;
    @onacl = `grep \:root\@ATHENA.MIT.EDU /var/spool/discuss/$meeting/acl`;
    if (!@onacl) {
	print LOG "root\@ATHENA.MIT.EDU not on acl for $meeting.  Skipping.\n";
	next;
    }
    # Try to add the meeting, just in case it's not in our meetings list.
    &sendCmd("am $hostname:/var/spool/discuss/$meeting\n");
    @out = &getOutput($rdr);
    &sendCmd("go $meeting\n");
    @out = &getOutput($rdr);
    &sendCmd("ls all\n");
    @out = &getOutput($rdr);
    foreach $line (@out) {

	# skip this line if it's our prompt.
	next if $line =~ /^discuss:/;

	$line =~ 
	  /^.\[(\d+)\](F?)\*?\s*\((\d+)\)\s*(\d\d\/\d\d\/\d\d)\s*(\d\d:\d\d)/;
	$tnum = $1;
	$aflag = $2;
	$lines = $3;
	$date = $4;

	# keep the first couple of transactions, they often have useful info.
	next if $tnum <= 2;

	# mangle date into more tractable format.
	($transmon, $transday, $transyear) = split("/", $date);
	# heuristic for deciding what to transform a 2-digit year into.
	# discuss didn't exist before 1980, so this is a pretty safe bet.
	if ($transyear > 80) {
	    $transyear = $transyear + 1900;
	} else {
	    $transyear = $transyear + 2000;
	}
	$date = sprintf "%d%02d%02d", $transyear, $transmon, $transday;

	next if (defined($maxdate) && $date > $maxdate);
	push @transactions, $tnum;
    }

    # delete everything between the two ends of the array we just built.
    # punt if either end of our range is empty.
    if (!defined($transactions[0]) || !defined($transactions[-1])) {
	print LOG "Nothing to delete for meeting $meeting.\n";
	next;
    }
    $delrange = "$transactions[0],$transactions[-1]";
    print LOG "deleting $meeting $delrange\n";
    &sendCmd("delete $delrange\n");
    @out = &getOutput($rdr);
    # Once we're done deleting messages, expunge the meeting.
    print LOG "$expunge /var/spool/discuss/$meeting\n";
    system("$expunge /var/spool/discuss/$meeting >>$logfile 2>&1");
    $exit_status = $? >> 8;
    if ($exit_status) {
	print LOG 
	    "$expunge for meeting $meeting exited with status $exit_status\n";
    } else {
	print LOG 
	    "$expunge for meeting $meeting completed successfully.\n";
    }
}

$now = localtime;
print LOG "autoexpunge exiting normally at $now.\n";
close(LOG);
exit 0;

sub getOutput {
  local($file) = @_;
  local($rin, $rout, $nf, $c);
  local(@out) = ();
  local($line, $tmp, $blksize);

  $blksize = 8;
  if (defined($file)) {
    $rin = "";
    vec($rin, fileno($file), 1) = 1;
    $nf = select($rout=$rin, undef, undef, undef);
    if ($nf == 0) {
      print "no input\n";
      return undef;
    }
    $line = "";
    $tmp = "";
    while ($tmp ne "discuss:  ") {
      sysread($file, $c, $tmp =~ /^b/ ? 1 : $blksize);
      $tmp .= $c;
      while ($tmp =~ /\n/) {
        ($line, $tmp) = ($tmp =~ /^([^\n]*\n)(.*)$/s);
        push(@out, $line);
      }
      $nf = select($rout=$rin, undef, undef, 3);
      for($cnt=0; $nf == 0 && $tmp ne "discuss:  "; ++$cnt) {
        # Output should end with the prompt, wait a little more...
        print STDERR "prompt lossage, retrying...\n" unless $opt_q;
        if ($cnt%10 == 9 && !$opt_q) {
          print STDERR "$cnt tries so far; last line reads: $tmp\n";
        }
        $nf = select($rout=$rin, undef, undef, 10);
      }
    }
    push(@out, $tmp) if $tmp ne "";
    return @out;
  } else {
    print "no input\n";
    return undef;
  }
}

sub sendCmd {
    print $wtr @_;
}

sub bombout {
    $now = localtime;
    print LOG "autoexpunge exiting due to error at $now.\n";
    exit 1;
}
