#!/usr/bin/perl -w
=head1 NAME

moderate-lists - moderate some mailing lists from the command-line

=head1 SYNOPSIS

    moderate-list [options] { --dir maildir | --file filename }
    [... script outputs message synopsis...]
    Moderation action [ynab] (y=yes, n=no, a=allow in future, b=block in future)?
    [... script mails the correct address appropriately.]

    moderate-list --auto [options] { --dir maildir | --file filename }
    [... script operates automatically with no user intervention...]

    options: 
            --config configfile: file where previous moderation choices,
                      and list passwords, are stored

=head1 DESCRIPTION

Works for ezmlm and MailMan 2.1.x lists, which both produce 'message
awaiting moderation' mails with enough info to allow this to operate.

=head1 OPTIONS

=item --dir=/path/to/maildir

Directory containing the pending moderation requests, RFC-822 format, one per
file.   (MH or Maildir style!)

=item --config=/path/to/configfile

Where moderation passwords and 'always accept mail from this address' choices
are stored between runs.

=head1 CONFIGURATION

These config settings can be used in C<~/.moderate_sa/moderate.cf>:

  # The directory containing your pending moderation requests, RFC-822
  # format, one per file.  Maildir 'cur' and 'new' subdirectories are OK,
  # as are MH folders.
  defaultdir ~/Mail/Mod

  # block messages that score this high in SpamAssassin score.
  blockscore 5.0

=head1 SEE ALSO

L<http://taint.org/wk/ModerateList>

=head1 VERSION

1.6, May  1 2007 jm

=cut

# where my "accept always" addrs are listed.
my $store = $ENV{HOME}.'/.moderate_sa/moderate.cf';

# where my SpamAssassin config is kept.
my $saconfig = $ENV{HOME}.'/.moderate_sa/user_prefs';

# where my SpamAssassin modules live.  I use SpamAssassin dev branch,
# from the build dir, not installed; if you're using installed SpamAssassin,
# then comment this line.
use lib '/home/jm/ftp/spamassassin/lib';

# rules directory to use for SpamAssassin (comment this line to use default
# system-wide rules)
my $sarules = '/home/jm/ftp/spamassassin/rules';

# ---------------------------------------------------------------------------

sub usage {
  die "
moderate-list [options] { --dir maildir | --file filename }

options: --auto: automatic, no prompts

         --config configfile: file where previous moderation choices,
                  and list passwords, are stored

";
}

use Getopt::Long;
use vars qw($opt_dir $opt_file $opt_config $opt_auto);
GetOptions ("dir=s", "file=s", "config=s", "auto");
if ($opt_config) { $store = $opt_config; }
if ($opt_dir) { $dir = $opt_dir; }

if (!-t STDIN) {
  print "STDIN is not a tty; automatic mode\n";
  $opt_auto = 1;
}

my $saopts = {
  # local_tests_only => 1
};
if (defined( $saconfig )) { $saopts->{userprefs_filename} = $saconfig; }
if (defined( $sarules )) { $saopts->{rules_filename} = $sarules; }

$| = 1;
my %modchoice = ();
my %listpwd = ();
my %cf = ( blockscore => 5 );
load_mod_choices();

if (!$dir) { $dir = $cf{defaultdir}; }

if (!$dir && !$opt_file) { usage; }

use Mail::SpamAssassin;
my $mailsa = new Mail::SpamAssassin $saopts;

