diff options
author | Norbert Tretkowski <nobse@debian.org> | 2006-01-16 15:39:25 +0100 |
---|---|---|
committer | Unit 193 <unit193@ubuntu.com> | 2019-12-05 16:35:04 -0500 |
commit | d4bc6557a7bf98047304676ada0200effcdc9f6b (patch) | |
tree | 9b4c7ad5998be91600d6a516a32dabe685b1cd78 | |
parent | 02e718ab8c4c3cfd21c8a5d2dbc6eca67be25007 (diff) | |
download | listadmin-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/changelog | 15 | ||||
-rwxr-xr-x | listadmin.pl | 135 |
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) { |