aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorLibravatarNorbert Tretkowski <nobse@debian.org>2006-01-16 15:39:25 +0100
committerLibravatarUnit 193 <unit193@ubuntu.com>2019-12-05 16:35:04 -0500
commitd4bc6557a7bf98047304676ada0200effcdc9f6b (patch)
tree9b4c7ad5998be91600d6a516a32dabe685b1cd78
parent02e718ab8c4c3cfd21c8a5d2dbc6eca67be25007 (diff)
downloadlistadmin-d4bc6557a7bf98047304676ada0200effcdc9f6b.tar.bz2
listadmin-d4bc6557a7bf98047304676ada0200effcdc9f6b.tar.xz
listadmin-d4bc6557a7bf98047304676ada0200effcdc9f6b.tar.zst
Import Debian changes 2.27-1bpo1debian/2.27-1bpo1
listadmin (2.27-1bpo1) sarge-backports; urgency=low * Rebuilt for sarge. listadmin (2.27-2) unstable; urgency=low * applied mailman 2.1 patch from Sam Watkins <sam nipl.net> with a correction from Petter Reinholdtsen <pere hungry.com> Thanks alot for your work. (closes: Bug#292929)
-rw-r--r--debian/changelog15
-rwxr-xr-xlistadmin.pl135
2 files changed, 103 insertions, 47 deletions
diff --git a/debian/changelog b/debian/changelog
index 6e7e457..bb73c95 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,18 @@
+listadmin (2.27-1bpo1) sarge-backports; urgency=low
+
+ * Rebuilt for sarge.
+
+ -- Norbert Tretkowski <nobse@debian.org> Mon, 16 Jan 2006 15:39:25 +0100
+
+listadmin (2.27-2) unstable; urgency=low
+
+ * applied mailman 2.1 patch from Sam Watkins <sam nipl.net>
+ with a correction from Petter Reinholdtsen <pere hungry.com>
+ Thanks alot for your work.
+ (closes: Bug#292929)
+
+ -- Noèl Köthe <noel@debian.org> Fri, 30 Dec 2005 08:21:36 +0100
+
listadmin (2.27-1) unstable; urgency=low
* new upstream version
diff --git a/listadmin.pl b/listadmin.pl
index d9c32d9..7842971 100755
--- a/listadmin.pl
+++ b/listadmin.pl
@@ -1,10 +1,12 @@
#! /usr/bin/perl -w
#
-# listadmin version 2.27
+# listadmin version 2.27 (mangled to work with mailman-2.1)
# Written 2003 - 2005 by
# Kjetil Torgrim Homme <kjetilho+listadmin@ifi.uio.no>
# Released into public domain.
+# mangled by Sam Watkins to work with mailman-2.1
+
use HTML::TokeParser;
use LWP::UserAgent;
use MIME::Base64;
@@ -412,56 +414,77 @@ sub get_list {
my %data = ();
my $starttime = time;
- my $page;
+ my $page_subscriptions;
+ my $page_approvals;
+
+ my $resp_subscriptions = $ua->post (mailman_url($list, $url), mailman_params($user, $pw));
+ $page_subscriptions = $resp_subscriptions->content;
+ my $pattern = "$url?details=all" if $url;
+ my $resp_approvals = $ua->post (mailman_url($list, $pattern), mailman_params($user, $pw));
+ $page_approvals = $resp_approvals->content;
- 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 $dumpdir = $config->{$list}{"dumpdir"};
+ if (defined $dumpdir) {
+ if (open (DUMP, ">$dumpdir/dump-subs-$list.html")) {
+ print DUMP $page_subscriptions;
+ close (DUMP);
+ }
+ if (open (DUMP, ">$dumpdir/dump-held-$list.html")) {
+ print DUMP $page_approvals;
+ close (DUMP);
+ }
}
- unless ($resp->is_success) {
- print STDERR $resp->error_as_HTML;
- return ();
+ for my $resp ($resp_subscriptions, $resp_approvals) {
+ unless ($resp->is_success) {
+ print STDERR $resp->error_as_HTML;
+ return ();
+ }
}
+
+ my $mmver = 2.1; # not negotiable!
+ for my $page ($page_subscriptions, $page_approvals) {
+
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 ();
+ if ($page =~ /<title>/) {
+ $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 ();
+ }
}
- my $mmver;
$parse->get_tag ("hr");
- $parse->get_tag ("h2") || return ();
+ $parse->get_tag ("h2") || next;
my $headline = $parse->get_trimmed_text ("/h2") || die;
if ($headline =~ /subscription/i) {
parse_subscriptions ($parse, \%data);
my $token = $parse->get_token;
- if (lc ($token->[1]) eq "input") {
- return () unless parse_footer ($parse, \%data, $mmver);
- return (\%data);
- } else {
+ $token = $parse->get_token if
+ $token->[0] eq "S" && lc ($token->[1]) eq "center";
+ unless (lc ($token->[1]) eq "input") {
$parse->get_tag ("h2") || die;
$headline = $parse->get_trimmed_text ("/h2") || die;
}
}
if ($headline =~ /held for approval/i) {
- $mmver = parse_approvals ($parse, \%data);
+ my $_mmver = parse_approvals ($parse, \%data);
+# $mmver ||= $_mmver;
} else {
$parse->get_tag ("hr") || die;
my $token = $parse->get_token;
if ($token->[0] eq "S" && lc ($token->[1]) eq "center") {
- $mmver = parse_approvals ($parse, \%data);
+ my $_mmver = parse_approvals ($parse, \%data);
+# $mmver ||= $_mmver;
}
}
- return () unless parse_footer ($parse, \%data, $mmver);
+ next unless parse_footer ($parse, \%data, $mmver);
+ }
return (\%data);
}
@@ -504,6 +527,8 @@ sub parse_approvals {
$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);
}
@@ -599,7 +624,7 @@ sub parse_approval {
$data->{$id}->{"date"} = $1
if $headers =~ /^Date: (.*)$/m;
- if ($mmver == 2) {
+ if ($mmver >= 2) {
$parse->get_tag ("tr") || die; # Message Excerpt
$parse->get_tag ("td") || die;
$parse->get_tag ("textarea") || die;
@@ -620,20 +645,22 @@ sub parse_approval {
sub parse_footer {
my ($parse, $data, $mmver) = @_;
- $parse->get_tag ("address") || die;
- my $text = $parse->get_trimmed_text ("/address") || die;
-
- 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 ($parse->get_tag ("address")) {
+# my $text = $parse->get_trimmed_text ("/address") || die;
+#
+# if ($text =~ /Mailman\s*v(ersion)? (\d+\.\d+)/) {
+# $mmver = 0+$2;
+# # 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 >= 2) {
$data->{"global"}{"actions"} = { "a" => 1,
"r" => 2,
"d" => 3,
@@ -689,6 +716,7 @@ sub read_config {
my $count = 0;
my $lineno = 0;
my $logfile;
+ my $dumpdir;
my $confirm = 1;
my $url;
my %patterns = map { $_ => undef; }
@@ -769,15 +797,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 = expand_pathname(unquote($')); # ' stupid perl-mode
+ } elsif ($line =~ /^dumpdir\s+/i) {
+ $dumpdir = expand_pathname(unquote($')); # ' stupid perl-mode
+ if (defined $dumpdir) {
+ mkdir $dumpdir;
}
- $logfile = undef if $logfile eq "none";
} elsif ($line =~ /^subscription_action\s+/) {
$subact = unquote ($'); # ' stupid perl-mode
unless (exists $sact{$subact}) {
@@ -817,6 +842,7 @@ sub read_config {
"action" => $action,
"default" => $default,
"logfile" => $logfile,
+ "dumpdir" => $dumpdir,
%patterns,
"order" => ++$count,
};
@@ -840,6 +866,20 @@ 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) = @_;
@@ -985,6 +1025,7 @@ sub log_timestamp {
sub submit_http {
my ($url, $params, $log, $logfile) = @_;
+ $url =~ s/\?.*//;
my $opened;
if ($logfile) {