#!/usr/bin/perl -w
#Script to check for Open Relay EMAIL Servers on port 25
#Author: Felipe Ferreira  fel.h2o(at)gmail Date: 18/02/2009
#ref. http://www.perlmonks.org/index.pl?node_id=718552
#TODO: 
#1. Should get from a list of IPs, should report any Open servers to a .txt file
#smtp->code() and message() are the responses of the server!

use Net::SMTP;
my $host;
my $filename = "servers.txt";

#open .txt file with all servers names or IPs
#open($filehandle, "<" . $filename);
open FILE, "<servers.txt" or die $!;
while (my $host = <FILE>) {
	print "Testing: $host";
	my $smtp = Net::SMTP->new($host, 
		Hello => "admin", 
		Timeout => 3,
		Debug => 0);
	if (!$smtp) {		print STDOUT "No connection to $host \n";
		
	}
	else {
	$smtp->mail('relayfromtest@testing.com');
	$smtp->to('relaytotest@local.com')
	   or 
	   print "SERVIDOR OK: $host RCPT TO: ", $smtp->code(), " ", $smtp->message();
	if ($smtp->code() eq "250" ) {
	   print "SERVIDOR CRITICAL: $host Tiene problema de OPEN RELAY!!!";
	}
#	$smtp->quit;	
	}
} #Next host
close FILE;