#!/usr/bin/perl

#
# DISCLAIMER:
#	If the use of this program is in violation of your countrys
#	local Internet Security laws - Then Do Not Use!
#
#	(C) 2oo4 WC -Sx- Jones; All Rights Reserved...
#	All Warranties for Fitness or Use Are Specifically Denied.
#

use Net::DNS;
use Net::Telnet;
use Sys::Hostname;
use Time::CTime;

# Version and Author...
my $VERSION = '4.00';
my $AUTHOR  = "WC -Sx- Jones; code last modified by -Sx- 2/21/2oo4...";

# Initialize the state variables that will tell us the results in the end
my $all_good=1;
my $incomplete=0;
my $unknown=0;

# Get my own hostname:
my $my_hostname = hostname() || 'localhost';

# What is the script name
my $iam;        ($iam = $0) =~ s,.*/,,;

# By default only localhost is tested...
my @domains = @ARGV ? @ARGV : qw(localhost);
my $target; # Each domain as a target

# More Vars...
my %check_ips;		# Hash of IPs
my @session_lines;	# The session lines of the test
my $now	= time;	# reference time
my $width	= 80;		# screen char width
my $timeout;		# How long to wait on tests

# Global report variables...
my ($rr, $rbltype, $mx, $ip, $result, $session, $smtp, $start, $openretval, 
      $prebanner, $banner, $helo_retval, $prematch, $match, $mail_retval, 
      $postmaster_failed, $abuse_failed, $rcpt_retval, $anybody_failed, $rev_ip, 
      $blackhole);

# Patterns and Responses
my @known_rejection_patterns;
my @known_good_patterns;

my @mx;			# The array of MX records
my ($name, $res, $query); # The individual responses

# How long should we wait for things?
my $tmout = $ARGV[-1] || '. ';
if ($tmout =~ /[\D\s.]/) { $timeout = 30; } else { $timeout = $ARGV[-1]; }

# get ALL the [host.]domain.org passed as cmd line args
# OTHERWISE - set help flag...
my $FQDN = $ARGV[0] || 'help';
&help() unless ($FQDN =~ /\w\.(.+){2,4}/);

@known_rejection_patterns = (
  '^5\d\d .*(?i)((?i:spam)|bogus mail from|invalid (mail|address|user|sender)|access denied|configured to (reject|refuse)|syntax err|empty|<>|buildaddr|fqdn|Malformed|where is .* in that|Anonymous Senders Prohibited|input error|not verified|refused|error parsing|Argument required|Sender Not Authorised|Transaction failed|Illegal Address|envelope sender|sorry|not legal|local error in processing|Internal System Error|non local adresses|Address Rejected|fatal error|command argument|Failed address)',
  '451 (Command parser|Bad sender)',
  '452 Out of memory',
  '421 .*closing transmission channel',
  '451-.*local error in processing',
  '^5\d\d \s*$',
  );


@known_good_patterns = (
    '^[45]\d\d .*(?i)(message size|exceeds maximum|Insufficient disk space)',
    );


################################
############## Main Program Logic...
# Let's Rock!!!
print "\n\n..............................\n\tProgram: $0\tVersion: $VERSION\nAuthor: $AUTHOR\n...\n\n";

