mdns.patch

   1 --- check_rbl-1.2.0/check_rbl   2010-04-06 20:40:42.858468257 +0300
   2 +++ check_rbl-1.1.0/check_rbl   2010-04-06 21:00:56.970381943 +0300
   3 @@ -4,6 +4,7 @@
   4  # See  the INSTALL file for installation instructions
   5  #
   6  # Copyright (c) 2007, ETH Zurich.
   7 +# Copyright (c) 2010, Elan Ruusamäe <glen@delfi.ee>.
   8  #
   9  # This module is free software; you can redistribute it and/or modify it
  10  # under the terms of GNU general public license (gpl) version 3.
  11 @@ -22,13 +23,11 @@
  12  use strict;
  13  use warnings;
  14
  15 -use Carp;
  16 -use English '-no_match_vars';
  17  use Nagios::Plugin::Threshold;
  18  use Nagios::Plugin;
  19  use Nagios::Plugin::Getopt;
  20  use Net::DNS;
  21 -use Parallel::Iterator qw(iterate);
  22 +use IO::Select;
  23  use Readonly;
  24
  25  Readonly my $DEFAULT_RETRIES => 4;
  26 @@ -47,48 +46,15 @@
  27  #
  28  use vars qw(
  29    @BLACKLISTED
  30 +  @TIMEOUTS
  31    $IP
  32    $OPTIONS
  33    $PLUGIN
  34    $THRESHOLD
  35 +  $res
  36  );
  37
  38  ##############################################################################
  39 -# Usage     : my $ip = lookup( $hostname );
  40 -# Purpose   : DNS lookup
  41 -# Returns   : $ip if found; undef if not found
  42 -# Arguments : $hostname : the FQDN to resolve
  43 -# Throws    : n/a
  44 -# Comments  : n/a
  45 -# See also  : n/a
  46 -sub lookup {
  47 -
  48 -    my ($hostname) = @_;
  49 -
  50 -    require Net::DNS;
  51 -
  52 -    my $res = Net::DNS::Resolver->new;
  53 -
  54 -    $res->retry( $OPTIONS->retry() );
  55 -
  56 -    my $query = $res->search($hostname);
  57 -
  58 -    if ($query) {
  59 -        foreach my $rr ( $query->answer ) {
  60 -            if ( $rr->type eq 'A' ) {
  61 -                return $rr->address;
  62 -            }
  63 -        }
  64 -    }
  65 -    else {
  66 -        return;
  67 -    }
  68 -
  69 -    return;    # dead code to make perlcritic happy
  70 -
  71 -}
  72 -
  73 -##############################################################################
  74  # Usage     : verbose("some message string", $optional_verbosity_level);
  75  # Purpose   : write a message if the verbosity level is high enough
  76  # Returns   : n/a
  77 @@ -123,36 +89,116 @@
  78  }
  79
  80  ##############################################################################
  81 -# Usage     : check_server( $ip, $server )
  82 -# Purpose   : checks if $ip is blacklisted by $server
  83 +# Usage     : mdns(\@addresses, $callback)
  84 +# Purpose   : Perform multiple DNS lookups in parallel
  85  # Returns   : n/a
  86 -# Arguments : $ip     : host IP
  87 -#             $server : RBL server
  88 -# Throws    : n/a
  89 -# Comments  : if blacklisted pushed $server onto @blacklisted
  90 -# See also  : n/a
  91 -sub check_server {
  92 -
  93 -    my ($server) = @_;
  94 -
  95 -    my $lookup_ip = $IP;
  96 -
  97 -    $lookup_ip =~
  98 -s/(\d{1,3}) [.] (\d{1,3}) [.] (\d{1,3}) [.] (\d{1,3})/$4.$3.$2.$1.$server/mxs;
  99 -
 100 -    verbose " -> $lookup_ip\n";
 101 -
 102 -    if ( lookup($lookup_ip) ) {
 103 -
 104 -        verbose "LISTED: $lookup_ip\n";
 105 -        return $lookup_ip;
 106 -
 107 -    }
 108 -
 109 -    verbose "OK: $lookup_ip\n";
 110 -
 111 -    return 0;
 112 +# See also  : Perl Net::DNS module mresolv in examples
 113 +#
 114 +# Resolves all IPs in C<@addresses> in parallel.
 115 +# If answer is found C<$callback> is called with arguments as: $name, $host.
 116 +#
 117 +# Author: Elan Ruusamäe <glen@delfi.ee>, (c) 1999-2010
 118 +sub mdns {
 119 +       my $data = shift;
 120 +       my $callback = shift;
 121 +
 122 +       # number of requests to have outstanding at any time
 123 +       my $opt_n = $OPTIONS->workers;
 124 +       # timeout per query (seconds)
 125 +       my $opt_t = 15;
 126 +       my $opt_d = $OPTIONS->verbose;
 127 +
 128 +       my $sel = IO::Select->new;
 129 +       my $eof = 0;
 130 +
 131 +       my @addrs = @$data;
 132 +       my %addrs;
 133 +       while (1) {
 134 +               #----------------------------------------------------------------------
 135 +               # Read names until we've filled our quota of outstanding requests.
 136 +               #----------------------------------------------------------------------
 137 +
 138 +               while (!$eof && $sel->count < $opt_n) {
 139 +                       print "DEBUG: reading..." if $opt_d;
 140 +                       my $name = shift @addrs;
 141 +                       unless (defined $name) {
 142 +                               print "EOF.\n" if $opt_d;
 143 +                               $eof = 1;
 144 +                               last;
 145 +                       }
 146 +                       print "NAME: $name\n" if $opt_d;
 147 +                       my $sock = $res->bgsend($name);
 148 +
 149 +                       # we store in a hash the query we made, as parsing it back from
 150 +                       # response gives different ip for ips with multiple hosts
 151 +                       $addrs{$sock} = $name;
 152 +                       $sel->add($sock);
 153 +                       print "name = $name, outstanding = ", $sel->count, "\n" if $opt_d;
 154 +               }
 155 +
 156 +               #----------------------------------------------------------------------
 157 +               # Wait for any replies.  Remove any replies from the outstanding pool.
 158 +               #----------------------------------------------------------------------
 159 +
 160 +               my @ready;
 161 +               my $timed_out = 1;
 162 +
 163 +               print "DEBUG: waiting for replies\n" if $opt_d;
 164 +
 165 +               for (@ready = $sel->can_read($opt_t);
 166 +                        @ready;
 167 +                        @ready = $sel->can_read(0)) {
 168 +
 169 +                       $timed_out = 0;
 170 +
 171 +                       print "DEBUG: replies received: ", scalar @ready, "\n" if $opt_d;
 172 +
 173 +                       foreach my $sock (@ready) {
 174 +                               print "DEBUG: handling a reply\n" if $opt_d;
 175 +                               my $addr = $addrs{$sock};
 176 +                               delete $addrs{$sock};
 177 +                               $sel->remove($sock);
 178 +
 179 +                               my $ans = $res->bgread($sock);
 180 +                               my $host;
 181 +                               if ($ans) {
 182 +                                       foreach my $rr ($ans->answer) {
 183 +                                               next unless $rr->type eq 'A';
 184 +                                               $host = $rr->address;
 185 +                                               # take just first answer
 186 +                                               last;
 187 +                                       }
 188 +                               } else {
 189 +                                       print "DEBUG: no answer: ". $res->errorstring. "\n" if $opt_d;
 190 +                               }
 191 +                               &$callback($addr, $host);
 192 +                       }
 193 +               }
 194 +
 195 +               #----------------------------------------------------------------------
 196 +               # If we timed out waiting for replies, remove all entries from the
 197 +               # outstanding pool.
 198 +               #----------------------------------------------------------------------
 199 +
 200 +               if ($timed_out) {
 201 +                       print "DEBUG: timeout: clearing the outstanding pool.\n" if $opt_d;
 202 +                       foreach my $sock ($sel->handles) {
 203 +                               my $addr = $addrs{$sock};
 204 +                               delete $addrs{$sock};
 205 +                               $sel->remove($sock);
 206 +                               # callback for hosts that timed out
 207 +                               &$callback($addr, '');
 208 +                       }
 209 +               }
 210 +
 211 +               print "DEBUG: outstanding = ", $sel->count, ", eof = $eof\n" if $opt_d;
 212 +
 213 +               #----------------------------------------------------------------------
 214 +               # We're done if there are no outstanding queries and we've read EOF.
 215 +               #----------------------------------------------------------------------
 216
 217 +               last if ($sel->count == 0) && $eof;
 218 +       }
 219  }
 220
 221  ##############################################################################
 222 @@ -232,9 +278,16 @@
 223          'critical has to be greater or equal warning' );
 224  }
 225
 226 +$res = new Net::DNS::Resolver;
 227 +$res->force_v4(1) if $res->can('force_v4');
 228 +$res->retry($OPTIONS->retry());
 229 +
 230  $IP = $OPTIONS->host;
 231 -if ( $IP =~ m/[[:lower:]]/mxs ) {
 232 -    $IP = lookup( $OPTIONS->host );
 233 +if ($IP =~ m/[[:lower:]]/mxs) {
 234 +       mdns([ $OPTIONS->host ], sub {
 235 +               my ($addr, $host) = @_;
 236 +               $IP = $host;
 237 +       });
 238  }
 239
 240  if ( !$IP ) {
 241 @@ -259,28 +312,37 @@
 242
 243  verbose 'Checking ' . $OPTIONS->host . " ($IP) on $nservers server(s)\n";
 244
 245 -my $iter = iterate(
 246 -    { workers => $OPTIONS->workers },
 247 -    \&check_server,
 248 -    sub {
 249 -        while ( my $server = pop @servers ) {
 250 -            return $server;
 251 -        }
 252 -        return;
 253 -    }
 254 -);
 255 -
 256 -while ( my ( $server, $result ) = $iter->() ) {
 257 -    if ($result) {
 258 -        push @BLACKLISTED, $server;
 259 -    }
 260 +# build address lists
 261 +my @addrs;
 262 +foreach my $server (@servers) {
 263 +       (my $ip = $IP) =~ s/(\d{1,3}) [.] (\d{1,3}) [.] (\d{1,3}) [.] (\d{1,3})/$4.$3.$2.$1.$server/x;
 264 +       push(@addrs, $ip);
 265  }
 266
 267 +mdns(\@addrs, sub {
 268 +       my ($addr, $host) = @_;
 269 +       # extract RBL we checked
 270 +       $addr =~ s/^(?:\d+\.){4}//;
 271 +       if (defined $host) {
 272 +               if ($host eq '') {
 273 +                       push @TIMEOUTS, $addr;
 274 +               } else {
 275 +                       verbose "listed in $addr as $host\n";
 276 +                       push @BLACKLISTED, $addr;
 277 +               }
 278 +       }
 279 +});
 280 +
 281  my $total = scalar @BLACKLISTED;
 282
 283  my $status =
 284    $OPTIONS->host. " BLACKLISTED on $total " . ( ( $total == 1 ) ? 'server' : 'servers' ) . " of $nservers";
 285
 286 +# append timeout info, but do not account these in status
 287 +if (@TIMEOUTS) {
 288 +       $status .= sprintf(" (%d servers timeout: %s)", scalar @TIMEOUTS, join(', ', @TIMEOUTS));
 289 +}
 290 +
 291  if ( $total > 0 ) {
 292      $status .= " (@BLACKLISTED)";
 293  }