I've got a totally cool bayesian spam filter smtp proxy, but it dies mysteriously after a few hours in win2k with ActivePerl. I've posted the main loop below -- if you have insight how to fix it I'd love to know.

On the other hand, is there a good Net::Server replacement for Active perl? I think the reason it dies is that running an internet server in perl in win2k is touchy... I've thought about rewriting for fork instead of select, but I wasn't sure it would solve the problem, and it'd be some work.

Thanks,
John

use IO::Select;
use IO::Socket;
$lsn = new IO::Socket::INET(Listen => 10, LocalPort => $listenPort);
#print "l=$lsn\n";
$sel = new IO::Select( $lsn );
$nextNoop=time;
$endtime=$nextNoop+$RestartEvery;
$saveWhite=$nextNoop+$UpdateWhitelist;
$noops2=$noops>>1+1;
mlog(0,"Starting");
$SIG{INT}=sub {mlog(0,'Sig INT'); &SaveWhitelist; kill 6,$$;};
while(1) {
 @ready = $sel->can_read($noops2);
 foreach $fh (@ready) {
  if($fh == $lsn) {
   # Create a new socket
   my $client=$lsn->accept;
   my $server=new IO::Socket::INET(Proto=>'tcp',PeerAddr=>$smtpDestina
+tion);
   addfh($client,\&getline,$server);
   addfh($server,\&reply,$client);
   my $ip=$Con{$client}->{ip}=$client->peerhost();
   if($ip=~/^($acceptAllMail)/io) {
    $Con{$client}->{relayok}=1;
   }
   $time=gmtime(); $time=~s/... (...) (..) (........) ..(..)/$2 $1 $4 
+$3/;
   $Con{$client}->{header}="Received: from $ip ($ip) by $me ; $time -0
+000\n";
  } else {
   $buf='';
   if($fh->sysread($buf,10240)>0) {
    $this=$Con{$fh};
    $buf=$this->{_}.$buf;
    while($buf=~/(.*\n)/g) {
     ${$Con{$fh}}{getline}($fh,$1);
    }
    ($this->{_})=$buf=~/([^\n\r]*)$/s;
   } else {
    done($fh);
   }
  }
 }
 $time=time;
 if($time >= $nextNoop) {
  # boring code ommitted :-)
 }
 $ltime=$time;
}
# Never reached...

# done with a file handle -- close him and his friend
sub done {
 my $fh=shift;
 done2($Con{$fh}->{friend});
 done2($fh);
}

# close a file handle & clean up associated records
sub done2 {
 my $fh=shift;
 return unless $fh;
 my $this=$Con{$fh};
 return unless $this;
 #print "closing $fh\n";
 # remove timers for the filehandle
 delete $NoopList{$fh}; delete $NoopListTime{$fh};
 # close the maillog if it's still open
 my $f=$this->{maillogfh};
 close $f if $f;
 # remove from the select structure
 $sel->remove($fh);
 # close it
 $fh->close;
 # delete the Connection data
 delete $Con{$fh};
}

# adding a socket to the Select structure and Con hash
sub addfh {
 my ($fh,$getline,$friend) =@_;
 $sel->add($fh);
 binmode($fh);
 $Con{$fh}={};
 my $this=$Con{$fh};
 $this->{getline}=$getline;
 $this->{friend}=$friend;
 #print "add $fh: f=$friend\n";
}
[download]