foreach $target (@domains) {

$FQDN = $target;  exit unless ($FQDN =~ /\w\.(.+){2,4}/);
print  "OK, we are researching Host/Domain: $FQDN ... timeout set to $timeout\n";

$resolver = new Net::DNS::Resolver;

################################### Start of -Sx- section...
print "\n\n..............................\nStart of -Sx- tests ========\n\n";

#     Look up a host's addresses.

       $res   = Net::DNS::Resolver->new;
       $query = $res->search("$FQDN");

       if ($query) {
           foreach my $rr ($query->answer) {
               next unless $rr->type eq "A"; # Is this an A record?
               print $rr->address, " ... Host record was found!\n";

               # Do IP 'spam' testing ... double check.
               &print_if_blackhole($rr->address);
               &print_if_ordb($rr->address);
               &print_if_dsbl($rr->address);
               &print_if_visi($rr->address);
               &print_if_sorbs($rr->address);
           }
       } else {
           warn "query failed: ", $res->errorstring, "\n No Host (A) Records found...\n\n";
       }


#     Find the nameservers for a domain.

       $res   = Net::DNS::Resolver->new;
       $query = $res->query("$FQDN", "NS");

       if ($query) {
           foreach $rr (grep { $_->type eq 'NS' } $query->answer) {
               print $rr->nsdname, " ... Name Server was found!\n";

               # Do IP 'spam' testing ... double check.
               &print_if_blackhole($rr->nsdname);
               &print_if_ordb($rr->nsdname);
               &print_if_dsbl($rr->nsdname);
               &print_if_visi($rr->nsdname);
               &print_if_sorbs($rr->nsdname);
           }
       }
       else {
           warn "query failed: ", $res->errorstring, "\n No Name Servers (NS) Records found...\n\n";
       }


#     Find the MX records for a domain.

       $name = "$FQDN";
       $res  = Net::DNS::Resolver->new;
       @mx   = mx($res, $name);

       if (@mx) {
           foreach $rr (@mx) {
               print $rr->preference, " ", $rr->exchange, " ... possible Mail Server was found.\n";
           }
       } else {
           warn "Can't find MX records for $name: ", $res->errorstring, "\n No Mail eXchange (MX) Records found...\n\n";
       }


#     Print a domain's SOA record in zone file format.

       $res   = Net::DNS::Resolver->new;
       $query = $res->query("$FQDN", "SOA");

       if ($query) {
           ($query->answer)[0]->print;
       } else {
           print "query failed: ", $res->errorstring, "\n No SOA Record found...\n\n";
       }

print "\n... End of -Sx- tests ========\n..............................\n\n\n";
################################### End of -Sx- section...

# Check RFC-Ignorant lists for known bad behaviour
foreach $rbltype ("dsn", "abuse", "postmaster", "whois") {
  alarm($timeout);
  $query = $resolver->search($FQDN . ".$rbltype.rfc-ignorant.org.");
  alarm(0);
  if ($query) {
    foreach $rr ($query->answer) {
      next unless $rr->type eq "A";
      print  "\n\tWARNING: This host is listed with <http://www.rfc-ignorant.org/> as type: $rbltype\n\n";
    }
  }
}

# Look for MX hosts for the FQDN in question
@mx = mx($resolver,$FQDN);
if (scalar(@mx)>0) {

    # For each host returned on the MX list, get the A record(s)
    foreach $mx (@mx) {
        print  "MX: ",$mx->exchange,"(",$mx->preference,")\n";
        alarm($timeout);
        $query = $resolver->search($mx->exchange);
        alarm(0);
        if ($query) {
            foreach $rr ($query->answer) {
                next unless $rr->type eq "A";
                $check_ips{$rr->address} = "MX:" . $mx->preference . "(" . $mx->exchange . ")";
            }
        }
    }
}

# If there are MX hosts, use those, otherwise, search for an A record
if (!scalar(%check_ips)) {
    $query = $resolver->search($FQDN);
    if ($query) {
        foreach $rr ($query->answer) {
            next unless $rr->type eq "A";
            $check_ips{$rr->address} = "A($FQDN)";
        }
    }
}


foreach $ip (sort(keys(%check_ips))) {
    $result = &check_IP($ip);
    if (!defined($result)) {
        print  "Warning: Unable to check IP: $ip\n";
        $incomplete=1;
    } elsif ($result==0) {
        print  "ERROR: Bad response from IP: $ip\n";
        $all_good=0;
    } elsif ($result == -1) {
        print  "\nWARNING: Unknown response from IP: $ip\n";
        $unknown=1;
    } else {
        print  "\nOK: Acceptable response: $ip\n";
    }
}

if (!$all_good) {
  print  "ERROR: At least one host failed the check.\n";
}

if ($unknown) {
  print  "WARNING: Unknown response from at least one host, check manually.\n";
}

if ($incomplete) {
  print  "WARNING: No bad hosts, but some could not be checked.\n";
}

print  "\n\nDone checking $FQDN ... completed.\n" if ($all_good);

print "\t\t\t\t\t\n\n\n\n\n";

}  # foreach Loop end...


####################
### Support subroutines

