print STDERR __FILE__, "(", __LINE__, ")\n";
[download]

When you did the telnet, did you do exactly what is being sent? I could see the server rejecting the name in the EHLO and dropping the connection. Try setting the Hello parameter in the constructor to the local IP address or hostname.

I sent the same thing in telnet that I'm trying to send with the Perl. I thought it would be a good way to check that my parameters are ok. Which is why I'm confused on why it works through telnet, but not through the Perl script. I tried setting the Hello parameter to my local IP address and my hostname as you suggested, but I still get the same results. Thanks for the help.

When I use the "or die" line you suggested, I still get the identical return code that I posted, followed by the "cannot connect to xxx.xx.xxx.xxx. at c:\Email.pl line 37." So the $@ didn't give me any useful information,either. I appreciate the suggestion, though!

Before I discovered the full power of CPAN I used to do raw socket stuff to talk to servers. This code is in now way recommeneded for any sort of prodution use but is short and should allow you to diagnose the issue quickly as it lets you watch a SMTP transaction. You will need remove the CGI param() args. If this works then you have isolated it as a specific Net::SMTP problem.

sub smtp_relay {

    my $ip          = $q->param('ip')      || 'localhost';
    my $port        = $q->param('port')    || 25;
    my $timeout     = $q->param('timeout') || 30;
    my $domain      = $q->param('domain')      ||'localhost';
    my $to          = $q->param('to')      ||'you@yourdomain.com';
    my $from        = $q->param('from')      ||'nobody@nowhere.com';

    my $server = get_host_by_addr($ip);
    $ip = get_host_by_name($ip);

    my $message= "Test relay message for $server [$ip].
    You will get this message only if $server is an OPEN RELAY \015\01
+2.\015\012
";

    print "Attempting to connect to SMTP $server [$ip] on port $port\n
+";

    my $sock = IO::Socket::INET->new(   PeerAddr    => $ip,
                                        PeerPort    => $port,
                                        Proto       => 'tcp',
                                        Timeout     => $timeout
                                    );
    do{ print $CONN_FAILURE; return} unless $sock;

    $sock->autoflush(1);

    my $data = getline($sock);
    sendline( $sock, "HELO $domain" );
    $data = getline($sock);
    sendline( $sock,"MAIL from: <$from>" );
    $data = getline($sock);
    sendline( $sock, "RCPT to: <$to>" );
    $data = getline($sock);
    if ($data =~ m/^550/ ) {
        sendline( $sock, 'QUIT' );
        print "</pre><h3>$server [$ip] $NOT_RELAY_SERVER</h3>";
      return $NOT_RELAY_SERVER;
    }
    sendline( $sock, 'DATA' );
    $data = getline($sock);
    sendline( $sock, $message );
    $data = getline($sock);
    sendline( $sock, 'QUIT' );
    if ( $data =~ /^250.*(?:message accepted)|(?:queued mail for deliv
+ery)/i ) {
        print "</pre><h3>$server [$ip] $IS_RELAY_SERVER</h3>";
      return $IS_RELAY_SERVER;
    }
    else {
        print "</pre><h3>$server [$ip] $POSSIBLE_RELAY</h3>";
      return $POSSIBLE_RELAY
    }

    sub sendline {
        my ( $sock, $line ) = @_;
        $sock->write($line."\015\012");
        print $line . "\n";
    }

    sub getline {
        my $sock = shift;
        my $data = '';
        while ( defined( sysread($sock, my $buffer,1) ) ) {
            $data .= $buffer;
          last if $buffer eq "\n";
        }
        print $data;
      return $data;
    }
}
[download]