← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 03:09:29 2017
Reported on Mon Nov 6 13:20:47 2017

Filename/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/DnsResolver.pm
StatementsExecuted 156983 statements in 1.34s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
196811390ms5.16sMail::SpamAssassin::DnsResolver::::bgsendMail::SpamAssassin::DnsResolver::bgsend
197131317ms392msMail::SpamAssassin::DnsResolver::::available_nameserversMail::SpamAssassin::DnsResolver::available_nameservers
196811312ms1.72sMail::SpamAssassin::DnsResolver::::new_dns_packetMail::SpamAssassin::DnsResolver::new_dns_packet
196811154ms894msMail::SpamAssassin::DnsResolver::::_packet_idMail::SpamAssassin::DnsResolver::_packet_id
98575192.3ms92.3msMail::SpamAssassin::DnsResolver::::CORE:matchMail::SpamAssassin::DnsResolver::CORE:match (opcode)
11154.9ms54.9msMail::SpamAssassin::DnsResolver::::pick_random_available_portMail::SpamAssassin::DnsResolver::pick_random_available_port
39362140.9ms40.9msMail::SpamAssassin::DnsResolver::::CORE:substMail::SpamAssassin::DnsResolver::CORE:subst (opcode)
19681125.0ms82.1msMail::SpamAssassin::DnsResolver::::connect_sock_if_reqdMail::SpamAssassin::DnsResolver::connect_sock_if_reqd
3942117.07ms7.07msMail::SpamAssassin::DnsResolver::::CORE:regcompMail::SpamAssassin::DnsResolver::CORE:regcomp (opcode)
2221.07ms8.98msMail::SpamAssassin::DnsResolver::::load_resolverMail::SpamAssassin::DnsResolver::load_resolver
111263µs57.0msMail::SpamAssassin::DnsResolver::::connect_sockMail::SpamAssassin::DnsResolver::connect_sock
111112µs257µsMail::SpamAssassin::DnsResolver::::configured_nameserversMail::SpamAssassin::DnsResolver::configured_nameservers
11144µs44µsMail::SpamAssassin::DnsResolver::::fhs_to_vecMail::SpamAssassin::DnsResolver::fhs_to_vec
11142µs50µsMail::SpamAssassin::DnsResolver::::BEGIN@38Mail::SpamAssassin::DnsResolver::BEGIN@38
11139µs6.74msMail::SpamAssassin::DnsResolver::::newMail::SpamAssassin::DnsResolver::new
11130µs3.34msMail::SpamAssassin::DnsResolver::::BEGIN@50Mail::SpamAssassin::DnsResolver::BEGIN@50
11124µs294µsMail::SpamAssassin::DnsResolver::::BEGIN@52Mail::SpamAssassin::DnsResolver::BEGIN@52
11123µs130µsMail::SpamAssassin::DnsResolver::::BEGIN@48Mail::SpamAssassin::DnsResolver::BEGIN@48
11122µs113µsMail::SpamAssassin::DnsResolver::::BEGIN@51Mail::SpamAssassin::DnsResolver::BEGIN@51
11121µs485µsMail::SpamAssassin::DnsResolver::::BEGIN@47Mail::SpamAssassin::DnsResolver::BEGIN@47
11120µs48µsMail::SpamAssassin::DnsResolver::::BEGIN@39Mail::SpamAssassin::DnsResolver::BEGIN@39
11120µs146µsMail::SpamAssassin::DnsResolver::::BEGIN@46Mail::SpamAssassin::DnsResolver::BEGIN@46
11119µs67µsMail::SpamAssassin::DnsResolver::::BEGIN@41Mail::SpamAssassin::DnsResolver::BEGIN@41
11119µs77µsMail::SpamAssassin::DnsResolver::::BEGIN@56Mail::SpamAssassin::DnsResolver::BEGIN@56
11119µs24µsMail::SpamAssassin::DnsResolver::::BEGIN@40Mail::SpamAssassin::DnsResolver::BEGIN@40
11118µs18µsMail::SpamAssassin::DnsResolver::::BEGIN@57Mail::SpamAssassin::DnsResolver::BEGIN@57
11113µs13µsMail::SpamAssassin::DnsResolver::::BEGIN@45Mail::SpamAssassin::DnsResolver::BEGIN@45
0000s0sMail::SpamAssassin::DnsResolver::::__ANON__[:940]Mail::SpamAssassin::DnsResolver::__ANON__[:940]
0000s0sMail::SpamAssassin::DnsResolver::::bgabortMail::SpamAssassin::DnsResolver::bgabort
0000s0sMail::SpamAssassin::DnsResolver::::bgreadMail::SpamAssassin::DnsResolver::bgread
0000s0sMail::SpamAssassin::DnsResolver::::disable_available_portMail::SpamAssassin::DnsResolver::disable_available_port
0000s0sMail::SpamAssassin::DnsResolver::::dnsext_dns0x20Mail::SpamAssassin::DnsResolver::dnsext_dns0x20
0000s0sMail::SpamAssassin::DnsResolver::::errorstringMail::SpamAssassin::DnsResolver::errorstring
0000s0sMail::SpamAssassin::DnsResolver::::finishMail::SpamAssassin::DnsResolver::finish
0000s0sMail::SpamAssassin::DnsResolver::::finish_socketMail::SpamAssassin::DnsResolver::finish_socket
0000s0sMail::SpamAssassin::DnsResolver::::get_resolverMail::SpamAssassin::DnsResolver::get_resolver
0000s0sMail::SpamAssassin::DnsResolver::::get_sockMail::SpamAssassin::DnsResolver::get_sock
0000s0sMail::SpamAssassin::DnsResolver::::poll_responsesMail::SpamAssassin::DnsResolver::poll_responses
0000s0sMail::SpamAssassin::DnsResolver::::reinit_post_forkMail::SpamAssassin::DnsResolver::reinit_post_fork
0000s0sMail::SpamAssassin::DnsResolver::::sendMail::SpamAssassin::DnsResolver::send
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# <@LICENSE>
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:
8#
9# http://www.apache.org/licenses/LICENSE-2.0
10#
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.
16# </@LICENSE>
17
18=head1 NAME
19
20Mail::SpamAssassin::DnsResolver - DNS resolution engine
21
22=head1 DESCRIPTION
23
24This is a DNS resolution engine for SpamAssassin, implemented in order to
25reduce file descriptor usage by Net::DNS and avoid a response collision bug in
26that module.
27
28=head1 METHODS
29
30=over 4
31
32=cut
33
34# TODO: caching in this layer instead of in callers.
35
36package Mail::SpamAssassin::DnsResolver;
37
38256µs258µs
# spent 50µs (42+8) within Mail::SpamAssassin::DnsResolver::BEGIN@38 which was called: # once (42µs+8µs) by Mail::SpamAssassin::BEGIN@77 at line 38
use strict;
# spent 50µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@38 # spent 8µs making 1 call to strict::import
39251µs275µs
# spent 48µs (20+27) within Mail::SpamAssassin::DnsResolver::BEGIN@39 which was called: # once (20µs+27µs) by Mail::SpamAssassin::BEGIN@77 at line 39
use warnings;
# spent 48µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@39 # spent 27µs making 1 call to warnings::import
40252µs229µs
# spent 24µs (19+5) within Mail::SpamAssassin::DnsResolver::BEGIN@40 which was called: # once (19µs+5µs) by Mail::SpamAssassin::BEGIN@77 at line 40
use bytes;
# spent 24µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@40 # spent 5µs making 1 call to bytes::import
41270µs2115µs
# spent 67µs (19+48) within Mail::SpamAssassin::DnsResolver::BEGIN@41 which was called: # once (19µs+48µs) by Mail::SpamAssassin::BEGIN@77 at line 41
use re 'taint';
# spent 67µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@41 # spent 48µs making 1 call to re::import
42
43130µsrequire 5.008001; # needs utf8::is_utf8()
44
45249µs113µs
# spent 13µs within Mail::SpamAssassin::DnsResolver::BEGIN@45 which was called: # once (13µs+0s) by Mail::SpamAssassin::BEGIN@77 at line 45
use Mail::SpamAssassin;
# spent 13µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@45
46259µs2273µs
# spent 146µs (20+126) within Mail::SpamAssassin::DnsResolver::BEGIN@46 which was called: # once (20µs+126µs) by Mail::SpamAssassin::BEGIN@77 at line 46
use Mail::SpamAssassin::Logger;
# spent 146µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@46 # spent 126µs making 1 call to Exporter::import
47264µs2948µs
# spent 485µs (21+463) within Mail::SpamAssassin::DnsResolver::BEGIN@47 which was called: # once (21µs+463µs) by Mail::SpamAssassin::BEGIN@77 at line 47
use Mail::SpamAssassin::Constants qw(:ip);
# spent 485µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@47 # spent 463µs making 1 call to Exporter::import
48259µs2237µs
# spent 130µs (23+107) within Mail::SpamAssassin::DnsResolver::BEGIN@48 which was called: # once (23µs+107µs) by Mail::SpamAssassin::BEGIN@77 at line 48
use Mail::SpamAssassin::Util qw(untaint_var decode_dns_question_entry);
# spent 130µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@48 # spent 107µs making 1 call to Exporter::import
49
50266µs26.66ms
# spent 3.34ms (30µs+3.31) within Mail::SpamAssassin::DnsResolver::BEGIN@50 which was called: # once (30µs+3.31ms) by Mail::SpamAssassin::BEGIN@77 at line 50
use Socket;
# spent 3.34ms making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@50 # spent 3.31ms making 1 call to Exporter::import
51258µs2205µs
# spent 113µs (22+91) within Mail::SpamAssassin::DnsResolver::BEGIN@51 which was called: # once (22µs+91µs) by Mail::SpamAssassin::BEGIN@77 at line 51
use Errno qw(EADDRINUSE EACCES);
# spent 113µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@51 # spent 91µs making 1 call to Exporter::import
52291µs2565µs
# spent 294µs (24+271) within Mail::SpamAssassin::DnsResolver::BEGIN@52 which was called: # once (24µs+271µs) by Mail::SpamAssassin::BEGIN@77 at line 52
use Time::HiRes qw(time);
# spent 294µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@52 # spent 271µs making 1 call to Time::HiRes::import
53
54110µsour @ISA = qw();
55
562158µs2134µs
# spent 77µs (19+58) within Mail::SpamAssassin::DnsResolver::BEGIN@56 which was called: # once (19µs+58µs) by Mail::SpamAssassin::BEGIN@77 at line 56
use vars qw($io_socket_module_name);
# spent 77µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@56 # spent 58µs making 1 call to vars::import
57
# spent 18µs within Mail::SpamAssassin::DnsResolver::BEGIN@57 which was called: # once (18µs+0s) by Mail::SpamAssassin::BEGIN@77 at line 65
BEGIN {
58217µs if (eval { require IO::Socket::IP }) {
5912µs $io_socket_module_name = 'IO::Socket::IP';
60 } elsif (eval { require IO::Socket::INET6 }) {
61 $io_socket_module_name = 'IO::Socket::INET6';
62 } elsif (eval { require IO::Socket::INET }) {
63 $io_socket_module_name = 'IO::Socket::INET';
64 }
6518.44ms118µs}
# spent 18µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@57
66
67###########################################################################
68
69
# spent 6.74ms (39µs+6.70) within Mail::SpamAssassin::DnsResolver::new which was called: # once (39µs+6.70ms) by Mail::SpamAssassin::init at line 1796 of Mail/SpamAssassin.pm
sub new {
7013µs my $class = shift;
7113µs $class = ref($class) || $class;
72
7312µs my ($main) = @_;
74 my $self = {
75 'main' => $main,
76 'conf' => $main->{conf},
7718µs 'id_to_callback' => { },
78 };
7912µs bless ($self, $class);
80
8119µs16.70ms $self->load_resolver();
# spent 6.70ms making 1 call to Mail::SpamAssassin::DnsResolver::load_resolver
82111µs $self;
83}
84
85###########################################################################
86
87=item $res->load_resolver()
88
89Load the C<Net::DNS::Resolver> object. Returns 0 if Net::DNS cannot be used,
901 if it is available.
91
92=cut
93
94
# spent 8.98ms (1.07+7.91) within Mail::SpamAssassin::DnsResolver::load_resolver which was called 2 times, avg 4.49ms/call: # once (657µs+6.04ms) by Mail::SpamAssassin::DnsResolver::new at line 81 # once (414µs+1.87ms) by Mail::SpamAssassin::PerMsgStatus::load_resolver at line 444 of Mail/SpamAssassin/Dns.pm
sub load_resolver {
9525µs my ($self) = @_;
96
97210µs if ($self->{res}) { return 1; }
9827µs $self->{no_resolver} = 1;
99
100 # force only ipv4 if no IO::Socket::INET6 or ipv6 doesn't work
10126µs my $force_ipv4 = $self->{main}->{force_ipv4};
10227µs my $force_ipv6 = $self->{main}->{force_ipv6};
103
10427µs if (!$force_ipv4 && $io_socket_module_name eq 'IO::Socket::INET') {
105 dbg("dns: socket module for IPv6 support not available");
106 die "Use of IPv6 requested, but not available\n" if $force_ipv6;
107 $force_ipv4 = 1; $force_ipv6 = 0;
108 }
109212µs if (!$force_ipv4) { # test drive IPv6
110 eval {
11124µs my $sock6;
11228µs if ($io_socket_module_name) {
113230µs22.92ms $sock6 = $io_socket_module_name->new(LocalAddr=>'::', Proto=>'udp');
# spent 2.92ms making 2 calls to IO::Socket::IP::new, avg 1.46ms/call
114 }
11524µs if ($sock6) { $sock6->close() or warn "error closing socket: $!" }
11624µs $sock6;
117215µs } or do {
118216µs216µs dbg("dns: socket module %s is available, but no host support for IPv6",
# spent 16µs making 2 calls to Mail::SpamAssassin::Logger::dbg, avg 8µs/call
119 $io_socket_module_name);
12024µs die "Use of IPv6 requested, but not available\n" if $force_ipv6;
12149µs $force_ipv4 = 1; $force_ipv6 = 0;
122 }
123 }
124
125 eval {
12628µs require Net::DNS;
127 # force_v4 is set in new() to avoid error in older versions of Net::DNS
128 # that don't have it; other options are set by function calls so a typo
129 # or API change will cause an error here
130248µs22.69ms my $res = $self->{res} = Net::DNS::Resolver->new(force_v4 => $force_ipv4);
# spent 2.69ms making 2 calls to Net::DNS::Resolver::Base::new, avg 1.35ms/call
13128µs if ($res) {
13225µs $self->{no_resolver} = 0;
13326µs $self->{force_ipv4} = $force_ipv4;
13425µs $self->{force_ipv6} = $force_ipv6;
13527µs $self->{retry} = 1; # retries for non-backgrounded query
13625µs $self->{retrans} = 3; # initial timeout for "non-backgrounded"
137 # query run in background
138
139230µs269µs $res->retry(1); # If it fails, it fails
# spent 55µs making 1 call to Net::DNS::Resolver::Base::AUTOLOAD # spent 14µs making 1 call to Net::DNS::Resolver::Base::__ANON__[Net/DNS/Resolver/Base.pm:1130]
140226µs262µs $res->retrans(0); # If it fails, it fails
# spent 51µs making 1 call to Net::DNS::Resolver::Base::AUTOLOAD # spent 11µs making 1 call to Net::DNS::Resolver::Base::__ANON__[Net/DNS/Resolver/Base.pm:1130]
141222µs275µs $res->dnsrch(0); # ignore domain search-list
# spent 63µs making 1 call to Net::DNS::Resolver::Base::AUTOLOAD # spent 12µs making 1 call to Net::DNS::Resolver::Base::__ANON__[Net/DNS/Resolver/Base.pm:1130]
142220µs255µs $res->defnames(0); # don't append stuff to end of query
# spent 44µs making 1 call to Net::DNS::Resolver::Base::AUTOLOAD # spent 11µs making 1 call to Net::DNS::Resolver::Base::__ANON__[Net/DNS/Resolver/Base.pm:1130]
143221µs250µs $res->tcp_timeout(3); # timeout of 3 seconds only
# spent 39µs making 1 call to Net::DNS::Resolver::Base::AUTOLOAD # spent 11µs making 1 call to Net::DNS::Resolver::Base::__ANON__[Net/DNS/Resolver/Base.pm:1130]
144242µs2113µs $res->udp_timeout(3); # timeout of 3 seconds only
# spent 102µs making 1 call to Net::DNS::Resolver::Base::AUTOLOAD # spent 11µs making 1 call to Net::DNS::Resolver::Base::__ANON__[Net/DNS/Resolver/Base.pm:1130]
145225µs266µs $res->persistent_tcp(0); # bug 3997
# spent 56µs making 1 call to Net::DNS::Resolver::Base::AUTOLOAD # spent 10µs making 1 call to Net::DNS::Resolver::Base::__ANON__[Net/DNS/Resolver/Base.pm:1130]
146221µs251µs $res->persistent_udp(0); # bug 3997
# spent 41µs making 1 call to Net::DNS::Resolver::Base::AUTOLOAD # spent 10µs making 1 call to Net::DNS::Resolver::Base::__ANON__[Net/DNS/Resolver/Base.pm:1130]
147
148 # RFC 6891 (ex RFC 2671): EDNS0, value is a requestor's UDP payload size
149210µs my $edns = $self->{conf}->{dns_options}->{edns};
150215µs if ($edns && $edns > 512) {
151222µs268µs $res->udppacketsize($edns);
# spent 68µs making 2 calls to Net::DNS::Resolver::Base::udppacketsize, avg 34µs/call
152216µs215µs dbg("dns: EDNS, UDP payload size %d", $edns);
# spent 15µs making 2 calls to Mail::SpamAssassin::Logger::dbg, avg 8µs/call
153 }
154
155 # set $res->nameservers for the benefit of plugins which don't use
156 # our send/bgsend infrastructure but rely on Net::DNS::Resolver entirely
157221µs2764µs my @ns_addr_port = $self->available_nameservers();
# spent 764µs making 2 calls to Mail::SpamAssassin::DnsResolver::available_nameservers, avg 382µs/call
15827µs local($1,$2);
159 # drop port numbers, Net::DNS::Resolver can't take them
160260µs418µs @ns_addr_port = map(/^\[(.*)\]:(\d+)\z/ ? $1 : $_, @ns_addr_port);
# spent 18µs making 4 calls to Mail::SpamAssassin::DnsResolver::CORE:match, avg 5µs/call
161218µs213µs dbg("dns: nameservers set to %s", join(', ', @ns_addr_port));
# spent 13µs making 2 calls to Mail::SpamAssassin::Logger::dbg, avg 6µs/call
162221µs2654µs $res->nameservers(@ns_addr_port);
# spent 654µs making 2 calls to Net::DNS::Resolver::Base::nameservers, avg 327µs/call
163 }
16426µs 1;
16529µs } or do {
166 my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
167 dbg("dns: eval failed: $eval_stat");
168 };
169
170 dbg("dns: using socket module: %s version %s%s",
171 $io_socket_module_name,
172 $io_socket_module_name->VERSION,
173 $self->{force_ipv4} ? ', forced IPv4' :
174292µs453µs $self->{force_ipv6} ? ', forced IPv6' : '');
# spent 40µs making 2 calls to version::_VERSION, avg 20µs/call # spent 13µs making 2 calls to Mail::SpamAssassin::Logger::dbg, avg 6µs/call
175 dbg("dns: is Net::DNS::Resolver available? %s",
176216µs212µs $self->{no_resolver} ? "no" : "yes" );
# spent 12µs making 2 calls to Mail::SpamAssassin::Logger::dbg, avg 6µs/call
177216µs if (!$self->{no_resolver} && defined $Net::DNS::VERSION) {
178213µs211µs dbg("dns: Net::DNS version: %s", $Net::DNS::VERSION);
# spent 11µs making 2 calls to Mail::SpamAssassin::Logger::dbg, avg 5µs/call
179 }
180
181231µs return (!$self->{no_resolver});
182}
183
184=item $resolver = $res->get_resolver()
185
186Return the C<Net::DNS::Resolver> object.
187
188=cut
189
190sub get_resolver {
191 my ($self) = @_;
192 return $self->{res};
193}
194
195=item $res->configured_nameservers()
196
197Get a list of nameservers as configured by dns_server directives
198or as provided by Net::DNS, typically from /etc/resolv.conf
199
200=cut
201
202
# spent 257µs (112+144) within Mail::SpamAssassin::DnsResolver::configured_nameservers which was called: # once (112µs+144µs) by Mail::SpamAssassin::DnsResolver::available_nameservers at line 236
sub configured_nameservers {
20312µs my $self = shift;
204
20513µs my $res = $self->{res};
20612µs my @ns_addr_port; # list of name servers: [addr]:port entries
20719µs if ($self->{conf}->{dns_servers}) { # specified in a config file
208 @ns_addr_port = @{$self->{conf}->{dns_servers}};
209 dbg("dns: servers set by config to: %s", join(', ',@ns_addr_port));
210 } elsif ($res) { # default as provided by Net::DNS, e.g. /etc/resolv.conf
211 my @ns = $res->UNIVERSAL::can('nameservers') ? $res->nameservers
212129µs265µs : @{$res->{nameservers}};
# spent 56µs making 1 call to Net::DNS::Resolver::Base::nameservers # spent 9µs making 1 call to UNIVERSAL::can
213122µs17µs my $port = $res->UNIVERSAL::can('port') ? $res->port : $res->{port};
# spent 7µs making 1 call to UNIVERSAL::can
214126µs266µs @ns_addr_port = map(untaint_var("[$_]:" . $port), @ns);
# spent 66µs making 2 calls to Mail::SpamAssassin::Util::untaint_var, avg 33µs/call
215110µs17µs dbg("dns: servers obtained from Net::DNS : %s", join(', ',@ns_addr_port));
# spent 7µs making 1 call to Mail::SpamAssassin::Logger::dbg
216 }
217112µs return @ns_addr_port;
218}
219
220=item $res->available_nameservers()
221
222Get or set a list of currently available nameservers,
223which is typically a known-to-be-good subset of configured nameservers
224
225=cut
226
227
# spent 392ms (317+74.9) within Mail::SpamAssassin::DnsResolver::available_nameservers which was called 1971 times, avg 199µs/call: # 1968 times (316ms+74.5ms) by Mail::SpamAssassin::DnsResolver::bgsend at line 694, avg 199µs/call # 2 times (342µs+422µs) by Mail::SpamAssassin::DnsResolver::load_resolver at line 157, avg 382µs/call # once (97µs+20µs) by Mail::SpamAssassin::DnsResolver::connect_sock at line 371
sub available_nameservers {
22819713.69ms my $self = shift;
229
23019716.95ms if (@_) {
231 $self->{available_dns_servers} = [ @_ ]; # copy
232 dbg("dns: servers set by a caller to: %s",
233 join(', ',@{$self->{available_dns_servers}}));
234 } elsif (!$self->{available_dns_servers}) {
235 # a list of configured name servers: [addr]:port entries
236112µs1257µs $self->{available_dns_servers} = [ $self->configured_nameservers() ];
# spent 257µs making 1 call to Mail::SpamAssassin::DnsResolver::configured_nameservers
237 }
23819718.03ms if ($self->{force_ipv4} || $self->{force_ipv6}) {
239 # filter the list according to a chosen protocol family
24019713.89ms my $ip4_re = IPV4_ADDRESS;
24119713.44ms my(@filtered_addr_port);
242394216.3ms for (@{$self->{available_dns_servers}}) {
243394224.6ms local($1,$2);
244394269.0ms394228.2ms /^ \[ (.*) \] : (\d+) \z/xs or next;
# spent 28.2ms making 3942 calls to Mail::SpamAssassin::DnsResolver::CORE:match, avg 7µs/call
245394214.7ms my($addr,$port) = ($1,$2);
2463942151ms788446.5ms if ($addr =~ /^${ip4_re}\z/o) {
# spent 39.4ms making 3942 calls to Mail::SpamAssassin::DnsResolver::CORE:match, avg 10µs/call # spent 7.07ms making 3942 calls to Mail::SpamAssassin::DnsResolver::CORE:regcomp, avg 2µs/call
247394222.2ms push(@filtered_addr_port, $_) unless $self->{force_ipv6};
248 } elsif ($addr =~ /:.*:/) {
249 push(@filtered_addr_port, $_) unless $self->{force_ipv4};
250 } else {
251 warn "Unrecognized DNS server specification: $_";
252 }
253 }
254394212.6ms if (@filtered_addr_port < @{$self->{available_dns_servers}}) {
255 dbg("dns: filtered DNS servers according to protocol family: %s",
256 join(", ",@filtered_addr_port));
257 }
258394225.1ms @{$self->{available_dns_servers}} = @filtered_addr_port;
259 }
260 die "available_nameservers: No DNS servers available!\n"
261394211.2ms if !@{$self->{available_dns_servers}};
262394261.7ms return @{$self->{available_dns_servers}};
263}
264
265sub disable_available_port {
266 my($self, $lport) = @_;
267 if ($lport >= 0 && $lport <= 65535) {
268 my $conf = $self->{conf};
269 if (!defined $conf->{dns_available_portscount}) {
270 $self->pick_random_available_port(); # initialize
271 }
272 if (vec($conf->{dns_available_ports_bitset}, $lport, 1)) {
273 dbg("dns: disabling local port %d", $lport);
274 vec($conf->{dns_available_ports_bitset}, $lport, 1) = 0;
275 $conf->{dns_available_portscount_buckets}->[$lport >> 8] --;
276 $conf->{dns_available_portscount} --;
277 }
278 }
279}
280
281
# spent 54.9ms (54.9+24µs) within Mail::SpamAssassin::DnsResolver::pick_random_available_port which was called: # once (54.9ms+24µs) by Mail::SpamAssassin::DnsResolver::connect_sock at line 400
sub pick_random_available_port {
28212µs my $self = shift;
28312µs my $port_number; # resulting port number, or undef if none available
284
28514µs my $conf = $self->{conf};
28614µs my $available_portscount = $conf->{dns_available_portscount};
287
288 # initialize when called for the first time or after a config change
28915µs if (!defined $available_portscount) {
29014µs my $ports_bitset = $conf->{dns_available_ports_bitset};
29112µs if (!defined $ports_bitset) { # ensure it is initialized
292 Mail::SpamAssassin::Conf::set_ports_range(\$ports_bitset, 0, 0, 0);
293 $conf->{dns_available_ports_bitset} = $ports_bitset;
294 }
295 # prepare auxilliary data structure to speed up further free-port lookups;
296 # 256 buckets, each accounting for 256 ports: 8+8 = 16 bit port numbers;
297 # each bucket holds a count of available ports in its range
298127µs my @bucket_counts = (0) x 256;
29913µs my $all_zeroes = "\000" x 32; # one bucket's worth (256) of zeroes
30013µs my $all_ones = "\377" x 32; # one bucket's worth (256) of ones
30113µs my $ind = 0;
30212µs $available_portscount = 0; # number of all available ports
30318µs foreach my $bucket (0..255) {
304256443µs my $cnt = 0;
3052561.10ms my $b = substr($ports_bitset, $bucket*32, 32); # one bucket: 256 bits
306299984µs if ($b eq $all_zeroes) { $ind += 256 }
307234363µs elsif ($b eq $all_ones) { $ind += 256; $cnt += 256 }
308 else { # count nontrivial cases the slow way
3099645.7ms vec($ports_bitset, $ind++, 1) && $cnt++ for 0..255;
310 }
311256410µs $available_portscount += $cnt;
3122561.35ms $bucket_counts[$bucket] = $cnt;
313 }
31419µs $conf->{dns_available_portscount} = $available_portscount;
315113µs if ($available_portscount) {
316110µs $conf->{dns_available_portscount_buckets} = \@bucket_counts;
317 } else { # save some storage
318 $conf->{dns_available_portscount_buckets} = undef;
319 $conf->{dns_available_ports_bitset} = '';
320 }
321 }
322
323 # find the n-th port number from the ordered set of available port numbers
324122µs124µs dbg("dns: %d configured local ports for DNS queries", $available_portscount);
# spent 24µs making 1 call to Mail::SpamAssassin::Logger::dbg
32514µs if ($available_portscount > 0) {
32613µs my $ports_bitset = $conf->{dns_available_ports_bitset};
327112µs my $n = int(rand($available_portscount));
32812µs my $bucket_counts_ref = $conf->{dns_available_portscount_buckets};
32912µs my $ind = 0;
33015µs foreach my $bucket (0..255) {
331 # find the bucket containing n-th turned-on bit
332247706µs my $cnt = $bucket_counts_ref->[$bucket];
3337402.04ms if ($cnt > $n) { last } else { $n -= $cnt; $ind += 256 }
334 }
33512µs while ($ind <= 65535) { # scans one bucket, runs at most 256 iterations
336 # find the n-th turned-on bit within the corresponding bucket
337138472µs if (vec($ports_bitset, $ind, 1)) {
338277651µs if ($n <= 0) { $port_number = $ind; last } else { $n-- }
339 }
340137462µs $ind++;
341 }
342 }
343138µs return $port_number;
344}
345
346=item $res->connect_sock()
347
348Re-connect to the first nameserver listed in C</etc/resolv.conf> or similar
349platform-dependent source, as provided by C<Net::DNS>.
350
351=cut
352
353
# spent 57.0ms (263µs+56.8) within Mail::SpamAssassin::DnsResolver::connect_sock which was called: # once (263µs+56.8ms) by Mail::SpamAssassin::DnsResolver::connect_sock_if_reqd at line 475
sub connect_sock {
35412µs my ($self) = @_;
355
35617µs16µs dbg("dns: connect_sock, resolver: %s", $self->{no_resolver} ? "no" : "yes");
# spent 6µs making 1 call to Mail::SpamAssassin::Logger::dbg
35712µs return if $self->{no_resolver};
358
35912µs $io_socket_module_name
360 or die "No Perl modules for network socket available";
361
36213µs if ($self->{sock}) {
363 $self->{sock}->close()
364 or info("connect_sock: error closing socket %s: %s", $self->{sock}, $!);
365 $self->{sock} = undef;
366 }
36712µs my $sock;
368 my $errno;
369
370 # list of name servers: [addr]:port entries
371110µs1117µs my @ns_addr_port = $self->available_nameservers();
# spent 117µs making 1 call to Mail::SpamAssassin::DnsResolver::available_nameservers
372 # use the first name server in a list
37326µs my($ns_addr,$ns_port); local($1,$2);
374118µs16µs ($ns_addr,$ns_port) = ($1,$2) if $ns_addr_port[0] =~ /^\[(.*)\]:(\d+)\z/;
# spent 6µs making 1 call to Mail::SpamAssassin::DnsResolver::CORE:match
375
376 # Ensure families of src and dest addresses match (bug 4412 comment 29).
377 # Older IO::Socket::INET6 may choose a wrong LocalAddr if protocol family
378 # is unspecified, causing EINVAL failure when automatically assigned local
379 # IP address and a remote address do not belong to the same address family.
380 # Let's choose a suitable source address if possible.
38112µs my $ip4_re = IPV4_ADDRESS;
38212µs my $srcaddr;
38314µs if ($self->{force_ipv4}) {
38413µs $srcaddr = "0.0.0.0";
385 } elsif ($self->{force_ipv6}) {
386 $srcaddr = "::";
387 } elsif ($ns_addr =~ /^${ip4_re}\z/o) {
388 $srcaddr = "0.0.0.0";
389 } elsif ($ns_addr =~ /:.*:/) {
390 $srcaddr = "::";
391 } else { # unrecognized
392 # unspecified address, unspecified protocol family
393 }
394
395 # find a free local random port from a set of declared-to-be-available ports
39612µs my $lport;
39712µs my $attempts = 0;
39812µs for (;;) {
39912µs $attempts++;
400110µs154.9ms $lport = $self->pick_random_available_port();
# spent 54.9ms making 1 call to Mail::SpamAssassin::DnsResolver::pick_random_available_port
40112µs if (!defined $lport) {
402 $lport = 0;
403 dbg("no configured local ports for DNS queries, letting OS choose");
404 }
40513µs if ($attempts+1 > 50) { # sanity check
406 warn "could not create a DNS resolver socket in $attempts attempts\n";
407 $errno = 0;
408 last;
409 }
410118µs117µs dbg("dns: LocalAddr: [%s]:%d, name server: [%s]:%d, module %s",
# spent 17µs making 1 call to Mail::SpamAssassin::Logger::dbg
411 $srcaddr||'x', $lport, $ns_addr, $ns_port, $io_socket_module_name);
412117µs my %args = (
413 PeerAddr => $ns_addr,
414 PeerPort => $ns_port,
415 LocalAddr => $srcaddr,
416 LocalPort => $lport,
417 Type => SOCK_DGRAM,
418 Proto => 'udp',
419 );
420124µs11.52ms $sock = $io_socket_module_name->new(%args);
# spent 1.52ms making 1 call to IO::Socket::IP::new
421
42215µs last if $sock; # ok, got it
423
424 # IO::Socket::IP constructor provides full error messages in $@
425 $errno = $io_socket_module_name eq 'IO::Socket::IP' ? $@ : $!;
426
427 if ($! == EADDRINUSE || $! == EACCES) {
428 # in use, let's try another source port
429 dbg("dns: UDP port $lport already in use, trying another port");
430 if ($self->{conf}->{dns_available_portscount} > 100) { # still abundant
431 $self->disable_available_port($lport);
432 }
433 } else {
434 warn "error creating a DNS resolver socket: $errno";
435 goto no_sock;
436 }
437 }
43812µs if (!$sock) {
439 warn "could not create a DNS resolver socket in $attempts attempts: $errno";
440 goto no_sock;
441 }
442
443 eval {
44412µs my($bufsiz,$newbufsiz);
445114µs1143µs $bufsiz = $sock->sockopt(Socket::SO_RCVBUF)
# spent 143µs making 1 call to IO::Socket::sockopt
446 or die "cannot get a resolver socket rx buffer size: $!";
44714µs if ($bufsiz >= 32*1024) {
44818µs18µs dbg("dns: resolver socket rx buffer size is %d bytes, local port %d",
# spent 8µs making 1 call to Mail::SpamAssassin::Logger::dbg
449 $bufsiz, $lport);
450 } else {
451 $sock->sockopt(Socket::SO_RCVBUF, 32*1024)
452 or die "cannot set a resolver socket rx buffer size: $!";
453 $newbufsiz = $sock->sockopt(Socket::SO_RCVBUF)
454 or die "cannot get a resolver socket rx buffer size: $!";
455 dbg("dns: resolver socket rx buffer size changed from %d to %d bytes, ".
456 "local port %d", $bufsiz, $newbufsiz, $lport);
457 }
45813µs 1;
45914µs } or do {
460 my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
461 info("dns: socket buffer size error: $eval_stat");
462 };
463
46414µs $self->{sock} = $sock;
465112µs144µs $self->{sock_as_vec} = $self->fhs_to_vec($self->{sock});
# spent 44µs making 1 call to Mail::SpamAssassin::DnsResolver::fhs_to_vec
466117µs return;
467
468no_sock:
469 undef $self->{sock};
470 undef $self->{sock_as_vec};
471}
472
473
# spent 82.1ms (25.0+57.0) within Mail::SpamAssassin::DnsResolver::connect_sock_if_reqd which was called 1968 times, avg 42µs/call: # 1968 times (25.0ms+57.0ms) by Mail::SpamAssassin::DnsResolver::bgsend at line 702, avg 42µs/call
sub connect_sock_if_reqd {
47419683.92ms my ($self) = @_;
475196833.6ms157.0ms $self->connect_sock() if !$self->{sock};
# spent 57.0ms making 1 call to Mail::SpamAssassin::DnsResolver::connect_sock
476}
477
478=item $res->get_sock()
479
480Return the C<IO::Socket::INET> object used to communicate with
481the nameserver.
482
483=cut
484
485sub get_sock {
486 my ($self) = @_;
487 $self->connect_sock_if_reqd();
488 return $self->{sock};
489}
490
491###########################################################################
492
493=item $packet = new_dns_packet ($domain, $type, $class)
494
495A wrapper for C<Net::DNS::Packet::new()> which traps a die thrown by it.
496
497To use this, change calls to C<Net::DNS::Resolver::bgsend> from:
498
499 $res->bgsend($domain, $type);
500
501to:
502
503 $res->bgsend(Mail::SpamAssassin::DnsResolver::new_dns_packet($domain, $type, $class));
504
505=cut
506
507# implements draft-vixie-dnsext-dns0x20-00
508#
509sub dnsext_dns0x20 {
510 my ($string) = @_;
511 my $rnd;
512 my $have_rnd_bits = 0;
513 my $result = '';
514 for my $ic (unpack("C*",$string)) {
515 if (chr($ic) =~ /^[A-Za-z]\z/) {
516 if ($have_rnd_bits < 1) {
517 # only reveal few bits at a time, hiding most of the accumulator
518 $rnd = int(rand(0x7fffffff)) & 0xff; $have_rnd_bits = 8;
519 }
520 $ic ^= 0x20 if $rnd & 1; # flip the 0x20 bit in name if dice says so
521 $rnd = $rnd >> 1; $have_rnd_bits--;
522 }
523 $result .= chr($ic);
524 }
525 return $result;
526}
527
528# this subroutine mimics the Net::DNS::Resolver::Base::make_query_packet()
529#
530
# spent 1.72s (312ms+1.40) within Mail::SpamAssassin::DnsResolver::new_dns_packet which was called 1968 times, avg 872µs/call: # 1968 times (312ms+1.40s) by Mail::SpamAssassin::DnsResolver::bgsend at line 691, avg 872µs/call
sub new_dns_packet {
531196814.7ms my ($self, $domain, $type, $class) = @_;
532
53319683.96ms return if $self->{no_resolver};
534
535 # construct a PTR query if it looks like an IPv4 address
53619685.34ms if (!defined($type) || $type eq 'PTR') {
537 local($1,$2,$3,$4);
538 if ($domain =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
539 $domain = "$4.$3.$2.$1.in-addr.arpa.";
540 $type = 'PTR';
541 }
542 }
54319683.51ms $type = 'A' if !defined $type; # a Net::DNS::Packet default
54419684.46ms $class = 'IN' if !defined $class; # a Net::DNS::Packet default
545
54619683.31ms my $packet;
547 eval {
548
549196836.2ms19689.92ms if (utf8::is_utf8($domain)) { # since Perl 5.8.1
# spent 9.92ms making 1968 calls to utf8::is_utf8, avg 5µs/call
550 info("dns: new_dns_packet: domain is utf8 flagged: %s", $domain);
551 }
552
553196854.9ms196831.0ms $domain =~ s/\.*\z/./s;
# spent 31.0ms making 1968 calls to Mail::SpamAssassin::DnsResolver::CORE:subst, avg 16µs/call
554196860.3ms196824.7ms if (length($domain) > 255) {
# spent 24.7ms making 1968 calls to Mail::SpamAssassin::DnsResolver::CORE:match, avg 13µs/call
555 die "domain name longer than 255 bytes\n";
556 } elsif ($domain !~ /^ (?: [^.]{1,63} \. )+ \z/sx) {
557 if ($domain !~ /^ (?: [^.]+ \. )+ \z/sx) {
558 die "a domain name contains a null label\n";
559 } else {
560 die "a label in a domain name is longer than 63 bytes\n";
561 }
562 }
563
56419689.48ms if ($self->{conf}->{dns_options}->{dns0x20}) {
565 $domain = dnsext_dns0x20($domain);
566 } else {
567196811.0ms $domain =~ tr/A-Z/a-z/; # lowercase, limited to plain ASCII
568 }
569
570 # Net::DNS expects RFC 1035 zone format encoding even in its API, silly!
571 # Since 0.68 it also assumes that domain names containing characters
572 # with codes above 0177 imply that IDN translation is to be performed.
573 # Protect also nonprintable characters just in case, ensuring transparency.
574196823.7ms19689.89ms $domain =~ s{ ( [\000-\037\177-\377\\] ) }
# spent 9.89ms making 1968 calls to Mail::SpamAssassin::DnsResolver::CORE:subst, avg 5µs/call
575 { $1 eq '\\' ? "\\$1" : sprintf("\\%03d",ord($1)) }xgse;
576
577196817.4ms1968751ms $packet = Net::DNS::Packet->new($domain, $type, $class);
# spent 751ms making 1968 calls to Net::DNS::Packet::new, avg 381µs/call
578
579 # a bit noisy, so commented by default...
580 #dbg("dns: new DNS packet time=%.3f domain=%s type=%s id=%s",
581 # time, $domain, $type, $packet->id);
58219686.16ms 1;
58319688.23ms } or do {
584 # this can if a domain name in a query is invalid, or if a timeout signal
585 # happened to be trapped by this eval, or if Net::DNS signalled an error
586 my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
587 # resignal if alarm went off
588 die "dns: (1) $eval_stat\n" if $eval_stat =~ /__alarm__ignore__\(.*\)/s;
589 warn sprintf(
590 "dns: new_dns_packet (domain=%s type=%s class=%s) failed: %s\n",
591 $domain, $type, $class, $eval_stat);
592 };
593
59419687.58ms if ($packet) {
595 # RD flag needs to be set explicitly since Net::DNS 1.01, Bug 7223
596196824.3ms393699.4ms $packet->header->rd(1);
# spent 77.4ms making 1968 calls to Net::DNS::Header::rd, avg 39µs/call # spent 22.0ms making 1968 calls to Net::DNS::Packet::header, avg 11µs/call
597
598 # my $udp_payload_size = $self->{res}->udppacketsize;
59919685.25ms my $udp_payload_size = $self->{conf}->{dns_options}->{edns};
60019687.97ms if ($udp_payload_size && $udp_payload_size > 512) {
601 # dbg("dns: adding EDNS ext, UDP payload size %d", $udp_payload_size);
602196837.4ms196818.0ms if ($packet->UNIVERSAL::can('edns')) { # available since Net::DNS 0.69
# spent 18.0ms making 1968 calls to UNIVERSAL::can, avg 9µs/call
603196825.0ms3936461ms $packet->edns->size($udp_payload_size);
# spent 419ms making 1968 calls to Net::DNS::Packet::edns, avg 213µs/call # spent 41.6ms making 1968 calls to Net::DNS::RR::OPT::size, avg 21µs/call
604 } else { # legacy mechanism
605 my $optrr = Net::DNS::RR->new(Type => 'OPT', Name => '', TTL => 0,
606 Class => $udp_payload_size);
607 $packet->push('additional', $optrr);
608 }
609 }
610 }
611
612196829.6ms return $packet;
613}
614
615# Internal function used only in this file
616## compute a unique ID for a packet to match the query to the reply
617## It must use only data that is returned unchanged by the nameserver.
618## Argument is a Net::DNS::Packet that has a non-empty question section,
619## return is an (opaque) string that can be used as a hash key
620
# spent 894ms (154+739) within Mail::SpamAssassin::DnsResolver::_packet_id which was called 1968 times, avg 454µs/call: # 1968 times (154ms+739ms) by Mail::SpamAssassin::DnsResolver::bgsend at line 720, avg 454µs/call
sub _packet_id {
62119684.24ms my ($self, $packet) = @_;
622196813.0ms196825.3ms my $header = $packet->header;
# spent 25.3ms making 1968 calls to Net::DNS::Packet::header, avg 13µs/call
623196813.9ms196828.1ms my $id = $header->id;
# spent 28.1ms making 1968 calls to Net::DNS::Header::id, avg 14µs/call
624196819.0ms196840.7ms my @questions = $packet->question;
# spent 40.7ms making 1968 calls to Net::DNS::Packet::question, avg 21µs/call
625
62619684.07ms @questions <= 1
627 or warn "dns: packet has multiple questions: " . $packet->string . "\n";
628
62919683.83ms if ($questions[0]) {
630 # Bug 6232: Net::DNS::Packet::new is not consistent in keeping data in
631 # sections of a packet either as original bytes or presentation-encoded:
632 # creating a query packet as above in new_dns_packet() keeps label in
633 # non-encoded form, yet on parsing an answer packet, its query section
634 # is converted to presentation form by Net::DNS::Question::parse calling
635 # Net::DNS::Packet::dn_expand and Net::DNS::wire2presentation in turn.
636 # Let's undo the effect of the wire2presentation routine here to make
637 # sure the query section of an answer packet matches the query section
638 # in our packet as formed by new_dns_packet():
639 #
640196819.9ms1968645ms my($class,$type,$qname) = decode_dns_question_entry($questions[0]);
# spent 645ms making 1968 calls to Mail::SpamAssassin::Util::decode_dns_question_entry, avg 328µs/call
641196819.1ms $qname =~ tr/A-Z/a-z/ if !$self->{conf}->{dns_options}->{dns0x20};
642196835.0ms return join('/', $id, $class, $type, $qname);
643
644 } else {
645 # Odd, this should not happen, a DNS servers is supposed to retain
646 # a question section in its reply. There is a bug in Net::DNS 0.72
647 # and earlier where a signal (e.g. a timeout alarm) during decoding
648 # of a reply packet produces a seemingly valid packet object, but
649 # with missing sections - see [rt.cpan.org #83451] .
650 #
651 # Better support it; just return the (safe) ID part, along with
652 # a text token indicating that the packet had no question part.
653 #
654 return $id . "/NO_QUESTION_IN_PACKET";
655 }
656}
657
658###########################################################################
659
660=item $id = $res->bgsend($domain, $type, $class, $cb)
661
662Quite similar to C<Net::DNS::Resolver::bgsend>, except that when a reply
663packet eventually arrives, and C<poll_responses> is called, the callback
664sub reference C<$cb> will be called.
665
666Note that C<$type> and C<$class> may be C<undef>, in which case they
667will default to C<A> and C<IN>, respectively.
668
669The callback sub will be called with three arguments -- the packet that was
670delivered, and an id string that fingerprints the query packet and the expected
671reply. The third argument is a timestamp (Unix time, floating point), captured
672at the time the packet was collected. It is expected that a closure callback
673be used, like so:
674
675 my $id = $self->{resolver}->bgsend($domain, $type, undef, sub {
676 my ($reply, $reply_id, $timestamp) = @_;
677 $self->got_a_reply ($reply, $reply_id);
678 });
679
680The callback can ignore the reply as an invalid packet sent to the listening
681port if the reply id does not match the return value from bgsend.
682
683=cut
684
685
# spent 5.16s (390ms+4.77) within Mail::SpamAssassin::DnsResolver::bgsend which was called 1968 times, avg 2.62ms/call: # 1968 times (390ms+4.77s) by Mail::SpamAssassin::AsyncLoop::bgsend_and_start_lookup at line 354 of Mail/SpamAssassin/AsyncLoop.pm, avg 2.62ms/call
sub bgsend {
686196813.2ms my ($self, $domain, $type, $class, $cb) = @_;
68719684.43ms return if $self->{no_resolver};
688
68919684.49ms $self->{send_timed_out} = 0;
690
691196816.4ms19681.72s my $pkt = $self->new_dns_packet($domain, $type, $class);
# spent 1.72s making 1968 calls to Mail::SpamAssassin::DnsResolver::new_dns_packet, avg 872µs/call
69219683.61ms return if !$pkt; # just bail out, new_dns_packet already reported a failure
693
694196818.1ms1968391ms my @ns_addr_port = $self->available_nameservers();
# spent 391ms making 1968 calls to Mail::SpamAssassin::DnsResolver::available_nameservers, avg 199µs/call
695196816.7ms196814.5ms dbg("dns: bgsend, DNS servers: %s", join(', ',@ns_addr_port));
# spent 14.5ms making 1968 calls to Mail::SpamAssassin::Logger::dbg, avg 7µs/call
69619684.20ms my $n_servers = scalar @ns_addr_port;
697
69819683.40ms my $ok;
69919688.84ms for (my $attempts=1; $attempts <= $n_servers; $attempts++) {
700196813.1ms196811.7ms dbg("dns: attempt %d/%d, trying connect/sendto to %s",
# spent 11.7ms making 1968 calls to Mail::SpamAssassin::Logger::dbg, avg 6µs/call
701 $attempts, $n_servers, $ns_addr_port[0]);
702196813.7ms196882.1ms $self->connect_sock_if_reqd();
# spent 82.1ms making 1968 calls to Mail::SpamAssassin::DnsResolver::connect_sock_if_reqd, avg 42µs/call
703196829.0ms39361.64s if ($self->{sock} && defined($self->{sock}->send($pkt->data, 0))) {
# spent 1.43s making 1968 calls to Net::DNS::Packet::data, avg 724µs/call # spent 209ms making 1968 calls to IO::Socket::send, avg 106µs/call
704393619.4ms $ok = 1; last;
705 } else { # any other DNS servers in a list to try?
706 my $msg = !$self->{sock} ? "unable to connect to $ns_addr_port[0]"
707 : "sendto() to $ns_addr_port[0] failed: $!";
708 $self->finish_socket();
709 if ($attempts >= $n_servers) {
710 warn "dns: $msg, no more alternatives\n";
711 last;
712 }
713 # try with a next DNS server, rotate the list left
714 warn "dns: $msg, failing over to $ns_addr_port[1]\n";
715 push(@ns_addr_port, shift(@ns_addr_port));
716 $self->available_nameservers(@ns_addr_port);
717 }
718 }
71919683.33ms return if !$ok;
720196817.0ms1968894ms my $id = $self->_packet_id($pkt);
# spent 894ms making 1968 calls to Mail::SpamAssassin::DnsResolver::_packet_id, avg 454µs/call
721196819.6ms196825.6ms dbg("dns: providing a callback for id: $id");
# spent 25.6ms making 1968 calls to Mail::SpamAssassin::Logger::dbg, avg 13µs/call
722196819.5ms $self->{id_to_callback}->{$id} = $cb;
723196842.5ms return $id;
724}
725
726###########################################################################
727
728=item $id = $res->bgread()
729
730Similar to C<Net::DNS::Resolver::bgread>. Reads a DNS packet from
731a supplied socket, decodes it, and returns a Net::DNS::Packet object
732if successful. Dies on error.
733
734=cut
735
736sub bgread() {
737 my ($self) = @_;
738 my $sock = $self->{sock};
739 my $packetsize = $self->{res}->udppacketsize;
740 $packetsize = 512 if $packetsize < 512; # just in case
741 my $data = '';
742 my $peeraddr = $sock->recv($data, $packetsize+256); # with some size margin for troubleshooting
743 defined $peeraddr or die "bgread: recv() failed: $!";
744 my $peerhost = $sock->peerhost;
745 $data ne '' or die "bgread: received empty packet from $peerhost";
746 dbg("dns: bgread: received %d bytes from %s", length($data), $peerhost);
747 my($answerpkt, $decoded_length) = Net::DNS::Packet->new(\$data);
748 $answerpkt or die "bgread: decoding DNS packet failed: $@";
749 $answerpkt->answerfrom($peerhost);
750 if ($decoded_length ne length($data)) {
751 warn sprintf("bgread: received a %d bytes packet from %s, decoded %d bytes\n",
752 length($data), $peerhost, $decoded_length);
753 }
754 return $answerpkt;
755}
756
757###########################################################################
758
759=item $nfound = $res->poll_responses()
760
761See if there are any C<bgsend> reply packets ready, and return
762the number of such packets delivered to their callbacks.
763
764=cut
765
766sub poll_responses {
767 my ($self, $timeout) = @_;
768 return if $self->{no_resolver};
769 return if !$self->{sock};
770 my $cnt = 0;
771
772 my $rin = $self->{sock_as_vec};
773 my $rout;
774
775 for (;;) {
776 my ($nfound, $timeleft, $eval_stat);
777 eval { # use eval to catch alarm signal
778 my $timer; # collects timestamp when variable goes out of scope
779 if (!defined($timeout) || $timeout > 0)
780 { $timer = $self->{main}->time_method("poll_dns_idle") }
781 $! = 0;
782 ($nfound, $timeleft) = select($rout=$rin, undef, undef, $timeout);
783 1;
784 } or do {
785 $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
786 };
787 if (defined $eval_stat) {
788 # most likely due to an alarm signal, resignal if so
789 die "dns: (2) $eval_stat\n" if $eval_stat =~ /__alarm__ignore__\(.*\)/s;
790 warn "dns: select aborted: $eval_stat\n";
791 return;
792 } elsif (!defined $nfound || $nfound < 0) {
793 if ($!) { warn "dns: select failed: $!\n" }
794 else { info("dns: select interrupted") } # shouldn't happen
795 return;
796 } elsif (!$nfound) {
797 if (!defined $timeout) { warn("dns: select returned empty-handed\n") }
798 elsif ($timeout > 0) { dbg("dns: select timed out %.3f s", $timeout) }
799 return;
800 }
801
802 my $now = time;
803 $timeout = 0; # next time around collect whatever is available, then exit
804 last if $nfound == 0;
805
806 my $packet;
807 eval {
808 $packet = $self->bgread();
809 } or do {
810 undef $packet;
811 my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
812 # resignal if alarm went off
813 die $eval_stat if $eval_stat =~ /__alarm__ignore__\(.*\)/s;
814 info("dns: bad dns reply: %s", $eval_stat);
815 };
816
817# Bug 7265, use our own bgread()
818# my $packet = $self->{res}->bgread($self->{sock});
819
820 if (!$packet) {
821 # error already reported above
822# my $dns_err = $self->{res}->errorstring;
823# die "dns (3) $dns_err\n" if $dns_err =~ /__alarm__ignore__\(.*\)/s;
824# info("dns: bad dns reply: $dns_err");
825 } else {
826 my $header = $packet->header;
827 if (!$header) {
828 info("dns: dns reply is missing a header section");
829 } else {
830 my $rcode = $header->rcode;
831 my $packet_id = $header->id;
832 my $id = $self->_packet_id($packet);
833
834 if ($rcode eq 'NOERROR') { # success
835 # NOERROR, may or may not have answer records
836 dbg("dns: dns reply %s is OK, %d answer records",
837 $packet_id, $header->ancount);
838 if ($header->tc) { # truncation flag turned on
839 my $edns = $self->{conf}->{dns_options}->{edns} || 512;
840 info("dns: reply to %s truncated (%s), %d answer records", $id,
841 $edns == 512 ? "EDNS off" : "EDNS $edns bytes",
842 $header->ancount);
843 }
844 } else {
845 # some failure, e.g. NXDOMAIN, SERVFAIL, FORMERR, REFUSED, ...
846 # btw, one reason for SERVFAIL is an RR signature failure in DNSSEC
847 dbg("dns: dns reply to %s: %s", $id, $rcode);
848 }
849
850 # A hash lookup: the id must match exactly (case-sensitively).
851 # The domain name part of the id was lowercased if dns0x20 is off,
852 # and case-randomized when dns0x20 option is on.
853 #
854 my $cb = delete $self->{id_to_callback}->{$id};
855
856 if ($cb) {
857 $cb->($packet, $id, $now);
858 $cnt++;
859 } else { # no match, report the problem
860 if ($rcode eq 'REFUSED' || $id =~ m{^\d+/NO_QUESTION_IN_PACKET\z}) {
861 # the failure was already reported above
862 } else {
863 info("dns: no callback for id %s, ignored; packet: %s",
864 $id, $packet ? $packet->string : "undef" );
865 }
866 # report a likely matching query for diagnostic purposes
867 local $1;
868 if ($id =~ m{^(\d+)/}) {
869 my $dnsid = $1; # the raw DNS packet id
870 my @matches =
871 grep(m{^\Q$dnsid\E/}, keys %{$self->{id_to_callback}});
872 if (!@matches) {
873 info("dns: no likely matching queries for id %s", $dnsid);
874 } else {
875 info("dns: a likely matching query: %s", join(', ', @matches));
876 }
877 }
878 }
879 }
880 }
881 }
882
883 return $cnt;
884}
885
886###########################################################################
887
888=item $res->bgabort()
889
890Call this to release pending requests from memory, when aborting backgrounded
891requests, or when the scan is complete.
892C<Mail::SpamAssassin::PerMsgStatus::check> calls this before returning.
893
894=cut
895
896sub bgabort {
897 my ($self) = @_;
898 $self->{id_to_callback} = {};
899}
900
901###########################################################################
902
903=item $packet = $res->send($name, $type, $class)
904
905Emulates C<Net::DNS::Resolver::send()>.
906
907This subroutine is a simple synchronous leftover from SpamAssassin version
9083.3 and does not participate in packet query caching and callback grouping
909as implemented by AsyncLoop::bgsend_and_start_lookup(). As such it should
910be avoided for mainstream usage.
911
912=cut
913
914sub send {
915 my ($self, $name, $type, $class) = @_;
916 return if $self->{no_resolver};
917
918 # Avoid passing utf8 character strings to DNS, as it has no notion of
919 # character set encodings - encode characters somehow to plain bytes
920 # using some arbitrary encoding (they are normally just 7-bit ascii
921 # characters anyway, just need to get rid of the utf8 flag). Bug 6959
922 # Most if not all af these come from a SPF plugin.
923 #
924 utf8::encode($name);
925
926 my $retrans = $self->{retrans};
927 my $retries = $self->{retry};
928 my $timeout = $retrans;
929 my $answerpkt;
930 my $answerpkt_avail = 0;
931 for (my $i = 0;
932 (($i < $retries) && !defined($answerpkt));
933 ++$i, $retrans *= 2, $timeout = $retrans) {
934
935 $timeout = 1 if ($timeout < 1);
936 # note nifty use of a closure here. I love closures ;)
937 my $id = $self->bgsend($name, $type, $class, sub {
938 my ($reply, $reply_id, $timestamp) = @_;
939 $answerpkt = $reply; $answerpkt_avail = 1;
940 });
941
942 last if !defined $id; # perhaps a restricted zone or a serious failure
943
944 my $now = time;
945 my $deadline = $now + $timeout;
946
947 while (!$answerpkt_avail) {
948 if ($now >= $deadline) { $self->{send_timed_out} = 1; last }
949 $self->poll_responses(1);
950 $now = time;
951 }
952 }
953 return $answerpkt;
954}
955
956###########################################################################
957
958=item $res->errorstring()
959
960Little more than a stub for callers expecting this from C<Net::DNS::Resolver>.
961
962If called immediately after a call to $res->send this will return
963C<query timed out> if the $res->send DNS query timed out. Otherwise
964C<unknown error or no error> will be returned.
965
966No other errors are reported.
967
968=cut
969
970sub errorstring {
971 my ($self) = @_;
972 return 'query timed out' if $self->{send_timed_out};
973 return 'unknown error or no error';
974}
975
976###########################################################################
977
978=item $res->finish_socket()
979
980Reset socket when done with it.
981
982=cut
983
984sub finish_socket {
985 my ($self) = @_;
986 if ($self->{sock}) {
987 $self->{sock}->close()
988 or warn "finish_socket: error closing socket $self->{sock}: $!";
989 undef $self->{sock};
990 }
991}
992
993###########################################################################
994
995=item $res->finish()
996
997Clean up for destruction.
998
999=cut
1000
1001sub finish {
1002 my ($self) = @_;
1003 $self->finish_socket();
1004 %{$self} = ();
1005}
1006
1007###########################################################################
1008# non-public methods.
1009
1010# should move to Util.pm (TODO)
1011
# spent 44µs within Mail::SpamAssassin::DnsResolver::fhs_to_vec which was called: # once (44µs+0s) by Mail::SpamAssassin::DnsResolver::connect_sock at line 465
sub fhs_to_vec {
101213µs my ($self, @fhlist) = @_;
101312µs my $rin = '';
101415µs foreach my $sock (@fhlist) {
101513µs my $fno = fileno($sock);
1016113µs if (!defined $fno) {
1017 warn "dns: oops! fileno now undef for $sock";
1018 } else {
101918µs vec ($rin, $fno, 1) = 1;
1020 }
1021 }
1022113µs return $rin;
1023}
1024
1025# call Mail::SA::init() instead
1026sub reinit_post_fork {
1027 my ($self) = @_;
1028 # release parent's socket, don't want all spamds sharing the same socket
1029 $self->finish_socket();
1030}
1031
1032111µs1;
1033
1034=back
1035
1036=cut
 