sub check_IP {
    my($ip)=shift;
    print  "Checking IP: $ip [$check_ips{$ip}] ... \n";
    &print_if_blackhole($ip);
    &print_if_ordb($ip);
    &print_if_dsbl($ip);
    &print_if_visi($ip);
    &print_if_sorbs($ip);

##### call each SMTP test individually ...
&print_from($ip);
&print_anybody($ip);
&print_postmaster($ip);
&print_abuse($ip);

}

# test Postmaster
sub print_postmaster {
    my $ip = shift;
    $session="\nWhile talking with $ip on " . ctime(time);
    $smtp = new Net::Telnet;
    $smtp->errmode("return");
    $start=time;
    $openretval = $smtp->open(Host => $ip, Port => 25, Timeout => $timeout);
    if (!defined($openretval)) {
        if (time-$start<$timeout) {
            print  " - Postmaster Test - CONN_REFUSED\nThe remote system refused the request.\n\n";
        } else {
            print  " - Postmaster Test - TIMEOUT\nIs out-bound Port 25 being blocked from: $my_hostname?\n\n";
        }
        return(undef);
    }
    ($prebanner, $banner) = $smtp->waitfor('/^\d\d\d .*$/');
    $session .= "$prebanner\n" if (defined($prebanner) and $prebanner ne "");
    $session .= "$banner\n"    if (defined($banner)    and $banner    ne "");
#    $smtp->dump_log("/tmp/smtpdump");
    print "\nBanners seen: $prebanner $banner\n\n";

    print "\nTesting >>> HELO (send) ... ";
    $helo_retval = $smtp->print("HELO $my_hostname");
    $session .= "HELO $my_hostname\n";
    if (!defined($helo_retval) or !$helo_retval) {
        print  " - Postmaster Test FAILED(HELO)\n";
        return(0);
    }

    print "\nTesting <<< HELO (response) ... ";
    ($prematch, $match) = $smtp->waitfor('/^\d{3}.*$/m');
    $session .= "$prematch\n" if (defined($prematch) and $prematch =~ /\S/m);
    $session .= "$match\n"    if (defined($match)    and $match    ne "");
    if (!defined($match) or $match !~ /^2/) {
        print  " - Postmaster Test FAILED(HELO)\n";
        print  ">>> MAIL From: <>\n";
        print  "Postmaster Failure:\n"; &print_session($session); print  ".\n";
        return(0);
    }

    print "\nTesting >>> MAIL From: <> (send) ... ";
    $mail_retval = $smtp->print("MAIL From: <>");
    $session .= "MAIL From: <>\n";
    if (!defined($mail_retval) or !$mail_retval) {
        print  " - Postmaster Test FAILED(MAIL)\n";
        return(0);
    }

    print "\nTesting <<< MAIL (response) ... ";
    ($prematch, $match) = $smtp->waitfor('/^\d{3}.*$/m');
    $session .= "$prematch\n" if (defined($prematch) and $prematch =~ /\S/m);
    $session .= "$match\n"    if (defined($match)    and $match    ne "");
    if (!defined($match) or grep($match=~$_, @known_rejection_patterns)) {
        print  " - Postmaster Test FAILED(MAIL)\n";
        print  "Postmaster Failure:\n"; &print_session($session);
        return(0);
    } elsif (defined($match) and $match !~ /^2/) {
        print  " - Postmaster Test UNKNOWN_RESPONSE(MAIL)\n";
        print  "Postmaster - Strange Failure:\n"; &print_session($session);
        return(-1);
    }

    $postmaster_failed	= 0;
    print "\nTesting >>> RCPT To: <postmaster@$FQDN> (send) ... ";
    $rcpt_retval = $smtp->print("RCPT TO: <postmaster\@$FQDN>");
    $session .= "RCPT To: <postmaster\@$FQDN>\n";
    if (!defined($rcpt_retval) or !$rcpt_retval) {
        print  " - Postmaster Test FAILED(RCPT)\n";
        $postmaster_failed = 1;
    }
 
    ### <<< RCPT (response)
    ($prematch, $match) = $smtp->waitfor('/^\d{3}.*$/m');
    $session .= "$prematch\n" if (defined($prematch) and $prematch =~ /\S/m);
    $session .= "$match\n"    if (defined($match)    and $match    ne "");
    if (!defined($match) or $match !~ /^2/) {
        print  " - Postmaster Test FAILED(MAIL)\n";
        print  "Postmaster Failure:\n"; &print_session($session);
        return(0);
    }

    print "\n";
    $rcpt_retval = $smtp->print("RSET");
    $rcpt_retval = $smtp->print("QUIT");
    print  " - OK.  Postmaster Test Successful...\n";
}

