--- mailman-pop3d-v0.2.pl Wed Mar 31 14:03:12 2004 +++ mailman-pop3d-v0.3.pl Tue Apr 6 12:35:32 2004 @@ -7,10 +7,10 @@ =cut -# This software should be considered to be in alpha stage; bugs are -# certainly present, and bug reports would be very much appreciated. +# This software should be considered to be in beta stage; bugs are +# possibly present, and bug reports would be very much appreciated. # At this point, I would also be very interested in hearing about -# success stories. I've been testing only against mailman 2.0.11. +# success stories. I've been testing only against Mailman 2.0.11. # # -- Michael C. Toren Tue, 30 Mar 2004 20:11:06 -0500 @@ -19,7 +19,7 @@ ### Configurable section: # -# What's the base URL for your mailman web interface? The listname will be +# What's the base URL for your Mailman web interface? The listname will be # appended to this URL to access the administrative queue. my $url = "http://lists.netisland.net/mailman/admindb/"; # @@ -27,20 +27,20 @@ =head1 DESCRIPTION -mailman-pop3d provides a POP3 interface to mailman for the purposes of +mailman-pop3d provides a POP3 interface to GNU Mailman for the purposes of deleting spam stuck in the administrative requests queue. If you manage -a large mailman mailing list, and are tired of using the web interface +a large Mailman mailing list, and are tired of using the web interface to discard spam, this script may be for you. mailman-pop3d is typically invokved from /etc/inetd.conf, as: pop3 stream tcp nowait nobody.nogroup /usr/local/bin/mailman-pop3d.pl mailman-pop3d.pl -The POP3 interfaces accepts the name of a mailman list as the POP3 -username, and the mailman administrative password as the POP3 password. +The POP3 interfaces accepts the name of a Mailman list as the POP3 +username, and the Mailman administrative password as the POP3 password. Once authenticated, a client is presented with a list of the messages -currently stuck in the mailman queue. When messages are deleted from -the POP3 server, the corresponding message is discarded from the mailman +currently stuck in the Mailman queue. When messages are deleted from +the POP3 server, the corresponding message is discarded from the Mailman queue as spam. =head1 BUGS @@ -49,6 +49,8 @@ via the POP3 interface. Even so, mailman-pop3d is quite useful for purging large amounts of spam from a busy list's queue. +Arguably, the interface should be IMAP rather than POP3. + =head1 COPYRIGHT (c) Copyright 2004 Michael C. Toren @@ -75,7 +77,7 @@ For updates, please see: - http://michael.toren.net/code/ + http://michael.toren.net/code/mailman-pop3d/ =cut @@ -91,10 +93,10 @@ my %actioncodes = (discard => 3, approve => 1, reject => 2, defer => 0); my $debug = 0; -my ($version, $user, $pass, $ip, @msglist, $msgdata, $deleted, +my ($version, $list, $pass, $ip, @msglist, $msgdata, $deleted, $ua, $jar, $req, $res, $form); -$version = "0.2"; +$version = "0.3"; # Net::Server::POP3 writes debugging information to STDERR, with no # method to turn it off, which interferes with a servertype of INET. @@ -107,7 +109,8 @@ ( servertype => "INET", - welcome => "mailman-pop3d, version $version (http://michael.toren.net/code/)", + welcome => "mailman-pop3d, version $version" + . " (http://michael.toren.net/code/mailman-pop3d/)", "connect" => sub { if ($ip = getpeername STDIN) { @@ -120,10 +123,11 @@ }, authenticate => sub { - ($user, $pass) = @_; - syslog "debug", "login for list $user"; + ($list, $pass) = @_; + $url .= $list; + + syslog "debug", "login for list $list ($url)"; - $url .= $user; $ua = LWP::UserAgent->new; $ua->agent("mailman-pop3d version $version, "); $jar = HTTP::Cookies->new; @@ -134,14 +138,21 @@ unless ($res->is_success) { - syslog "err", "Error authenticating"; + syslog "err", "HTTP error: ", $res->message; return 0; } - if (($res->content =~ m!Mailman Admindb Error!i) or # no such list - ($res->content =~ m!plug Administrative Authentication!i)) # invalid password + my ($title) = ($res->content =~ m!(.*?)!smi); + + if ($title =~ /Mailman Admindb Error/i) { - syslog "err", "Invalid username or password"; + syslog "err", "Invalid list name"; + return 0; + } + + if ($title =~ /Administrative Authentication/i) + { + syslog "err", "Invalid password"; return 0; } @@ -151,7 +162,7 @@ for my $input ($form->inputs) { - my ($msg, $num, $id); + my ($msg, $num, $header, $body, $id); unless ($input->type eq "radio") { @@ -177,29 +188,21 @@ } $num = $input->name; - $msg->{form} = $input; - $msg->{header} = $form->find_input("headers-$num", - "textarea"); - $msg->{body} = $form->find_input("fulltext-$num", - "textarea"); - unless ($msg->{header}) { + unless ($header = $form->find_input("headers-$num", "textarea")) { syslog "err", "Header $num not found; skipping"; next; } - unless ($msg->{body}) { + unless ($body = $form->find_input("fulltext-$num", "textarea")) { syslog "err", "Body $num not found; skipping"; next; } - $msg->{header} = $msg->{header}->value; - $msg->{body} = $msg->{body}->value; - $msg->{size} = length($msg->{header}) + - length($msg->{body}); - - $id = "$num." . md5_hex join "\n", - $msg->{header}, $msg->{body}; + $msg->{form} = $input; + $msg->{data} = join "\n", $header->value, $body->value, ""; + $msg->{size} = length $msg->{data}; + $id = "$num." . md5_hex $msg->{data}; $msgdata->{$id} = $msg; push @msglist, $id; @@ -209,8 +212,7 @@ }, list => sub { - syslog "debug", "list returning ", scalar(@msglist), - " messages"; + syslog "debug", scalar(@msglist), " messages found"; return @msglist; }, @@ -222,9 +224,7 @@ retrieve => sub { my $id = (@_)[1]; syslog "debug", "retrieve $id" if ($debug); - return join "\n", $msgdata->{$id}->{header}, - $msgdata->{$id}->{body}, - ""; + return $msgdata->{$id}->{data}; }, "delete" => sub { @@ -238,14 +238,13 @@ unless ($deleted) { syslog "debug", "disconnect, no messages deleted"; return; - } else { - syslog "debug", "disconnect, deleting $deleted messages..."; } + syslog "debug", "disconnect, deleting $deleted messages..."; $req = $form->click; $jar->add_cookie_header($req); $res = $ua->request($req); - syslog "err", "Error handling requests" + syslog "err", "HTTP error: ", $res->message unless ($res->is_success); syslog "debug", "...disconnect complete"; },