sub poll_responses()

in lib/Mail/SpamAssassin/DnsResolver.pm [779:926]

• 117 lines of code
• 34 McCabe index (conditional complexity)

sub poll_responses {
  my ($self, $timeout) = @_;
  return if $self->{no_resolver};
  return if !$self->{sock};
  my $cnt = 0;
  my $cnt_cb = 0;

  my $rin = $self->{sock_as_vec};
  my $rout;

  for (;;) {
    my ($nfound, $timeleft, $eval_stat);
    # if a restartable signal is caught, retry 3 times before aborting
    my $eintrcount = 3;
    eval {  # use eval to caught alarm signal
      my $timer;  # collects timestamp when variable goes out of scope
      if (!defined($timeout) || $timeout > 0)
        { $timer = $self->{main}->time_method("poll_dns_idle") }
      $! = 0;
      ($nfound, $timeleft) = select($rout=$rin, undef, undef, $timeout);
      1;
    } or do {
      $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
    };
    if (defined $eval_stat) {
      # most likely due to an alarm signal, resignal if so
      die "dns: (2) $eval_stat\n"  if $eval_stat =~ /__alarm__ignore__\(.*\)/s;
      warn "dns: select aborted: $eval_stat\n";
      last;
    } elsif (!defined $nfound || $nfound < 0) {
      if ($!{EINTR} and $eintrcount > 0) {
        $eintrcount--;
        next;
      }
      if ($!) { warn "dns: select failed: $!\n" }
      else    { info("dns: select interrupted") }  # shouldn't happen
      last;
    } elsif (!$nfound) {
      if (!defined $timeout) { warn("dns: select returned empty-handed\n") }
      elsif ($timeout > 0) { dbg("dns: select timed out %.3f s", $timeout) }
      last;
    }
    $cnt += $nfound;

    my $now = time;
    $timeout = 0;  # next time around collect whatever is available, then exit
    last  if $nfound == 0;

    my $packet;
    # Bug 7265, use our own bgread() below
    # $packet = $self->{res}->bgread($self->{sock});
    eval {
      $packet = $self->bgread();  # Bug 7265, use our own bgread()
    } or do {
      undef $packet;
      my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
      # resignal if alarm went off
      die $eval_stat  if $eval_stat =~ /__alarm__ignore__\(.*\)/s;
      info("dns: bad dns reply: %s", $eval_stat);
    };

    # bug 8225 - Do TCP fallback when UDP reply packet is too long, by retrying using Net::DNS::Resolver bgsend and bgread
    my ($id, $packet_id);
    if ($packet && $packet->header) {
      my $header = $packet->header;
      $packet_id = $header->id;  # set these here in case we need to retry for TCP fallback
      $id = $self->_packet_id($packet);  # which will change $packet to a different class object
      if ($header->rcode eq 'NOERROR' && $header->tc) {
        # Use original Resolver which can handle TCP fallback, but keep id from the custom packet
        my (undef, $qclass, $qtype, $qname) = split('/', $id);
        dbg("dns: TCP fallback retry with %s, %s, %s", $qname, $qtype, $qclass);
        my $orig_resolver =  $self->{main}->{resolver}->get_resolver();
        eval {
          my $handle = $orig_resolver->bgsend($qname, $qtype, $qclass);
          $packet = $orig_resolver->bgread($handle);
        } or do {
          undef $packet;
          my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
          # resignal if alarm went off
          die $eval_stat  if $eval_stat =~ /__alarm__ignore__\(.*\)/s;
          info("dns: bad dns tcp fallback reply: %s", $eval_stat);
        };
      }
    }

    if (!$packet) {
      # error already reported above
#     my $dns_err = $self->{res}->errorstring;
#     die "dns (3) $dns_err\n"  if $dns_err =~ /__alarm__ignore__\(.*\)/s;
#     info("dns: bad dns reply: $dns_err");
    } else {
      my $header = $packet->header;
      if (!$header) {
        info("dns: dns reply is missing a header section");
      } else {
        my $rcode = $header->rcode;
        if ($rcode eq 'NOERROR') {  # success
          # NOERROR, may or may not have answer records
          dbg("dns: dns reply %s is OK, %d answer records",
              $packet_id, $header->ancount);
          if ($header->tc) {  # truncation flag turned on
            my $edns = $self->{conf}->{dns_options}->{edns} || 512;
            info("dns: reply to %s truncated (%s), %d answer records", $id,
                 $edns == 512 ? "EDNS off" : "EDNS $edns bytes",
                 $header->ancount);
          }
        } else {
          # some failure, e.g. NXDOMAIN, SERVFAIL, FORMERR, REFUSED, ...
          # btw, one reason for SERVFAIL is an RR signature failure in DNSSEC
          dbg("dns: dns reply to %s: %s", $id, $rcode);
        }

        # A hash lookup: the id must match exactly (case-sensitively).
        # The domain name part of the id was lowercased if dns0x20 is off,
        # and case-randomized when dns0x20 option is on.
        #
        my $cb = delete $self->{id_to_callback}->{$id};

        if ($cb) {
          $cb->($packet, $id, $now);
          $cnt_cb++;
        } else {  # no match, report the problem
          if ($rcode eq 'REFUSED' || $id =~ m{^\d+/NO_QUESTION_IN_PACKET\z}) {
            # the failure was already reported above
          } else {
            info("dns: no callback for id $id, ignored, packet on next debug line");
            # prevent filling normal logs with huge packet dumps
            dbg("dns: %s", $packet ? $packet->string : "undef");
          }
          # report a likely matching query for diagnostic purposes
          local $1;
          if ($id =~ m{^(\d+)/}) {
            my $dnsid = $1;  # the raw DNS packet id
            my @matches =
              grep(m{^\Q$dnsid\E/}o, keys %{$self->{id_to_callback}});
            if (!@matches) {
              info("dns: no likely matching queries for id %s", $dnsid);
            } else {
              info("dns: a likely matching query: %s", join(', ', @matches));
            }
          }
        }
      }
    }
  }

  return ($cnt, $cnt_cb);
}