# test Abuse...
sub print_abuse {
    my $ip = shift;
    $session="\nWhile talking with $ip on " . ctime(time);
    $smtp = new Net::Telnet;
    $smtp->errmode("return");
    $start=time;
    $openretval = $smtp->open(Host => $ip, Port => 25, Timeout => $timeout);
    if (!defined($openretval)) {
        if (time-$start<$timeout) {
            print  " - Abuse Test - CONN_REFUSED\nThe remote system refused the request.\n\n";
        } else {
            print  " - Abuse Test - TIMEOUT\nIs out-bound Port 25 being blocked from: $my_hostname?\n\n";
        }
        return(undef);
    }
    ($prebanner, $banner) = $smtp->waitfor('/^\d\d\d .*$/');
    $session .= "$prebanner\n" if (defined($prebanner) and $prebanner ne "");
    $session .= "$banner\n"    if (defined($banner)    and $banner    ne "");
#    $smtp->dump_log("/tmp/smtpdump");
    print "\nBanners seen: $prebanner $banner\n\n";

    print "\nTesting >>> HELO (send) ... ";
    $helo_retval = $smtp->print("HELO $my_hostname");
    $session .= "HELO $my_hostname\n";
    if (!defined($helo_retval) or !$helo_retval) {
        print  " - Abuse Test FAILED(HELO)\n";
        return(0);
    }

    print "\nTesting <<< HELO (response) ... ";
    ($prematch, $match) = $smtp->waitfor('/^\d{3}.*$/m');
    $session .= "$prematch\n" if (defined($prematch) and $prematch =~ /\S/m);
    $session .= "$match\n"    if (defined($match)    and $match    ne "");
    if (!defined($match) or $match !~ /^2/) {
        print  " - Abuse Test FAILED(HELO)\n";
        print  ">>> MAIL From: <>\n";
        print  "Abuse Failure:\n"; &print_session($session); print  ".\n";
        return(0);
    }

    print "\nTesting >>> MAIL From: <> (send) ... ";
    $mail_retval = $smtp->print("MAIL From: <>");
    $session .= "MAIL From: <>\n";
    if (!defined($mail_retval) or !$mail_retval) {
        print  " - Abuse Test FAILED(MAIL)\n";
        return(0);
    }

    print "\nTesting <<< MAIL (response) ... ";
    ($prematch, $match) = $smtp->waitfor('/^\d{3}.*$/m');
    $session .= "$prematch\n" if (defined($prematch) and $prematch =~ /\S/m);
    $session .= "$match\n"    if (defined($match)    and $match    ne "");
    if (!defined($match) or grep($match=~$_, @known_rejection_patterns)) {
        print  " - Abuse Test FAILED(MAIL)\n";
        print  "Abuse Failure:\n"; &print_session($session);
        return(0);
    } elsif (defined($match) and $match !~ /^2/) {
        print  " - Abuse Test UNKNOWN_RESPONSE(MAIL)\n";
        print  "Abuse - Strange Failure:\n"; &print_session($session);
        return(-1);
    }
 
    $abuse_failed	= 0;
    print "\nTesting >>> RCPT To: <abuse@$FQDN> (send) ... ";
    $rcpt_retval = $smtp->print("RCPT TO: <abuse\@$FQDN>");
    $session .= "RCPT To: <abuse\@$FQDN>\n";
    if (!defined($rcpt_retval) or !$rcpt_retval) {
        print  " - Abuse Test FAILED(RCPT)\n";
        $abuse_failed = 1;
    }
 
    ### <<< RCPT (response)
    ($prematch, $match) = $smtp->waitfor('/^\d{3}.*$/m');
    $session .= "$prematch\n" if (defined($prematch) and $prematch =~ /\S/m);
    $session .= "$match\n"    if (defined($match)    and $match    ne "");
    if (!defined($match) or $match !~ /^2/) {
        print  " - Abuse Test FAILED(MAIL)\n";
        print  "Abuse Failure:\n"; &print_session($session);
        return(0);
    }

    print "\n";
    $rcpt_retval = $smtp->print("RSET");
    $rcpt_retval = $smtp->print("QUIT");
    print  " - OK.  Abuse Test Successful.\n";
}


