diff options
author | Unit 193 <unit193@ubuntu.com> | 2019-12-05 16:35:06 -0500 |
---|---|---|
committer | Unit 193 <unit193@ubuntu.com> | 2019-12-05 16:35:06 -0500 |
commit | 7d205e0ab81fb362055f2c07ab51d29656c01c53 (patch) | |
tree | 7990f4efac4d2874d1e8109e8cd2e527740959c7 | |
parent | 748708cf83bc93ffbdb72a2b9c613bb564793ad2 (diff) | |
download | listadmin-7d205e0ab81fb362055f2c07ab51d29656c01c53.tar.bz2 listadmin-7d205e0ab81fb362055f2c07ab51d29656c01c53.tar.xz listadmin-7d205e0ab81fb362055f2c07ab51d29656c01c53.tar.zst |
Import Upstream version 2.28upstream/2.28
-rw-r--r-- | Makefile | 2 | ||||
-rw-r--r-- | listadmin.man | 22 | ||||
-rwxr-xr-x | listadmin.pl | 388 | ||||
-rw-r--r-- | listadmin.txt | 24 |
4 files changed, 275 insertions, 161 deletions
@@ -1,7 +1,7 @@ SHELL = /bin/sh INSTALL = install -c -VERSION = 2.27 +VERSION = 2.28 PREFIX = /usr/local BINDIR = $(PREFIX)/bin diff --git a/listadmin.man b/listadmin.man index b6419e3..0add86a 100644 --- a/listadmin.man +++ b/listadmin.man @@ -81,6 +81,13 @@ This specifies the threshold for automatic discard of suspected spam messages. 12 is unlikely to have false positives. No user confirmation is needed, so it is best to play it safe. Less than 5 is not recommended. +.IP "spamheader \fIheader-name\fP" +The name of the header which contains the spam score. It is assumed +that the score is encoded as a sequence of characters, like "*****" +for the value 5. By default it will look for all headers with names +containing "spam" and "score" or "level", and pick the highest score +if there is more than one. Setting the header-name to \fIdefault\fP +will restore this behaviour. .IP "not_spam_if_from \fIpattern\fP" If the message's From header matches the pattern, all automatic actions will be cancelled and you will be asked what action to take @@ -130,7 +137,8 @@ This batch of lines are terminated by a line saying \fBchanges sent to server\fP. .IP The filename \fBnone\fP turns off logging. -.RE +\" "dumpdir" is for developer use, so it isn't documented. + .SH INTERACTIVE USE The user interface to \fBlistadmin\fP is line oriented with single @@ -151,6 +159,8 @@ Skip the message, leave its status as pending unchanged. View Body, display the first 20 lines of the message. .IP f View Full, display the complete message, including headers. +.IP t +View Time, display the Date header from the message. .IP \fInumber\fP Jump forward or backward to message \fInumber\fP. .IP /\fIpattern\fP @@ -159,6 +169,8 @@ Subject. If \fIpattern\fP is left out, the previous value will be used. .IP ?\fIpattern\fP As above, but backwards. +.IP . +Redisplay information about current message. .IP q Quit processing this list and go on to the next. .RE @@ -212,17 +224,9 @@ An example configuration file: The default configuration file. .SH BUGS -The SpamAssassin score is fetched from the header X-Spam-Level, the -value is the number of asterisks following. It will also check a -header specific to the University of Oslo. If this does not match -your setup, you will need to change the Perl code. I'd be interested -in ideas on how to best make this configurable. - The HTML parser is quite fragile and depends on Mailman not to change the format of its generated code. -Mailman 2.1 is not supported. - ISO 8859-1 environment is assumed. .SH AUTHOR diff --git a/listadmin.pl b/listadmin.pl index d9c32d9..8703e9b 100755 --- a/listadmin.pl +++ b/listadmin.pl @@ -1,8 +1,12 @@ #! /usr/bin/perl -w # -# listadmin version 2.27 -# Written 2003 - 2005 by +# listadmin version 2.28 +# Written 2003 - 2006 by # Kjetil Torgrim Homme <kjetilho+listadmin@ifi.uio.no> +# +# Thank you, Sam Watkins and Bernie Hoeneisen, for contributions and +# feedback. +# # Released into public domain. use HTML::TokeParser; @@ -13,9 +17,9 @@ use Data::Dumper; use Term::ReadLine; use Getopt::Std; use strict; +use English; my $rc = $ENV{"HOME"}."/.listadmin.ini"; -my $oldconf = $ENV{"HOME"}."/.listconf"; sub usage { print STDERR <<_end_; @@ -31,7 +35,6 @@ _end_ my $term; my $ua = new LWP::UserAgent ("timeout" => 600); -upgrade_config($oldconf, $rc); our ($opt_f, $opt_t); @@ -65,9 +68,12 @@ if (@ARGV) { @lists = sort config_order keys %{$config} } -my ($from, $subject, $reason, $spamscore); +my ($num, $count, $list, $from, $subject, $reason, $spamscore); format STDOUT = + +@<<<<<<< ========== @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +sprintf("[%d/%d]", $num, $count), $list." "."=" x (51 - length($list)) From: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $from Subject: ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @@ -79,22 +85,35 @@ Reason: @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< Spam? @<< . -for my $list (@lists) { +for $list (@lists) { my $user = $config->{$list}{"user"}; - my $pw = $config->{$list}{"password"}; + my $pw = $config->{$list}{"password"} || ""; if (time > $time_limit) { print "Time's up, skipping the remaining lists\n"; last; } + + my $info = {}; print "fetching data for $list\n"; - my $info = get_list ($list, $config->{$list}{"adminurl"}, $user, $pw); + do { + if ($pw eq "" || $info->{'autherror'}) { + $pw = prompt_password("Enter password" . + ($user ? " for $user: ": ": ")); + } + $info = get_list ($list, $config->{$list}, $pw) if $pw; + } while ($info->{'autherror'} && $pw); + if ($info->{'servererror'} || $info->{'autherror'}) { + print "skipping...\n"; + next; + } + my %change = (); - process_subscriptions ($list, $info, $config->{$list}, \%change); - my $num = undef; + process_subscriptions ($info, $config->{$list}, \%change); + $num = undef; restart_approval: - approve_messages ($list, $info, $config->{$list}, \%change, $num); + approve_messages ($info, $config->{$list}, \%change); if ($config->{$list}->{"confirm"}) { if (scalar %change) { @@ -124,7 +143,7 @@ _END_ } sub process_subscriptions { - my ($list, $info, $config, $change) = @_; + my ($info, $config, $change) = @_; my %subscribers = (); my $num = 0; for my $req (keys %{$info}) { @@ -186,7 +205,7 @@ end } sub approve_messages { - my ($list, $info, $config, $change, $num) = @_; + my ($info, $config, $change) = @_; my $listdef = $config->{"default"}; my $spamlevel = $config->{"spamlevel"}; @@ -196,7 +215,7 @@ sub approve_messages { my $dis_subj = $config->{"discard_if_subject"}; my $dis_reas = $config->{"discard_if_reason"}; - my $count = keys (%{$info}) - 1; # subtract 1 for globals + $count = keys (%{$info}) - 1; # subtract 1 for globals my $search_pattern = ""; my $dont_skip_forward = 0; if (!defined ($num)) { @@ -214,7 +233,6 @@ sub approve_messages { $subject = $info->{$id}{"subject"} || ""; $reason = $info->{$id}{"reason"}; $spamscore = $info->{$id}{"spamscore"}; - print "\n[$num/$count] ========== $list ==========\n"; write; while (1) { @@ -332,9 +350,14 @@ sub approve_messages { my @lines = split (/\n/, $text, 21); pop @lines; print join ("\n", @lines), "\n"; + } elsif ($ans eq "t") { + print $info->{$id}{"date"}, "\n"; } elsif ($ans eq "url") { - print mailman_url($list, $config->{adminurl}, - $config->{user}), "\n"; + print mailman_url($list, $config->{adminurl}), "\n"; + } elsif ($ans eq ".") { + # write modifies $subject, so reinitialise it + $subject = $info->{$id}{"subject"} || ""; + write; } elsif ($ans eq "") { # nothing. } else { @@ -348,9 +371,11 @@ and pressing Return. 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 + t view Time -- display the date the message was sent # jump -- jump backward or forward to message number # /pattern -- search for next message with matching From or Subject ?pattern -- search for previous message with matching From or Subject + . -- redisplay entry q Quit -- go on to the next list end @@ -371,7 +396,7 @@ sub url_quote_parameter { sub mailman_params { my ($user, $pw) = @_; - my %params = (); + my %params; $params{"username"} = $user if defined $user; $params{"adminpw"} = $pw if defined $pw; return \%params; @@ -385,11 +410,13 @@ sub uio_adminurl { if ($domain eq "lister.uio.no"); return 'http://{subdomain}-lists.uio.no/mailman/admindb/{list}@{domain}' if ($domain =~ /^(\w+\.)?uio\.no$/); + return 'http://lists.{domain}/mailman/admindb/{list}@{domain}' + if ($domain eq "simula.no"); undef; } sub mailman_url { - my ($list, $pattern) = @_; + my ($list, $pattern, $params) = @_; my ($lp, $domain) = split ('@', $list); @@ -398,54 +425,92 @@ sub mailman_url { my $url = $pattern; my $subdom = $domain; - $subdom = $` if $subdom =~ /\./; + $subdom = $PREMATCH if $subdom =~ /\./; $url =~ s/\{list\}/$lp/g; $url =~ s/\{domain\}/$domain/g; $url =~ s/\{subdomain\}/$subdom/g; + $url .= "?$params" if $params; return $url; } +# Returns a ref to a hash with all the information about pending messages sub get_list { - my ($list, $url, $user, $pw) = @_; + my ($list, $config, $pw) = @_; - # where we gather all the information about pending messages - my %data = (); my $starttime = time; - - my $page; - - my $resp = $ua->post (mailman_url($list, $url), mailman_params($user, $pw)); - $page = $resp->content; - - # save it for eased debug for the developer... - if ($< == 1232 && open (DUMP, ">/tmp/dump-$list.html")) { - print DUMP $page; - close (DUMP); - } - + my $mmver; + my ($page, $page_appr, $resp_appr); + my $resp = $ua->post(mailman_url($list, $config->{"adminurl"}), + mailman_params($config->{"user"}, $pw)); unless ($resp->is_success) { print STDERR $resp->error_as_HTML; - return (); + return {'servererror' => 1}; } - my $parse = HTML::TokeParser->new(\$page) || die; + $page = $resp->content; + my $parse = HTML::TokeParser->new(\$page) || die; $parse->get_tag ("title") || die; my $title = $parse->get_trimmed_text ("/title") || die; if ($title =~ /authentication/i) { print STDERR "Unable to log in. Is your username and password correct?\n"; - return (); + return {'autherror' => 1}; } - my $mmver; + my @mailman_mentions = grep {/Mailman/} split (/\n/, $page); + my $last_mention = pop(@mailman_mentions); + die "Can not find version information in '$last_mention'\n" + unless $last_mention =~ /\bv(ersion)?\s(\d+\.\d+)/; + $mmver = $2; + + if ($mmver ge "2.1") { + # Mailman does not look for "details" in parameters, so it + # must be part of the query string. + $resp = $ua->post(mailman_url($list, $config->{"adminurl"}, + "details=all"), + mailman_params($config->{"user"}, $pw)); + unless ($resp->is_success) { + print STDERR $resp->error_as_HTML; + return {'servererror' => 1}; + } + $page_appr = $resp->content; + } + + my $dumpdir = $config->{$list}{"dumpdir"}; + if (defined $dumpdir) { + if (open (DUMP, ">$dumpdir/dump-subs-$list.html")) { + print DUMP $page; + close (DUMP); + } + if ($page_appr && open (DUMP, ">$dumpdir/dump-held-$list.html")) { + print DUMP $page_appr; + close (DUMP); + } + } + + my $data; + if ($mmver eq "2.1") { + my $parse_appr = HTML::TokeParser->new(\$page_appr) || die; + $data = parse_pages_mm_2_1($mmver, $config, $parse, $parse_appr); + } else { + $data = parse_pages_mm_old($mmver, $config, $parse); + } + set_param_values($mmver, $data); + return $data; +} + +sub parse_pages_mm_old { + my ($mmver, $config, $parse) = @_; + + my %data = (); + my $token; $parse->get_tag ("hr"); $parse->get_tag ("h2") || return (); my $headline = $parse->get_trimmed_text ("/h2") || die; if ($headline =~ /subscription/i) { - parse_subscriptions ($parse, \%data); - my $token = $parse->get_token; + parse_subscriptions ($mmver, $config, $parse, \%data); + $token = $parse->get_token; if (lc ($token->[1]) eq "input") { - return () unless parse_footer ($parse, \%data, $mmver); return (\%data); } else { $parse->get_tag ("h2") || die; @@ -453,27 +518,44 @@ sub get_list { } } if ($headline =~ /held for approval/i) { - $mmver = parse_approvals ($parse, \%data); + parse_approvals ($mmver, $config, $parse, \%data); } else { $parse->get_tag ("hr") || die; - my $token = $parse->get_token; + $token = $parse->get_token; if ($token->[0] eq "S" && lc ($token->[1]) eq "center") { - $mmver = parse_approvals ($parse, \%data); + parse_approvals ($mmver, $config, $parse, \%data); } } - return () unless parse_footer ($parse, \%data, $mmver); + return (\%data); +} + +sub parse_pages_mm_2_1 { + my ($mmver, $config, $parse_subs, $parse_appr) = @_; + + my %data = (); + my $headline; + + $parse_subs->get_tag ("hr"); + if ($parse_subs->get_tag ("h2")) { + parse_subscriptions ($mmver, $config, $parse_subs, \%data); + } + + $parse_appr->get_tag ("hr"); + if ($parse_appr->get_tag ("h2")) { + parse_approvals ($mmver, $config, $parse_appr, \%data); + } return (\%data); } sub parse_subscriptions { - my ($parse, $data) = @_; + my ($mmver, $config, $parse, $data) = @_; my $token; $parse->get_tag ("table") || die; $parse->get_tag ("tr") || die; $parse->get_tag ("tr") || die; do { - parse_subscription ($parse, $data); + parse_subscription ($mmver, $config, $parse, $data); do { $token = $parse->get_token; } until ($token->[0] eq "S"); @@ -481,7 +563,7 @@ sub parse_subscriptions { } sub parse_subscription { - my ($parse, $data) = @_; + my ($mmver, $config, $parse, $data) = @_; $parse->get_tag ("td") || die; my $address = $parse->get_trimmed_text ("/td") || die; @@ -493,19 +575,18 @@ sub parse_subscription { } sub parse_approvals { - my ($parse, $data) = @_; + my ($mmver, $config, $parse, $data) = @_; my $token; - my $mmver; do { $parse->get_tag ("table") || die; - my $ret = parse_approval ($parse, $data); - $mmver = $ret if $ret; + parse_approval ($mmver, $config, $parse, $data); $parse->get_tag ("/table"); $parse->get_tag ("hr"); $token = $parse->get_token; + $token = $parse->get_token + if ($token->[0] eq "S" && lc ($token->[1]) eq "center"); } until ($token->[0] eq "S" && lc ($token->[1]) eq "input"); - return ($mmver); } # NB! lossy! @@ -530,29 +611,29 @@ sub decode_rfc2047_qp { } sub parse_approval { - my ($parse, $data) = @_; - my ($from, $reason, $subject, $id, $mmver, $body, $headers); + my ($mmver, $config, $parse, $data) = @_; + my ($from, $reason, $subject, $id, $body, $headers); - $parse->get_tag ("tr") || die; + $parse->get_tag ("tr") || die; # From: $parse->get_tag ("td") || die; $parse->get_tag ("td") || die; $from = $parse->get_trimmed_text("/td"); - $parse->get_tag ("tr") || die; # Reason: _or_ Subject: - $parse->get_tag ("td") || die; - my $field = $parse->get_trimmed_text ("/td"); - $parse->get_tag ("td") || die; - if ($field =~ /Reason/) { - $mmver = 1.2; + if ($mmver eq "1.2") { + $parse->get_tag ("tr") || die; # 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 ("tr") || die; # Subject: $parse->get_tag ("td") || die; $parse->get_tag ("td") || die; $subject = $parse->get_trimmed_text("/td"); } else { - $mmver = 2; + $parse->get_tag ("tr") || die; # Subject: + $parse->get_tag ("td") || die; + $parse->get_tag ("td") || die; $subject = $parse->get_trimmed_text("/td"); - $parse->get_tag ("tr") || die; # Reason: + $parse->get_tag ("tr") || die; # Reason: $parse->get_tag ("td") || die; $parse->get_tag ("td") || die; $reason = $parse->get_trimmed_text("/td"); @@ -568,7 +649,7 @@ sub parse_approval { $utf8 ||= 1 if defined $1 && $1 =~ /utf-8/i; $subject = utf8_to_latin1 ($subject) if $utf8; - $parse->get_tag ("tr") || die; # Action: + $parse->get_tag ("tr") || die; # Action: my $tag = $parse->get_tag ("input") || die; $id = $tag->[1]{"name"}; @@ -577,7 +658,7 @@ sub parse_approval { "reason" => $reason }; $parse->get_tag ("tr") || die; # Reject _or_ Preserve message - if ($mmver >= 2) { + if ($mmver ge "2.0") { $parse->get_tag ("tr") || die; # forward $parse->get_tag ("tr") || die; # Reject } @@ -590,24 +671,34 @@ sub parse_approval { $parse->get_tag ("td") || die; $parse->get_tag ("td") || die; $headers = $parse->get_text("/td"); - $data->{$id}->{"spamscore"} = 0; - $data->{$id}->{"spamscore"} = length ($1) - if $headers =~ /^X-Spam-Level: (\*+)/im; - $data->{$id}->{"spamscore"} = length ($1) - if $headers =~ /^X-UiO-Spam-score: (s+)/m; + + # We handle spam score headers on the formats: + # X-spam-score: ***** + # X-spam-score: 4.23 (****) + # + # The name of the header is flexible. + my $header_re = $config->{"spamheader"} || 'X-\S*spam-?(?:level|score)'; + + # Extract the length from all spam score headers, sort them in + # descending order, and pick the front (max) element: + my ($score) = sort {$b <=> $a} + map {length} + $headers =~ /^$header_re:\s+ + (?:\d+\.\d+\s+)? \(?(\S+)\)?/xgim; + + $data->{$id}->{"spamscore"} = $score || 0; $data->{$id}->{"date"} = "<no date>"; $data->{$id}->{"date"} = $1 - if $headers =~ /^Date: (.*)$/m; - - if ($mmver == 2) { + if $headers =~ /^Date:\s+(.*)$/m; + if ($mmver ge "2.0") { $parse->get_tag ("tr") || die; # Message Excerpt $parse->get_tag ("td") || die; $parse->get_tag ("textarea") || die; $body = $parse->get_text("/textarea"); } else { $headers =~ s/\n\n//s; - $body = $'; # ' # stupid perl-mode - $headers = $`; + $body = $POSTMATCH; + $headers = $PREMATCH; } $headers =~ s/^\s+//; $body .= "\n" unless $body =~ /\n$/; @@ -617,23 +708,10 @@ sub parse_approval { return ($mmver); } -sub parse_footer { - my ($parse, $data, $mmver) = @_; - - $parse->get_tag ("address") || die; - my $text = $parse->get_trimmed_text ("/address") || die; +sub set_param_values { + my ($mmver, $data) = @_; - if ($text =~ /Mailman\s*v(ersion)? (\d+\.\d+)/) { - if ($mmver && $mmver != 0 + $2) { - print STDERR "Unknown version of Mailman. First I thought ", - "this was version $mmver.\n", "Now version ", 0 + $2, - " looks more likely. Help!\n"; - return (0); - } - $mmver = 0 + $2; - } - - if ($mmver == 2) { + if ($mmver ge "2.0") { $data->{"global"}{"actions"} = { "a" => 1, "r" => 2, "d" => 3, @@ -648,32 +726,6 @@ sub parse_footer { "sr" => 0, # subscribe reject }; } - return (1); -} - -# .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; (". <<'END' . ") > $rc"; - printf "# automatically converted from .listconf\r\n"; - printf "#\r\n"; - printf "username $LISTUSER\r\n"; - printf "password \"$LISTPASS\"\r\n"; - printf "spamlevel 12\r\n"; - printf "not_spam_if_from uio\.no\n"; - printf "default discard\r\n"; - printf "# uncomment the following to get a terse transaction log\r\n"; - printf "# log \"~/.listadmin.log\"\r\n"; - printf "\r\n"; - for l in $LISTS; do printf "$l\r\n"; done -END - system $cmd; } sub read_config { @@ -689,8 +741,10 @@ sub read_config { my $count = 0; my $lineno = 0; my $logfile; + my $dumpdir; my $confirm = 1; my $url; + my $spamheader; my %patterns = map { $_ => undef; } qw (not_spam_if_from not_spam_if_subject @@ -710,25 +764,25 @@ sub read_config { chomp; s/\r$//; s/\s+$//; # trailing whitespace is "always" unintended - next if /^\s*#/; + next if /^\s*\#/; s/^\s+// if $line; # remove leading whitespace after continuation if (/\\$/) { - $line .= $`; # $PREFIX + $line .= $PREMATCH; next; } $line .= $_; $line =~ s/^\s+//; next if /^$/; if ($line =~ /^username\s+/i) { - $user = unquote ($'); # ' stupid perl-mode + $user = unquote($POSTMATCH); if ($user !~ /^[a-z0-9._+-]+\@[a-z0-9.-]+$/) { print STDERR "$file:$lineno: Illegal username: '$user'\n"; exit 1; } } elsif ($line =~ /^password\s+/i) { - $pw = unquote ($'); # ' stupid perl-mode + $pw = unquote($POSTMATCH); } elsif ($line =~ /^spamlevel\s+/i) { - $spam = unquote ($'); # ' stupid perl-mode + $spam = unquote($POSTMATCH); if ($spam =~ /^(\d+)\s*$/) { $spam = $1; } else { @@ -737,7 +791,7 @@ sub read_config { exit 1; } } elsif ($line =~ /^confirm\s+/i) { - $confirm = unquote ($'); # ' stupid perl-mode + $confirm = unquote($POSTMATCH); if ($confirm eq "yes") { $confirm = 1; } elsif ($confirm eq "no") { @@ -748,7 +802,7 @@ sub read_config { exit 1; } } elsif ($line =~ /^action\s+/i) { - $action = unquote ($'); # ' stupid perl-mode + $action = unquote($POSTMATCH); unless (exists $act{$action}) { print STDERR "$file:$lineno: Illegal value: '$action'\n"; print STDERR "choose one of ", @@ -757,10 +811,10 @@ sub read_config { } $action = $act{$action}; } elsif ($line =~ /^adminurl\s+/i) { - $url = unquote ($'); # ' stupid perl-mode + $url = unquote($POSTMATCH); $url = undef if $url eq "NONE"; } elsif ($line =~ /^default\s+/i) { - $default = unquote ($'); # ' stupid perl-mode + $default = unquote($POSTMATCH); unless (exists $act{$default}) { print STDERR "$file:$lineno: Illegal value: '$default'\n"; print STDERR "choose one of ", @@ -769,17 +823,12 @@ sub read_config { } $default = $act{$default}; } elsif ($line =~ /^log\s+/i) { - $logfile = unquote ($'); # ' stupid perl-mode - $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"; + $logfile = expand_pathname(unquote($POSTMATCH)); + } elsif ($line =~ /^dumpdir\s+/i) { + $dumpdir = expand_pathname(unquote($POSTMATCH)); + mkdir($dumpdir) if (defined $dumpdir); } elsif ($line =~ /^subscription_action\s+/) { - $subact = unquote ($'); # ' stupid perl-mode + $subact = unquote($POSTMATCH); unless (exists $sact{$subact}) { print STDERR "$file:$lineno: Illegal value: '$subact'\n"; print STDERR "choose one of ", @@ -788,7 +837,7 @@ sub read_config { } $subact = $sact{$subact}; } elsif ($line =~ /^subscription_default\s+/) { - $subdef = unquote ($'); # ' stupid perl-mode + $subdef = unquote($POSTMATCH); unless (exists $sact{$subdef}) { print STDERR "$file:$lineno: Illegal value: '$subdef'\n"; print STDERR "choose one of ", @@ -798,7 +847,7 @@ sub read_config { $subdef = $sact{$subdef}; } elsif ($line =~ /^($pattern_keywords)\s+/o) { my $key = $1; - my $val = $'; # ' stupid perl-mode + my $val = $POSTMATCH; $val =~ s/\s+$//; if ($val =~ /^"(.*)"$/) { $val = $1; @@ -806,6 +855,14 @@ sub read_config { $val =~ s/\\\\/\\/g; } $patterns{$key} = ($val eq "NONE") ? undef : $val; + } elsif ($line =~ /^spamheader\s+/) { + $spamheader = unquote($POSTMATCH); + unless ($spamheader =~ /^[\w-]+$/) { + print STDERR "$file:$lineno: Illegal header name: ". + "'$spamheader'\n"; + exit 1; + } + $spamheader = undef if $spamheader eq "default"; } elsif ($line =~ /^([^@ \t]+@[^@])+\s*/) { $conf->{$line} = { "user" => $user, "password" => $pw, @@ -817,6 +874,8 @@ sub read_config { "action" => $action, "default" => $default, "logfile" => $logfile, + "dumpdir" => $dumpdir, + "spamheader" => $spamheader, %patterns, "order" => ++$count, }; @@ -840,6 +899,22 @@ sub unquote { } return ($val); } + +sub expand_pathname { + my ($pathname) = @_; + + $pathname =~ s,^\$HOME/,$ENV{'HOME'}/,; + $pathname =~ s,^~/,$ENV{'HOME'}/,; + $pathname =~ s,^~(\w+)/,(getpwnam($1))[7]."/",e; + if ($pathname =~ /^M:/i) { + $pathname =~ s,\\,/,g; + $pathname =~ s,^M:,$ENV{'HOME'},; + } + $pathname = undef if $pathname eq "none"; + return $pathname; +} + + sub prompt_for_config { my ($rc) = @_; @@ -858,7 +933,7 @@ sub prompt_for_config { my $user = prompt ("Enter Mailman username: "); print "\n"; print RC "username $user\r\n"; - my $pass = prompt ("Enter Mailman password (will appear on screen): "); + my $pass = prompt_password("Enter Mailman password: "); print "\n"; $pass =~ s/"/\\"/g; print RC "password \"$pass\"\r\n"; @@ -899,7 +974,7 @@ END do { $list = prompt ("> "); print "\n"; - $list =~ s/\s*//g; + $list =~ s/\s*//g if $list; print RC "$list\r\n" if $list; } while ($list); close (RC); @@ -1022,6 +1097,33 @@ sub got_match { } } +sub restore_echo_and_exit { + system("stty echo"); + print "\n"; + exit(1); +} + +sub prompt_password { + my ($prompt) = @_; + my $answer; + my $echooff; + + $SIG{'INT'} = $SIG{'TERM'} = \&restore_echo_and_exit; + system("stty -echo 2>/dev/null"); + if ($? == 0) { + $echooff = 1; + } else { + $prompt .= "(will appear on screen): "; + } + $answer = prompt($prompt); + if ($echooff) { + print "\n"; + system("stty echo"); + $SIG{'INT'} = $SIG{'TERM'} = 'DEFAULT'; + } + return $answer; +} + sub prompt { # $term is a global variable. we initialise it here, so that it # is only done if the user actually needs prompting. diff --git a/listadmin.txt b/listadmin.txt index 818df55..daf165c 100644 --- a/listadmin.txt +++ b/listadmin.txt @@ -1,3 +1,6 @@ +XXX +XXX WARNING: old character encoding and/or character set +XXX LISTADMIN(1) LISTADMIN(1) NAME @@ -93,6 +96,15 @@ DIRECTIVES positives. No user confirmation is needed, so it is best to play it safe. Less than 5 is not recommended. + spamheader header-name + The name of the header which contains the spam score. It + is assumed that the score is encoded as a sequence of + characters, like "*****" for the value 5. By default it + will look for all headers with names containing "spam" + and "score" or "level", and pick the highest score if + there is more than one. Setting the header-name to + default will restore this behaviour. + not_spam_if_from pattern If the message's From header matches the pattern, all automatic actions will be cancelled and you will be asked @@ -174,6 +186,8 @@ INTERACTIVE USE f View Full, display the complete message, including headers. + t View Time, display the Date header from the message. + number Jump forward or backward to message number. /pattern @@ -184,6 +198,8 @@ INTERACTIVE USE ?pattern As above, but backwards. + . Redisplay information about current message. + q Quit processing this list and go on to the next. Changes will not take effect until the end of the list has been @@ -232,17 +248,9 @@ FILES The default configuration file. BUGS - The SpamAssassin score is fetched from the header X-Spam-Level, the - value is the number of asterisks following. It will also check a - header specific to the University of Oslo. If this does not match your - setup, you will need to change the Perl code. I'd be interested in - ideas on how to best make this configurable. - The HTML parser is quite fragile and depends on Mailman not to change the format of its generated code. - Mailman 2.1 is not supported. - ISO 8859-1 environment is assumed. AUTHOR |