my @deferred_for_user = ();
my $results_overview = '';
my $non_mod_files = 0;
my $handled_ok = 0;
if ($opt_file) {
  $handled_ok = read_mod_message_from_file ($opt_file, 1);
}
else {
  my @files = (<$dir/*>, <$dir/cur/*>, <$dir/new/*>);
  foreach my $file (sort @files) {
    next if ($file =~ /\*$/);           # unexpanded glob
    next if ($file =~ /\/\.[^\/]+$/);	# dotfiles
    next if ($file =~ /\/\,[^\/]+$/);	# deleted MH messages
    $handled_ok += read_mod_message_from_file ($file, 0);

    push @files_processed, $file;
  }

  # now, handle the ones that SpamAssassin didn't auto-discard already
  my @needuser = ();
  foreach my $msg (@deferred_for_user) {
    if (proc_msg_without_user ($msg)) {
      $handled_ok++;
    } else {
      push (@needuser, $msg);
    }
  }

  @deferred_for_user = @needuser;
  print "\n\n".$handled_ok." messages dealt with automatically, but\n".
    scalar(@deferred_for_user)." messages still need user input...\n";

  # and finally, ask the user for their input for anything we haven't
  # already dealt with with existing old moderation choices
  if (!$opt_auto) {
    foreach my $msg (@deferred_for_user) {
      $handled_ok += proc_msg_with_user ($msg);
    }
  }
}

if ($non_mod_files > 0) {
  $results_overview .= "$non_mod_files non-moderate-request files\n";
}

print "\n\n", $results_overview, "\n\n";
final_cleanup();

if ($handled_ok) {
  exit 0;
} else {
  exit 22;
}

# ---------------------------------------------------------------------------

sub read_mod_message_from_file {
  my $file = shift;
  my $procnow = shift;

  print "[reading $file]\n";
  open (IN, "<$file") or warn "cannot read $file";

  my $msg = { };
  my $bound = 'NOTFOUND';
  my $hdrs = '';
  while (<IN>) {
    $hdrs .= $_;
    /^$/ and last;
  }

  $msg->{file} = $file;
  $hdrs =~ s/[ \t]*\n[ \t]+/ /gs;	# remove line continuations

  my $automodded = 0;
  if ($hdrs =~ /^X-Moderate-List-Performed: yes/m) {
    warn "already moderated $file successfully, skipping\n";
    close IN;
    $non_mod_files++;
    return 1;
  }

  if ($hdrs =~ /^Subject: MODERATE for (\S+)$/m) {
    # it's ezmlm!
    $msg->{listserv} = 'ezmlm';
    $msg->{list} = $1;
    $hdrs =~ /^From: (\S+)$/m and $msg->{reject} = $1;
    $hdrs =~ /^Cc: (\S+)$/m and $msg->{allow} = $1;
    $hdrs =~ /^Content-Type: multipart.mixed; boundary=(\S+)$/m and $bound = $1;
    $hdrs =~ /^Reply-To: (\S+)$/m and $msg->{accept} = $1;
  }
  elsif ($hdrs =~ /^Subject: CONFIRM subscribe to (\S+)$/m) {
    # it's ezmlm! a subscription
    $msg->{listserv} = 'ezmlmsub';
    $msg->{list} = $1;
    $hdrs =~ /^From: (\S+)$/m and $msg->{reject} = $1;
    $hdrs =~ /^To: (\S+)$/m and $msg->{to} = $1;
    $hdrs =~ /^Reply-To: (\S+)$/m and $msg->{accept} = $1;
    $msg->{no_sa_check} = 1;
    $msg->{from} = $msg->{accept};
    $msg->{subj} = "[subscription request: $msg->{to} to list $msg->{reject}]";
  }
  elsif ($hdrs =~ /^Subject: (\S+) post from \S+ requires approval$/m) {
    # it's MailMan 2.1.x!
    $msg->{listserv} = 'mailman';
    $msg->{list} = $1;
    $hdrs =~ /^Content-Type: multipart.mixed; boundary=\"(=\S+=)\"$/m and $bound = $1;
  }

  if (!defined $msg->{list}) {
    warn "cannot find moderation details from $file, skipping\n";
    close IN;
    $non_mod_files++;
    return 0;
  }

  while (<IN>) {
    if (/^Content-Type: message.rfc822/) { last; }
  }
  while (<IN>) {
    if (/^$/) { last; }
  }

  $msg->{fullmsg} = '';
  while (<IN>) {
    $msg->{fullmsg} .= $_;
    /^From: (.*)$/ and $msg->{from} = $1;
    /^Subject: (.*)$/ and $msg->{subj} = $1;
    /^To: (.*)$/ and $msg->{to} = $1;
    /^X-Spam-Rating: (.*)$/ and $msg->{spamrating} = $1;
    /^$/ and last;
  }

  $msg->{previewbody} = '';
  my $lines = 5;
  my $mimeend = 0;

  while (<IN>) {
    if (/^--${bound}--$/) { $mimeend = 1; last; }
    if (/^--${bound}$/) { last; }
    $msg->{fullmsg} .= $_;
    if ($lines-- > 0) { $msg->{previewbody} .= $_; }
  }

  # mailman includes the moderation message as another part
  if (!$mimeend && $msg->{listserv} eq 'mailman') {
    while (<IN>) { if (/^Content-Type: message.rfc822/) { last; } }
    while (<IN>) { if (/^$/) { last; } }
    while (<IN>) {
      /^Subject: (confirm \S+)/ and $msg->{mm_confirm_subj} = $1;
      /^From: (\S+)/ and $msg->{mm_confirm_addr} = $1;
      if (/^$/) { last; }
    }
  }

  # validate
  if ($msg->{listserv} eq 'mailman') {
    if (!$msg->{mm_confirm_subj} || !$msg->{mm_confirm_addr}) {
      $non_mod_files++;
      warn "failed to find MailMan confirm msg. skip\n"; return 0;
    }

  } elsif ($msg->{listserv} eq 'ezmlm') {
    if (!$msg->{reject} || !$msg->{accept}) {
      $non_mod_files++;
      warn "failed to find ezmlm confirm hdrs. skip\n"; return 0;
    }

  } elsif ($msg->{listserv} eq 'ezmlmsub') {
    if (!$msg->{reject} || !$msg->{accept}) {
      $non_mod_files++;
      warn "failed to find ezmlmsub confirm hdrs. skip\n"; return 0;
    }

  } else {
    warn "no confirm msg. skip\n"; return 0;
  }

  close IN;

  if (!$modchoice{$msg->{from}} && !$msg->{no_sa_check}) {
    run_thru_sa ($msg);
  }

  if ($procnow) {
    return proc_msg_with_user($msg);
  }
  else {
    push (@deferred_for_user, $msg);
    return 0;
  }
}

sub proc_msg_without_user {
  my $msg = shift;
  if (ask_user_for_action ($msg, 1)) {
    return 1;
  } else {
    return 0;
  }
}

sub proc_msg_with_user {
  my $msg = shift;
  if (ask_user_for_action ($msg, 0)) {
    return 1;
  } else {
    return 0;
  }
}

sub run_thru_sa {
  my $msg = shift;

  print "[checking with SpamAssassin]\n";
  my $status = $mailsa->check_message_text( $msg->{fullmsg} );
  $msg->{is_spam} = $status->is_spam();
  $msg->{score} = $status->get_hits();
  $msg->{required} = $status->get_required_hits();
  $msg->{rules} = $status->get_names_of_tests_hit();
  $status->finish;
}

sub ask_user_for_action {
  my $msg = shift;
  my $unattended = shift;

  if ($opt_auto) { $unattended = 1; }       # override

  my $extra = '';
  if ( $msg->{spamrating}) { $extra .= "X-Spam-Rating: $msg->{spamrating}\n"; }

  $msg->{previewbody} =~ s/\n/\n\| /gs;

  print "

+------------------------------------------------------------------------
| FILE: $msg->{file}
| List: $msg->{list}
| From: $msg->{from}
| To: $msg->{to}
| Subject: $msg->{subj}
| $extra
| Preview: $msg->{previewbody} [....cut]
";
  if (defined $msg->{score}) {
    print
      "| SpamAssassin: score=$msg->{score}/$msg->{required} rules=$msg->{rules}\n";
  } else {
    print
      "| SpamAssassin: not run\n";
  }

  print
"+------------------------------------------------------------------------

";

  foreach my $retry (0 .. 10) {
    my $action;

    if ($msg->{listserv} ne 'ezmlmsub') {
      if ($modchoice{$msg->{from}}) {
        $action = $modchoice{$msg->{from}}; goto skipprompt;
      }
    }

    if ($msg->{is_spam}) {
      if ($msg->{score} > $cf{blockscore}) {
        print "SpamAssassin score $msg->{score} > $cf{blockscore}, blocking!\n";
        $action = 'b'; goto skipprompt;
      }
    }

    print "Moderation action [ynabf] (y=yes, n=no, a=allow in future, b=block in future, f=show full)? ";
    if ($unattended) {
      print "[deferred for user input]\n";
      return 0;
    } else {
      $action = <STDIN>;
    }

skipprompt:
    if ($action =~ /^f/i) { show_full($msg); next; }

    if ($msg->{listserv} eq 'ezmlm') {
      if ($action =~ /^y/i) { ezmlm_action_accept($msg); return 1; }
      elsif ($action =~ /^n/i) { ezmlm_action_reject($msg); return 1; }
      elsif ($action =~ /^a/i) { ezmlm_action_allow($msg); return 1; }
      elsif ($action =~ /^b/i) { ezmlm_action_block($msg); return 1; }

    } elsif ($msg->{listserv} eq 'ezmlmsub') {
      if ($action =~ /^y/i) { ezmlm_action_accept($msg); return 1; }
      elsif ($action =~ /^n/i) { return 1; }
      elsif ($action =~ /^a/i) { ezmlm_action_accept($msg); return 1; }
      elsif ($action =~ /^b/i) { return 1; }

    } elsif ($msg->{listserv} eq 'mailman') {
      if ($action =~ /^y/i) { mm_action_accept($msg); return 1; }
      elsif ($action =~ /^n/i) { mm_action_reject($msg); return 1; }
      elsif ($action =~ /^a/i) { mm_action_allow($msg); return 1; }
      elsif ($action =~ /^b/i) { mm_action_block($msg); return 1; }

    } else { die; }
    
    warn "eh? try again.\n";
  }
  return 0;
}

sub show_full {
  my $msg = shift;

  print "\n\n".('-' x 75)."\nFULL MESSAGE:\n\n";
  print $msg->{fullmsg};
  print "\n".('-' x 75)."\n";
}

# ---------------------------------------------------------------------------

sub ezmlm_action_accept { my $msg = shift; ezmlm_send_mail_to ($msg->{accept}); mod_save (1,0, $msg); }
sub ezmlm_action_reject { my $msg = shift; ezmlm_send_mail_to ($msg->{reject}); mod_save (0,0, $msg); }
# note: "allow" does NOT permit the message implicitly!  total misfeature
sub ezmlm_action_allow { my $msg = shift; ezmlm_send_mail_to ($msg->{accept}); ezmlm_send_mail_to ($msg->{allow}); mod_save (1,1, $msg); }
sub ezmlm_action_block { my $msg = shift; ezmlm_send_mail_to ($msg->{reject}); mod_save (0,1, $msg); }

sub ezmlm_send_mail_to {
  my $addr = shift;
  my $cmd = "/usr/sbin/sendmail -oi '".$addr."'";
  print "[$cmd]\n";
  open (OUT, "|$cmd") or die "cannot run";
  print OUT "This is a non-empty message to work around\n".
            "brokenness in the ASF's spam filtering setup.\n".
            "Someday hopefully they'll fix it...\n\n";
  close OUT or die "failed $cmd";
}

# ---------------------------------------------------------------------------

sub mm_action_accept { my $msg = shift; send_mm_confirm (1, $msg); mod_save (1,0, $msg); }
sub mm_action_reject { my $msg = shift; send_mm_confirm (0, $msg); mod_save (0,0, $msg); }
sub mm_action_allow { my $msg = shift; send_mm_confirm (1, $msg); mod_save (1,1, $msg); }
sub mm_action_block { my $msg = shift; send_mm_confirm (0, $msg); mod_save (0,1, $msg); }

sub send_mm_confirm {
  my $accept = shift;
  my $msg = shift;

  my $send = "Subject: ".$msg->{mm_confirm_subj}."\n";

  if ($accept) {
    if (!defined $listpwd{$msg->{list}}) {
      $listpwd{$msg->{list}} = ask_pwd_for_list ($msg);
      print "[pwd was \"$listpwd{$msg->{list}}\"]\n";
    }
    $send .= "Approved: ".$listpwd{$msg->{list}}."\n";
  }

  $send =~ s/'/,/gs;
  my $addr = $msg->{mm_confirm_addr};

  my $cmd = "echo '".$send."' | /usr/sbin/sendmail -oi '".$addr."'";
  print "[$cmd]\n";
  system $cmd;
}

# ---------------------------------------------------------------------------


sub ask_pwd_for_list {
  my $msg = shift;
  my $list = $msg->{list};

  my $retry;
  for ($retry = 20; $retry >= 0; $retry--) {
    print "Password for list \"$list\"? ";
    if (!-T STDIN) {
      die "not a terminal";
    }

    my $pwd = <STDIN>;
    chomp $pwd;

    if ($pwd) {
      $listpwd{$msg->{list}} = $pwd;
      save_mod_choices();
      return $pwd;
    }
  }
  die "failed to get pwd";
}

# ---------------------------------------------------------------------------

sub mod_save {
  my $accept = shift;
  my $save = shift;
  my $msg = shift;

  if ($save) {
    $modchoice{$msg->{from}} = ($accept ? 'y' : 'n');
    save_mod_choices();
  }

  if ($save) {
    bayes_learn($accept,$msg);
  }

  $results_overview .=
      ($accept ? "y" : "n").
      ($save ? " (permanent)" : "").
      ": ". $msg->{from}. "\n";
}

sub load_mod_choices {
  open (IN, "<$store") or return;
  while (<IN>) {
    s/^\s+//; next if (/^\#/);
    /^listpwd (\S+) (.*)$/ and $listpwd{$1} = $2;
    /^ok (.+)$/ and $modchoice{$1} = 'y';
    /^bad (.+)$/ and $modchoice{$1} = 'n';
    /^defaultdir\s+(.+?)\s*$/ and $cf{defaultdir} = $1;
    /^blockscore\s+(\S+?)\s*$/ and $cf{blockscore} = $1;
  }
  close IN;
}

sub save_mod_choices {
  umask 0077;
  open (OUT, ">$store") or warn "cannot write $store";
  foreach my $key (sort keys %cf) {
    my $val = $cf{$key};
    print OUT "$key $val\n";
  }
  foreach my $addr (sort keys %modchoice) {
    my $choice = $modchoice{$addr};
    if ($choice eq 'y') { print OUT "ok $addr\n"; }
    if ($choice eq 'n') { print OUT "bad $addr\n"; }
  }
  foreach my $list (sort keys %listpwd) {
    my $pwd = $listpwd{$list};
    print OUT "listpwd $list $pwd\n";
  }
  close OUT;
  print "[wrote passwords and permanent choices]\n";
}

# ---------------------------------------------------------------------------

sub bayes_learn {
  my ($isgood, $msg) = @_;

  my $samsg = $mailsa->parse($msg->{fullmsg}, 0);
  my $status = $mailsa->learn( $samsg, undef, !$isgood);
  if ($status->did_learn()) {
    print "[learned as ".($isgood ? "nonspam" : "spam")."]\n";
  } else {
    print "[did not learn as ".($isgood ? "nonspam" : "spam")."]\n";
  }
  $status->finish();
  $samsg->finish();
}

# ---------------------------------------------------------------------------

sub final_cleanup {
  return unless @files_processed;

  print "Remove processed message files [yn] (y=yes, n=no)? ";
  if ($opt_auto) {
    return 0;
  }

  my $action = <STDIN>;

  if ($action !~ /^y/i) {
    print "Not removed.\n";
    return 0;
  }

  print "Removing.\n";
  foreach my $file (@files_processed) {
    unlink $file or warn "cannot rm $file";
  }
  return 1;
}