# test Anybody
sub print_anybody {
    my $ip = shift;
    $session="\nWhile talking with $ip on " . ctime(time);
    $smtp = new Net::Telnet;
    $smtp->errmode("return");
    $start=time;
    $openretval = $smtp->open(Host => $ip, Port => 25, Timeout => $timeout);
    if (!defined($openretval)) {
        if (time-$start<$timeout) {
            print  " - Anybody Test - CONN_REFUSED\nThe remote system refused the request.\n\n";
        } else {
            print  " - Anybody Test - TIMEOUT\nIs out-bound Port 25 being blocked from: $my_hostname?\n\n";
        }
        return(undef);
    }
    ($prebanner, $banner) = $smtp->waitfor('/^\d\d\d .*$/');
    $session .= "$prebanner\n" if (defined($prebanner) and $prebanner ne "");
    $session .= "$banner\n"    if (defined($banner)    and $banner    ne "");
#    $smtp->dump_log("/tmp/smtpdump");
    print "\nBanners seen: $prebanner $banner\n\n";

    print "\nTesting >>> HELO (send) ... ";
    $helo_retval = $smtp->print("HELO $my_hostname");
    $session .= "HELO $my_hostname\n";
    if (!defined($helo_retval) or !$helo_retval) {
        print  " - Anybody Test FAILED(HELO)\n";
        return(0);
    }

    print "\nTesting <<< HELO (response) ... ";
    ($prematch, $match) = $smtp->waitfor('/^\d{3}.*$/m');
    $session .= "$prematch\n" if (defined($prematch) and $prematch =~ /\S/m);
    $session .= "$match\n"    if (defined($match)    and $match    ne "");
    if (!defined($match) or $match !~ /^2/) {
        print  " - Anybody Test FAILED(HELO)\n";
        print  ">>> MAIL From: <>\n";
        print  "Anybody Failure:\n"; &print_session($session); print  ".\n";
        return(0);
    }

    print "\nTesting >>> MAIL From: <> (send) ... ";
    $mail_retval = $smtp->print("MAIL From: <>");
    $session .= "MAIL From: <>\n";
    if (!defined($mail_retval) or !$mail_retval) {
        print  " - Anybody Test FAILED(MAIL)\n";
        return(0);
    }

    print "\nTesting <<< MAIL (response) ... ";
    ($prematch, $match) = $smtp->waitfor('/^\d{3}.*$/m');
    $session .= "$prematch\n" if (defined($prematch) and $prematch =~ /\S/m);
    $session .= "$match\n"    if (defined($match)    and $match    ne "");
    if (!defined($match) or grep($match=~$_, @known_rejection_patterns)) {
        print  " - Anybody Test FAILED(MAIL)\n";
        print  "Anybody Failure:\n"; &print_session($session);
        return(0);
    } elsif (defined($match) and $match !~ /^2/) {
        print  " - Anybody Test UNKNOWN_RESPONSE(MAIL)\n";
        print  "Anybody - Strange Failure:\n"; &print_session($session);
        return(-1);
    }

    $anybody_failed	= 0;
    print "\nTesting >>> RCPT To: <anybody@$FQDN> (send) ... ";
    $rcpt_retval = $smtp->print("RCPT TO: <anybody\@$FQDN>");
    $session .= "RCPT To: <anybody\@$FQDN>\n";
    if (!defined($rcpt_retval) or !$rcpt_retval) {
        print  " - Anybody Test SUCCESS: FAILED(RCPT)\n";
        $anybody_failed = 1;
    }
   
    ### <<< RCPT (response)
    ($prematch, $match) = $smtp->waitfor('/^\d{3}.*$/m');
    $session .= "$prematch\n" if (defined($prematch) and $prematch =~ /\S/m);
    $session .= "$match\n"    if (defined($match)    and $match    ne "");
    if (!defined($match) or $match !~ /^2/) {
        print  " - Anybody Test SUCCESS: FAILED(MAIL)\n";
        print  "Anybody Success:\n"; &print_session($session);
        return(0);
    }

    print "\n";
    $rcpt_retval = $smtp->print("RSET");
    $rcpt_retval = $smtp->print("QUIT");
    print  " - NOT OK.  Anybody test was successful when it should have failed.\n";
}


