[Mon-commit] mon-contrib/monitors/dnsbl rbl.monitor,NONE,1.1

[Jim T. <tr...@us...>]

Update of /cvsroot/mon/mon-contrib/monitors/dnsbl
In directory sfp-cvsdas-4.v30.ch3.sourceforge.com:/tmp/cvs-serv31357/dnsbl

Added Files:
	rbl.monitor 
Log Message:
added rbl monitor

--- NEW FILE: rbl.monitor ---
#!/usr/bin/perl

# rbl.monitor - check RBL blacklists for an IP address.  Uses asynch I/O
# to send all the requests simultaneously

my $usage="\
Usage: rbl.monitor [options] hostname [...]

Options [and default values]:

    --listfile <list of RBL domains>                 [preset list, see script]
    --rbllist <comma separated list of RBL domains>
    --timeout  <master timeout>                      [60 seconds]
    --debug                                          [off]
";


use strict;

use Net::DNS;
use IO::Select;
use Getopt::Long;

my %opt;
GetOptions(\%opt,
	"listfile=s",
	"rbllist=s",
	"timeout=i",
	"debug",
) or die $usage;

my $listfile= $opt{listfile} || "";
my $rbllist= $opt{rbllist} || "";
my $selecttimeout = 5;
my $timeout= ($opt{timeout} || 60) + ($selecttimeout * 2);
my $debug= $opt{debug} || 0;


# Default RBLs to check - just a few of the lists most likely to block mail
# Sites with specific needs should customize via the command line
my @rbls2check=(
	"bl.spamcop.net",
	"relays.mail-abuse.org", 
	"zen.spamhaus.org",
	"dnsbl.sorbs.net",
	"dnsbl-1.uceprotect.net",
);

if ($listfile) {
	open(LIST, "< $listfile") ||
		die "$0: cannot open list file \"$listfile\": $!\n";
	@rbls2check= grep !/^\s*#/, <LIST>;
	@rbls2check= grep !/^\s*$/, @rbls2check;
	map {chomp} @rbls2check;
	close LIST;
	die "$0: no RBL names found in \"$listfile\"\n" unless @rbls2check;
}

if ($rbllist) {
	@rbls2check= split(',', $rbllist);
}

print "*** checking these RBLs:\n   " . join("\n   ", @rbls2check) . "\n"
	if $debug;

my (@summary, @detail);
my @sockets;


my $res	 = Net::DNS::Resolver->new;
my $sel	 = IO::Select->new();
my $starttime= time;

my %hostpart2host;

# gethostbyname is non-reentrant, so do all the queries up front
foreach my $host (@ARGV) {
	my $hostdata= gethostbyname($host);
	if (!defined($hostdata)) {
		push @summary, $host;
		push @detail, "$host: bad hostname";
		next;
	}
	my $hostpart= join(".", reverse(unpack("C4", $hostdata)));
	$hostpart2host{$hostpart}= $host;
}

# start all the queries
foreach my $hostpart (keys %hostpart2host) {
	foreach my $rbl (@rbls2check) {
		my $dnssock=  $res->bgsend(join(".", $hostpart, $rbl));
		push @sockets, $dnssock;
		$sel->add($dnssock);
	}
}

MAINLOOP:
while ($sel->handles > 0) {
	my @ready = $sel->can_read($selecttimeout);
	if ( (time - $starttime) > $timeout) { # waited too long?
		push @detail, "TIMEOUT: " . scalar($sel->handles) . " responses still pending";
		last MAINLOOP;
	}
	foreach my $sock (@ready) {
		my ($authority, $ipaddress, $hostpart, $host);
		my $packet = $res->bgread($sock);
		foreach my $rr ($packet->answer) {
			if ($rr->type eq "A") {
				$ipaddress= $rr->address;
				$authority= $rr->name;
				if ($authority=~ /^(\d+\.\d+\.\d+\.\d+)\./) {
					$hostpart= $1;
					$host= $hostpart2host{$hostpart};
				} else { $host= "???" }
				push @summary, $host
					unless grep /^$host$/, @summary;
				push @detail, "$host: $authority: " . $rr->address;
			}
		}
		$sel->remove($sock);
	}
}

print join(" ", (sort @summary)) if (@summary);
print "\n";

print join("\n", (sort @detail)), "\n"  if @detail;

exit 1 if @summary;
exit 0;