#!/usr/bin/perl

use Socket;
use Net::SMTP;


my $MAXPIDS=250;

my $TESTFROM="YOUR\@EMAIL.HERE";
my $TESTTO="OTHER\@EMAIL.ADDRESS";

my $HELP=q
{Usage: perl relaycheck.pl [-h | --help] host
};

my @hosts;

for $_ (@ARGV){
    if(/^--(.*)/){
	$_=$1;
	if(/help/){
	    print $HELP;
	    exit(0);
	}
    }
    elsif(/^-(.*)/){
	$_=$1;
	if(/^h/ or /^?/){
	    print $HELP;
	    exit(0);
	}
    }else{
	push @hosts,$_;
    }
}

if(!$hosts[0]){
    print $HELP;
    exit(-1);
}

my $host;

print "relaycheck v0.3 by dave weekly <dew\@cs.stanford.edu>\n\n";

# bury dead children
$SIG{CHLD}= sub{wait()};

# go through all of the hosts, replacing subnets with all contained IPs.
for $host (@hosts){
    $_=shift(@hosts);

    # scan a class C
    if(/^([^.]+)\.([^.]+)\.([^.]+)$/){
	my $i;
	print "Expanding class C $_\n";
	for($i=1;$i<255;$i++){
	    my $thost="$_.$i";
	    push @hosts,$thost;
	}
    }
    else{
	push @hosts,$_;
    }
}

my @pids;
my $npids=0;

for $host (@hosts){
    my $pid;
    $pid=fork();
    if($pid>0){
	$npids++;
	if($npids>$MAXPIDS){
	    for(1..($MAXPIDS/2)){
		if(wait()>0){
		    $npids--;
		}
	    }
	}
	next;
    }elsif($pid==-1){
	print "fork error\n";
	exit(0);
    }else{
	$ARGV0="(checking $host)";
	my($proto,$port,$sin,$ip);
	$proto=getprotobyname('tcp');
	$port=25;
	$ip=inet_aton($host);
	if(!$ip){
	    print "couldn't find host $host\n";
	    exit(0);
	}
	$sin=sockaddr_in($port,$ip);
	socket(Sock, PF_INET, SOCK_STREAM, $proto);
	if(!connect(Sock,$sin)){
#	    print "couldn't connect to SMTP port on $host\n";
	    exit(0);
	}
	close(Sock);

	# SOMETHING is listening on the mail port...
	
	my $smtp = Net::SMTP->new($host, Timeout => 30);
	if(!$smtp){
#	    print "$host doesn't have an SMTP port open.\n";
	    exit(0);
	}
	my $domain = $smtp->domain();
#	print "host $host identifies as $domain.\n";
	$smtp->mail($TESTFROM);
	if($smtp->to($TESTTO)){
	    print "SMTP host $host [$domain] relays.\n";
	}else{
	    print "SMTP host $host [$domain] does not relay.\n";
	}
	$smtp->reset();
	$smtp->quit();
	exit(0);
    }
}

print "done spawning, $npids children remain\n";
# wait for my children
$|=1;
for(1..$npids){
    my $wt=wait();
    if($wt==-1){
	print "hey $!\n";
	redo;
    }else{
#	print "$wt\n";
    }
}

print "Done\n";