Perl Script to Test for Open Mail Relays

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

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.