--- 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 . # # 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 - $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 , (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)"; }