# test From
sub print_from {
    my $ip = shift;
    $session="\nWhile talking with $ip on " . ctime(time);
    $smtp = new Net::Telnet;
    $smtp->errmode("return");
    $start=time;
    $openretval = $smtp->open(Host => $ip, Port => 25, Timeout => $timeout);
    if (!defined($openretval)) {
        if (time-$start<$timeout) {
            print  " - Empty From Test - CONN_REFUSED\nThe remote system refused the request.\n\n";
        } else {
            print  " - Empty From Test - TIMEOUT\nIs out-bound Port 25 being blocked from: $my_hostname?\n\n";
        }
        return(undef);
    }
    ($prebanner, $banner) = $smtp->waitfor('/^\d\d\d .*$/');
    $session .= "$prebanner\n" if (defined($prebanner) and $prebanner ne "");
    $session .= "$banner\n"    if (defined($banner)    and $banner    ne "");
#    $smtp->dump_log("/tmp/smtpdump");
    print "\nBanners seen: $prebanner $banner\n\n";

    print "\nTesting >>> HELO (send) ... ";
    $helo_retval = $smtp->print("HELO $my_hostname");
    $session .= "HELO $my_hostname\n";
    if (!defined($helo_retval) or !$helo_retval) {
        print  " - Empty From Test FAILED(HELO)\n";
        return(0);
    }

    print "\nTesting <<< HELO (response) ... ";
    ($prematch, $match) = $smtp->waitfor('/^\d{3}.*$/m');
    $session .= "$prematch\n" if (defined($prematch) and $prematch =~ /\S/m);
    $session .= "$match\n"    if (defined($match)    and $match    ne "");
    if (!defined($match) or $match !~ /^2/) {
        print  " - Empty From Test FAILED(HELO)\n";
        print  ">>> MAIL From: <>\n";
        print  "Empty From Failure:\n"; &print_session($session); print  ".\n";
        return(0);
    }

    print "\nTesting >>> MAIL From: <> (send) ... ";
    $mail_retval = $smtp->print("MAIL From: <>");
    $session .= "MAIL From: <>\n";
    if (!defined($mail_retval) or !$mail_retval) {
        print  " - Empty From Test SUCCESS: FAILED(MAIL)\n";
        return(0);
    }

    print "\nTesting <<< MAIL (response) ... ";
    ($prematch, $match) = $smtp->waitfor('/^\d{3}.*$/m');
    $session .= "$prematch\n" if (defined($prematch) and $prematch =~ /\S/m);
    $session .= "$match\n"    if (defined($match)    and $match    ne "");
    if (!defined($match) or grep($match=~$_, @known_rejection_patterns)) {
        print  " - Empty From Test SUCCESS(MAIL)\n";
        print  "Empty From Success:\n"; &print_session($session);
        return(0);
    } elsif (defined($match) and $match !~ /^2/) {
        print  " - Empty From Test UNKNOWN_RESPONSE(MAIL)\n";
        print  "Empty From - Strange Failure:\n"; &print_session($session);
        return(-1);
    }

    print "\n";
    $rcpt_retval = $smtp->print("RSET");
    $rcpt_retval = $smtp->print("QUIT");
    print  " - NOT OK.  Empty From Test was Successful when it should have failed.\n";
}


###############  Sessions ...
sub print_session {
    my($session)=shift;
    @session_lines=split(/\n/,$session);
    print  "  ",join("\n  ",@session_lines),"\n";
}

