I'm posting a script for using SA with the Mailman listserver.
The script makes possible message approval via the shell, saving a
lot of time otherwise spent on downloading Mailman web pages,
typing passwords etc. The script is written by Kjetil Torgrim
Homme <[EMAIL PROTECTED]>, send comments if any to him. The
script allows for example setting the spam level you want for
automatic discard. The script contains some UiO-specific code for
retrieving the location of Mailman and list files.
Thomas Gramstad
[EMAIL PROTECTED]
--
#! /local/bin/perl5
#
# listadmin version 2.00
# Written 2003 by Kjetil Torgrim Homme <[EMAIL PROTECTED]>
# Released into public domain.
use HTML::TokeParser;
use LWP::Simple;
use Data::Dumper;
use Term::ReadLine;
use strict;
my $term = new Term::ReadLine 'listadmin';
my $rc = $ENV{"HOME"}."/.listadmin.ini";
my $oldconf = $ENV{"HOME"}."/.listconf";
upgrade_config($oldconf, $rc);
if (@ARGV >= 2 && $ARGV[0] eq "-f") {
shift; $rc = shift;
}
if (@ARGV != 0) {
print STDERR "Usage: $0 [-f CONFIGFILE]\n";
exit (64);
}
my $config = read_config ($rc);
unless ($config) {
exit (0) unless prompt_for_config ($rc);
$config = read_config ($rc);
}
my ($info, $id, $subject);
format STDOUT =
From: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$info->{$id}{"from"}
Subject: ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$subject
~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$subject
Reason: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< Spam? @<<
$info->{$id}{"reason"}, $info->{$id}{"spamscore"}
.
my $prompt =
'Approve/Reject/Discard/Skip/view Body/view Full/Help/Quit/eXit';
for my $list (sort {$config->{$a}{"order"} <=> $config->{$b}{"order"}}
keys %{$config}) {
my $def = $config->{$list}{"default"};
my $spamlevel = $config->{$list}{"spamlevel"};
my $user = $config->{$list}{"user"};
my $pw = $config->{$list}{"password"};
print "fetching data for $list\n";
$info = get_list ($list, $user, $pw);
my $num = 0;
my $count = keys (%{$info}) - 1;
my %change = ();
my $listprompt = $prompt;
$listprompt = $prompt . " [" . uc($def) . "]" if $def;
$listprompt .= " ? ";
msgloop:
for $id (sort keys %{$info}) {
next if $id eq "global";
++$num;
$subject = $info->{$id}{"subject"};
print "\n[$num/$count] ======= #$id of $list =======\n";
write;
while (1) {
my $ans;
if ($spamlevel && $info->{$id}{"spamscore"} >= $spamlevel) {
print "Automatically discarded as spam.\n";
$ans = "d";
}
$ans ||= $config->{$list}{"action"};
$ans ||= $term->readline ($listprompt);
$ans = "q" unless defined $ans;
$ans = $def if $ans eq "";
$ans =~ s/\s+//g;
$ans = lc $ans;
last msgloop if $ans eq "q";
next msgloop if $ans eq "s";
if ($ans eq "a" || $ans eq "d") {
$change{$id} = [ $ans ];
last;
} elsif ($ans eq "r") {
my $r = $term->readline ("Why do you reject? ",
$info->{$id}{"rejreason"});
if ($r =~ /^\s*$/) {
print "aborted\n";
next;
}
$change{$id} = [ "r", $r ];
last;
} elsif ($ans eq "x") {
%change = ();
last msgloop;
} elsif ($ans eq "f") {
print $info->{$id}{"excerpt"};
} elsif ($ans eq "b") {
my $text = $info->{$id}{"excerpt"};
$text =~ s/.*?\n\n//s;
my @lines = split (/\n/, $text, 21);
pop @lines;
print join ("\n", @lines), "\n";
} elsif ($ans eq "") {
# nothing.
} else {
print <<"end";
Choose one of the following actions by typing the corresponding letter
and pressing Return.
a Approve -- the message will be sent to all member of the list
r Reject -- notify sender that the message was rejected
d Discard -- throw message away, don't notify sender
s Skip -- don't decide now, leave it for later
b view Body -- display the first 20 lines of the message
f view Full -- display the complete message, including headers
q Quit -- go on to the next list
x eXit -- go on to the next list, undo all actions chosen
end
print <<"end" if $def;
The default action for this list when you only press Return is '$def'
end
}
}
}
commit_changes ($list, $user, $pw, \%change, $info);
}
sub mailman_url {
my ($list, $user, $pw) = @_;
$pw =~ s/(\W)/sprintf("%%%02x", ord($1))/ge;
my $args = "username=$user&adminpw=$pw";
my ($lp, $domain) = split ('@', $list);
my $www;
if ($domain eq "lister.ping.uio.no") {
return "https://$domain/mailman/$domain/admindb/$lp?$args";;
} elsif ($domain =~ /^(\w+)\.uio\.no$/) {
$www = "$1-lists.uio.no";
} elsif ($domain eq "uio.no") {
$www = "uio-lists.uio.no";
} else {
$www = "lister.uio.no";
}
return "http://$www/mailman/admindb/$list?$args";;
}
sub get_list {
my ($list, $user, $pw) = @_;
# where we gather all the information about pending messages
my %data = ();
my $page = get (mailman_url ($list, $user, $pw));
my $parse = HTML::TokeParser->new(\$page) || die;
my ($from, $subject, $reason, $id, $tag, $excerpt, $spamscore, $rej);
my $date;
my $mailmanversion = 1;
while ($parse->get_tag ("table")) {
$parse->get_tag ("tr") || die; # From:_or_ at end
$parse->get_tag ("td") || die;
my $ver = $parse->get_trimmed_text ("/td") || die;
last if $ver =~ /version/;
$parse->get_tag ("td") || die;
$from = $parse->get_trimmed_text("/td");
$parse->get_tag ("tr") || die $page; # Reason:
$parse->get_tag ("td") || die;
$parse->get_tag ("td") || die;
$reason = $parse->get_trimmed_text("/td");
$parse->get_tag ("tr") || die; # Subject:
$parse->get_tag ("td") || die;
# the parsing just happens to fail here when the wrong
# password is given...
$parse->get_tag ("td") ||
die "Parse failed. Is your username and password correct?\n";
$subject = $parse->get_trimmed_text("/td");
$parse->get_tag ("tr") || die; # Action:
$tag = $parse->get_tag ("input") || die;
$id = $tag->[1]{"name"};
$parse->get_tag ("tr") || die; # Reject _or_ Preserve message
$parse->get_tag ("td") || die;
$parse->get_tag ("td") || die;
$rej = $parse->get_trimmed_text("/td") || die;
if ($rej =~ /Preserve message/) {
$mailmanversion = 2;
$parse->get_tag ("tr") || die; # forward
$parse->get_tag ("tr") || die; # Reject
$parse->get_tag ("td") || die;
$parse->get_tag ("td") || die;
$rej = $parse->get_trimmed_text("/td") || die;
}
$parse->get_tag ("tr") || die; # Message Excerpt _or_ Headers
$parse->get_tag ("td") || die;
$parse->get_tag ("td") || die;
$excerpt = $parse->get_text("/td");
$excerpt =~ /^X-UiO-Spam-score: (s+)/m;
$spamscore = length ($1 || "");
$excerpt =~ /^Date: (.*)$/m;
$date = $1;
if ($mailmanversion == 2) {
$parse->get_tag ("tr") || die; # Message Excerpt
$parse->get_tag ("td") || die;
$parse->get_tag ("td") || die;
$excerpt .= "\n" . $parse->get_text("/td");
}
$parse->get_tag ("/table") || die;
$data{$id} = { "from" => $from,
"subject" => $subject,
"date" => $date,
"reason" => $reason,
"spamscore" => $spamscore,
"rejreason" => $rej,
"excerpt" => $excerpt };
}
if ($mailmanversion == 1) {
$data{"global"}{"actions"} = { "a" => 0,
"r" => 1,
"d" => 2 };
} else {
$data{"global"}{"actions"} = { "a" => 1,
"r" => 2,
"d" => 3 };
}
return \%data;
}
# .listconf was the configuration file for the previous listadmin
# script, which was written in Bash and simply sourced the file...
sub upgrade_config {
my ($conf, $rc) = @_;
return if -f $rc;
return unless -f $conf;
print "Converting to new configuration file, $rc\n\n";
my $cmd = ". $conf; umask 077; > $rc ". <<'END';
(echo "# automatically converted from .listconf";
echo "#";
echo "username $LISTUSER";
echo "password \"$LISTPASS\"";
echo "spamlevel 12";
echo "default discard";
echo "# uncomment the following to get a terse transaction log";
echo "# log \"~/.listadmin.log\"";
echo ""
for l in $LISTS; do echo "$l"; done
)
END
system $cmd;
}
sub read_config {
my ($file) = @_;
my ($user, $pw, $spam, $list);
my %conf = ();
my $line = "";
my $action = "";
my $default = "";
my $count = 0;
my $lineno = 0;
my $logfile;
my %act = ("approve" => "a", "discard" => "d",
"reject" => "r", "skip" => "s", "none" => "");
return undef unless open (CONF, $file);
while (<CONF>) {
++$lineno;
chomp;
s/\r$//;
next if /^\s*#/;
if (/\\$/) {
$line = $`; # $PREFIX
next;
}
$line .= $_;
$line =~ s/^\s+//;
next if /^$/;
if ($line =~ /^username\s+/i) {
$user = $'; # $POSTFIX
$user =~ s/\s+$//;
$user =~ s/^"(.*)"$/$1/;
if ($user !~ /[EMAIL PROTECTED]/) {
print STDERR "$file:$lineno: Illegal username: '$user'\n";
exit 1;
}
} elsif ($line =~ /^password\s+/i) {
$pw = $'; # $POSTFIX
$pw =~ s/\s+$//;
if ($pw =~ /^"(.*)"$/) {
$pw = $1;
$pw =~ s/\\"/"/g;
$pw =~ s/\\\\/\\/g;
}
} elsif ($line =~ /^spamlevel\s+/i) {
$spam = $';
if ($spam =~ /^(\d+)\s*$/) {
$spam = $1;
} else {
print STDERR "$file:$lineno: Illegal spamlevel value: '$spam'\n";
exit 1;
}
} elsif ($line =~ /^action\s+/i) {
$action = $'; # $POSTFIX
$action =~ s/^"(.*)"\s*/$1/;
unless (defined $act{$action}) {
print STDERR "$file:$lineno: Illegal action value: '$action'\n";
exit 1;
}
$action = $act{$action};
} elsif ($line =~ /^default\s+/i) {
$default = $'; # $POSTFIX
$default =~ s/^"(.*)"\s*/$1/;
unless (defined $act{$default}) {
print STDERR "$file:$lineno: Illegal default value: '$default'\n";
exit 1;
}
$default = $act{$default};
} elsif ($line =~ /^log\s+/i) {
$logfile = $'; # $POSTFIX
$logfile =~ s/^"(.*)"\s*/$1/;
$logfile =~ s/\\"/"/g;
$logfile =~ s/\\\\/\\/g;
$logfile =~ s,^\$HOME/,$ENV{'HOME'}/,;
$logfile =~ s,^~/,$ENV{'HOME'}/,;
$logfile =~ s,^~(\w+)/,(getpwnam($1))[7]."/",e;
if ($logfile =~ /^M:/i) {
$logfile =~ s,\\,/,g;
$logfile =~ s,^M:,$ENV{'HOME'},;
}
$logfile = undef if $logfile eq "none";
} elsif ($line =~ /^([^@ [EMAIL PROTECTED]@])+\s*/) {
$conf{$line} = { "user" => $user,
"password" => $pw,
"spamlevel" => $spam,
"action" => $action,
"default" => $default,
"logfile" => $logfile,
"order" => ++$count,
};
} else {
print STDERR "$file:$lineno: Syntax error: '$line'\n";
exit 1;
}
$line = "";
}
close (CONF);
return \%conf;
}
sub prompt_for_config {
my ($rc) = @_;
print "No configuration file found: $rc\n";
my $ans = $term->readline ("Do you want to create one? [yes] ");
print "\n";
if ($ans !~ /^\s*(|y|yes|j|ja)\s*$/i) {
print "I take that as a no. Goodbye!\n";
return undef;
}
umask 077;
unless (open (RC, ">$rc")) {
print STDERR "$rc: $!\n";
return undef;
}
my $user = $term->readline ("Enter Mailman username: ");
print "\n";
print RC "username $user\r\n";
my $pass = $term->readline ("Enter Mailman password (will appear on screen): ");
print "\n";
$pass =~ s/"/\\"/g;
print RC "password \"$pass\"\r\n";
print <<END;
Listadmin can discard messages with a high spam score automatically.
A value in the interval 5 to 12 is recommended.
END
my $spam = $term->readline ("What threshold do you want? [8]");
print "\n";
$spam =~ s/\s*//g;
$spam ||= "8";
if ($spam =~ /^\d+$/) {
print RC "spamlevel $spam\r\n";
} else {
print "No automatic discard will be done.\n";
}
my $extra = <<END;
# If you uncomment the following you will only have to press Return
# to discard a message:
#
# default discard
# Uncomment the following to get a terse transaction log:
#
# log "~/.listadmin.log"
END
$extra =~ s/\n/\r\n/g;
print RC $extra;
print <<END;
Now enter the addresses of the lists you maintain. End with an empty
line.
END
my $list;
do {
$list = $term->readline ("> ");
print "\n";
$list =~ s/\s*//g;
print RC "$list\r\n" if $list;
} while ($list);
close (RC);
print <<END;
The configuration has been saved in $rc.
You can edit this file with an ordinary text editor, such as Notepad,
Pico, or Emacs. To read about all the configuration options, run
'man listadmin'.
END
return 1;
}
sub commit_changes {
my ($list, $user, $pw, $change, $msgs, $logfile) = @_;
my $url = mailman_url ($list, $user, $pw);
my $changes = 0;
my ($sec, $min, $hour, $mday, $mon, $year) = (localtime (time))[0..5];
my $log = sprintf ("submitting %s %04d-%02d-%02dT%02d:%02d:%02d\n",
$list, $year+1900, $mon+1, $mday, $hour, $min, $sec);
my $action = $msgs->{"global"}{"actions"};
for $id (keys %{$change}) {
my ($what, $text) = @{$change->{$id}};
$url .= "&$id=" . $action->{$what};
$log .= sprintf ("%s D:[%s] F:[%s] S:[%s]\n",
$what,
$msgs->{$id}{"date"},
$msgs->{$id}{"from"},
$msgs->{$id}{"subject"});
if ($what == "r") {
$text =~ s/(\W)/sprintf("%%%02x", ord($1))/ge;
$url .= "&comment_$id=$text";
}
++$changes;
}
if ($changes) {
my $opened;
if ($logfile) {
if (open (LOG, ">>$logfile")) {
$opened = 1;
print LOG $log;
} else {
print STDERR "WARNING: Failed to append to $logfile: $!\n";
}
}
get ($url);
if ($opened) {
print LOG "changes sent to server.\n";
close (LOG);
}
}
}
--
-------------------------------------------------------
This SF.Net email is sponsored by: INetU
Attention Web Developers & Consultants: Become An INetU Hosting Partner.
Refer Dedicated Servers. We Manage Them. You Get 10% Monthly Commission!
INetU Dedicated Managed Hosting http://www.inetu.net/partner/index.php
_______________________________________________
Spamassassin-talk mailing list
[EMAIL PROTECTED]
https://lists.sourceforge.net/lists/listinfo/spamassassin-talk
