#!/usr/bin/perl -w
#
# MAILMAN BLOWS GOATS.

# You can't block mails to mailman, you can only redirect them to the
# admin address. So my attempts to stop up some of the spam on the
# BBDB list results in me getting a steady stream of crap at the admin
# address instead. This script is designed to go in and rip them
# out. If there's a real admin request in there, tough. I might notice
# it in the mailshots I get, and then again I might not.

# 22/05/2003 Rewrote to use HTML::TokeParser and also Mail::SpamAssassin
#
# 22/08/2003 HTA: Added some stuff to make Mailman 2.1 easier
#                 (mailman 2.1 has to have details=all in order to get the messages,
#                  but fails if you add that into the URL when blipping them)
#                 Also added reporting of nonspam.
#
# TODO:
# * add a --learn switch where it assumes that everything it grabs is
#   spam and feeds it to SpamAssassin's learn stuff.
#
# * cgi mode, where it generates a Mailman admin page, but with
#   defaults set sanely (i.e. if it's spam, set the default option to
#   'discard')
#
# * remove default listurl!
#
use LWP::UserAgent;
use Getopt::Long;
use HTML::TokeParser;
use Mail::SpamAssassin;

$| = 1;

my $listurl = 'http://lists.sourceforge.net/lists/admindb/bbdb-info';
my $password;
my $learn = 0;
my $mailmanversion = "2.0";

GetOptions( "url:s" => \$listurl,
		  "password:s" => \$password,
			"learn!" => \$learn,
	           "mailmanversion:s" => \$mailmanversion
		  ) or usage();

usage() unless $password;
if ($mailmanversion ne "2.0" && $mailmanversion ne "2.1") {
    warn "Untested with version $mailmanversion, use at own risk, or say 2.0 or 2.1\n";
}

my %cookies;
my $ua = new LWP::UserAgent;
$ua->env_proxy();
$ua->cookie_jar( \%cookies ); # according to the man page, this is okay...

my $req;
if ($mailmanversion eq "2.1") {
    warn "adding details=all\n";
    $req = new HTTP::Request POST => $listurl . "?details=all";
    # for some reason, $req->add_content("details=all") doesn't do the same thing
} else {
    $req = new HTTP::Request POST => $listurl;
}
$req->add_content( "adminpw=$password" );

my $res = $ua->request( $req );
if ( !$res->is_success ) {
  die "Urgh. Died.\n";
}

my $content = $res->content;
# debugging
#open( HONK, ">$ENV{'HOME'}/honk" );
#print HONK $content;
#close( HONK );

# Reset the request. use the password, because I still don't trust the cookie stuff.
$req = new HTTP::Request POST => $listurl;
$req->add_content( "adminpw=$password" );

# Set up for SPAM ASSASSINATIONS, muahahah!
my $spamass = new Mail::SpamAssassin;

my $p = HTML::TokeParser->new( \$content );
my $text = "";
my $tag = "";
my $count = 0;
my %lusers;

$p->get_tag( "form" ) or die "No form.";

while ( 1 ) {
  $p->get_tag( "h2" ) or last;
  $text = $p->get_trimmed_text;
  if ( $text !~ /Posting Held for Approval/is ) {
	print "Unexpected: $text";
	last;
  } else {
	my ($msgnum) = $text =~ m{\((\d+) of \d+\)};          #};

	# find the From address
	$p->get_tag( "td" ); # label
	$p->get_tag( "td" );
	my $from = $p->get_trimmed_text();

	# and the subject
	$p->get_tag( "td" ); # label
	$p->get_tag( "td" );
	my $subject = $p->get_trimmed_text();

	# Now get the ID so we can nuke it later
	$tag = $p->get_tag( "input" );
	my $id = $tag->[1]{'name'};

	if ( !defined( $id ) or $id !~ /^\d+$/ ) {
	  warn "Lost track at message $msgnum\n";
	  last;
	}

	# Next, grab the message headers
	$tag = $p->get_tag( "textarea" ); # if you reject this post...
	$tag = $p->get_tag( "textarea" );
	if ( $tag->[1]{'name'} !~ /headers-$id/ ) {
	  warn "Lost track at message $msgnum\n";
	  last;
	}
	my $headers = $p->get_text( "/textarea" );

	# and a message excerpt
	$tag = $p->get_tag( "textarea" );
	my $excerpt = $p->get_text( "/textarea" );

	my $msg =<<"EOT";
From $from
$headers

$excerpt
EOT

	my $status = $spamass->check_message_text( $msg );
	if ( $status->is_spam()) {
	  print "Spam: " . $status->get_hits . "/" . $status->get_required_hits . "\n";
	  print "  Blipping $from\n";
	  $req->add_content( "&$id=3" );
	  $count++;
	} else {
	  # HTA: This branch is for nonspam. Report.
	  print "Not Spam: " . $status->get_hits . "/" . $status->get_required_hits . "\n";
	  print "  Keeping $from\n";
	  # In order for this to work I need to read about Mail::Audit,
	  # which has a whole backwash of prerequisite modules.
	  if ( $learn ) {
		print "Spam: " . $status->get_hits . "/" . $status->get_required_hits . "\n";
		print "  Learning this and blipping it\n";
#		$req->add_content( "&$id=3" );
		$count++;
	  } else {
		$lusers{$from} ||= 0;
		$lusers{$from}++;
	  }
	}
	$status->finish;

  }
}

if ( $count ) {
  $res = $ua->request( $req );
  if ( !$res->is_success ) {
	die "Urgh. Died.\n";
  }
  print "Okay, done. Cleared out $count bits of crap\n";
} else {
  print "Can't find any requests. Being overzealous, are we?\n" unless %lusers;
}

if ( %lusers ) {
  print "Leftovers:\n";
  print join( "\n", map { $_ . " (" . $lusers{$_} . ")" } sort { my ($sa) = $a =~ /@(.*)$/; my ( $sb ) = $b =~ /@(.*)$/; $sa ||= $a; $sb ||= $b; $sa cmp $sb;} keys %lusers ) . "\n";
}

sub usage {
  die "usage: $0 --password=<password>";
}
