+++ /dev/null
---- check_rbl-1.2.0/check_rbl 2010-04-06 20:40:42.858468257 +0300
-+++ check_rbl-1.1.0/check_rbl 2010-04-06 21:00:56.970381943 +0300
-@@ -4,6 +4,7 @@
- # 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,13 +23,11 @@
- 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;
-@@ -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
-@@ -123,36 +89,116 @@
- }
-
- ##############################################################################
--# Usage : check_server( $ip, $server )
--# Purpose : checks if $ip is blacklisted by $server
-+# Usage : mdns(\@addresses, $callback)
-+# Purpose : Perform multiple DNS lookups in parallel
- # 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;
--
-- $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;
--
-- }
--
-- verbose "OK: $lookup_ip\n";
--
-- return 0;
-+# See also : Perl Net::DNS module mresolv in examples
-+#
-+# Resolves all IPs in C<@addresses> in parallel.
-+# If answer is found C<$callback> is called with arguments as: $name, $host.
-+#
-+# Author: Elan Ruusamäe <glen@delfi.ee>, (c) 1999-2010
-+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) {
-+ #----------------------------------------------------------------------
-+ # Read names until we've filled our quota of outstanding requests.
-+ #----------------------------------------------------------------------
-+
-+ while (!$eof && $sel->count < $opt_n) {
-+ print "DEBUG: reading..." if $opt_d;
-+ my $name = shift @addrs;
-+ unless (defined $name) {
-+ print "EOF.\n" if $opt_d;
-+ $eof = 1;
-+ last;
-+ }
-+ print "NAME: $name\n" if $opt_d;
-+ my $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 my $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;
-+ foreach my $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 +278,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 +312,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