#!/usr/bin/perl -w

#
# unspamify_mailman.pl
# $xId: unspamify_mailman.pl,v 1.9 2004/01/30 05:29:20 johnh Exp $
#
# Copyright (C) 2003 by John Heidemann <johnh@isi.edu>
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License,
# version 2, as published by the Free Software Foundation.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
#



sub usage {
    print STDERR <<END;
usage: $0 [-mv] -p PASSWORD [URL]

Given a URL for a mailman mailing list and a PASSWORD to that list,
this program logs in to the list and discards all pending messages
(on the assumption that they are all spam).

Options:

-d	debug mode.  Do everything except discarding the messages.

-m	mail mode.  Read an e-mail message from stdin and find URL
	therein (where URL is whatever includes mailman and admindb)

-v	verbose.  Show what messages are dropped.

WARNING: this program blindly discards all messages.  If you do run it
in response to mailman nag-mail, there may be messages that are new
(since the nag mail) that will be silently dropped by this program.

Brought to you by the virtues of WWW::Mechanize and screen-scraping.
"Oh what a tangled web we weave..."
END
    exit 1;
}

use strict;
use WWW::Mechanize;
use Getopt::Long;

&usage if ($#ARGV >= 0 && $ARGV[0] eq '-?');
my $debug = undef;
my $verbose = undef;
my $mailmode = undef;
my $password = undef;
GetOptions('d' => \$debug,
	    'm' => \$mailmode,
	    'p=s' => \$password,
	    'v+' => \$verbose);

if ($mailmode && $#ARGV < 0) {
    handle_mail("-");
};
foreach (@ARGV) {
    if ($mailmode) {
	handle_mail($_);
    } else {
	handle_url($_);
    };
};

exit 0;

sub assert_success {
    my($b) = @_;
    die "$0: error on " . $b->uri . ": " . $b->response()->status_line . "\n"
	if (! $b->success());
}

sub handle_mail {
    my($filename) = @_;
    # simple validation
    die "$0: your filename $_ contains suspicious characters.  refusing to run.\n"
	if (($filename =~ /[^a-zA-Z0-9\/]/) && $filename ne '-');
    my(@urls);
    open(IN, "<$filename") || die "$0: cannot open $filename\n";
    while (<IN>) {
	push(@urls, $1)	if (m@^\s*(https?://.*mailman/admindb/\S+)\s*$@);
    };
    close IN;
    print "found URLs: " . join("\n", @urls) . "\n" if ($verbose);
    die "$0: no urls in message.\n"
	if ($#urls == -1);
    die "$0: too many urls in message.\n" . join("\n", @urls)
	if ($#urls != 0);
    foreach (@urls) {
	handle_url($_);
    };
}

sub handle_url {
    my($mailman_url) = @_;

    # create a new browser
    my $b = WWW::Mechanize->new();

    #
    #  authenticate ourselves
    #
    $b->get($mailman_url);
    assert_success($b);

    $b->field('adminpw', $password);
#    $b->click("admlogin");
    $b->submit();
    assert_success($b);

    #
    # extract the messages
    #
    my %actionids;
    foreach my $line (split(/\n/, $b->response->content)) {
	# this pattern matches 2.0.5 and 2.1.1
	if ($line =~ /input name=\"([^"]+)\"\s+type=\"radio\"\s+value=\"\d\"/i) { # "
	    my($key) = $1;
	    # discard senderfilter in 2.1.1
	    next if ($key =~ /^senderfilter-/);
	    if (defined($actionids{$key})) {
		$actionids{$key}++;
	    } else {
		$actionids{$key} = 1;
	    };
	    print "found $key in $line\n" if (defined($verbose) && $verbose > 1);
	};
    };

    #
    # sanity check: 
    # make sure we saw four of each senderaction
    #
    foreach (keys %actionids) {
	die "$0: confusion on $_.\n" if ($actionids{$_} != 4);
	# print "$_\n";
    };

    #
    # kill them (set to 3)
    # 0=defer, 1=accept, 2=reject, 3=discard
    #
    foreach (sort keys %actionids) {
        $b->field($_, 3);  # 3=discard
	print "discarding $_\n" if ($verbose);
    };
    if ($debug) {
	print "debugging mode, aborting.\n";
	exit 1;
    };
    $b->click("submit");
    assert_success($b);
}
    

exit 0;