xymon check rbl

xymon_rblcheck.pl

$|=1;
use warnings;
use strict;
use Getopt::Long;
use Net::IP;
use Net::DNS;

my $debug = 1;

my @rbl=(
        'b.barracudacentral.org',
        'cbl.abuseat.org',
        'http.dnsbl.sorbs.net',
        'misc.dnsbl.sorbs.net',
        'socks.dnsbl.sorbs.net',
        'web.dnsbl.sorbs.net',
        'dnsbl-1.uceprotect.net',
        #'dnsbl-2.uceprotect.net',
        'dnsbl-3.uceprotect.net',
        'sbl.spamhaus.org',
        'zen.spamhaus.org',
        'psbl.surriel.com',
        'dnsbl.njabl.org',
        'rbl.spamlab.com',
        #'ircbl.ahbl.org',
        'noptr.spamrats.com',
        'cbl.anti-spam.org.cn',
        'dnsbl.inps.de',
        'httpbl.abuse.ch',
        'korea.services.net',
        'virus.rbl.jp',
        'wormrbl.imp.ch',
        'rbl.suresupport.com',
        'ips.backscatterer.org',
        'opm.tornevall.org',
        'multi.surbl.org',
        'tor.dan.me.uk',
        'relays.mail-abuse.org',
        'rbl-plus.mail-abuse.org',
        'access.redhawk.org',
        'rbl.interserver.net',
        'bogons.cymru.com',
        'bl.spamcop.net',
        'dnsbl.sorbs.net',
        'dul.dnsbl.sorbs.net',
        'smtp.dnsbl.sorbs.net',
        'spam.dnsbl.sorbs.net',
        'zombie.dnsbl.sorbs.net',
        'pbl.spamhaus.org',
        'xbl.spamhaus.org',
        'bl.spamcannibal.org',
        'ubl.unsubscore.com',
        'combined.njabl.org',
        #'multi.uribl.com',
        #'black.uribl.com',
        'cblless.anti-spam.org.cn',
        'cblplus.anti-spam.org.cn',
        'blackholes.five-ten-sg.com',
        'sorbs.dnsbl.net.au',
        'rmst.dnsbl.net.au',
        'dnsbl.kempt.net',
        'rot.blackhole.cantv.net',
        'virus.rbl.msrbl.net',
        'phishing.rbl.msrbl.net',
        'images.rbl.msrbl.net',
        'spam.rbl.msrbl.net',
        'spamlist.or.kr',
        'dnsbl.abuse.ch',
        'bl.deadbeef.com',
        'forbidden.icm.edu.pl',
        'probes.dnsbl.net.au',
        'ubl.lashback.com',
        'ksi.dnsbl.net.au',
        'uribl.swinog.ch',
        'bsb.spamlookup.net',
        'dob.sibl.support-intelligence.net',
        'url.rbl.jp',
        'dyndns.rbl.jp',
        'omrs.dnsbl.net.au',
        'relays.nether.net',
);

# BB and related test constants
use constant GREEN => 'green';
use constant YELLOW => 'yellow';
use constant RED => 'red';

# BB Global variables
my $bbtest = 'rblcheck';
my $timeout = 15;
my %hosts;

# MAIN
print "DEBUG $ENV{BBHOME}/bin/bbhostgrep $bbtest\n" if $debug;
open GREP, "$ENV{BBHOME}/bin/bbhostgrep $bbtest |" or die $!;
while (<GREP>) {
        my ($ip, $host, $x, $var) = split ' ';
        if ($ip =~ /\d+\.\d+\.\d+\.\d+/) {
                $hosts{$ip} = $host;
                print "DEBUG GREP ip=$ip host=$host\n" if $debug;
        }
}
close GREP;

foreach my $h (keys %hosts) {
        print "DEBUG ip=$h host=$hosts{$h}\n" if $debug;

        my $data = "";
        my $color = GREEN;
        my $status = $bbtest . " OK";

        my $ip = new Net::IP($h);
        my $reverse = $ip->reverse_ip();
        $reverse =~ s/in\-addr\.arpa\.//gi;

        my $sel = IO::Select->new;
        my $res = Net::DNS::Resolver->new;
        my %own;

        foreach (@rbl) {
                my $query = $reverse . $_;
                my $set = $res->bgsend($query);
                $sel->add($set);
                $own{$set} = $_;
                print "QUERY: $query\n" if $debug;
        }

        while (my @ready = $sel->can_read($timeout)) {
                foreach my $sock (@ready) {
                        my $packet = $res->bgread($sock);
                        if ($packet->answer) {
                                $data .= "&red $own{$sock}";
                        } else {
                                $data .= "&green $own{$sock}\n";
                        }
                        foreach my $rr ($packet->answer) {
                                my $info = $rr->name . " " . $rr->address;
                                $color = RED;
                                $status = $bbtest . " NOT OK";
                                $data .= " => found $info\n";
                                print "FOUND: $info\n";
                        }
                        $sel->remove($sock);
                        delete $own{$sock};
                }
        }

        map { print "TIMEOUT: $_\n"; $color = YELLOW; $data .= "&yellow $_ => timeout\n"; } (values %own);

        # Send to Hobbit
        my $date = `date`; chomp($date);
        system("$ENV{BB} $ENV{BBDISP} 'status+90 $hosts{$h}.$bbtest $color $date - $status\n\n$data'\n");
        print "DEBUG data=$data status=$status\n" if $debug;
}