#!/usr/athena/bin/perl

require 'ctime.pl'; # a throwback to perl 4

# $Id: requeue,v 1.1 2012/09/30 01:48:21 pjk Exp $

# the canonical root directory for news.answers
$root = '/afs/sipb.mit.edu/project/periodic-postings/news.answers';
# the username of the invoker of the 
$user = $ENV{'USER'};
# the new homedir according to this program will be canonical root
$ENV{'HOME'} = $root;
# append /usr/athena/bin to the $PATH
$ENV{'PATH'} = '/usr/athena/bin:' . $ENV{'PATH'};
# file for logging
$log_file = "$root/lock-log";

# 03/30/98: pgreene: added this because it keeps conflicting with
#           other users (trying to use /tmp/mh-context)
# 11/23/00: pshuang: unnecessarily ties script to rtfm.mit.edu,
#           use context file in user's MH folder instead.

# Set the environment var $MHCONTEXT
$ENV{'MHCONTEXT'} = "$root/Mail/$user/.lock.script.pick.mhcontext";

if ($ENV{'REPORT_ADDRESS'}) {
  # If this account has $REPORT_ADDRESS in their environment, then set 
  # the $report_address variable to it.
  $report_address = $ENV{'REPORT_ADDRESS'};
}
else {
  # Otherwise, set it to a catch-all email address
  $report_address = 'faqs@mit.edu';
}

# Set initial values, default to a lock state (since the point of this
# script is to requeue, requiring unlocking of messages)
$mode = "Lock";
$action = "Locked";
$mail_action = "locked";
$infolder = 'inbox';
$outfolder = $user;

if ($0 =~ /\bunlock\b/) {
    # this script can be symlinked to "unlock", a practice which is 
    # strongly discouraged. Invoke this script as "requeue".
    # In other words, there should be no "unlock" symlinked to this
    # script, and as a consequence, this "if" clause should never
    # execute.
    $mode = "Unlock";
    $action = "Unlocked";
    $mail_action = "unlocked";
    $infolder = $user;
    $outfolder = undef;
}
elsif ($0 =~ /\brequeue\b/) {
    # This should normally happen.
    $mode = "Requeue";
    $action = "Requeued";
    $mail_action = "requeued";
    $infolder = $user;
    $outfolder = 'inbox';
}


if (! $user) { # Exit in unusual cases where $user is not set
    die "USER environment variable must be set.\n";
}

# run the folder command on the user's inbox
system 'folder', "+$infolder";

# Open a pipe, send output to this running program
$childpid = open(PICK, "-|");

if (! defined($childpid)) { # maybe pick isn't installed?
    die "Aborting because fork for pick failed: $!.\n";
}
elsif ($childpid) { # parent process sees the childpid
    while (<PICK>) {     # while pick is still passing lines of output to us
	chop;            # cut out the last char (usually a <CR>)
	push(@msgs, $_); # add this new line in the array @msgs
	$msgs{$_}++;     # go to the next hash
    }
    # terminate the process or abort
    close(PICK) || die "Aborting because close(PICK) failed: $!.\n";
}
else { # if you can't see $childpid, you must be the child process
    # run pick on the messages
    exec 'pick', @ARGV;
    exit 1;
}

if (@msgs == 0) { # nothing to do
    die "No matching messages.\n";
}

for (@msgs) { # process each line
    s/\n//;   # get rid of <CR>
    $msgs{$_}++;
}

# pipe the output of scan on @msgs here
open(SCAN, "scan @msgs|") || die "Aborting because scan failed: $!.\n";

while (<SCAN>) { # traverse each scan line
    # Parse the scan line -- I think this is for separating "From:"
    # from "Subject:".
    # When output is presented it is in the form of msgnum, date, from,
    # and subject.
    s/^(\s*[0-9]+)\+/$1 /;
    if (/^\s*([0-9]+)\s+([^\s].*)/) {
	$scan{$1} = $2;
    }
    else {
	die "Aborting because couldn\'t parse scan line: $_.\n";
    }
    print; # print a newline
}

if (@msgs == 1) {
    # If there is one message, process it then exit
    &process($msgs[0]);
    exit 0;
}

close(SCAN) || die "Aborting because close(SCAN) failed: $!.\n";

