I've rewritten the prototype rbl.monitor that was submitted by Tim
Hanes a while back. This version uses asynchronous DNS requests
(using Net::DNS), and allows for an external list of the RBL zones
to check. It also has a master timeout in case it gets stuck on
any of the DNS queries.
Please let me know what you think of it. I haven't put this in
Sourceforge yet, I want to make sure it runs in at least one other
environment besides mine.
-- Ed
#!/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;
_______________________________________________
mon mailing list
[email protected]
http://linux.kernel.org/mailman/listinfo/mon
