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