while (scalar(keys %msgs) > 0) {
    # Why prompt to standard error? I am supposing this is meant to
    # separate this output from the output from other processes.
    print STDERR "$mode which one (all for all, return to exit)? ";

    # Take the response from stdin, then cut the last char (usually a
    # <CR>)
    chop ($response = <STDIN>);

    if ($response eq "") { # if string is otherwise empty, bail out
	exit 0;
    }

    if ($response eq "all") { # user says "all"
	for (sort keys %msgs) {
	    &process($_);
	    delete $msgs{$_}; # delete all messages
	}
	# since all messages have been deleted, it makes little sense to
	# iterate through the loop, so bail out of that.
	last;
    }

    if ($response !~ /^[0-9]+$/) { # improper input
	print STDERR "Please enter a number.\n";
	next;
    }

    if (! $msgs{$response}) { # Number chosen is not in the list
	local($,) = " ";
	warn "$response is not one of the listed messages.\n";
	print STDERR "Please pick one of:", keys %msgs, "\n";
	next;
    }

    # Process the newly-chosen message
    &process($response);

    # Delete the newly-chosen message
    delete $msgs{$response};
}

sub process {
    # Process
    # Takes message number as parameter
    local($msg) = $_[0]; # the message number
    local($text) = "";   # text is empty until message is found

    if ($mail_action && $outfolder) { # if these vars are set
	local($/) = "\n\n"; # 2 <CR>s make the record separator
	local($*) = 1;      # go for multi-line matching

	# Open the message indicated by the message number, otherwise
	# abort. The filename is the message number $msg
	open(MSG, "$root/Mail/$infolder/$msg") || die "Aborting because couldn\'t open $root/Mail/$infolder/$msg: $!.\n";

	# Chuck the whole message in $text
	$text = <MSG>;

	# Cut out the Received: lines
	$text =~ s/^(X400-|)Received:.*\n([ \t]+.*\n)*//g;
    }

    if ($outfolder) {
	# If $outfolder is set, run refile to that folder
	if (system("refile $msg +$outfolder")) {
	    die "Aborting because refile failed.\n";
	}
    }
    elsif (system("rmm $msg")) {
        # run rmm on $msg to remove it
	die "Aborting because rmm failed.\n";
    }

    if ($mail_action && $outfolder) {
        # write to log file
	chop($ctime = &ctime(time));
	open(LOG, ">>$log_file") || 
	    die "Aborting because can't write to $log_file: $!.\n";
	print LOG "$ctime $ENV{'USER'} has $mail_action: $scan{$msg}\n" ||
	    die "Aborting because can't write to $log_file: $!.\n";
	close(LOG) ||
	    die "Aborting because close(LOG) failed: $!.\n";

	# send the mail message to the user via sendmail
	open(MAIL, "|/usr/lib/sendmail -oi -t") || die "Aborting because sendmail failed: $!.\n";

	print MAIL "From: $ENV{'USER'}\n";
	print MAIL "To: $report_address\n";
	print MAIL "Subject: $ENV{'USER'} has $mail_action: $scan{$msg}\n";
	print MAIL "\nHeader of $mail_action message:\n\n";
	print MAIL $text;

	close(MAIL) || die "Aborting because close(MAIL) failed: $!.\n";
    }

    # report what you did to stdout
    print "$action: $scan{$msg}\n";
}

############################
# You can view the documentation below by issuing the command
#      perldoc requeue
# in the shell.

=pod

=head2

User Documentation for FAQ Archive Maintainers

=head1 requeue

=head1 Syntax: requeue

requeue goes through email locked by the user, sending it back to the
moderation queue of news-answers-request. In sum, it reverses the
effect of the lock command. This command supersedes the unlock command
which used to do the same thing.

requeue parses through the general $NADIR/Mail/$user directory where the MH
mail being directed to news-answers-request resides. It then provides
the user with a numbered list of senders and subject lines. The user
must pick either one of the numbered messages or all of them to requeue.
Pressing "Enter" while entering no number at all terminates the program
with no messages being re-sent into the queue.

With each selected message number, the associated email is returned to
the moderation queue and a separate email is sent to
news-answers-request announcing that fact.

A number of outside programs are called by this script. Sendmail(8) is
used to send notifications to the moderation queue; rmm(1) deletes
messages by number; refile(1) sends mail back to the moderation queue;
pick(1) and scan(1) are used to present subject lists to the user. All
of these programs except sendmail are part of a suite of programs
belonging to the MH mail system.

=head1 SEE ALSO:

The following commands are used by this script:

=over

=item *

pick(1)

=item *

refile(1)

=item *

scan(1)

=item *

rmm(1)

=item *

sendmail(8)

=back

=head1 BUGS:

1. This command does not accept message numbers as parameters. This is
arguably a feature, as the whole idea of maintaining the moderation
queue is that it be done carefully.

2. Old code, so there is some non-Posix and deprecated Perl syntax that
won't work on newer Perl installations.

=head1 AUTHOR:

	This documentation written by Paul King (pjk@mit.edu).