| Subject: | nice to have more control of looper |
This is a very nice module. To allow more customization, it would be nice if the looper method allowed you to set the select timeout and if it returned a status indicating if there was any activity during the last loop or not. For example,
sub looper {
my $self = shift;
my $timeout = shift;
...
my ($toread, $towrite) = IO::Select->select($self->{read_sockets}, $self->{write_sockets},undef, $timeout);
my $activity = $#$toread + $#$towrite > -2 ? 1 : undef;
...
return $activity;
}
The reason for doing this can be see in the attached script that uses this module as the basis for a SpamAssassin proxy. This script is based on the pop3proxy.pl script and includes its exit port technique. It also supports an HTTP interface at localhost:8800 to the Bayesian learning system. By having better control of the looper method, I can support these extra features better. The activity return allows me to play a sound on receiving some ham.
Thanks again for a great module,
Mike
P.S. To setup the attached script, follow the pop3proxy.pl instructions except there is no hostmap needed.
use Getopt::Long;
use Mail::SpamAssassin;
use Win32::Sound;
use Net::Server::POP3proxy;
use IO::Socket;
use IO::Select;
use FindBin;
my $logfile = 'pop3proxy.log';
my $run_learning_interface = 1;
my $exit_port = 9625;
my $maxscan = 250000;
my $helpflag = 0;
usage() unless GetOptions(
"logfile:s" => \$logfile,
"maxscan=i" => \$max_scan_size,
"exitport=i" => \$exit_port,
"help" => \$helpflag,
"learn" => \$run_learning_interface,
);
usage() if $helpflag;
chdir "$FindBin::RealBin";
# Prevent concurrent proxies - kill any previous instance
#
if ( IO::Socket::INET->new (
PeerAddr => 'localhost',
PeerPort => $exit_port,
Proto => "tcp",
Type => SOCK_STREAM ) )
{
sleep ( 10 );
warn "WARNING: Existing proxy killed\n";
}
if ( $logfile )
{
# Redirect stdout and stderr to logfile if specified.
# Windows strangeness - you can't reopen STDOUT/STDERR successfully
# under wperl.exe unless you've already closed it. Go figure.
close STDOUT;
close STDERR;
open(STDOUT, "> $logfile") or die "Can't redirect stdout: $!";
open(STDERR, ">&STDOUT") or die "Can't dup stdout: $!";
}
$| = 1;
my $spamtest = Mail::SpamAssassin->new (
{
userprefs_filename => './user_prefs',
dont_copy_prefs => 1
} );
$spamtest->init_learner ( );
my $readable = IO::Select->new;
my $writeable = IO::Select->new;
# Create the "exit socket" - any connection on this socket from
# localhost will cause us to exit.
#
my $exit_socket;
if ( $exit_port )
{
$exit_socket = IO::Socket::INET->new(LocalPort => $exit_port, Listen => 1, Reuse => 1);
$readable->add ( $exit_socket );
}
my @hamQueue;
my $learning_port = 8800;
my $learning_socket;
my %URLESCAPE_MAP;
if ( $run_learning_interface )
{
require HTTP::Daemon;
require HTTP::Status;
require HTTP::Response;
require URI::Escape;
$HTTP::Status::RC_FORBIDDEN = $HTTP::Status::RC_FORBIDDEN;
$HTTP::Status::RC_OK = $HTTP::Status::RC_OK;
$learning_socket = HTTP::Daemon->new ( LocalPort => $learning_port ) || die "cannot start the learning interface: $!";
$readable->add ( $learning_socket );
}
my $popproxy = new Net::Server::POP3proxy (
# Port => $port,
Debug => sub { print ($_[0]) . "\n"; },
Action => sub { filterAction ( $_[0] ); },
Error => sub { die ( $_[0] ); },
MaxSize => $maxscan
) or die ( "Cannot init POP3 proxy server" );
my $ding = undef;
my $dingGrace = 5;
while ( 1 )
{
my $activity = $popproxy->looper ( 1 );
if ( $activity < 0 )
{
last;
}
if ( $ding )
{
if ( ! $activity )
{
$dingGrace--;
}
else
{
$dingGrace = 5;
}
if ( ! $dingGrace )
{
Win32::Sound::Play ( "/winnt/media/notify.wav" );
$ding = undef;
}
}
my ( $toread ) = IO::Select->select ( $readable, undef, undef, 0 );
foreach my $socket ( @$toread )
{
if ( $socket == $exit_socket )
{
all_done ( $socket );
next;
}
if ( $socket->sockport == $learning_port )
{
handleLearningRequest ( $socket );
next;
}
unless ($socket && $socket->connected()) {
undef $socket;
}
}
# cleanup
undef $toread;
}
my @mail;
sub filterAction
{
my $mailMsg = shift;
my $bytecount = length $mailMsg;
$mailMsg =~ s/\012\.\./\012\./g; # un-byte-stuff
@mail = split /^/, $mailMsg;
my $response = shift @mail;
# SpamAssassin::NoMailAudit adds a Unix mbox From_ line, unless
# you construct your NoMailAudit message with the (ahem,
# undocumented) add_From_line param set to false. That From_
# kinda breaks the protocol - the client isn't expecting mbox,
# he's expecting raw 822 mail - so we leave it out.
my $message = Mail::SpamAssassin::Message->new({message => \@mail});
my $status = $spamtest->check($message);
my $id = $message->get_pristine_header('Message-id') || '*none*';
print "$bytecount bytes, ", $status->is_spam() ? 'SPAM' : 'NOT spam', ", Message-id: $id\n";
if ( ! $status->is_spam() )
{
$ding = 1; # Notify ham reception.
if ( $id ne '*none*' )
{
if ( $#hamQueue + 1 >= 50 )
{
my $oldMessage = shift @hamQueue;
$oldMessage->finish ( );
}
# Save the ham for learning.
push @hamQueue, $message;
}
}
else
{
# learn it as spam
$spamtest->learn ( $message, undef, 1, undef );
}
print $status->get_report();
my $rewritten = $status->rewrite_mail();
$mailMsg = $response;
$mailMsg .= $rewritten;
$mailMsg =~ s|(?<!\015)\012|\015\012|g;
$status->finish();
$mailMsg =~ s/\012\./\012\.\./g; # byte-stuff
return $mailMsg;
}
sub handleLearningRequest
{
my $socket = shift;
if ( $socket == $learning_socket )
{
my $client = $learning_socket->accept;
if ( ! $client )
{
$learning_socket->close;
$readable->remove($learning_socket);
$learning_socket = HTTP::Daemon->new ( LocalPort => $learning_port ) || die "cannot restart the learning interface: $!";
$readable->add($learning_socket);
}
else
{
$readable->add ( $client );
}
}
else
{
if ( my $request = $socket->get_request )
{
if ( $request->method eq 'GET' and $request->url->path =~ "/learn_ham(/(ham|spam)){0,1}" )
{
my $command = $2;
my $response = HTTP::Response->new ( $HTTP::Status::RC_OK );
$response->header ( 'Content-type' => 'text/html' );
my $content = "<html><head><title>Ham Learner</title></head><body>";
if ( $command eq "ham" || $command eq "spam" )
{
my $id = $request->url->query;
if ( $id =~ /id=(.*)$/ )
{
$id = URI::Escape::uri_unescape ( $1 );
foreach ( my $index = 0; $index <= $#hamQueue; $index++ )
{
my $message = $hamQueue [ $index ];
my $msgId = $message->get_pristine_header ( 'Message-id' );
if ( $msgId eq $id )
{
my $status = $spamtest->learn ( $message, undef, $command eq "ham" ? undef : 1, undef );
if ( $status->did_learn ( ) )
{
$content .= "Marking message \"" . $message->get_pristine_header( 'Subject' ) . "\" as $command.<br /><br />";
}
else
{
$content .= "The message \"" . $message->get_pristine_header( 'Subject' ) . "\" was not learned.<br /><br />";
}
$status->finish ( );
$message->finish ( );
splice @hamQueue, $index, 1;
}
}
}
}
if ( $#hamQueue < 0 )
{
$content .= "There is no more ham to rate.";
}
else
{
$content .= "<table cellpadding=\"3\">";
$content .= "<tr><td></td><td></td><td bgcolor=\"#CCCCCC\"><b>From</b></td><td><b>Subject</b></td></tr>";
foreach my $message ( @hamQueue )
{
my $id = $message->get_pristine_header ( 'Message-id' ) || next;
$id = URI::Escape::uri_escape ( $id );
$content .= "<tr><td bgcolor=\"#00CC00\"><a href=\"/learn_ham/ham?id=$id\">HAM</a></td><td bgcolor=\"#CC0000\"><a href=\"/learn_ham/spam?id=$id\">SPAM</a></td><td bgcolor=\"#CCCCCC\">" . $message->get_pristine_header( 'From' ) . "</td><td>" . $message->get_pristine_header( 'Subject' ) . "</td></tr>";
}
$content .= "</table>";
}
$content .= "</body></html>";
$response->content ( $content );
$socket->send_response ( $response );
}
else
{
$socket->send_error ( $HTTP::Status::RC_FORBIDDEN )
}
}
else
{
$readable->remove($socket);
$socket->close;
}
}
}
sub usage
{
print <<EOT;
Usage: $0 [options]
Options include:
--logfile filename
Use filename as the log file. Default is pop3proxy.log. If the
filename is omitted, log to STDOUT.
--maxscan bytes
Messages which exceed this size will not be scanned for spam. The
default is 250000. Setting this to zero disables this behavior.
--exitport port
Any connection from localhost on this port will cause us to exit.
The default is 9625. Setting this to zero disables this behavior.
--learn
Run the spam learning interface.
EOT
exit;
}
sub all_done {
my $socket = shift;
my $new_sock = $socket->accept;
if ($new_sock->peerhost eq '127.0.0.1') {
print "Connection on exit socket, exiting\n";
exit;
} else {
print "Connection on exit socket from non-local host!\n";
$new_sock->close;
}
cleanup ( );
}
sub cleanup
{
if ( $popproxy )
{
$popproxy->cleanup ( );
# run last buffers - with a grace of 50
# communications for the rest buffer
my $gracecounter = 50;
while ($popproxy->looper() && $gracecounter ) { $gracecounter--; }
$popproxy->cleanup ( 1 );
}
}