Filename | /usr/local/lib/perl5/site_perl/Mail/SpamAssassin/DnsResolver.pm |
Statements | Executed 156695 statements in 1.29s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1968 | 1 | 1 | 379ms | 5.06s | bgsend | Mail::SpamAssassin::DnsResolver::
1968 | 1 | 1 | 376ms | 1.74s | new_dns_packet | Mail::SpamAssassin::DnsResolver::
1971 | 3 | 1 | 326ms | 397ms | available_nameservers | Mail::SpamAssassin::DnsResolver::
1968 | 1 | 1 | 179ms | 793ms | _packet_id | Mail::SpamAssassin::DnsResolver::
9857 | 5 | 1 | 85.7ms | 85.7ms | CORE:match (opcode) | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 53.7ms | 53.7ms | pick_random_available_port | Mail::SpamAssassin::DnsResolver::
3936 | 2 | 1 | 34.7ms | 34.7ms | CORE:subst (opcode) | Mail::SpamAssassin::DnsResolver::
1968 | 1 | 1 | 15.3ms | 71.1ms | connect_sock_if_reqd | Mail::SpamAssassin::DnsResolver::
3942 | 1 | 1 | 7.20ms | 7.20ms | CORE:regcomp (opcode) | Mail::SpamAssassin::DnsResolver::
2 | 2 | 2 | 1.11ms | 17.3ms | load_resolver | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 253µs | 55.7ms | connect_sock | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 115µs | 246µs | configured_nameservers | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 44µs | 61µs | BEGIN@38 | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 41µs | 41µs | fhs_to_vec | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 38µs | 6.69ms | new | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 33µs | 5.98ms | BEGIN@50 | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 31µs | 67µs | BEGIN@39 | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 30µs | 174µs | BEGIN@48 | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 28µs | 94µs | BEGIN@41 | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 28µs | 165µs | BEGIN@51 | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 28µs | 33µs | BEGIN@40 | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 27µs | 121µs | BEGIN@56 | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 27µs | 189µs | BEGIN@46 | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 26µs | 399µs | BEGIN@52 | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 26µs | 596µs | BEGIN@47 | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 17µs | 17µs | BEGIN@57 | Mail::SpamAssassin::DnsResolver::
1 | 1 | 1 | 15µs | 15µs | BEGIN@45 | Mail::SpamAssassin::DnsResolver::
0 | 0 | 0 | 0s | 0s | __ANON__[:940] | Mail::SpamAssassin::DnsResolver::
0 | 0 | 0 | 0s | 0s | bgabort | Mail::SpamAssassin::DnsResolver::
0 | 0 | 0 | 0s | 0s | bgread | Mail::SpamAssassin::DnsResolver::
0 | 0 | 0 | 0s | 0s | disable_available_port | Mail::SpamAssassin::DnsResolver::
0 | 0 | 0 | 0s | 0s | dnsext_dns0x20 | Mail::SpamAssassin::DnsResolver::
0 | 0 | 0 | 0s | 0s | errorstring | Mail::SpamAssassin::DnsResolver::
0 | 0 | 0 | 0s | 0s | finish | Mail::SpamAssassin::DnsResolver::
0 | 0 | 0 | 0s | 0s | finish_socket | Mail::SpamAssassin::DnsResolver::
0 | 0 | 0 | 0s | 0s | get_resolver | Mail::SpamAssassin::DnsResolver::
0 | 0 | 0 | 0s | 0s | get_sock | Mail::SpamAssassin::DnsResolver::
0 | 0 | 0 | 0s | 0s | poll_responses | Mail::SpamAssassin::DnsResolver::
0 | 0 | 0 | 0s | 0s | reinit_post_fork | Mail::SpamAssassin::DnsResolver::
0 | 0 | 0 | 0s | 0s | send | Mail::SpamAssassin::DnsResolver::
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 | |||||
20 | Mail::SpamAssassin::DnsResolver - DNS resolution engine | ||||
21 | |||||
22 | =head1 DESCRIPTION | ||||
23 | |||||
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 | ||||
26 | that module. | ||||
27 | |||||
28 | =head1 METHODS | ||||
29 | |||||
30 | =over 4 | ||||
31 | |||||
32 | =cut | ||||
33 | |||||
34 | # TODO: caching in this layer instead of in callers. | ||||
35 | |||||
36 | package Mail::SpamAssassin::DnsResolver; | ||||
37 | |||||
38 | 2 | 65µs | 2 | 78µs | # spent 61µs (44+17) within Mail::SpamAssassin::DnsResolver::BEGIN@38 which was called:
# once (44µs+17µs) by Mail::SpamAssassin::BEGIN@77 at line 38 # spent 61µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@38
# spent 17µs making 1 call to strict::import |
39 | 2 | 87µs | 2 | 103µs | # spent 67µs (31+36) within Mail::SpamAssassin::DnsResolver::BEGIN@39 which was called:
# once (31µs+36µs) by Mail::SpamAssassin::BEGIN@77 at line 39 # spent 67µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@39
# spent 36µs making 1 call to warnings::import |
40 | 2 | 63µs | 2 | 38µs | # spent 33µs (28+5) within Mail::SpamAssassin::DnsResolver::BEGIN@40 which was called:
# once (28µs+5µs) by Mail::SpamAssassin::BEGIN@77 at line 40 # spent 33µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@40
# spent 5µs making 1 call to bytes::import |
41 | 2 | 80µs | 2 | 161µs | # spent 94µs (28+66) within Mail::SpamAssassin::DnsResolver::BEGIN@41 which was called:
# once (28µs+66µs) by Mail::SpamAssassin::BEGIN@77 at line 41 # spent 94µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@41
# spent 66µs making 1 call to re::import |
42 | |||||
43 | 1 | 33µs | require 5.008001; # needs utf8::is_utf8() | ||
44 | |||||
45 | 2 | 65µs | 1 | 15µs | # spent 15µs within Mail::SpamAssassin::DnsResolver::BEGIN@45 which was called:
# once (15µs+0s) by Mail::SpamAssassin::BEGIN@77 at line 45 # spent 15µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@45 |
46 | 2 | 73µs | 2 | 351µs | # spent 189µs (27+162) within Mail::SpamAssassin::DnsResolver::BEGIN@46 which was called:
# once (27µs+162µs) by Mail::SpamAssassin::BEGIN@77 at line 46 # spent 189µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@46
# spent 162µs making 1 call to Exporter::import |
47 | 2 | 74µs | 2 | 1.17ms | # spent 596µs (26+570) within Mail::SpamAssassin::DnsResolver::BEGIN@47 which was called:
# once (26µs+570µs) by Mail::SpamAssassin::BEGIN@77 at line 47 # spent 596µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@47
# spent 570µs making 1 call to Exporter::import |
48 | 2 | 70µs | 2 | 319µs | # spent 174µs (30+145) within Mail::SpamAssassin::DnsResolver::BEGIN@48 which was called:
# once (30µs+145µs) by Mail::SpamAssassin::BEGIN@77 at line 48 # spent 174µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@48
# spent 145µs making 1 call to Exporter::import |
49 | |||||
50 | 2 | 82µs | 2 | 11.9ms | # spent 5.98ms (33µs+5.94) within Mail::SpamAssassin::DnsResolver::BEGIN@50 which was called:
# once (33µs+5.94ms) by Mail::SpamAssassin::BEGIN@77 at line 50 # spent 5.98ms making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@50
# spent 5.94ms making 1 call to Exporter::import |
51 | 2 | 72µs | 2 | 303µs | # spent 165µs (28+138) within Mail::SpamAssassin::DnsResolver::BEGIN@51 which was called:
# once (28µs+138µs) by Mail::SpamAssassin::BEGIN@77 at line 51 # spent 165µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@51
# spent 138µs making 1 call to Exporter::import |
52 | 2 | 116µs | 2 | 772µs | # spent 399µs (26+373) within Mail::SpamAssassin::DnsResolver::BEGIN@52 which was called:
# once (26µs+373µs) by Mail::SpamAssassin::BEGIN@77 at line 52 # spent 399µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@52
# spent 373µs making 1 call to Time::HiRes::import |
53 | |||||
54 | 1 | 10µs | our @ISA = qw(); | ||
55 | |||||
56 | 2 | 168µs | 2 | 214µs | # spent 121µs (27+93) within Mail::SpamAssassin::DnsResolver::BEGIN@56 which was called:
# once (27µs+93µs) by Mail::SpamAssassin::BEGIN@77 at line 56 # spent 121µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@56
# spent 93µs making 1 call to vars::import |
57 | # spent 17µs within Mail::SpamAssassin::DnsResolver::BEGIN@57 which was called:
# once (17µs+0s) by Mail::SpamAssassin::BEGIN@77 at line 65 | ||||
58 | 2 | 20µs | if (eval { require IO::Socket::IP }) { | ||
59 | 1 | 2µ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 | } | ||||
65 | 1 | 8.98ms | 1 | 17µs | } # spent 17µs making 1 call to Mail::SpamAssassin::DnsResolver::BEGIN@57 |
66 | |||||
67 | ########################################################################### | ||||
68 | |||||
69 | # spent 6.69ms (38µs+6.65) within Mail::SpamAssassin::DnsResolver::new which was called:
# once (38µs+6.65ms) by Mail::SpamAssassin::init at line 1796 of Mail/SpamAssassin.pm | ||||
70 | 1 | 2µs | my $class = shift; | ||
71 | 1 | 2µs | $class = ref($class) || $class; | ||
72 | |||||
73 | 1 | 2µs | my ($main) = @_; | ||
74 | my $self = { | ||||
75 | 'main' => $main, | ||||
76 | 'conf' => $main->{conf}, | ||||
77 | 1 | 8µs | 'id_to_callback' => { }, | ||
78 | }; | ||||
79 | 1 | 3µs | bless ($self, $class); | ||
80 | |||||
81 | 1 | 9µs | 1 | 6.65ms | $self->load_resolver(); # spent 6.65ms making 1 call to Mail::SpamAssassin::DnsResolver::load_resolver |
82 | 1 | 10µs | $self; | ||
83 | } | ||||
84 | |||||
85 | ########################################################################### | ||||
86 | |||||
87 | =item $res->load_resolver() | ||||
88 | |||||
89 | Load the C<Net::DNS::Resolver> object. Returns 0 if Net::DNS cannot be used, | ||||
90 | 1 if it is available. | ||||
91 | |||||
92 | =cut | ||||
93 | |||||
94 | # spent 17.3ms (1.11+16.2) within Mail::SpamAssassin::DnsResolver::load_resolver which was called 2 times, avg 8.65ms/call:
# once (410µs+10.2ms) by Mail::SpamAssassin::PerMsgStatus::load_resolver at line 444 of Mail/SpamAssassin/Dns.pm
# once (697µs+5.96ms) by Mail::SpamAssassin::DnsResolver::new at line 81 | ||||
95 | 2 | 4µs | my ($self) = @_; | ||
96 | |||||
97 | 2 | 9µs | if ($self->{res}) { return 1; } | ||
98 | 2 | 7µs | $self->{no_resolver} = 1; | ||
99 | |||||
100 | # force only ipv4 if no IO::Socket::INET6 or ipv6 doesn't work | ||||
101 | 2 | 7µs | my $force_ipv4 = $self->{main}->{force_ipv4}; | ||
102 | 2 | 6µs | my $force_ipv6 = $self->{main}->{force_ipv6}; | ||
103 | |||||
104 | 2 | 7µ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 | } | ||||
109 | 2 | 12µs | if (!$force_ipv4) { # test drive IPv6 | ||
110 | eval { | ||||
111 | 2 | 4µs | my $sock6; | ||
112 | 2 | 8µs | if ($io_socket_module_name) { | ||
113 | 2 | 28µs | 2 | 3.00ms | $sock6 = $io_socket_module_name->new(LocalAddr=>'::', Proto=>'udp'); # spent 3.00ms making 2 calls to IO::Socket::IP::new, avg 1.50ms/call |
114 | } | ||||
115 | 2 | 4µs | if ($sock6) { $sock6->close() or warn "error closing socket: $!" } | ||
116 | 2 | 4µs | $sock6; | ||
117 | 2 | 16µs | } or do { | ||
118 | 2 | 17µs | 2 | 16µ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); | ||||
120 | 2 | 4µs | die "Use of IPv6 requested, but not available\n" if $force_ipv6; | ||
121 | 4 | 9µs | $force_ipv4 = 1; $force_ipv6 = 0; | ||
122 | } | ||||
123 | } | ||||
124 | |||||
125 | eval { | ||||
126 | 2 | 7µ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 | ||||
130 | 2 | 50µs | 2 | 2.67ms | my $res = $self->{res} = Net::DNS::Resolver->new(force_v4 => $force_ipv4); # spent 2.67ms making 2 calls to Net::DNS::Resolver::Base::new, avg 1.33ms/call |
131 | 2 | 15µs | if ($res) { | ||
132 | 2 | 6µs | $self->{no_resolver} = 0; | ||
133 | 2 | 6µs | $self->{force_ipv4} = $force_ipv4; | ||
134 | 2 | 5µs | $self->{force_ipv6} = $force_ipv6; | ||
135 | 2 | 7µs | $self->{retry} = 1; # retries for non-backgrounded query | ||
136 | 2 | 5µs | $self->{retrans} = 3; # initial timeout for "non-backgrounded" | ||
137 | # query run in background | ||||
138 | |||||
139 | 2 | 32µs | 2 | 74µs | $res->retry(1); # If it fails, it fails # spent 57µs making 1 call to Net::DNS::Resolver::Base::AUTOLOAD
# spent 17µs making 1 call to Net::DNS::Resolver::Base::__ANON__[Net/DNS/Resolver/Base.pm:1130] |
140 | 2 | 20µs | 2 | 50µs | $res->retrans(0); # If it fails, it fails # spent 37µ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] |
141 | 2 | 24µs | 2 | 65µs | $res->dnsrch(0); # ignore domain search-list # spent 46µs making 1 call to Net::DNS::Resolver::Base::AUTOLOAD
# spent 19µs making 1 call to Net::DNS::Resolver::Base::__ANON__[Net/DNS/Resolver/Base.pm:1130] |
142 | 2 | 23µs | 2 | 80µs | $res->defnames(0); # don't append stuff to end of query # spent 52µs making 1 call to Net::DNS::Resolver::Base::AUTOLOAD
# spent 28µs making 1 call to Net::DNS::Resolver::Base::__ANON__[Net/DNS/Resolver/Base.pm:1130] |
143 | 2 | 22µs | 2 | 56µs | $res->tcp_timeout(3); # timeout of 3 seconds only # spent 45µ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] |
144 | 2 | 20µs | 2 | 60µs | $res->udp_timeout(3); # timeout of 3 seconds only # spent 49µ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] |
145 | 2 | 25µs | 2 | 65µs | $res->persistent_tcp(0); # bug 3997 # spent 53µ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] |
146 | 2 | 22µs | 2 | 66µs | $res->persistent_udp(0); # bug 3997 # spent 52µs making 1 call to Net::DNS::Resolver::Base::AUTOLOAD
# spent 15µ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 | ||||
149 | 2 | 11µs | my $edns = $self->{conf}->{dns_options}->{edns}; | ||
150 | 2 | 10µs | if ($edns && $edns > 512) { | ||
151 | 2 | 22µs | 2 | 66µs | $res->udppacketsize($edns); # spent 66µs making 2 calls to Net::DNS::Resolver::Base::udppacketsize, avg 33µs/call |
152 | 2 | 14µs | 2 | 14µs | dbg("dns: EDNS, UDP payload size %d", $edns); # spent 14µs making 2 calls to Mail::SpamAssassin::Logger::dbg, avg 7µ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 | ||||
157 | 2 | 23µs | 2 | 9.05ms | my @ns_addr_port = $self->available_nameservers(); # spent 9.05ms making 2 calls to Mail::SpamAssassin::DnsResolver::available_nameservers, avg 4.52ms/call |
158 | 2 | 8µs | local($1,$2); | ||
159 | # drop port numbers, Net::DNS::Resolver can't take them | ||||
160 | 2 | 60µs | 4 | 19µs | @ns_addr_port = map(/^\[(.*)\]:(\d+)\z/ ? $1 : $_, @ns_addr_port); # spent 19µs making 4 calls to Mail::SpamAssassin::DnsResolver::CORE:match, avg 5µs/call |
161 | 2 | 18µs | 2 | 14µs | dbg("dns: nameservers set to %s", join(', ', @ns_addr_port)); # spent 14µs making 2 calls to Mail::SpamAssassin::Logger::dbg, avg 7µs/call |
162 | 2 | 22µs | 2 | 633µs | $res->nameservers(@ns_addr_port); # spent 633µs making 2 calls to Net::DNS::Resolver::Base::nameservers, avg 316µs/call |
163 | } | ||||
164 | 2 | 5µs | 1; | ||
165 | 2 | 9µ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' : | ||||
174 | 2 | 91µs | 4 | 55µs | $self->{force_ipv6} ? ', forced IPv6' : ''); # spent 42µs making 2 calls to version::_VERSION, avg 21µ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", | ||||
176 | 2 | 15µs | 2 | 11µs | $self->{no_resolver} ? "no" : "yes" ); # spent 11µs making 2 calls to Mail::SpamAssassin::Logger::dbg, avg 6µs/call |
177 | 2 | 22µs | if (!$self->{no_resolver} && defined $Net::DNS::VERSION) { | ||
178 | 2 | 13µs | 2 | 11µ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 | |||||
181 | 2 | 23µs | return (!$self->{no_resolver}); | ||
182 | } | ||||
183 | |||||
184 | =item $resolver = $res->get_resolver() | ||||
185 | |||||
186 | Return the C<Net::DNS::Resolver> object. | ||||
187 | |||||
188 | =cut | ||||
189 | |||||
190 | sub get_resolver { | ||||
191 | my ($self) = @_; | ||||
192 | return $self->{res}; | ||||
193 | } | ||||
194 | |||||
195 | =item $res->configured_nameservers() | ||||
196 | |||||
197 | Get a list of nameservers as configured by dns_server directives | ||||
198 | or as provided by Net::DNS, typically from /etc/resolv.conf | ||||
199 | |||||
200 | =cut | ||||
201 | |||||
202 | # spent 246µs (115+131) within Mail::SpamAssassin::DnsResolver::configured_nameservers which was called:
# once (115µs+131µs) by Mail::SpamAssassin::DnsResolver::available_nameservers at line 236 | ||||
203 | 1 | 2µs | my $self = shift; | ||
204 | |||||
205 | 1 | 3µs | my $res = $self->{res}; | ||
206 | 1 | 2µs | my @ns_addr_port; # list of name servers: [addr]:port entries | ||
207 | 1 | 5µ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 | ||||
212 | 1 | 25µs | 2 | 60µs | : @{$res->{nameservers}}; # spent 54µs making 1 call to Net::DNS::Resolver::Base::nameservers
# spent 6µs making 1 call to UNIVERSAL::can |
213 | 1 | 20µs | 1 | 6µs | my $port = $res->UNIVERSAL::can('port') ? $res->port : $res->{port}; # spent 6µs making 1 call to UNIVERSAL::can |
214 | 1 | 24µs | 2 | 58µs | @ns_addr_port = map(untaint_var("[$_]:" . $port), @ns); # spent 58µs making 2 calls to Mail::SpamAssassin::Util::untaint_var, avg 29µs/call |
215 | 1 | 10µs | 1 | 7µ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 | } | ||||
217 | 1 | 11µs | return @ns_addr_port; | ||
218 | } | ||||
219 | |||||
220 | =item $res->available_nameservers() | ||||
221 | |||||
222 | Get or set a list of currently available nameservers, | ||||
223 | which is typically a known-to-be-good subset of configured nameservers | ||||
224 | |||||
225 | =cut | ||||
226 | |||||
227 | # spent 397ms (326+70.9) within Mail::SpamAssassin::DnsResolver::available_nameservers which was called 1971 times, avg 201µs/call:
# 1968 times (317ms+70.4ms) by Mail::SpamAssassin::DnsResolver::bgsend at line 694, avg 197µs/call
# 2 times (8.61ms+442µs) by Mail::SpamAssassin::DnsResolver::load_resolver at line 157, avg 4.52ms/call
# once (120µs+21µs) by Mail::SpamAssassin::DnsResolver::connect_sock at line 371 | ||||
228 | 1971 | 3.75ms | my $self = shift; | ||
229 | |||||
230 | 1971 | 6.48ms | 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 | ||||
236 | 1 | 12µs | 1 | 246µs | $self->{available_dns_servers} = [ $self->configured_nameservers() ]; # spent 246µs making 1 call to Mail::SpamAssassin::DnsResolver::configured_nameservers |
237 | } | ||||
238 | 1971 | 7.65ms | if ($self->{force_ipv4} || $self->{force_ipv6}) { | ||
239 | # filter the list according to a chosen protocol family | ||||
240 | 1971 | 3.83ms | my $ip4_re = IPV4_ADDRESS; | ||
241 | 1971 | 3.36ms | my(@filtered_addr_port); | ||
242 | 3942 | 16.4ms | for (@{$self->{available_dns_servers}}) { | ||
243 | 3942 | 18.6ms | local($1,$2); | ||
244 | 3942 | 93.7ms | 3942 | 24.4ms | /^ \[ (.*) \] : (\d+) \z/xs or next; # spent 24.4ms making 3942 calls to Mail::SpamAssassin::DnsResolver::CORE:match, avg 6µs/call |
245 | 3942 | 15.0ms | my($addr,$port) = ($1,$2); | ||
246 | 3942 | 148ms | 7884 | 46.2ms | if ($addr =~ /^${ip4_re}\z/o) { # spent 39.0ms making 3942 calls to Mail::SpamAssassin::DnsResolver::CORE:match, avg 10µs/call
# spent 7.20ms making 3942 calls to Mail::SpamAssassin::DnsResolver::CORE:regcomp, avg 2µs/call |
247 | 3942 | 19.5ms | 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 | } | ||||
254 | 3942 | 12.4ms | 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 | } | ||||
258 | 3942 | 18.4ms | @{$self->{available_dns_servers}} = @filtered_addr_port; | ||
259 | } | ||||
260 | die "available_nameservers: No DNS servers available!\n" | ||||
261 | 3942 | 10.6ms | if !@{$self->{available_dns_servers}}; | ||
262 | 3942 | 25.8ms | return @{$self->{available_dns_servers}}; | ||
263 | } | ||||
264 | |||||
265 | sub 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 53.7ms (53.7+10µs) within Mail::SpamAssassin::DnsResolver::pick_random_available_port which was called:
# once (53.7ms+10µs) by Mail::SpamAssassin::DnsResolver::connect_sock at line 400 | ||||
282 | 1 | 2µs | my $self = shift; | ||
283 | 1 | 2µs | my $port_number; # resulting port number, or undef if none available | ||
284 | |||||
285 | 1 | 3µs | my $conf = $self->{conf}; | ||
286 | 1 | 4µs | my $available_portscount = $conf->{dns_available_portscount}; | ||
287 | |||||
288 | # initialize when called for the first time or after a config change | ||||
289 | 1 | 4µs | if (!defined $available_portscount) { | ||
290 | 1 | 4µs | my $ports_bitset = $conf->{dns_available_ports_bitset}; | ||
291 | 1 | 2µ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 | ||||
298 | 1 | 28µs | my @bucket_counts = (0) x 256; | ||
299 | 1 | 3µs | my $all_zeroes = "\000" x 32; # one bucket's worth (256) of zeroes | ||
300 | 1 | 3µs | my $all_ones = "\377" x 32; # one bucket's worth (256) of ones | ||
301 | 1 | 2µs | my $ind = 0; | ||
302 | 1 | 2µs | $available_portscount = 0; # number of all available ports | ||
303 | 1 | 7µs | foreach my $bucket (0..255) { | ||
304 | 256 | 416µs | my $cnt = 0; | ||
305 | 256 | 1.53ms | my $b = substr($ports_bitset, $bucket*32, 32); # one bucket: 256 bits | ||
306 | 299 | 966µs | if ($b eq $all_zeroes) { $ind += 256 } | ||
307 | 234 | 391µs | elsif ($b eq $all_ones) { $ind += 256; $cnt += 256 } | ||
308 | else { # count nontrivial cases the slow way | ||||
309 | 96 | 45.8ms | vec($ports_bitset, $ind++, 1) && $cnt++ for 0..255; | ||
310 | } | ||||
311 | 256 | 421µs | $available_portscount += $cnt; | ||
312 | 256 | 895µs | $bucket_counts[$bucket] = $cnt; | ||
313 | } | ||||
314 | 1 | 4µs | $conf->{dns_available_portscount} = $available_portscount; | ||
315 | 1 | 8µs | if ($available_portscount) { | ||
316 | 1 | 7µ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 | ||||
324 | 1 | 10µs | 1 | 10µs | dbg("dns: %d configured local ports for DNS queries", $available_portscount); # spent 10µs making 1 call to Mail::SpamAssassin::Logger::dbg |
325 | 1 | 4µs | if ($available_portscount > 0) { | ||
326 | 1 | 3µs | my $ports_bitset = $conf->{dns_available_ports_bitset}; | ||
327 | 1 | 7µs | my $n = int(rand($available_portscount)); | ||
328 | 1 | 2µs | my $bucket_counts_ref = $conf->{dns_available_portscount_buckets}; | ||
329 | 1 | 2µs | my $ind = 0; | ||
330 | 1 | 3µs | foreach my $bucket (0..255) { | ||
331 | # find the bucket containing n-th turned-on bit | ||||
332 | 244 | 421µs | my $cnt = $bucket_counts_ref->[$bucket]; | ||
333 | 731 | 1.94ms | if ($cnt > $n) { last } else { $n -= $cnt; $ind += 256 } | ||
334 | } | ||||
335 | 1 | 2µs | while ($ind <= 65535) { # scans one bucket, runs at most 256 iterations | ||
336 | # find the n-th turned-on bit within the corresponding bucket | ||||
337 | 69 | 227µs | if (vec($ports_bitset, $ind, 1)) { | ||
338 | 139 | 340µs | if ($n <= 0) { $port_number = $ind; last } else { $n-- } | ||
339 | } | ||||
340 | 68 | 210µs | $ind++; | ||
341 | } | ||||
342 | } | ||||
343 | 1 | 14µs | return $port_number; | ||
344 | } | ||||
345 | |||||
346 | =item $res->connect_sock() | ||||
347 | |||||
348 | Re-connect to the first nameserver listed in C</etc/resolv.conf> or similar | ||||
349 | platform-dependent source, as provided by C<Net::DNS>. | ||||
350 | |||||
351 | =cut | ||||
352 | |||||
353 | # spent 55.7ms (253µs+55.5) within Mail::SpamAssassin::DnsResolver::connect_sock which was called:
# once (253µs+55.5ms) by Mail::SpamAssassin::DnsResolver::connect_sock_if_reqd at line 475 | ||||
354 | 1 | 2µs | my ($self) = @_; | ||
355 | |||||
356 | 1 | 8µs | 1 | 5µs | dbg("dns: connect_sock, resolver: %s", $self->{no_resolver} ? "no" : "yes"); # spent 5µs making 1 call to Mail::SpamAssassin::Logger::dbg |
357 | 1 | 2µs | return if $self->{no_resolver}; | ||
358 | |||||
359 | 1 | 2µs | $io_socket_module_name | ||
360 | or die "No Perl modules for network socket available"; | ||||
361 | |||||
362 | 1 | 2µ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 | } | ||||
367 | 1 | 2µs | my $sock; | ||
368 | my $errno; | ||||
369 | |||||
370 | # list of name servers: [addr]:port entries | ||||
371 | 1 | 9µs | 1 | 141µs | my @ns_addr_port = $self->available_nameservers(); # spent 141µs making 1 call to Mail::SpamAssassin::DnsResolver::available_nameservers |
372 | # use the first name server in a list | ||||
373 | 2 | 5µs | my($ns_addr,$ns_port); local($1,$2); | ||
374 | 1 | 16µs | 1 | 5µs | ($ns_addr,$ns_port) = ($1,$2) if $ns_addr_port[0] =~ /^\[(.*)\]:(\d+)\z/; # spent 5µ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. | ||||
381 | 1 | 2µs | my $ip4_re = IPV4_ADDRESS; | ||
382 | 1 | 2µs | my $srcaddr; | ||
383 | 1 | 4µs | if ($self->{force_ipv4}) { | ||
384 | 1 | 3µ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 | ||||
396 | 1 | 2µs | my $lport; | ||
397 | 1 | 2µs | my $attempts = 0; | ||
398 | 1 | 2µs | for (;;) { | ||
399 | 1 | 2µs | $attempts++; | ||
400 | 1 | 14µs | 1 | 53.7ms | $lport = $self->pick_random_available_port(); # spent 53.7ms making 1 call to Mail::SpamAssassin::DnsResolver::pick_random_available_port |
401 | 1 | 2µs | if (!defined $lport) { | ||
402 | $lport = 0; | ||||
403 | dbg("no configured local ports for DNS queries, letting OS choose"); | ||||
404 | } | ||||
405 | 1 | 3µ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 | } | ||||
410 | 1 | 8µs | 1 | 8µs | dbg("dns: LocalAddr: [%s]:%d, name server: [%s]:%d, module %s", # spent 8µs making 1 call to Mail::SpamAssassin::Logger::dbg |
411 | $srcaddr||'x', $lport, $ns_addr, $ns_port, $io_socket_module_name); | ||||
412 | 1 | 12µ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 | ); | ||||
420 | 1 | 18µs | 1 | 1.47ms | $sock = $io_socket_module_name->new(%args); # spent 1.47ms making 1 call to IO::Socket::IP::new |
421 | |||||
422 | 1 | 4µ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 | } | ||||
438 | 1 | 2µs | if (!$sock) { | ||
439 | warn "could not create a DNS resolver socket in $attempts attempts: $errno"; | ||||
440 | goto no_sock; | ||||
441 | } | ||||
442 | |||||
443 | eval { | ||||
444 | 1 | 2µs | my($bufsiz,$newbufsiz); | ||
445 | 1 | 15µs | 1 | 90µs | $bufsiz = $sock->sockopt(Socket::SO_RCVBUF) # spent 90µs making 1 call to IO::Socket::sockopt |
446 | or die "cannot get a resolver socket rx buffer size: $!"; | ||||
447 | 1 | 11µs | if ($bufsiz >= 32*1024) { | ||
448 | 1 | 12µs | 1 | 11µs | dbg("dns: resolver socket rx buffer size is %d bytes, local port %d", # spent 11µ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 | } | ||||
458 | 1 | 5µs | 1; | ||
459 | 1 | 4µs | } or do { | ||
460 | my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat; | ||||
461 | info("dns: socket buffer size error: $eval_stat"); | ||||
462 | }; | ||||
463 | |||||
464 | 1 | 4µs | $self->{sock} = $sock; | ||
465 | 1 | 16µs | 1 | 41µs | $self->{sock_as_vec} = $self->fhs_to_vec($self->{sock}); # spent 41µs making 1 call to Mail::SpamAssassin::DnsResolver::fhs_to_vec |
466 | 1 | 14µs | return; | ||
467 | |||||
468 | no_sock: | ||||
469 | undef $self->{sock}; | ||||
470 | undef $self->{sock_as_vec}; | ||||
471 | } | ||||
472 | |||||
473 | # spent 71.1ms (15.3+55.7) within Mail::SpamAssassin::DnsResolver::connect_sock_if_reqd which was called 1968 times, avg 36µs/call:
# 1968 times (15.3ms+55.7ms) by Mail::SpamAssassin::DnsResolver::bgsend at line 702, avg 36µs/call | ||||
474 | 1968 | 3.96ms | my ($self) = @_; | ||
475 | 1968 | 18.9ms | 1 | 55.7ms | $self->connect_sock() if !$self->{sock}; # spent 55.7ms making 1 call to Mail::SpamAssassin::DnsResolver::connect_sock |
476 | } | ||||
477 | |||||
478 | =item $res->get_sock() | ||||
479 | |||||
480 | Return the C<IO::Socket::INET> object used to communicate with | ||||
481 | the nameserver. | ||||
482 | |||||
483 | =cut | ||||
484 | |||||
485 | sub 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 | |||||
495 | A wrapper for C<Net::DNS::Packet::new()> which traps a die thrown by it. | ||||
496 | |||||
497 | To use this, change calls to C<Net::DNS::Resolver::bgsend> from: | ||||
498 | |||||
499 | $res->bgsend($domain, $type); | ||||
500 | |||||
501 | to: | ||||
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 | # | ||||
509 | sub 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.74s (376ms+1.36) within Mail::SpamAssassin::DnsResolver::new_dns_packet which was called 1968 times, avg 885µs/call:
# 1968 times (376ms+1.36s) by Mail::SpamAssassin::DnsResolver::bgsend at line 691, avg 885µs/call | ||||
531 | 1968 | 15.5ms | my ($self, $domain, $type, $class) = @_; | ||
532 | |||||
533 | 1968 | 4.07ms | return if $self->{no_resolver}; | ||
534 | |||||
535 | # construct a PTR query if it looks like an IPv4 address | ||||
536 | 1968 | 4.98ms | 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 | } | ||||
543 | 1968 | 3.42ms | $type = 'A' if !defined $type; # a Net::DNS::Packet default | ||
544 | 1968 | 4.53ms | $class = 'IN' if !defined $class; # a Net::DNS::Packet default | ||
545 | |||||
546 | 1968 | 3.39ms | my $packet; | ||
547 | eval { | ||||
548 | |||||
549 | 1968 | 28.6ms | 1968 | 10.7ms | if (utf8::is_utf8($domain)) { # since Perl 5.8.1 # spent 10.7ms 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 | |||||
553 | 1968 | 53.6ms | 1968 | 27.4ms | $domain =~ s/\.*\z/./s; # spent 27.4ms making 1968 calls to Mail::SpamAssassin::DnsResolver::CORE:subst, avg 14µs/call |
554 | 1968 | 51.6ms | 1968 | 22.3ms | if (length($domain) > 255) { # spent 22.3ms making 1968 calls to Mail::SpamAssassin::DnsResolver::CORE:match, avg 11µ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 | |||||
564 | 1968 | 9.45ms | if ($self->{conf}->{dns_options}->{dns0x20}) { | ||
565 | $domain = dnsext_dns0x20($domain); | ||||
566 | } else { | ||||
567 | 1968 | 8.24ms | $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. | ||||
574 | 1968 | 56.1ms | 1968 | 7.26ms | $domain =~ s{ ( [\000-\037\177-\377\\] ) } # spent 7.26ms making 1968 calls to Mail::SpamAssassin::DnsResolver::CORE:subst, avg 4µs/call |
575 | { $1 eq '\\' ? "\\$1" : sprintf("\\%03d",ord($1)) }xgse; | ||||
576 | |||||
577 | 1968 | 17.0ms | 1968 | 703ms | $packet = Net::DNS::Packet->new($domain, $type, $class); # spent 703ms making 1968 calls to Net::DNS::Packet::new, avg 357µ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); | ||||
582 | 1968 | 5.19ms | 1; | ||
583 | 1968 | 8.35ms | } 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 | |||||
594 | 1968 | 7.23ms | if ($packet) { | ||
595 | # RD flag needs to be set explicitly since Net::DNS 1.01, Bug 7223 | ||||
596 | 1968 | 25.0ms | 3936 | 115ms | $packet->header->rd(1); # spent 98.9ms making 1968 calls to Net::DNS::Header::rd, avg 50µs/call
# spent 15.8ms making 1968 calls to Net::DNS::Packet::header, avg 8µs/call |
597 | |||||
598 | # my $udp_payload_size = $self->{res}->udppacketsize; | ||||
599 | 1968 | 5.69ms | my $udp_payload_size = $self->{conf}->{dns_options}->{edns}; | ||
600 | 1968 | 7.61ms | if ($udp_payload_size && $udp_payload_size > 512) { | ||
601 | # dbg("dns: adding EDNS ext, UDP payload size %d", $udp_payload_size); | ||||
602 | 1968 | 40.8ms | 1968 | 9.17ms | if ($packet->UNIVERSAL::can('edns')) { # available since Net::DNS 0.69 # spent 9.17ms making 1968 calls to UNIVERSAL::can, avg 5µs/call |
603 | 1968 | 23.9ms | 3936 | 470ms | $packet->edns->size($udp_payload_size); # spent 435ms making 1968 calls to Net::DNS::Packet::edns, avg 221µs/call
# spent 35.1ms making 1968 calls to Net::DNS::RR::OPT::size, avg 18µ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 | |||||
612 | 1968 | 19.1ms | 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 793ms (179+614) within Mail::SpamAssassin::DnsResolver::_packet_id which was called 1968 times, avg 403µs/call:
# 1968 times (179ms+614ms) by Mail::SpamAssassin::DnsResolver::bgsend at line 720, avg 403µs/call | ||||
621 | 1968 | 4.33ms | my ($self, $packet) = @_; | ||
622 | 1968 | 13.6ms | 1968 | 17.5ms | my $header = $packet->header; # spent 17.5ms making 1968 calls to Net::DNS::Packet::header, avg 9µs/call |
623 | 1968 | 14.4ms | 1968 | 21.4ms | my $id = $header->id; # spent 21.4ms making 1968 calls to Net::DNS::Header::id, avg 11µs/call |
624 | 1968 | 14.8ms | 1968 | 22.5ms | my @questions = $packet->question; # spent 22.5ms making 1968 calls to Net::DNS::Packet::question, avg 11µs/call |
625 | |||||
626 | 1968 | 4.18ms | @questions <= 1 | ||
627 | or warn "dns: packet has multiple questions: " . $packet->string . "\n"; | ||||
628 | |||||
629 | 1968 | 3.88ms | 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 | # | ||||
640 | 1968 | 19.7ms | 1968 | 552ms | my($class,$type,$qname) = decode_dns_question_entry($questions[0]); # spent 552ms making 1968 calls to Mail::SpamAssassin::Util::decode_dns_question_entry, avg 281µs/call |
641 | 1968 | 12.9ms | $qname =~ tr/A-Z/a-z/ if !$self->{conf}->{dns_options}->{dns0x20}; | ||
642 | 1968 | 40.5ms | 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 | |||||
662 | Quite similar to C<Net::DNS::Resolver::bgsend>, except that when a reply | ||||
663 | packet eventually arrives, and C<poll_responses> is called, the callback | ||||
664 | sub reference C<$cb> will be called. | ||||
665 | |||||
666 | Note that C<$type> and C<$class> may be C<undef>, in which case they | ||||
667 | will default to C<A> and C<IN>, respectively. | ||||
668 | |||||
669 | The callback sub will be called with three arguments -- the packet that was | ||||
670 | delivered, and an id string that fingerprints the query packet and the expected | ||||
671 | reply. The third argument is a timestamp (Unix time, floating point), captured | ||||
672 | at the time the packet was collected. It is expected that a closure callback | ||||
673 | be 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 | |||||
680 | The callback can ignore the reply as an invalid packet sent to the listening | ||||
681 | port if the reply id does not match the return value from bgsend. | ||||
682 | |||||
683 | =cut | ||||
684 | |||||
685 | # spent 5.06s (379ms+4.68) within Mail::SpamAssassin::DnsResolver::bgsend which was called 1968 times, avg 2.57ms/call:
# 1968 times (379ms+4.68s) by Mail::SpamAssassin::AsyncLoop::bgsend_and_start_lookup at line 354 of Mail/SpamAssassin/AsyncLoop.pm, avg 2.57ms/call | ||||
686 | 1968 | 13.3ms | my ($self, $domain, $type, $class, $cb) = @_; | ||
687 | 1968 | 4.57ms | return if $self->{no_resolver}; | ||
688 | |||||
689 | 1968 | 4.07ms | $self->{send_timed_out} = 0; | ||
690 | |||||
691 | 1968 | 17.1ms | 1968 | 1.74s | my $pkt = $self->new_dns_packet($domain, $type, $class); # spent 1.74s making 1968 calls to Mail::SpamAssassin::DnsResolver::new_dns_packet, avg 885µs/call |
692 | 1968 | 3.55ms | return if !$pkt; # just bail out, new_dns_packet already reported a failure | ||
693 | |||||
694 | 1968 | 18.8ms | 1968 | 388ms | my @ns_addr_port = $self->available_nameservers(); # spent 388ms making 1968 calls to Mail::SpamAssassin::DnsResolver::available_nameservers, avg 197µs/call |
695 | 1968 | 17.0ms | 1968 | 14.6ms | dbg("dns: bgsend, DNS servers: %s", join(', ',@ns_addr_port)); # spent 14.6ms making 1968 calls to Mail::SpamAssassin::Logger::dbg, avg 7µs/call |
696 | 1968 | 4.26ms | my $n_servers = scalar @ns_addr_port; | ||
697 | |||||
698 | 1968 | 3.41ms | my $ok; | ||
699 | 1968 | 8.71ms | for (my $attempts=1; $attempts <= $n_servers; $attempts++) { | ||
700 | 1968 | 13.5ms | 1968 | 12.5ms | dbg("dns: attempt %d/%d, trying connect/sendto to %s", # spent 12.5ms making 1968 calls to Mail::SpamAssassin::Logger::dbg, avg 6µs/call |
701 | $attempts, $n_servers, $ns_addr_port[0]); | ||||
702 | 1968 | 13.7ms | 1968 | 71.1ms | $self->connect_sock_if_reqd(); # spent 71.1ms making 1968 calls to Mail::SpamAssassin::DnsResolver::connect_sock_if_reqd, avg 36µs/call |
703 | 1968 | 29.1ms | 3936 | 1.64s | if ($self->{sock} && defined($self->{sock}->send($pkt->data, 0))) { # spent 1.44s making 1968 calls to Net::DNS::Packet::data, avg 734µs/call
# spent 196ms making 1968 calls to IO::Socket::send, avg 100µs/call |
704 | 3936 | 13.2ms | $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 | } | ||||
719 | 1968 | 3.29ms | return if !$ok; | ||
720 | 1968 | 28.6ms | 1968 | 793ms | my $id = $self->_packet_id($pkt); # spent 793ms making 1968 calls to Mail::SpamAssassin::DnsResolver::_packet_id, avg 403µs/call |
721 | 1968 | 19.2ms | 1968 | 16.8ms | dbg("dns: providing a callback for id: $id"); # spent 16.8ms making 1968 calls to Mail::SpamAssassin::Logger::dbg, avg 9µs/call |
722 | 1968 | 21.1ms | $self->{id_to_callback}->{$id} = $cb; | ||
723 | 1968 | 32.0ms | return $id; | ||
724 | } | ||||
725 | |||||
726 | ########################################################################### | ||||
727 | |||||
728 | =item $id = $res->bgread() | ||||
729 | |||||
730 | Similar to C<Net::DNS::Resolver::bgread>. Reads a DNS packet from | ||||
731 | a supplied socket, decodes it, and returns a Net::DNS::Packet object | ||||
732 | if successful. Dies on error. | ||||
733 | |||||
734 | =cut | ||||
735 | |||||
736 | sub 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 | |||||
761 | See if there are any C<bgsend> reply packets ready, and return | ||||
762 | the number of such packets delivered to their callbacks. | ||||
763 | |||||
764 | =cut | ||||
765 | |||||
766 | sub 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 | |||||
890 | Call this to release pending requests from memory, when aborting backgrounded | ||||
891 | requests, or when the scan is complete. | ||||
892 | C<Mail::SpamAssassin::PerMsgStatus::check> calls this before returning. | ||||
893 | |||||
894 | =cut | ||||
895 | |||||
896 | sub bgabort { | ||||
897 | my ($self) = @_; | ||||
898 | $self->{id_to_callback} = {}; | ||||
899 | } | ||||
900 | |||||
901 | ########################################################################### | ||||
902 | |||||
903 | =item $packet = $res->send($name, $type, $class) | ||||
904 | |||||
905 | Emulates C<Net::DNS::Resolver::send()>. | ||||
906 | |||||
907 | This subroutine is a simple synchronous leftover from SpamAssassin version | ||||
908 | 3.3 and does not participate in packet query caching and callback grouping | ||||
909 | as implemented by AsyncLoop::bgsend_and_start_lookup(). As such it should | ||||
910 | be avoided for mainstream usage. | ||||
911 | |||||
912 | =cut | ||||
913 | |||||
914 | sub 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 | |||||
960 | Little more than a stub for callers expecting this from C<Net::DNS::Resolver>. | ||||
961 | |||||
962 | If called immediately after a call to $res->send this will return | ||||
963 | C<query timed out> if the $res->send DNS query timed out. Otherwise | ||||
964 | C<unknown error or no error> will be returned. | ||||
965 | |||||
966 | No other errors are reported. | ||||
967 | |||||
968 | =cut | ||||
969 | |||||
970 | sub 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 | |||||
980 | Reset socket when done with it. | ||||
981 | |||||
982 | =cut | ||||
983 | |||||
984 | sub 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 | |||||
997 | Clean up for destruction. | ||||
998 | |||||
999 | =cut | ||||
1000 | |||||
1001 | sub 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 41µs within Mail::SpamAssassin::DnsResolver::fhs_to_vec which was called:
# once (41µs+0s) by Mail::SpamAssassin::DnsResolver::connect_sock at line 465 | ||||
1012 | 1 | 3µs | my ($self, @fhlist) = @_; | ||
1013 | 1 | 3µs | my $rin = ''; | ||
1014 | 1 | 5µs | foreach my $sock (@fhlist) { | ||
1015 | 1 | 3µs | my $fno = fileno($sock); | ||
1016 | 1 | 12µs | if (!defined $fno) { | ||
1017 | warn "dns: oops! fileno now undef for $sock"; | ||||
1018 | } else { | ||||
1019 | 1 | 7µs | vec ($rin, $fno, 1) = 1; | ||
1020 | } | ||||
1021 | } | ||||
1022 | 1 | 11µs | return $rin; | ||
1023 | } | ||||
1024 | |||||
1025 | # call Mail::SA::init() instead | ||||
1026 | sub 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 | |||||
1032 | 1 | 10µs | 1; | ||
1033 | |||||
1034 | =back | ||||
1035 | |||||
1036 | =cut | ||||
# spent 85.7ms within Mail::SpamAssassin::DnsResolver::CORE:match which was called 9857 times, avg 9µs/call:
# 3942 times (39.0ms+0s) by Mail::SpamAssassin::DnsResolver::available_nameservers at line 246, avg 10µs/call
# 3942 times (24.4ms+0s) by Mail::SpamAssassin::DnsResolver::available_nameservers at line 244, avg 6µs/call
# 1968 times (22.3ms+0s) by Mail::SpamAssassin::DnsResolver::new_dns_packet at line 554, avg 11µs/call
# 4 times (19µs+0s) by Mail::SpamAssassin::DnsResolver::load_resolver at line 160, avg 5µs/call
# once (5µs+0s) by Mail::SpamAssassin::DnsResolver::connect_sock at line 374 | |||||
# spent 7.20ms within Mail::SpamAssassin::DnsResolver::CORE:regcomp which was called 3942 times, avg 2µs/call:
# 3942 times (7.20ms+0s) by Mail::SpamAssassin::DnsResolver::available_nameservers at line 246, avg 2µs/call | |||||
# spent 34.7ms within Mail::SpamAssassin::DnsResolver::CORE:subst which was called 3936 times, avg 9µs/call:
# 1968 times (27.4ms+0s) by Mail::SpamAssassin::DnsResolver::new_dns_packet at line 553, avg 14µs/call
# 1968 times (7.26ms+0s) by Mail::SpamAssassin::DnsResolver::new_dns_packet at line 574, avg 4µs/call |