On Thu, May 20, 2010 at 08:33:45PM -0400, Nathan Gibbs wrote:
> Anybody already done this?

Yes, see attached.  Note that it queries all the RBL lists in parallel,
so if you run it with a big list and/or a lot of IPs to check,it can run
out of file descriptors.  If that happens, adjust the max number of FDs
with "ulimit -n" or the like.

> If, so where can I find it?

Argh, did I not upload it to the config section on Sourceforge?  Do I
still even remember how?

        -- Ed

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

# Copyright (c) 2007, 2008 by Ed Ravin <era...@panix.com>.  License is GNU.
# Available to the public courtesy of Public Access Networks http://panix.com

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;
) 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=(

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 %revip2host;

# gethostbyname is non-reentrant, so parse the hostnames to test up front
foreach my $host (@ARGV) {
        my $hostdata= gethostbyname($host);
        if (!defined($hostdata)) {
                push @summary, $host;
                push @detail, "$host: bad hostname";
        my $revip= join(".", reverse(unpack("C4", $hostdata)));
        $revip2host{$revip}= $host;

# start all the queries
foreach my $revip (keys %revip2host) {
        foreach my $rbl (@rbls2check) {
                my $dnssock=  $res->bgsend(join(".", $revip, $rbl));
                die "$0: Net::DNS::Resolver::bgsend returns undef - too many 
open files?\n"
                        unless defined($dnssock);
                push @sockets, $dnssock;

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, $revip, $forwardip, $host);
                my $packet = $res->bgread($sock);
                foreach my $rr ($packet->answer) {
                        if ($rr->type eq "A") {
                                $ipaddress= $rr->address;
                                $authority= $rr->name;
                                my $q= \$packet->question;
                                my @qquads= split('\.',${$$q}{qname});
                                splice(@qquads, 4);
                                $revip= join('.', @qquads);
                                $forwardip= join('.', reverse(@qquads));
                                $host= $revip2host{$revip} || $forwardip;
                                push @summary, $host
                                        unless grep /^$host$/, @summary;
                                push @detail, "$host: $authority: " . 

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

Reply via email to