--- /dev/null
+--- check_rbl-1.1.0/check_rbl 2010-04-06 20:26:18.598337785 +0300
++++ check_rbl-1.2.0/check_rbl 2010-04-06 20:40:42.858468257 +0300
+@@ -2,8 +2,9 @@
+ # check_rbl is a Nagios plugin to check if an SMTP server is blacklisted
+ #
+ # See the INSTALL file for installation instructions
+ #
+ # Copyright (c) 2007, ETH Zurich.
++# Copyright (c) 2010, Elan Ruusamäe <glen@delfi.ee>.
+ #
+ # This module is free software; you can redistribute it and/or modify it
+ # under the terms of GNU general public license (gpl) version 3.
+@@ -22,14 +23,12 @@
+ use strict;
+ use warnings;
+
+-use Carp;
+-use English '-no_match_vars';
+ use Nagios::Plugin::Threshold;
+ use Nagios::Plugin;
+ use Nagios::Plugin::Getopt;
+ use Net::DNS;
+-use Parallel::Iterator qw(iterate);
++use IO::Select;
+ use Readonly;
+
+ Readonly my $DEFAULT_RETRIES => 4;
+ Readonly my $DEFAULT_WORKERS => 20;
+@@ -47,48 +46,15 @@
+ #
+ use vars qw(
+ @BLACKLISTED
++ @TIMEOUTS
+ $IP
+ $OPTIONS
+ $PLUGIN
+ $THRESHOLD
++ $res
+ );
+
+ ##############################################################################
+-# Usage : my $ip = lookup( $hostname );
+-# Purpose : DNS lookup
+-# Returns : $ip if found; undef if not found
+-# Arguments : $hostname : the FQDN to resolve
+-# Throws : n/a
+-# Comments : n/a
+-# See also : n/a
+-sub lookup {
+-
+- my ($hostname) = @_;
+-
+- require Net::DNS;
+-
+- my $res = Net::DNS::Resolver->new;
+-
+- $res->retry( $OPTIONS->retry() );
+-
+- my $query = $res->search($hostname);
+-
+- if ($query) {
+- foreach my $rr ( $query->answer ) {
+- if ( $rr->type eq 'A' ) {
+- return $rr->address;
+- }
+- }
+- }
+- else {
+- return;
+- }
+-
+- return; # dead code to make perlcritic happy
+-
+-}
+-
+-##############################################################################
+ # Usage : verbose("some message string", $optional_verbosity_level);
+ # Purpose : write a message if the verbosity level is high enough
+ # Returns : n/a
+@@ -122,37 +88,119 @@
+
+ }
+
+-##############################################################################
+-# Usage : check_server( $ip, $server )
+-# Purpose : checks if $ip is blacklisted by $server
+-# Returns : n/a
+-# Arguments : $ip : host IP
+-# $server : RBL server
+-# Throws : n/a
+-# Comments : if blacklisted pushed $server onto @blacklisted
+-# See also : n/a
+-sub check_server {
+-
+- my ($server) = @_;
+-
+- my $lookup_ip = $IP;
++=item B<mdns(\@addresses, $callback)>
+
+- $lookup_ip =~
+-s/(\d{1,3}) [.] (\d{1,3}) [.] (\d{1,3}) [.] (\d{1,3})/$4.$3.$2.$1.$server/mxs;
+-
+- verbose " -> $lookup_ip\n";
+-
+- if ( lookup($lookup_ip) ) {
+-
+- verbose "LISTED: $lookup_ip\n";
+- return $lookup_ip;
+-
+- }
++Resolves all IPs in C<@addresses> in parallel.
++If answer is found C<$callback> is called with arguments as: $name, $host.
+
+- verbose "OK: $lookup_ip\n";
++Perform multiple DNS lookups in parallel. Based on Perl Net-DNS/mresolv.
++Elan Ruusamäe <glen@delfi.ee>, (c) 1999-2010
+
+- return 0;
++=cut
++sub mdns {
++ my $data = shift;
++ my $callback = shift;
++
++ # number of requests to have outstanding at any time
++ my $opt_n = $OPTIONS->workers;
++ # timeout per query (seconds)
++ my $opt_t = 15;
++ my $opt_d = $OPTIONS->verbose;
++
++ my $sel = IO::Select->new;
++ my $eof = 0;
++
++ my @addrs = @$data;
++ my %addrs;
++ while (1) {
++ my ($name, $sock);
++
++ #----------------------------------------------------------------------
++ # Read names until we've filled our quota of outstanding requests.
++ #----------------------------------------------------------------------
++
++ while (!$eof && $sel->count < $opt_n) {
++ print "DEBUG: reading..." if $opt_d;
++ $name = shift @addrs;
++ unless (defined $name) {
++ print "EOF.\n" if $opt_d;
++ $eof = 1;
++ last;
++ }
++ print "NAME: $name\n" if $opt_d;
++ $sock = $res->bgsend($name);
++
++ # we store in a hash the query we made, as parsing it back from
++ # response gives different ip for ips with multiple hosts
++ $addrs{$sock} = $name;
++ $sel->add($sock);
++ print "name = $name, outstanding = ", $sel->count, "\n" if $opt_d;
++ }
++
++ #----------------------------------------------------------------------
++ # Wait for any replies. Remove any replies from the outstanding pool.
++ #----------------------------------------------------------------------
++
++ my @ready;
++ my $timed_out = 1;
++
++ print "DEBUG: waiting for replies\n" if $opt_d;
++
++ for (@ready = $sel->can_read($opt_t);
++ @ready;
++ @ready = $sel->can_read(0)) {
++
++ $timed_out = 0;
++
++ print "DEBUG: replies received: ", scalar @ready, "\n" if $opt_d;
++
++ foreach $sock (@ready) {
++ print "DEBUG: handling a reply\n" if $opt_d;
++ my $addr = $addrs{$sock};
++ delete $addrs{$sock};
++ $sel->remove($sock);
++
++ my $ans = $res->bgread($sock);
++ my $host;
++ if ($ans) {
++ foreach my $rr ($ans->answer) {
++ next unless $rr->type eq 'A';
++ $host = $rr->address;
++ # take just first answer
++ last;
++ }
++ } else {
++ print "DEBUG: no answer: ". $res->errorstring. "\n" if $opt_d;
++ }
++ &$callback($addr, $host);
++ }
++ }
++
++ #----------------------------------------------------------------------
++ # If we timed out waiting for replies, remove all entries from the
++ # outstanding pool.
++ #----------------------------------------------------------------------
++
++ if ($timed_out) {
++ print "DEBUG: timeout: clearing the outstanding pool.\n" if $opt_d;
++ my $sock;
++ foreach $sock ($sel->handles) {
++ my $addr = $addrs{$sock};
++ delete $addrs{$sock};
++ $sel->remove($sock);
++ # callback for hosts that timed out
++ &$callback($addr, '');
++ }
++ }
++
++ print "DEBUG: outstanding = ", $sel->count, ", eof = $eof\n" if $opt_d;
++
++ #----------------------------------------------------------------------
++ # We're done if there are no outstanding queries and we've read EOF.
++ #----------------------------------------------------------------------
+
++ last if ($sel->count == 0) && $eof;
++ }
+ }
+
+ ##############################################################################
+@@ -232,9 +280,16 @@
+ 'critical has to be greater or equal warning' );
+ }
+
++$res = new Net::DNS::Resolver;
++$res->force_v4(1) if $res->can('force_v4');
++$res->retry($OPTIONS->retry());
++
+ $IP = $OPTIONS->host;
+-if ( $IP =~ m/[[:lower:]]/mxs ) {
+- $IP = lookup( $OPTIONS->host );
++if ($IP =~ m/[[:lower:]]/mxs) {
++ mdns([ $OPTIONS->host ], sub {
++ my ($addr, $host) = @_;
++ $IP = $host;
++ });
+ }
+
+ if ( !$IP ) {
+@@ -259,28 +314,37 @@
+
+ verbose 'Checking ' . $OPTIONS->host . " ($IP) on $nservers server(s)\n";
+
+-my $iter = iterate(
+- { workers => $OPTIONS->workers },
+- \&check_server,
+- sub {
+- while ( my $server = pop @servers ) {
+- return $server;
+- }
+- return;
+- }
+-);
+-
+-while ( my ( $server, $result ) = $iter->() ) {
+- if ($result) {
+- push @BLACKLISTED, $server;
+- }
++# build address lists
++my @addrs;
++foreach my $server (@servers) {
++ (my $ip = $IP) =~ s/(\d{1,3}) [.] (\d{1,3}) [.] (\d{1,3}) [.] (\d{1,3})/$4.$3.$2.$1.$server/x;
++ push(@addrs, $ip);
+ }
+
++mdns(\@addrs, sub {
++ my ($addr, $host) = @_;
++ # extract RBL we checked
++ $addr =~ s/^(?:\d+\.){4}//;
++ if (defined $host) {
++ if ($host eq '') {
++ push @TIMEOUTS, $addr;
++ } else {
++ verbose "listed in $addr as $host\n";
++ push @BLACKLISTED, $addr;
++ }
++ }
++});
++
+ my $total = scalar @BLACKLISTED;
+
+ my $status =
+ $OPTIONS->host. " BLACKLISTED on $total " . ( ( $total == 1 ) ? 'server' : 'servers' ) . " of $nservers";
+
++# append timeout info, but do not account these in status
++if (@TIMEOUTS) {
++ $status .= sprintf(" (%d servers timeout: %s)", scalar @TIMEOUTS, join(', ', @TIMEOUTS));
++}
++
+ if ( $total > 0 ) {
+ $status .= " (@BLACKLISTED)";
+ }
projects / packages / nagios-plugin-check_rbl.git / commitdiff