aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorLibravatarUnit 193 <unit193@ubuntu.com>2019-12-05 16:35:06 -0500
committerLibravatarUnit 193 <unit193@ubuntu.com>2019-12-05 16:35:06 -0500
commit7d205e0ab81fb362055f2c07ab51d29656c01c53 (patch)
tree7990f4efac4d2874d1e8109e8cd2e527740959c7
parent748708cf83bc93ffbdb72a2b9c613bb564793ad2 (diff)
downloadlistadmin-7d205e0ab81fb362055f2c07ab51d29656c01c53.tar.bz2
listadmin-7d205e0ab81fb362055f2c07ab51d29656c01c53.tar.xz
listadmin-7d205e0ab81fb362055f2c07ab51d29656c01c53.tar.zst
Import Upstream version 2.28upstream/2.28
-rw-r--r--Makefile2
-rw-r--r--listadmin.man22
-rwxr-xr-xlistadmin.pl388
-rw-r--r--listadmin.txt24
4 files changed, 275 insertions, 161 deletions
diff --git a/Makefile b/Makefile
index 4c24933..3aa4a22 100644
--- a/Makefile
+++ b/Makefile
@@ -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