view release on metacpan or  search on metacpan

lib/Mail/SpamAssassin/DnsResolver.pm  view on Meta::CPAN

      $conf->{dns_available_portscount_buckets}->[$lport >> 8] --;
      $conf->{dns_available_portscount} --;
    }
  }
}

sub pick_random_available_port {
  my $self = shift;
  my $port_number;  # resulting port number, or undef if none available

  my $conf = $self->{conf};
  my $available_portscount = $conf->{dns_available_portscount};

  # initialize when called for the first time or after a config change
  if (!defined $available_portscount) {
    my $ports_bitset = $conf->{dns_available_ports_bitset};
    if (!defined $ports_bitset) {  # ensure it is initialized
      Mail::SpamAssassin::Conf::set_ports_range(\$ports_bitset, 0, 0, 0);
      $conf->{dns_available_ports_bitset} = $ports_bitset;
    }
    # prepare auxiliary data structure to speed up further free-port lookups;
    # 256 buckets, each accounting for 256 ports: 8+8 = 16 bit port numbers;
    # each bucket holds a count of available ports in its range
    my @bucket_counts = (0) x 256;
    my $all_zeroes = "\000" x 32;  # one bucket's worth (256) of zeroes
    my $all_ones   = "\377" x 32;  # one bucket's worth (256) of ones
    my $ind = 0;
    $available_portscount = 0;  # number of all available ports
    foreach my $bucket (0..255) {
      my $cnt = 0;
      my $b = substr($ports_bitset, $bucket*32, 32);  # one bucket: 256 bits
      if  ($b eq $all_zeroes) { $ind += 256 }
      elsif ($b eq $all_ones) { $ind += 256; $cnt += 256 }
      else {  # count nontrivial cases the slow way
        vec($ports_bitset, $ind++, 1) && $cnt++  for 0..255;
      }
      $available_portscount += $cnt;
      $bucket_counts[$bucket] = $cnt;
    }
    $conf->{dns_available_portscount} = $available_portscount;
    if ($available_portscount) {
      $conf->{dns_available_portscount_buckets} = \@bucket_counts;
    } else {  # save some storage
      $conf->{dns_available_portscount_buckets} = undef;
      $conf->{dns_available_ports_bitset} = '';
    }
  }

  # find the n-th port number from the ordered set of available port numbers
  dbg("dns: %d configured local ports for DNS queries", $available_portscount);
  if ($available_portscount > 0) {
    my $ports_bitset = $conf->{dns_available_ports_bitset};
    my $n = int(rand($available_portscount));
    my $bucket_counts_ref = $conf->{dns_available_portscount_buckets};
    my $ind = 0;
    foreach my $bucket (0..255) {
      # find the bucket containing n-th turned-on bit
      my $cnt = $bucket_counts_ref->[$bucket];
      if ($cnt > $n) { last } else { $n -= $cnt; $ind += 256 }
    }
    while ($ind <= 65535) {  # scans one bucket, runs at most 256 iterations
      # find the n-th turned-on bit within the corresponding bucket
      if (vec($ports_bitset, $ind, 1)) {
        if ($n <= 0) { $port_number = $ind; last } else { $n-- }
      }
      $ind++;
    }
  }
  return $port_number;
}

=item $res-E<gt>connect_sock()

Re-connect to the first nameserver listed in C</etc/resolv.conf> or similar
platform-dependent source, as provided by C<Net::DNS>.

=cut

sub connect_sock {
  my ($self) = @_;

  dbg("dns: connect_sock, resolver: %s", $self->{no_resolver} ? "no" : "yes");
  return if $self->{no_resolver};

  $io_socket_module_name
    or die "No Perl modules for network socket available";

  if ($self->{sock}) {
    $self->{sock}->close()
      or info("dns: connect_sock: error closing socket %s: %s", $self->{sock}, $!);
    $self->{sock} = undef;
  }
  my $sock;
  my $errno;

  # list of name servers: [addr]:port entries
  my @ns_addr_port = $self->available_nameservers();
  # use the first name server in a list
  my($ns_addr,$ns_port); local($1,$2);
  ($ns_addr,$ns_port) = ($1,$2)  if $ns_addr_port[0] =~ /^\[(.*)\]:(\d+)\z/;

  # Ensure families of src and dest addresses match (bug 4412 comment 29).
  # Older IO::Socket::INET6 may choose a wrong LocalAddr if protocol family
  # is unspecified, causing EINVAL failure when automatically assigned local
  # IP address and a remote address do not belong to the same address family.
  # Let's choose a suitable source address if possible.
  my $srcaddr;
  if ($self->{force_ipv4}) {
    $srcaddr = "0.0.0.0";
  } elsif ($self->{force_ipv6}) {
    $srcaddr = "::";
  } elsif ($ns_addr =~ IS_IPV4_ADDRESS) {
    $srcaddr = "0.0.0.0";
  } elsif ($ns_addr =~ /:.*:/) {
    $srcaddr = "::";
  } else {  # unrecognized
    # unspecified address, unspecified protocol family
  }

  # find a free local random port from a set of declared-to-be-available ports
  my $lport;