# 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::Client2;
#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 = 5;
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('127.0.0.1', 25)
    or croak("Unable to handle client connection: $! : $^E\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::Client2($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]