You are completely right about me breaking the protocol. I'm trying to show evidence of what is wrong and screwing it up. Perhaps this will illustrate better.

Here is code using the Client3 library that uses fork:

# NOTE: We Could Write A Log Of Outgoing Email So That People Would Kn +ow If Their Stuff Went Out # Have to set RES_NAMESERVERS env to DNS server first # This Version Of The Relayer Forks To Handle Multiple Connections use strict; use Carp; use Net::SMTP::Server; use Net::SMTP::Server::Client3; use Net::SMTP_auth; use File::Temp qw/ tempfile tempdir /; # Server Code # Globals my $server = undef; my $conn = undef; # Create Temp Mail Directory For MIME files sent to this "SERVER" if (not -d ".\\MailToBeSent") { mkdir ".\\MailToBeSent"; } $server = new Net::SMTP::Server('192.168.10.68', 25) || croak("Unable +to handle client connection: $!\n"); while($conn = $server->accept()) { fork and last; $conn->close; }; # End Server Code # Client Code print "Client Thread Started\n"; # Store Mail In Temp File (Otherwise Bad Things Happen ;-)) my ($fh, $filename) = tempfile(TEMPLATE => 'tempXXXXX',DIR => '.\MailT +oBeSent',SUFFIX => '.dat'); my $client = new Net::SMTP::Server::Client3($conn,$fh) || croak("Unabl +e to handle client: $!\n"); $client->greet; # this is new while($client->get_message){ # this is different 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 to Mail Street Or usmail.b +etalasermike.com $smtp = Net::SMTP_auth->new( Host => 'hostname', Hello => 'server.com', Timeout => 30, ); # Could add a Debug => 1, directive to ge +t debug statements $smtp->auth('NTLM', 'user', 'pass'); $smtp->mail('username@server.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 Thread Closing\n"; # Cleanup exit; # End Client Code

Here is the output when I send mail via this code:

Net::SMTP>>> Net::SMTP(2.31) Net::SMTP>>> Net::Cmd(2.29) Net::SMTP>>> Exporter(5.60) Net::SMTP>>> IO::Socket::INET(1.31) Net::SMTP>>> IO::Socket(1.30) Net::SMTP>>> IO::Handle(1.27) Net::SMTP=GLOB(0x20f758c)<<< 220 Debatable SMTP 0.2 Ready. Net::SMTP=GLOB(0x20f758c)>>> EHLO localhost.localdomain Net::SMTP=GLOB(0x20f758c)<<< 250 OK Welcome Net::SMTP=GLOB(0x20f758c)>>> MAIL FROM:<lamberms@betalasermike.com> Net::SMTP=GLOB(0x20f758c)<<< 250 OK Envelope sender set to <lamberms@b +etalasermi ke.com> Net::SMTP=GLOB(0x20f758c)>>> RCPT TO:<lamberms@betalasermike.com> Net::SMTP=GLOB(0x20f758c)<<< 250 OK sending to lamberms@betalasermike. +com Net::SMTP=GLOB(0x20f758c)>>> DATA Net::SMTP=GLOB(0x20f758c)<<< 354 And what am I to tell them? Net::SMTP=GLOB(0x20f758c)>>> From: <lamberms@betalasermike.com> Net::SMTP=GLOB(0x20f758c)>>> To: lamberms@betalasermike.com Net::SMTP=GLOB(0x20f758c)>>> Cc: Net::SMTP=GLOB(0x20f758c)>>> Subject: Problems Registering Software Net::SMTP=GLOB(0x20f758c)>>> Hello. I purchased the .Net Winforms Ult +ra Pack an d received serial number of 2F46BC380D. However, when I try to instal +l that sof tware and use that serial number it wants to install as an evaluation. + What is going on? Net::SMTP=GLOB(0x20f758c)>>> Thanks, Net::SMTP=GLOB(0x20f758c)>>> Steve Net::SMTP=GLOB(0x20f758c)>>> . Net::SMTP=GLOB(0x20f758c)<<< 250 OK message saved for relay Net::SMTP=GLOB(0x20f758c)>>> QUIT

As you can see the email is sent properly. Here is the code I'm trying to use and having problems with:

# 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 = 2; 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"; } # NOTE: Probably should remove all files in .\MailToBeSent here print "Deleting Temp Files\n"; opendir(DIR,".\\MailToBeSent"); my @files = grep (!/^\.\.?$/, readdir (DIR)); foreach my $file (@files) { unlink ".\\MailToBeSent\\$file" || print "Could Not Delete .\\Mail +ToBeSent\\$file\n"; } close(DIR); # 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 { # Use thread::shared to read job queue (An Array with connection o +bjects) # pop them off and service them. We can use another hash in the f +orm of # $heartbeat{$thread_number} = timestamp to give last time the thr +ead # was active for the purposes of killing thread. Then we should m +onitor # the process to make sure it does not take too much memory. If i +t does # exit and re-launch 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 $!; #print "SOCKET: $socket\n"; print "Connection Being Serviced By Thread Number " . $thr +ead_obj->tid() . "\n"; 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 $conn "WOOT!\r\n"; #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 to Mail Street Or usma +il.betalasermike.com $smtp = Net::SMTP_auth->new( Host => 'hostname', Hello => 'server.com', Timeout => 30, ); # Could add a Debug => 1, directive t +o get debug statements $smtp->auth('NTLM', 'user', 'pass'); $smtp->mail('username@server.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

The only difference is that I'm treating the IO::Socket like an integer handle (This worked flawlessly for you as noted above). Here is the result of that code for me:

Net::SMTP>>> Net::SMTP(2.31) Net::SMTP>>> Net::Cmd(2.29) Net::SMTP>>> Exporter(5.60) Net::SMTP>>> IO::Socket::INET(1.31) Net::SMTP>>> IO::Socket(1.30) Net::SMTP>>> IO::Handle(1.27) Net::SMTP=GLOB(0x20f758c)<<< 220 Debatable SMTP 0.2 Ready. Net::SMTP=GLOB(0x20f758c)>>> EHLO localhost.localdomain Net::SMTP=GLOB(0x20f758c)<<< EHLO localhost.localdomain

Here you can see that it never get EHLO command. The client receives the 220 Debatable SMTP message so it is obvious that the socket is Read Write. However, once it starts reading data from the client (EHLO commands) it is sending Welcome messages but they are never received by the other side. It is really weird that this code works on your system and does not work on mine.


In reply to Re^6: Using Threads For Simple SMTP Relay Server by lamberms
in thread Using Threads For Simple SMTP Relay Server by lamberms

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.