# spent 92.3ms within Mail::SpamAssassin::DnsResolver::CORE:match which was called 9857 times, avg 9µs/call: # 3942 times (39.4ms+0s) by Mail::SpamAssassin::DnsResolver::available_nameservers at line 246, avg 10µs/call # 3942 times (28.2ms+0s) by Mail::SpamAssassin::DnsResolver::available_nameservers at line 244, avg 7µs/call # 1968 times (24.7ms+0s) by Mail::SpamAssassin::DnsResolver::new_dns_packet at line 554, avg 13µs/call # 4 times (18µs+0s) by Mail::SpamAssassin::DnsResolver::load_resolver at line 160, avg 5µs/call # once (6µs+0s) by Mail::SpamAssassin::DnsResolver::connect_sock at line 374
sub Mail::SpamAssassin::DnsResolver::CORE:match; # opcode
# spent 7.07ms within Mail::SpamAssassin::DnsResolver::CORE:regcomp which was called 3942 times, avg 2µs/call: # 3942 times (7.07ms+0s) by Mail::SpamAssassin::DnsResolver::available_nameservers at line 246, avg 2µs/call
sub Mail::SpamAssassin::DnsResolver::CORE:regcomp; # opcode
# spent 40.9ms within Mail::SpamAssassin::DnsResolver::CORE:subst which was called 3936 times, avg 10µs/call: # 1968 times (31.0ms+0s) by Mail::SpamAssassin::DnsResolver::new_dns_packet at line 553, avg 16µs/call # 1968 times (9.89ms+0s) by Mail::SpamAssassin::DnsResolver::new_dns_packet at line 574, avg 5µs/call
sub Mail::SpamAssassin::DnsResolver::CORE:subst; # opcode
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.