######################## Blackholes
sub print_if_blackhole {
    my($ip)=shift;
    $rev_ip=join(".",reverse(split(/\./,$ip))) . ".backholes.us.";

    my($query,$rr);
    alarm($timeout); $query = $resolver->search($rev_ip);
    alarm(0);
    if ($query) {
        foreach $rr ($query->answer) {
            next unless $rr->type eq "A";
            print  "t\t ... was found listed on [RBL:blackholes.us] ...\n\n";
        }
    }

    $blackhole = 0;  # This check is here for sanity...
# Is the IP Address a Private IP or maybe a 'BOGON' Listed IP? in other words, unallocated...
    $blackhole++ if ($ip =~ /^10\.0\./);
    $blackhole++ if ($ip =~ /^127\.0\./);
    $blackhole++ if ($ip =~ /^172\.16\./);
    $blackhole++ if ($ip =~ /^192\.168\./);
    $blackhole++ if ($ip =~ /^224\.0\./);
    print  "\nWARNING: One or more IP addresses are in the Unallocated IP block ... may be a blackhole.\n\n" if ($blackhole);
}

################### Open Relays
sub print_if_ordb {
    my($ip)=shift;
    $rev_ip=join(".",reverse(split(/\./,$ip))) . ".relays.ordb.org.";

    my($query,$rr);
    alarm($timeout); $query = $resolver->search($rev_ip);
    alarm(0);
    if ($query) {
        foreach $rr ($query->answer) {
            next unless $rr->type eq "A";
            print  "\t\t ... was found listed on [RBL:ordb.org] as a open relay.\n\n";
        }
    }
}

################### Other tests
sub print_if_dsbl {
    my($ip)=shift;
    $rev_ip=join(".",reverse(split(/\./,$ip))) . ".list.dsbl.org.";

    my($query,$rr);
    alarm($timeout); $query = $resolver->search($rev_ip);
    alarm(0);
    if ($query) {
        foreach $rr ($query->answer) {
            next unless $rr->type eq "A";
            print  "\t\t ... was found listed on [RBL:dsbl.org] ...\n\n";
        }
    }
}

################### Open Relays
sub print_if_visi {
    my($ip)=shift;
    $rev_ip=join(".",reverse(split(/\./,$ip))) . ".relays.visi.com.";

    my($query,$rr);
    alarm($timeout); $query = $resolver->search($rev_ip);
    alarm(0);
    if ($query) {
        foreach $rr ($query->answer) {
            next unless $rr->type eq "A";
            print  "\t\t ... was found listed on [RBL:visi.com] as a open relay.\n\n";
        }
    }
}

#################### Dynamic IPs
sub print_if_sorbs {
    my($ip)=shift;
    $rev_ip=join(".",reverse(split(/\./,$ip))) . ".dnsbl.sorbs.net.";

    my($query,$rr);
    alarm($timeout); $query = $resolver->search($rev_ip);
    alarm(0);
    if ($query) {
        foreach $rr ($query->answer) {
            next unless $rr->type eq "A";
            print  "\t\t ... was found listed on [Dynamic IP:dnsbl.sorbs.net]\n\t\t Dynamic IP Space (Cable, DSL & Dial Ups).\n\n";
        }
    }
}

################### Display Help...
sub help() {
	print<<_XHELP_;

Program: $iam\tVersion: $VERSION\nAuthor: $AUTHOR

FATAL: Usage: [perl] $iam [hostname.]domainname.tld [timeout]

	...	where [hostname.] is optional and if given should be a fully
		qualified host name domain name pair...

	If only domain.tld is given then it is a properly registered domain;
	you may enter as many fully qualified domain names as you desire.

	chasecreek.insecurity.org 60 or insecurity.org bellsouth.net 60
	...	but NOT simply host or localhost alone...
		(RAW IP addresses (like 127.0.0.1) are no longer accepted.)

	...	[timeout] is optional and should be indicated in seconds.
		(The default timeout is $timeout seconds...)

Examples:
	...	perl $0 insecurity.org $timeout > host_test.sx 2>&1
or
	...	perl $0 insecurity.org chasecreek.insecurity.org $timeout | tee -a host_test.sx

Notes:	Do not enter the [] brackets...
		RAW IP addresses (like 127.0.0.1) are no longer accepted...

		Usage Recap: $0 [hostname.]domainname.tld [timeout]

_XHELP_

exit;
};

__END__

... 

Enter any site specific notes here.

WC -Sx- Jones
	Feb 2oo4