My company is switching to an email hosting company in the next few weeks. Unfortunately, we have an old Unix box which sends out PO, Invoice and RMA data to our customers via email (PDF). The system that does this has no way to authenticate (via NTLM) to the new service provider (MailStreet). My thought was to create a quick Relay server that takes SMTP traffic from the Unix box and sends it via a specific MailStreet user (via Net::SMTP_auth). After various iterations using the fork command on ActiveState perl and finding horrible memory leaks, I decided to launch a set number of worker threads manually and just utilize those to handle mail traffic.

The next hurdle became how to hand off IO::Socket::INET connections off to the worker threads. Searching the hallowed halls of the Perl Monk library I found out that you can pass the integer handle of the IO::Socket between threads using the fileno sub. Unfortunately, it seems like this is not working for me. My code follows:

# NOTE: We Could Write A Log Of Outgoing Email So That People Would Kn
+ow If Their Emails Went Out
# Have to set RES_NAMESERVERS env to DNS server first
# This Version Of The Relayer Uses Explicit Threads To Handle Multiple
+ Clients At Once
use strict;
use Carp;
use Net::SMTP::Server;
# Net::SMTP::Server::Client3 is just a version of Client2 I modified t
+o use temp
# files instead of in memory variables to store the Mime Message.  Thi
+s yielded
# better results with large MIME files.
use Net::SMTP::Server::Client3;
use Net::SMTP_auth;
use File::Temp qw/ tempfile tempdir /;
use threads;
use threads::shared;
use IO::Socket;

# Server Code
# Globals
my $server = undef;
my $conn = undef;
my $oldconn = undef;
my $oldconn_to_close = undef;
my $sockthread = undef;
my @threads = ();
my $numthreads = 1;
my $threadcounter = 0;
my %heartbeat : shared;
my @jobqueue : shared;
my @connections_to_kill : shared;
my @old_connections = ();
# Vivify The Share Variables
#@jobqueue = &share([]);
# Create Temp Mail Directory For MIME files sent to this "SERVER"
# Start Main Thread
if (not -d ".\\MailToBeSent") {
    mkdir ".\\MailToBeSent";
}
# Create $numthreads threads and use them
for ($threadcounter = 0;$threadcounter < $numthreads;$threadcounter++)
+ {
    $sockthread = threads->new(\&thread_init);
    $sockthread->detach;
}
$server = new Net::SMTP::Server('192.168.10.68', 25) || croak("Unable 
+to handle client connection: $!\n");
while($conn = $server->accept()) {
    # Place connection on job queue
    # Push Onto A Non-Shared Array So That Connection Is Saved For Wor
+ker Thread
    push(@old_connections,$conn);
    {
        lock(@jobqueue);
        push(@jobqueue,$conn->fileno());
    }
    # Clean Up Old Connections
    {
        lock(@connections_to_kill);
        $oldconn_to_close = pop(@connections_to_kill);
        foreach $oldconn (@old_connections) {
            if ($oldconn->fileno() == $oldconn_to_close) {
                print "Closing Connection: " . $oldconn->fileno() . "\
+n";
                $oldconn->close();
            }
        }
    }

    # Check For Dead Threads using shared %heartbeat
};
# End Main Thread

# Start Worker Threads
sub thread_init {
    my $thread_obj = threads->self();
    my $thread_number = $thread_obj->tid();
    my $process_jobs = -1;
    
    print "Launched Thread Number " . $thread_obj->tid() . "\n";
    # Main Event Loop
    while ($process_jobs) {
        # Exit on bad conditions or when told to by master?
        my $conn = undef;
        # Lock queue and get one Connection off to service by this wor
+ker thread
        {
            lock(@jobqueue);
            $conn = pop(@jobqueue);
        }
        if (defined($conn)) {
            # De-reference Connection
            open my $socket, '+<&=' . $conn or die $!;
            serviceClient($socket);
            close($socket);
            # Put $conn on @connections_to_kill (this will be done in 
+the master thread)
            {
                lock(@connections_to_kill);
                push(@connections_to_kill,$conn);
            }
        }
        sleep(2);
    }
    return;
}

sub serviceClient {
    my $conn = $_[0];

    # Client Code
    print "Client Processing Started\n";
    # Store Mail In Temp File (Otherwise Bad Things Happen ;-))
    my ($fh, $filename) = tempfile(TEMPLATE => 'tempXXXXX',DIR => '.\M
+ailToBeSent',SUFFIX => '.dat');
    my $client = new Net::SMTP::Server::Client3($conn,$fh) || croak("U
+nable to handle client: $!\n");
    $client->greet; # this is new
    print "GOT IN HERE\n";
    while($client->get_message){ # this is different
        print "GOT IN HERE 2\n";
        my $smtp = undef;
        my $to = "";
        my $line = "";
        print "Sending Message\n";
        # Send Confirmation Of Receipt To The Sender
        $client->okay("message saved for relay"); # this is new
        $client->_quit();
        # Relay With Perl Module Net::SMTP_auth
        $smtp = Net::SMTP_auth->new(
                               Host => 'somehost.com',
                               Hello => 'somehoster.com',
                               Timeout => 30,
                              ); # Could add a Debug => 1, directive t
+o get debug statements
        $smtp->auth('NTLM', 'username', 'password');
        $smtp->mail('lamberms@somedomain.com');
        # Could Paste The $client->{FROM} Into The Body (Or Subject)
        # Add To Lines
        foreach $to (@{$client->{TO}}) {
            print "TO: $to\n";
            $smtp->to($to);
        }
        $smtp->data();
        open(IN,$filename);
        binmode(IN);
        while ($line = <IN>) {
            $smtp->datasend($line);
        }
        close(IN);
        $smtp->dataend();
        $smtp->quit;
        print "Message Sent\n";
        # End Relay With Perl Module Net::SMTP_auth
        close($fh);
        if (-e $filename) {
            unlink $filename;
        }
    }
    print "Client Processing Finished\n";
    # End Client Code
}
# End Worker Threads
[download]

The output after sending three SMTP emails to this server is:

C:\Project - SMTP Mailstreet And Postie Replacement>relayer4.pl
Launched Thread Number 1
Client Processing Started
GOT IN HERE
2192 command: EHLO LAMBERMSD521
2192 command: HELO LAMBERMSD521
2192 command: HELO 192.168.10.68
Client Processing Finished
Closing Connection: 4
Client Processing Started
GOT IN HERE
2192 command: EHLO LAMBERMSD521
2192 command: HELO LAMBERMSD521
2192 command: HELO 192.168.10.68
Client Processing Finished
Closing Connection: 5
Client Processing Started
GOT IN HERE
2192 command: EHLO LAMBERMSD521
2192 command: HELO LAMBERMSD521
2192 command: HELO 192.168.10.68
Client Processing Finished

The worker thread is obviously getting to the $client->greet; line in the serviceClient sub but it is not retrieving data from the $client->get_message() function. I'm really not sure what to do from here. Any ideas?