--- mailman-pop3d-v0.1.pl	Tue Mar 30 20:18:46 2004
+++ mailman-pop3d-v0.2.pl	Wed Mar 31 14:03:12 2004
@@ -3,7 +3,7 @@
 
 =head1 NAME
 
-mailman-pop3d.pl - POP3 interface to mailman's web interface
+mailman-pop3d - POP3 interface to mailman's web interface
 
 =cut
 
@@ -27,12 +27,12 @@
 
 =head1 DESCRIPTION
 
-mailman-pop3d.pl provides a POP3 interface to 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 annoying
-web interface to discard spam, this script may be for you.
+mailman-pop3d provides a POP3 interface to 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
+to discard spam, this script may be for you.
 
-mailman-pop3d.pl is typically invokved from /etc/inetd.conf, as:
+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
 
@@ -45,13 +45,9 @@
 
 =head1 BUGS
 
-Currently there is no method of approving messages to be forwarded to
-the list via the POP3 interface.  Even so, mailman-pop3d.pl is quite
-useful for purging large amounts of spam from a busy list's queue.
-
-If either an invalid POP3 username or password is supplied, no "invalid
-login" error message is generated.  Instead, the only indication is that
-no messages are presented to the client.
+Currently there is no method of approving messages to be forwarded to the list
+via the POP3 interface.  Even so, mailman-pop3d is quite useful for purging
+large amounts of spam from a busy list's queue.
 
 =head1 COPYRIGHT
 
@@ -98,20 +94,20 @@
 my ($version, $user, $pass, $ip, @msglist, $msgdata, $deleted,
 	$ua, $jar, $req, $res, $form);
 
-$version = "0.1";
+$version = "0.2";
 
 # Net::Server::POP3 writes debugging information to STDERR, with no
 # method to turn it off, which interferes with a servertype of INET.
 open STDERR, "> /dev/null" unless (-t STDOUT);
 
-Sys::Syslog::openlog "mailman-pop3d.pl", "pid", "daemon";
+Sys::Syslog::openlog "mailman-pop3d", "pid", "daemon";
 sub syslog { Sys::Syslog::syslog shift, join "", "[$ip] ", @_ } 
 
 my $server = Net::Server::POP3->new
 	(
 		servertype => "INET",
 
-		welcome => "mailman-pop3d.pl, version $version (http://michael.toren.net/code/)",
+		welcome => "mailman-pop3d, version $version (http://michael.toren.net/code/)",
 
 		"connect" => sub {
 				if ($ip = getpeername STDIN) {
@@ -129,7 +125,7 @@
 
 				$url .= $user;
 				$ua = LWP::UserAgent->new;
-				$ua->agent("mailman-pop3d.pl version $version, ");
+				$ua->agent("mailman-pop3d version $version, ");
 				$jar = HTTP::Cookies->new;
 
 				$req = POST $url,
@@ -142,8 +138,12 @@
 					return 0;
 				}
 
-				# XXX perform additional error checking to ensure the login
-				#     attempt was successful
+				if (($res->content =~ m!<TITLE>Mailman Admindb Error</TITLE>!i) or				# no such list
+					($res->content =~ m!<TITLE>plug Administrative Authentication</TITLE>!i))	# invalid password
+				{
+					syslog "err", "Invalid username or password";
+					return 0;
+				}
 
 				$jar->extract_cookies($res);
 				($form) = HTML::Form->parse($res->as_string, $res->base);
@@ -171,14 +171,17 @@
 					unless ($input->name =~ /^\d+$/)
 					{
 						syslog "debug", "Skipping input ", $input->name,
-							" due non-numeric characters in it's name" if ($debug);
+							" due non-numeric characters in it's name"
+								if ($debug);
 						next;
 					}
 
 					$num = $input->name;
 					$msg->{form} = $input;
-					$msg->{header} = $form->find_input("headers-$num", "textarea");
-					$msg->{body} = $form->find_input("fulltext-$num", "textarea");
+					$msg->{header} = $form->find_input("headers-$num",
+															"textarea");
+					$msg->{body} = $form->find_input("fulltext-$num",
+															"textarea");
 
 					unless ($msg->{header}) {
 						syslog "err", "Header $num not found; skipping";
@@ -192,9 +195,11 @@
 
 					$msg->{header} = $msg->{header}->value;
 					$msg->{body} = $msg->{body}->value;
-					$msg->{size} = length($msg->{header}) + length($msg->{body});
+					$msg->{size} = length($msg->{header}) +
+										length($msg->{body});
 
-					$id = "$num." . md5_hex join "\n", $msg->{header}, $msg->{body};
+					$id = "$num." . md5_hex join "\n",
+										$msg->{header}, $msg->{body};
 
 					$msgdata->{$id} = $msg;
 					push @msglist, $id;
@@ -204,7 +209,8 @@
 			},
 
 		list => sub {
-				syslog "debug", "list returning ", scalar(@msglist), " messages";
+				syslog "debug", "list returning ", scalar(@msglist),
+					" messages";
 				return @msglist;
 			},