in reply to SMTP Connection Problem
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; } }
cheers
tachyon
|
|---|