#!/usr/athena/bin/perl

# $Id: najunk,v 1.5 2012/08/13 00:31:31 pjk Exp $

# USAGE: najunk
# 
# The najunk script calls pick(1) and reads the offending messages to be
# junked, then reports the spam to a valid email address, if
# REPORT_ADDRESS is set. There are no options.
#
#

require 'ctime.pl';

$root = '/afs/sipb.mit.edu/project/periodic-postings/news.answers';
$user = $ENV{'USER'};
$ENV{'HOME'} = $root;
$ENV{'PATH'} = '/usr/athena/bin:' . $ENV{'PATH'};
$log_file = "$root/lock-log";

if ($ENV{'REPORT_ADDRESS'}) {
  $report_address = $ENV{'REPORT_ADDRESS'};
}

# 05/07/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.
# 06/06/10: pjk: added a brief usage and syntax notes.
# 08/12/12: pjk: added a perldoc

$ENV{'MHCONTEXT'} = "$root/Mail/$user/.najunk.script.pick.mhcontext";

$mode = "Junk";
$action = "Junkmailed";
$mail_action = "junkmailed";
$infolder = 'inbox';
$outfolder = 'junkmail';

if ($0 =~ /\bunlock\b/) {
    $mode = "Unlock";
    $action = "Unlocked";
    $mail_action = "unlocked";
    $infolder = 'junkmail';
    $outfolder = undef;
}
elsif ($0 =~ /\brequeue\b/) {
    $mode = "Requeue";
    $action = "Requeued";
    $mail_action = "requeued";
    $infolder = 'junkmail';
    $outfolder = 'inbox';
}


if (! $user) {
    die "USER environment variable must be set.\n";
}

system 'folder', "+$infolder";

$childpid = open(PICK, "-|");

if (! defined($childpid)) {
    die "Aborting because fork for pick failed: $!.\n";
}
elsif ($childpid) {
    while (<PICK>) {
	chop;
	push(@msgs, $_);
	$msgs{$_}++;
    }
    close(PICK) || die "Aborting because close(PICK) failed: $!.\n";
}
else {
    exec 'pick', @ARGV;
    exit 1;
}

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

for (@msgs) {
    s/\n//;
    $msgs{$_}++;
}

open(SCAN, "scan @msgs|") || die "Aborting because scan failed: $!.\n";

while (<SCAN>) {
    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;
}

if (@msgs == 1) {
    &process($msgs[0]);
    exit 0;
}

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

while (scalar(keys %msgs) > 0) {
    print STDERR "$mode which one (all for all, return to exit)? ";

    chop ($response = <STDIN>);

    if ($response eq "") {
	exit 0;
    }

    if ($response eq "all") {
	for (sort keys %msgs) {
	    &process($_);
	    delete $msgs{$_};
	}
	last;
    }

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

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

    &process($response);

    delete $msgs{$response};
}

sub process {
    local($msg) = $_[0];
    local($text) = "";

    if ($mail_action && $outfolder) {
	local($/) = "\n\n";
	local($*) = 1;

	open(MSG, "$root/Mail/$infolder/$msg") || die "Aborting because couldn\'t open $root/Mail/$infolder/$msg: $!.\n";

	$text = <MSG>;

	close(MSG);

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

    if ($outfolder) {
	if (system("refile $msg +$outfolder")) {
	    die "Aborting because refile failed.\n";
	}
    }
    elsif (system("rmm $msg")) {
	die "Aborting because rmm failed.\n";
    }

    if ($mail_action && $outfolder) {
	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";

	if ($report_address) {
	    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";
	}
    }

    print "$action: $scan{$msg}\n";
}

###################################################################
#
# What follows is user documentation on najunk. Users can access this in
# manpage format by issuing the command: "perldoc najunk" at a shell
# prompt with this script in their path or their current directory.
#
###################################################################

=pod

=head2

User documentation for FAQ Maintainers

=head1 najunk

=head1 USAGE

najunk 

=head1 DESCRIPTION

The najunk script calls pick(1) and reads the offending messages to be
junked, then reports the spam to a valid email address if the
REPORT_ADDRESS shell variable is set. There are no command line options.

A call to najunk generally calls MH's rmm(1) command to delete the
message. It gathers messages sent to news-answers-request and packaged
in its inbox via MH and lists these as possible candidates to be junked.

The user is presented with a non-paginated list of the message numbers
and subject lines of mail contained in the inbox. He or she choses
between
selecting which numbers to delete, one at a time, or deleting them all.
To delete ranges of messages, pine(1) is the best alternative, and can
present email from MH. 

It cannot be used as an automated script, because it is interactive.
This is likely to encourage *.answers moderators to delete email with
care.

=head1 SEE ALSO

=over

=item *

pick(1)

=item *

folder(1)

=item *

scan(1)

=item *

refile(1)

=item *

rmm(1)

=item *

sendmail(1)

=item * 

pine(1)

=back

=head1 BUGS

=over

=item *

uses ctime.pl (non-POSIX, deprecated)

=item *

$* is used (deprecated, non-POSIX)

=item *

Not being able to delete ranges of messages hampers its functionality,
but was probably done to encourage the user to analyse the email content
as much as possible before deleting ranges.

=item *

The lack of pagination when it comes to more than 24 subject lines is a
minor bug; users can just scroll back on their display. But more
important, you must already know the content of the email by looking at
the subject line, or at least have a good idea, before knowing what to
delete.

=back

=head1 AUTHOR

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