aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorLibravatarUnit 193 <unit193@ubuntu.com>2019-12-05 16:35:14 -0500
committerLibravatarUnit 193 <unit193@ubuntu.com>2019-12-05 16:35:14 -0500
commit379262652097893c9aabc5f9d2ba5d991ad3d7c6 (patch)
treec2c5e9c7fda9d36625f0851082112b750db59dd5
parent98331030271c4c646e78bf302d9b870c56fa8d7e (diff)
downloadlistadmin-379262652097893c9aabc5f9d2ba5d991ad3d7c6.tar.bz2
listadmin-379262652097893c9aabc5f9d2ba5d991ad3d7c6.tar.xz
listadmin-379262652097893c9aabc5f9d2ba5d991ad3d7c6.tar.zst
Import Upstream version 2.39upstream/2.39
-rw-r--r--Makefile15
-rw-r--r--listadmin.man7
-rwxr-xr-xlistadmin.pl133
-rw-r--r--listadmin.txt7
4 files changed, 126 insertions, 36 deletions
diff --git a/Makefile b/Makefile
index 9a43be4..2d542b5 100644
--- a/Makefile
+++ b/Makefile
@@ -1,11 +1,13 @@
SHELL = /bin/sh
-INSTALL = install -c
+# a BSD or GNU style install is required, e.g., /usr/ucb/install on Solaris
+INSTALL = install
-VERSION = 2.37
+VERSION = 2.39
PREFIX = /usr/local
-BINDIR = $(PREFIX)/bin
-MANDIR = $(PREFIX)/share/man
+prefix = $(PREFIX)
+bindir = $(prefix)/bin
+mandir = $(prefix)/share/man
SRCFILES = Makefile listadmin.pl listadmin.man
@@ -13,8 +15,9 @@ all:
@echo Nothing needs to be done
install:
- $(INSTALL) listadmin.pl $(bindir)/listadmin
- $(INSTALL) -m 644 listadmin.man $(mandir)/man1/listadmin.1
+ $(INSTALL) -d $(DESTDIR)$(bindir) $(DESTDIR)$(mandir)/man1
+ $(INSTALL) -m 755 listadmin.pl $(DESTDIR)$(bindir)/listadmin
+ $(INSTALL) -m 644 listadmin.man $(DESTDIR)$(mandir)/man1/listadmin.1
listadmin.txt: listadmin.man
# Note the verbatim backspace in the sed command
diff --git a/listadmin.man b/listadmin.man
index 72c79d4..7fd9995 100644
--- a/listadmin.man
+++ b/listadmin.man
@@ -161,10 +161,13 @@ in local time. Then one line for each message, in the format
.IP
\fIaction\fP D:[\fIdate\fP] F:[\fIsender\fP] S:[\fIsubject\fP]
.IP
-This batch of lines are terminated by a line saying \fBchanges sent to
+This batch of lines is terminated by a line saying \fBchanges sent to
server\fP.
.IP
-The filename \fBnone\fP turns off logging.
+The same substitutions are performed on \fIfilename\fP as on the
+argument to \fBadminurl\fP. Tilde syntax can be used to refer to home
+directories. The filename \fBnone\fP turns off logging.
+
\" "dumpdir" is for developer use, so it isn't documented.
.SH INTERACTIVE USE
diff --git a/listadmin.pl b/listadmin.pl
index e4390ed..bb7109c 100755
--- a/listadmin.pl
+++ b/listadmin.pl
@@ -9,7 +9,8 @@
#
# Released into public domain.
-my $version = "2.37";
+my $version = "2.39";
+my $maintainer = "kjetilho+listadmin\@ifi.uio.no";
use HTML::TokeParser;
use LWP::UserAgent;
@@ -187,7 +188,7 @@ for (@lists) {
if ($info->{'servererror'}) {
print "\n";
printf STDERR ("ERROR: fetching %s\n", $info->{'url'});
- printf STDERR ("ERROR: Server returned '%s' -- skipping list\n",
+ printf STDERR ("ERROR: %s -- skipping list\n",
$info->{'servererror'});
next;
} elsif ($info->{'autherror'}) {
@@ -647,29 +648,48 @@ sub get_list {
return {'servererror' => $resp->status_line, 'url' => $url};
}
$page = $resp->content;
- if ($page eq "") {
- if (time - $starttime > 60) {
- print "Mailman server timed out?\n";
- } else {
- print "empty page\n";
- }
- return {};
- }
+
my $dumpdir = $config->{"dumpdir"};
- if (defined $dumpdir) {
- if (open (DUMP, ">$dumpdir/dump-$list.html")) {
+ my $dumpfile;
+ if ($dumpdir && $page) {
+ $dumpfile = "$dumpdir/dump-$list.html";
+ if (open (DUMP, ">$dumpfile")) {
print DUMP $page;
close (DUMP);
}
}
+ if ($page eq "") {
+ if (time - $starttime > 60) {
+ return {servererror => "Mailman server timed out?", url => $url};
+ } else {
+ return {servererror => "Empty page", url => $url};
+ }
+ } elsif ($page =~ get_trans_re("no_such_list")) {
+ return {servererror => "No such list", url => $url}
+ }
+
my $parse = HTML::TokeParser->new(\$page) || die;
$parse->get_tag ("title") || die;
my $title = $parse->get_trimmed_text ("/title") || die;
- if ($title =~ /authentication/i) {
+
+ if ($title =~ get_trans_re("authentication")) {
return {'autherror' => 1};
}
+ if ($page !~ get_trans_re("pending_req")) {
+ my $msg = "unexpected contents";
+ # Use rand() to protect a little against tmpfile races
+ $dumpfile ||= "/tmp/dump-" . rand() . "-$list.html";
+ if (open(DUMP, ">$dumpfile")) {
+ chmod(0600, $dumpfile);
+ print DUMP $page;
+ close(DUMP);
+ $msg .= ", please send $dumpfile to $maintainer";
+ }
+ return {servererror => $msg, url => $url};
+ }
+
my @mailman_mentions = grep {/Mailman/} split (/\n/, $page);
for my $mention (reverse @mailman_mentions) {
if ($mention =~ /\bv(ersion)?\s(\d+\.\d+)/) {
@@ -678,10 +698,7 @@ sub get_list {
}
}
unless ($mmver) {
- if ($page =~ /no such list/i) {
- return {'servererror' => "No such list", 'url' => $url}
- }
- die "Can not find version information in, please mail maintainer.";
+ die "Can not find version information, please mail maintainer.";
}
if ($mmver ge "2.1") {
@@ -719,7 +736,7 @@ sub parse_pages_mm_old {
$parse->get_tag ("hr");
$parse->get_tag ("h2") || return \%data;
my $headline = $parse->get_trimmed_text ("/h2") || die;
- if ($headline =~ /subscription/i) {
+ if ($headline =~ get_trans_re("headline_subscr")) {
parse_subscriptions ($mmver, $config, $parse, \%data);
$token = $parse->get_token;
if (lc ($token->[1]) eq "input") {
@@ -729,7 +746,7 @@ sub parse_pages_mm_old {
$headline = $parse->get_trimmed_text ("/h2") || die;
}
}
- if ($headline =~ /held for approval/i) {
+ if ($headline =~ get_trans_re("held_for_approval")) {
parse_approvals ($mmver, $config, $parse, \%data);
} else {
$parse->get_tag ("hr") || die;
@@ -801,6 +818,60 @@ sub parse_approvals {
} until ($token->[0] eq "S" && lc ($token->[1]) eq "input");
}
+sub get_trans_re {
+ my ($key) = @_;
+
+ # Handle translations -- poorly...
+ #
+ # For now, we look for strings in all languages at the same time
+ # since they don't seem to overlap. This might have to change
+ # later.
+ #
+ # Please send additions if you have them.
+
+ my %translations =
+ ("authentication" =>
+ {
+ "en" => "authentication",
+ "fr" => "authentification",
+ },
+ "subscr_success" =>
+ {
+ "en" => "Successfully ((un)?subscribed|Removed)",
+ "de" => "Erfolgreich (ein|aus)getragen",
+ },
+ "subscr_error" =>
+ {
+ "en" => "Error (un)?subscribing",
+ },
+ "no_such_list" =>
+ {
+ "en" => "Mailman Admindb Error.*No such list:",
+ },
+ "pending_req" =>
+ {
+ "en" => "(current set of administrative|pending request)",
+ },
+ "headline_subscr" =>
+ {
+ "en" => "subscription",
+ },
+ "held_for_approval" =>
+ {
+ "en" => "held for approval",
+ },
+ "already_member" =>
+ {
+ "en" => "Already a member",
+ },
+ );
+
+ my $t = $translations{$key};
+ die "INTERNAL ERROR: Unknown translation key '$key'\n"
+ unless defined $t;
+ return "(?i)(" . join("|", values %{$t}) . ")";
+}
+
sub guess_charset {
my ($charset, $text) = @_;
@@ -1301,6 +1372,8 @@ sub commit_changes {
my $params = mailman_params ($user, $pw);
my $log = log_timestamp ($list);
+ # Expand {list}, {subdomain} and {domain}
+ $logfile = mailman_url($list, $logfile);
for my $id (sort { $a <=> $b } keys %{$change}) {
my ($what, $text) = @{$change->{$id}};
@@ -1375,7 +1448,7 @@ sub add_subscribers {
if (!$mail) {
my %left = map { $_ => 1 } @addresses;
for my $failed (keys %{$result}) {
- unless ($result->{$failed} =~ /Already a member/) {
+ unless ($result->{$failed} =~ get_trans_re("already_member")) {
delete $left{$failed};
}
}
@@ -1385,7 +1458,7 @@ sub add_subscribers {
# members.
@addresses = ();
for my $failed (keys %{$result}) {
- if ($result->{$failed} =~ /Already a member/) {
+ if ($result->{$failed} =~ get_trans_re("already_member")) {
push(@addresses, $failed);
}
}
@@ -1449,9 +1522,9 @@ sub parse_subscribe_response {
$parse->get_tag ("ul") || die;
my $ul = $parse->get_text ("/ul") || die;
- if ($h5 =~ /Successfully ((un)?subscribed|Removed)/i) {
+ if ($h5 =~ get_trans_re("subscr_success")) {
# hooray!
- } elsif ($h5 =~ /Error (un)?subscribing/i) {
+ } elsif ($h5 =~ get_trans_re("subscr_error")) {
for (split(/\n/, $ul)) {
chomp;
if (/^\s*(.*?)\s*--\s*(.*)/) {
@@ -1461,7 +1534,7 @@ sub parse_subscribe_response {
} else {
$ul =~ s/\n/\n\t/g;
print STDERR "You have an unusual Mailman output. Please mail ".
- "this message to\nkjetilho+listadmin\@ifi.uio.no:\n".
+ "this message to\n$maintainer\n:\n".
"\t[$h5]\n\t[$ul]\nThanks!\n";
}
$parse->get_tag ("p") || die;
@@ -1589,7 +1662,9 @@ sub submit_http {
if ($logfile) {
if (open (LOG, ">>$logfile")) {
LOG->autoflush(1);
- binmode LOG, ":encoding(" . langinfo(CODESET()) . ")";
+ # Perhaps we should force the encoding to US-ASCII
+ # instead, but I think this is more DWIM compliant.
+ binmode LOG, ":encoding($term_encoding)";
$opened = 1;
local $SIG{__WARN__} = sub {}; # see comment elsewhere
print LOG $log;
@@ -1634,6 +1709,9 @@ sub prompt_password {
my $answer;
my $echooff;
+ # This might not work, since some versions of readline screw up
+ # and turn on "echo" for us :-(
+
$SIG{'INT'} = $SIG{'TERM'} = \&restore_echo_and_exit;
system("stty -echo 2>/dev/null");
if ($? == 0) {
@@ -1655,7 +1733,10 @@ sub prompt {
# is only done if the user actually needs prompting.
$term = new Term::ReadLine 'listadmin'
unless $term;
- return ($term->readline (@_));
+ my $answer = $term->readline(@_);
+ # readline turns off autoflush, re-enable it
+ $| = 1;
+ return $answer;
}
sub config_order {
diff --git a/listadmin.txt b/listadmin.txt
index ffe92f6..694a054 100644
--- a/listadmin.txt
+++ b/listadmin.txt
@@ -195,10 +195,13 @@ DIRECTIVES
action D:[date] F:[sender] S:[subject]
- This batch of lines are terminated by a line saying
+ This batch of lines is terminated by a line saying
changes sent to server.
- The filename none turns off logging.
+ The same substitutions are performed on filename as on
+ the argument to adminurl. Tilde syntax can be used to
+ refer to home directories. The filename none turns off
+ logging.
INTERACTIVE USE
The user interface to listadmin is line oriented with single letter