primitve SMTP

[jdv79]

I as trying ot make a simple script for a friend and it needs the ability to E-mail. I didn't to have to make him install the smtp server module so I decided to do the SMTP primitively. I can't figure out why the end of message dot is not working. This script was built for Activestate PERL. Does anyone know why it fails? It works from the a terminal connection to port 25. I can't figure it out.

#!/usr/bin/perl -w
use IO::SOCKET::INET;

##CALL IP FROM SYSTEM##
$ipconfig=`ipconfig`;
$ipconfig=~/(.*IP.*\: )(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/;


##CHECK IF CURRENT IP IS SAME AS LAST IP##
open(LAST,">last_ip_info.txt") or die "couldn't open last status file.
+  reason:$!\n";
@last=<LAST>;
close(LAST);
#if($last[0]eq$2)
    #{
    #    print 'current IP is the same as last IP';
    #}
    #else
    #{
        &mail_ip($2);
    #}
    

##PRINT OUT CURRENT IP##
#print "IP\:"."$2".":IP\n";
open(LAST,">last_ip_info.txt") or die "couldn'topen last status file$!
+\n";
print LAST "$2\n";
close(LAST);


#################
###SUBROUTINES###
#################
sub mail_ip
    {
        my$ip=@_[0];
        $smtpaddr='jman.g3d.com';
        $mail_to='[e-mail]';
        $mail_from='[e-mail]';
        $hostname='nehal';

        $sock = new IO::Socket::INET (PeerAddr => "$smtpaddr",
            PeerPort => 25,
            Proto    => 'tcp',
            );
        die "Socket could not be created. Reason: $!\n" unless $sock;
        
        while($line=<$sock>)
            {
                print "$line\n";
                if($line=~/220/)
                    {
                        last;
                    }
            }
        print $sock "helo $hostname\n";
        print "helo $hostname\n";
        while($line=<$sock>)
            {
            print "$line\n";
            if($line=~/250/)
                {
                    last;
                }
            }
        print $sock "MAIL FROM: $mail_from <$mail_from>\n";
        print "MAIL FROM: $mail_from <$mail_from>\n";
        while($line=<$sock>)
            {
                print "$line\n";
                if($line=~/250/)
                {
                    last;
                }
            }
        print $sock "RCPT FROM: $mail_to <$mail_to>\n";
        print "RCPT FROM: $mail_to <$mail_to>\n";
        while($line=<$sock>)
            {
                print "$line\n";
                if($line=~/250/)
                    {
                        last;
                    }
            }
        print $sock "DATA\n\n";
        print "DATA\n\n";
        while($line=<$sock>)
            {
                print "$line\n";
                if($line=~/354/)
                    {
                        last;
                    }
            }
        print $sock "\r\n.\r\n";
        print ".\n";
        while($line=<$sock>)
            {
                print "$line\n";
                if($line=~/250/)
                    {
                        last;
                    }
            }
        print $sock "QUIT\n";
        print "QUIT\n";
        while($line=<$sock>)
            {
                print "$line\n";
                if($line=~/221/)
                    {
                        last;
                    }
            }
        close ($sock);
    }

[Desdinova]

While I still stick the comment above I will take ssome stabs at why this fails for the sake of learning...
A few things that I notice while looking at RFC 821 This line:
 print $sock "RCPT FROM: $mail_to <$mail_to>\n"; Should be:


print $sock "RCPT TO: $mail_to <$mail_to>\n";

Also the RFC states that the quit should be followed by cr+LF which would change

print "QUIT\n";

to:

print "QUIT\r\n";


Anyway those are a few things I noticed off the top of my head, also you should issue a QUIT before you close even if there is an error in an earlier step.
My advice in general is to not reivnvent the wheel use the SMTP module that already implements this correctly. Failing that take the time to read the RFC(s) and implement it they way it is stated.

[echo]

I didn't to have to make him install the smtp server module.

What you really need is an SMTP client module, such as Net::SMTP, whose author has gone through great pains to implement all the intricacies of the various RFCs covering this protocol.

Once you've changed some of the headers as pointed out by earlier responses, your code will fail in all sorts of mysterious ways, for example it fails to correctly interpret server reponses and will loop endlessly when the server emits a 4xx or 5xx error code. This will happen when you least expect it: an unforeseen change in the server's configuration, a transient DNS error, an attempt to send a message whose size is larger than what the server accepts, etc.

[cLive ;-)]

I didn't (want) to have to make him install the smtp server module

Hmmm. My guess is you could have installed the module for him - in his own account if he doesn't have root access - in less time than you could have written this.

And then he'd be learning to use Perl specifically designed for the job.

just my .02

cLive ;-)

[Desdinova]

Or cut and paste the SMTP module into the script he's writing :)

[blakem]

It sounds like you might be Suffering from Buffering.

-Blake

[mkmcconn]

That's a terrific article, blakem. Thank you for the reference.

In this case, though, the mendicant brother has used the IO::Socket module, and according to the article, this module defeats the problem of buffering.

  Use the IO::Socket module; recent versions (since  
  version 1.18) make sockets hot by default.

mkmcconn

[blakem]

Good catch..... I had the nagging suspicion that IO::Socket might sidestep this problem, but didn't bother to investigate further. (after all, its easier to slap up a link than to do any real digging ;-)   ) Thanks for pointing out the definitive answer.

-Blake

[davis]

Just a thought. You're sending:
"RCPT FROM: "
You should be sending:
"RCPT TO: "

Haven't checked out the rest of the code, but that should help
davis