2
# Licensed to the Apache Software Foundation (ASF) under one or more
3
# contributor license agreements. See the NOTICE file distributed with
4
# this work for additional information regarding copyright ownership.
5
# The ASF licenses this file to you under the Apache License, Version 2.0
6
# (the "License"); you may not use this file except in compliance with
7
# the License. You may obtain a copy of the License at:
9
# http://www.apache.org/licenses/LICENSE-2.0
11
# Unless required by applicable law or agreed to in writing, software
12
# distributed under the License is distributed on an "AS IS" BASIS,
13
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14
# See the License for the specific language governing permissions and
15
# limitations under the License.
20
Mail::SpamAssassin::DnsResolver - DNS resolution engine
24
This is a DNS resolution engine for SpamAssassin, implemented in order to
25
reduce file descriptor usage by Net::DNS and avoid a response collision bug in
34
# TODO: caching in this layer instead of in callers.
36
package Mail::SpamAssassin::DnsResolver;
43
use Mail::SpamAssassin;
44
use Mail::SpamAssassin::Logger;
48
use Errno qw(EADDRINUSE EACCES);
49
use Time::HiRes qw(time);
51
use constant HAS_SOCKET_INET6 => eval { require IO::Socket::INET6; };
55
###########################################################################
59
$class = ref($class) || $class;
64
'conf' => $main->{conf},
65
'id_to_callback' => { },
67
bless ($self, $class);
69
$self->load_resolver();
73
###########################################################################
75
=item $res->load_resolver()
77
Load the C<Net::DNS::Resolver> object. Returns 0 if Net::DNS cannot be used,
85
if (defined $self->{res}) { return 1; }
86
$self->{no_resolver} = 1;
87
# force only ipv4 if no IO::Socket::INET6 or ipv6 doesn't work
88
# to be safe test both ipv6 and ipv4 addresses in INET6
89
my $force_ipv4 = (!HAS_SOCKET_INET6) || $self->{main}->{force_ipv4} ||
91
my $sock6 = IO::Socket::INET6->new(
96
$sock6->close() or die "error closing inet6 socket: $!";
101
my $sock6 = IO::Socket::INET6->new(
102
LocalAddr => "0.0.0.0",
103
PeerAddr => "0.0.0.0",
108
$sock6->close() or die "error closing inet4 socket: $!";
115
# force_v4 is set in new() to avoid error in older versions of Net::DNS that don't have it
116
# other options are set by function calls so a typo or API change will cause an error here
117
$self->{res} = Net::DNS::Resolver->new(force_v4 => $force_ipv4);
118
if (defined $self->{res}) {
119
$self->{no_resolver} = 0;
120
$self->{force_ipv4} = $force_ipv4;
121
$self->{retry} = 1; # retries for non-backgrounded query
122
$self->{retrans} = 3; # initial timeout for "non-backgrounded" query run in background
123
$self->{res}->retry(1); # If it fails, it fails
124
$self->{res}->retrans(0); # If it fails, it fails
125
$self->{res}->dnsrch(0); # ignore domain search-list
126
$self->{res}->defnames(0); # don't append stuff to end of query
127
$self->{res}->tcp_timeout(3); # timeout of 3 seconds only
128
$self->{res}->udp_timeout(3); # timeout of 3 seconds only
129
$self->{res}->persistent_tcp(0); # bug 3997
130
$self->{res}->persistent_udp(0); # bug 3997
134
my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
135
dbg("dns: eval failed: $eval_stat");
138
dbg("dns: no ipv6") if $force_ipv4;
139
dbg("dns: is Net::DNS::Resolver available? %s",
140
$self->{no_resolver} ? "no" : "yes" );
141
if (!$self->{no_resolver} && defined $Net::DNS::VERSION) {
142
dbg("dns: Net::DNS version: %s", $Net::DNS::VERSION);
145
return (!$self->{no_resolver});
148
=item $resolver = $res->get_resolver()
150
Return the C<Net::DNS::Resolver> object.
159
=item $res->nameservers()
161
Wrapper for Net::DNS::Resolver->nameservers to get or set list of nameservers
167
my $res = $self->{res};
168
$self->connect_sock_if_reqd();
169
return $res->nameservers(@_) if $res;
172
=item $res->connect_sock()
174
Re-connect to the first nameserver listed in C</etc/resolv.conf> or similar
175
platform-dependent source, as provided by C<Net::DNS>.
182
return if $self->{no_resolver};
185
$self->{sock}->close() or die "error closing socket: $!";
190
# IO::Socket::INET6 may choose wrong LocalAddr if family is unspecified,
191
# causing EINVAL failure when automatically assigned local IP address
192
# and remote address do not belong to the same address family:
193
use Mail::SpamAssassin::Constants qw(:ip);
194
my $ip64 = IP_ADDRESS;
195
my $ip4 = IPV4_ADDRESS;
196
my $ns = $self->{res}->{nameservers}[0];
197
my $ipv6opt = !($self->{force_ipv4});
199
# ensure families of src and dest addresses match (bug 4412 comment 29)
201
if ($ipv6opt && $ns=~/^${ip64}$/o && $ns!~/^${ip4}$/o) {
204
$srcaddr = "0.0.0.0";
207
dbg("dns: name server: %s, LocalAddr: %s", $ns,$srcaddr);
209
# find next available unprivileged port (1024 - 65535)
210
# starting at a random value to spread out use of ports
211
my $port_offset = int(rand(64511)); # 65535 - 1024
212
for (my $i = 0; $i<64511; $i++) {
213
my $lport = 1024 + (($port_offset + $i) % 64511);
217
PeerPort => $self->{res}->{port},
221
LocalAddr => $srcaddr,
225
$sock = IO::Socket::INET6->new(%args);
227
$sock = IO::Socket::INET->new(%args);
230
if (defined $sock) { # ok, got it
232
} elsif ($! == EADDRINUSE || $! == EACCES) { # in use, let's try another source port
233
dbg("dns: UDP port %s already in use, trying another port", $lport);
235
warn "error creating a DNS resolver socket: $errno";
239
if (!defined $sock) {
240
warn "cannot create a DNS resolver socket: $errno";
245
my($bufsiz,$newbufsiz);
246
$bufsiz = $sock->sockopt(Socket::SO_RCVBUF)
247
or die "cannot get a resolver socket rx buffer size: $!";
248
if ($bufsiz >= 32*1024) {
249
dbg("dns: resolver socket rx buffer size is %d bytes", $bufsiz);
251
$sock->sockopt(Socket::SO_RCVBUF, 32*1024)
252
or die "cannot set a resolver socket rx buffer size: $!";
253
$newbufsiz = $sock->sockopt(Socket::SO_RCVBUF)
254
or die "cannot get a resolver socket rx buffer size: $!";
255
dbg("dns: resolver socket rx buffer size changed from %d to %d bytes",
256
$bufsiz, $newbufsiz);
260
my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
261
info("dns: socket buffer size error: $eval_stat");
264
$self->{sock} = $sock;
265
$self->{sock_as_vec} = $self->fhs_to_vec($self->{sock});
269
$self->{no_resolver} = 1;
272
sub connect_sock_if_reqd {
274
$self->connect_sock() if !$self->{sock};
277
=item $res->get_sock()
279
Return the C<IO::Socket::INET> object used to communicate with
286
$self->connect_sock_if_reqd();
287
return $self->{sock};
290
###########################################################################
292
=item $packet = new_dns_packet ($host, $type, $class)
294
A wrapper for C<Net::DNS::Packet::new()> which traps a die thrown by it.
296
To use this, change calls to C<Net::DNS::Resolver::bgsend> from:
298
$res->bgsend($hostname, $type);
302
$res->bgsend(Mail::SpamAssassin::DnsResolver::new_dns_packet($hostname, $type, $class));
307
my ($self, $host, $type, $class) = @_;
309
return if $self->{no_resolver};
311
# construct a PTR query if it looks like an IPv4 address
312
if ((!defined($type) || $type eq 'PTR') && $host =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
313
$host = "$4.$3.$2.$1.in-addr.arpa.";
317
$self->connect_sock_if_reqd();
320
$packet = Net::DNS::Packet->new($host, $type, $class);
322
# a bit noisy, so commented by default...
323
#dbg("dns: new DNS packet time=%s host=%s type=%s id=%s",
324
# time, $host, $type, $packet->id);
327
my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
328
# this can happen if Net::DNS isn't available -- but in this
329
# case this function should never be called!
330
warn "dns: cannot create Net::DNS::Packet, but new_dns_packet() was called: $eval_stat";
336
# Internal function used only in this file
337
## compute an unique ID for a packet to match the query to the reply
338
## It must use only data that is returned unchanged by the nameserver.
339
## Argument is a Net::DNS::Packet that has a non-empty question section,
340
## return is an (opaque) string that can be used as a hash key
342
my ($self, $packet) = @_;
343
my $header = $packet->header;
344
my $id = $header->id;
345
my @questions = $packet->question;
346
my $ques = $questions[0];
349
# Bug 6232: Net::DNS::Packet::new is not consistent in keeping data in
350
# sections of a packet either as original bytes or presentation-encoded:
351
# creating a query packet as above in new_dns_packet() keeps label in
352
# non-encoded form, yet on parsing an answer packet, its query section
353
# is converted to presentation form by Net::DNS::Question::parse calling
354
# Net::DNS::Packet::dn_expand and Net::DNS::wire2presentation in turn.
355
# Let's undo the effect of the wire2presentation routine here to make
356
# sure the query section of an answer packet matches the query section
357
# in our packet formed by new_dns_packet():
359
my $qname = $ques->qname;
360
$qname =~ s/\\([0-9]{3}|.)/length($1)==1 ? $1 : chr($1)/gse;
361
return join '/', $id, $qname, $ques->qtype, $ques->qclass;
364
# odd. this should not happen, but clearly some DNS servers
365
# can return something that Net::DNS interprets as having no
366
# question section. Better support it; just return the
367
# (safe) ID part, along with a text token indicating that
368
# the packet had no question part.
370
return $id . "NO_QUESTION_IN_PACKET";
374
###########################################################################
376
=item $id = $res->bgsend($host, $type, $class, $cb)
378
Quite similar to C<Net::DNS::Resolver::bgsend>, except that when a response
379
packet eventually arrives, and C<poll_responses> is called, the callback
380
sub reference C<$cb> will be called.
382
Note that C<$type> and C<$class> may be C<undef>, in which case they
383
will default to C<A> and C<IN>, respectively.
385
The callback sub will be called with three arguments -- the packet that was
386
delivered, and an id string that fingerprints the query packet and the expected
387
reply. The third argument is a timestamp (Unix time, floating point), captured
388
at the time the packet was collected. It is expected that a closure callback
391
my $id = $self->{resolver}->bgsend($host, $type, undef, sub {
392
my ($reply, $reply_id, $timestamp) = @_;
393
$self->got_a_reply ($reply, $reply_id);
396
The callback can ignore the reply as an invalid packet sent to the listening
397
port if the reply id does not match the return value from bgsend.
402
my ($self, $host, $type, $class, $cb) = @_;
403
return if $self->{no_resolver};
405
$self->{send_timed_out} = 0;
407
my $pkt = $self->new_dns_packet($host, $type, $class);
409
$self->connect_sock_if_reqd();
410
if (!defined($self->{sock}->send($pkt->data, 0))) {
411
warn "dns: sendto() failed: $!";
414
my $id = $self->_packet_id($pkt);
415
dbg("dns: providing a callback for id: $id");
416
$self->{id_to_callback}->{$id} = $cb;
420
###########################################################################
422
=item $nfound = $res->poll_responses()
424
See if there are any C<bgsend> response packets ready, and return
425
the number of such packets delivered to their callbacks.
430
my ($self, $timeout) = @_;
431
return if $self->{no_resolver};
432
return if !$self->{sock};
435
my $rin = $self->{sock_as_vec};
439
my ($nfound, $timeleft);
440
{ my $timer; # collects timestamp when variable goes out of scope
441
if (!defined($timeout) || $timeout > 0)
442
{ $timer = $self->{main}->time_method("poll_dns_idle") }
443
($nfound, $timeleft) = select($rout=$rin, undef, undef, $timeout);
445
if (!defined $nfound || $nfound < 0) {
446
warn "dns: select failed: $!";
451
$timeout = 0; # next time around collect whatever is available, then exit
452
last if $nfound == 0;
454
my $packet = $self->{res}->bgread($self->{sock});
455
my $err = $self->{res}->errorstring;
457
if (defined $packet &&
458
defined $packet->header &&
459
defined $packet->question &&
460
defined $packet->answer)
462
my $id = $self->_packet_id($packet);
464
my $cb = delete $self->{id_to_callback}->{$id};
466
dbg("dns: no callback for id: %s, ignored; packet: %s",
467
$id, $packet ? $packet->string : "undef" );
469
$cb->($packet, $id, $now);
474
dbg("dns: no packet! err=%s packet=%s",
475
$err, $packet ? $packet->string : "undef" );
482
###########################################################################
484
=item $res->bgabort()
486
Call this to release pending requests from memory, when aborting backgrounded
487
requests, or when the scan is complete.
488
C<Mail::SpamAssassin::PerMsgStatus::check> calls this before returning.
494
$self->{id_to_callback} = {};
497
###########################################################################
499
=item $packet = $res->send($name, $type, $class)
501
Emulates C<Net::DNS::Resolver::send()>.
506
my ($self, $name, $type, $class) = @_;
507
return if $self->{no_resolver};
509
my $retrans = $self->{retrans};
510
my $retries = $self->{retry};
511
my $timeout = $retrans;
513
my $answerpkt_avail = 0;
515
(($i < $retries) && !defined($answerpkt));
516
++$i, $retrans *= 2, $timeout = $retrans) {
518
$timeout = 1 if ($timeout < 1);
519
# note nifty use of a closure here. I love closures ;)
520
$self->bgsend($name, $type, $class, sub {
521
my ($reply, $reply_id, $timestamp) = @_;
522
$answerpkt = $reply; $answerpkt_avail = 1;
526
my $deadline = $now + $timeout;
528
while (!$answerpkt_avail) {
529
if ($now >= $deadline) { $self->{send_timed_out} = 1; last }
530
$self->poll_responses(1);
537
###########################################################################
539
=item $res->errorstring()
541
Little more than a stub for callers expecting this from C<Net::DNS::Resolver>.
543
If called immediately after a call to $res->send this will return
544
C<query timed out> if the $res->send DNS query timed out. Otherwise
545
C<unknown error or no error> will be returned.
547
No other errors are reported.
553
return 'query timed out' if $self->{send_timed_out};
554
return 'unknown error or no error';
557
###########################################################################
559
=item $res->finish_socket()
561
Reset socket when done with it.
568
$self->{sock}->close() or die "error closing socket: $!";
569
delete $self->{sock};
573
###########################################################################
577
Clean up for destruction.
583
$self->finish_socket();
587
###########################################################################
588
# non-public methods.
590
# should move to Util.pm (TODO)
592
my ($self, @fhlist) = @_;
594
foreach my $sock (@fhlist) {
595
my $fno = fileno($sock);
597
warn "dns: oops! fileno now undef for $sock";
599
vec ($rin, $fno, 1) = 1;
605
# call Mail::SA::init() instead
606
sub reinit_post_fork {
608
# and a new socket, so we don't have 5 spamds sharing the same
610
$self->connect_sock();
added
removed
.pc/98_bug721565-syntax-5.18/lib/Mail/SpamAssassin/DnsResolver.pm
