ProjectsMisc ScriptsPerl Script...

Perl Script to Test for Open Mail Relays

Thursday, July 29, 2004 by digitalpeer, updated Wednesday, August 18, 2004

Open relays are bad. You shouldn't never run one and your server will be killed if you do by spammers.

As a warning, while this will detect most normal relays, it does not test for vulnerabilities and unknown reactions that some mail servers may have that allow them to exploited as a mail relay. http://www.abuse.net is pretty good at detecting these things. I can personally speak for software like a fully patched Microsoft Exchange 5.5 server which is absolutely horrible at handling mail trying to be relayed.

#!/usr/bin/perl -w

use IO::Socket::INET;
my $SOCKET = IO::Socket::INET->new(
        PeerAddr => "mailserverhost",
        PeerPort => 25,
        Proto   => 'tcp') || die "Error in create socket!";

$SOCKET->autoflush= 0;

# Suck down the greeting and discard it
my $RESPONSE = <$SOCKET>;
print $RESPONSE;

print "HELO server";
print $SOCKET "HELO server";
$RESPONSE = <$SOCKET>;
print $RESPONSE;

print "RSET";
print $SOCKET "RSET";
$RESPONSE = <$SOCKET>;
print $RESPONSE;

print "MAIL FROM:<spamtest@somedomain.com>";
print $SOCKET "MAIL FROM:<spamtest@somedomain.com>";
$RESPONSE = <$SOCKET>;
print $RESPONSE;


print "RCPT TO:<to@domain.com>";
print $SOCKET "RCPT TO:<to@domain.com>";
$RESPONSE = <$SOCKET>;
print $RESPONSE;

# goodbye
print $SOCKET "QUIT";
# eat any response
$RESPONSE = <$SOCKET>;
print $RESPONSE;
# kill socket
close($SOCKET);

This script can basically be used to automate doing something like telneting to a server to test it's ability to deny an unauthorized relay.

If you are looking for a better solution, the Grinch is a more developed perl script.