← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 02:36:06 2017
Reported on Sun Nov 5 02:56:19 2017

Filename/usr/local/lib/perl5/site_perl/Net/DNS/Resolver/Base.pm
StatementsExecuted 530 statements in 19.4ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1117.56ms57.6msNet::DNS::Resolver::Base::::BEGIN@56Net::DNS::Resolver::Base::BEGIN@56
1116.24ms15.8msNet::DNS::Resolver::Base::::BEGIN@57Net::DNS::Resolver::Base::BEGIN@57
1115.73ms7.22msNet::DNS::Resolver::Base::::BEGIN@33Net::DNS::Resolver::Base::BEGIN@33
1112.94ms4.02msNet::DNS::Resolver::Base::::BEGIN@53Net::DNS::Resolver::Base::BEGIN@53
1111.91ms2.82msNet::DNS::Resolver::Base::::BEGIN@46Net::DNS::Resolver::Base::BEGIN@46
5221.06ms1.32msNet::DNS::Resolver::Base::::_untaintNet::DNS::Resolver::Base::_untaint (recurses: max depth 1, inclusive time 92µs)
432434µs872µsNet::DNS::Resolver::Base::::nameserversNet::DNS::Resolver::Base::nameservers
9881390µs390µsNet::DNS::Resolver::Base::::CORE:matchNet::DNS::Resolver::Base::CORE:match (opcode)
881322µs382µsNet::DNS::Resolver::Base::::AUTOLOADNet::DNS::Resolver::Base::AUTOLOAD
111255µs711µsNet::DNS::Resolver::Base::::_read_config_fileNet::DNS::Resolver::Base::_read_config_file
211253µs2.49msNet::DNS::Resolver::Base::::newNet::DNS::Resolver::Base::new
1221247µs337µsNet::DNS::Resolver::Base::::_ipv4Net::DNS::Resolver::Base::_ipv4
1692237µs237µsNet::DNS::Resolver::Base::::__ANON__[:1130]Net::DNS::Resolver::Base::__ANON__[:1130]
111218µs26.5msNet::DNS::Resolver::Base::::BEGIN@29Net::DNS::Resolver::Base::BEGIN@29
111170µs6.37msNet::DNS::Resolver::Base::::BEGIN@40Net::DNS::Resolver::Base::BEGIN@40
61189µs102µsNet::DNS::Resolver::Base::::_ipv6Net::DNS::Resolver::Base::_ipv6
122181µs81µsNet::DNS::Resolver::Base::::CORE:substNet::DNS::Resolver::Base::CORE:subst (opcode)
52176µs76µsNet::DNS::Resolver::Base::::CORE:readlineNet::DNS::Resolver::Base::CORE:readline (opcode)
11158µs255µsNet::DNS::Resolver::Base::::BEGIN@45Net::DNS::Resolver::Base::BEGIN@45
11154µs242µsNet::DNS::Resolver::Base::::BEGIN@31Net::DNS::Resolver::Base::BEGIN@31
11147µs47µsNet::DNS::Resolver::Base::::CORE:openNet::DNS::Resolver::Base::CORE:open (opcode)
11145µs50µsNet::DNS::Resolver::Base::::searchlistNet::DNS::Resolver::Base::searchlist
21145µs64µsNet::DNS::Resolver::Base::::udppacketsizeNet::DNS::Resolver::Base::udppacketsize
21144µs44µsNet::DNS::Resolver::Base::::force_v4Net::DNS::Resolver::Base::force_v4
11137µs47µsNet::DNS::Resolver::Base::::BEGIN@481Net::DNS::Resolver::Base::BEGIN@481
11132µs236µsNet::DNS::Resolver::Base::::BEGIN@44Net::DNS::Resolver::Base::BEGIN@44
11132µs47µsNet::DNS::Resolver::Base::::BEGIN@49Net::DNS::Resolver::Base::BEGIN@49
11132µs47µsNet::DNS::Resolver::Base::::BEGIN@544Net::DNS::Resolver::Base::BEGIN@544
11130µs90µsNet::DNS::Resolver::Base::::BEGIN@1124Net::DNS::Resolver::Base::BEGIN@1124
11130µs80µsNet::DNS::Resolver::Base::::domainNet::DNS::Resolver::Base::domain
54228µs28µsNet::DNS::Resolver::Base::::_defaultsNet::DNS::Resolver::Base::_defaults
11127µs218µsNet::DNS::Resolver::Base::::BEGIN@52Net::DNS::Resolver::Base::BEGIN@52
11126µs303µsNet::DNS::Resolver::Base::::BEGIN@59Net::DNS::Resolver::Base::BEGIN@59
11126µs26µsNet::DNS::Resolver::Base::::_read_envNet::DNS::Resolver::Base::_read_env
11125µs32µsNet::DNS::Resolver::Base::::BEGIN@51Net::DNS::Resolver::Base::BEGIN@51
11122µs50µsNet::DNS::Resolver::Base::::BEGIN@50Net::DNS::Resolver::Base::BEGIN@50
11122µs219µsNet::DNS::Resolver::Base::::BEGIN@36Net::DNS::Resolver::Base::BEGIN@36
11122µs6.80msNet::DNS::Resolver::Base::::BEGIN@54Net::DNS::Resolver::Base::BEGIN@54
11122µs220µsNet::DNS::Resolver::Base::::BEGIN@35Net::DNS::Resolver::Base::BEGIN@35
21120µs20µsNet::DNS::Resolver::Base::::_packetszNet::DNS::Resolver::Base::_packetsz
1119µs9µsNet::DNS::Resolver::Base::::CORE:closeNet::DNS::Resolver::Base::CORE:close (opcode)
0000s0sNet::DNS::Resolver::Base::::DESTROYNet::DNS::Resolver::Base::DESTROY
0000s0sNet::DNS::Resolver::Base::::__ANON__[:725]Net::DNS::Resolver::Base::__ANON__[:725]
0000s0sNet::DNS::Resolver::Base::::_accept_replyNet::DNS::Resolver::Base::_accept_reply
0000s0sNet::DNS::Resolver::Base::::_axfr_nextNet::DNS::Resolver::Base::_axfr_next
0000s0sNet::DNS::Resolver::Base::::_axfr_startNet::DNS::Resolver::Base::_axfr_start
0000s0sNet::DNS::Resolver::Base::::_bgreadNet::DNS::Resolver::Base::_bgread
0000s0sNet::DNS::Resolver::Base::::_bgsend_tcpNet::DNS::Resolver::Base::_bgsend_tcp
0000s0sNet::DNS::Resolver::Base::::_bgsend_udpNet::DNS::Resolver::Base::_bgsend_udp
0000s0sNet::DNS::Resolver::Base::::_cname_addrNet::DNS::Resolver::Base::_cname_addr
0000s0sNet::DNS::Resolver::Base::::_create_dst_sockaddrNet::DNS::Resolver::Base::_create_dst_sockaddr
0000s0sNet::DNS::Resolver::Base::::_create_tcp_socketNet::DNS::Resolver::Base::_create_tcp_socket
0000s0sNet::DNS::Resolver::Base::::_create_udp_socketNet::DNS::Resolver::Base::_create_udp_socket
0000s0sNet::DNS::Resolver::Base::::_diagNet::DNS::Resolver::Base::_diag
0000s0sNet::DNS::Resolver::Base::::_make_query_packetNet::DNS::Resolver::Base::_make_query_packet
0000s0sNet::DNS::Resolver::Base::::_optionNet::DNS::Resolver::Base::_option
0000s0sNet::DNS::Resolver::Base::::_read_tcpNet::DNS::Resolver::Base::_read_tcp
0000s0sNet::DNS::Resolver::Base::::_read_udpNet::DNS::Resolver::Base::_read_udp
0000s0sNet::DNS::Resolver::Base::::_reset_errorstringNet::DNS::Resolver::Base::_reset_errorstring
0000s0sNet::DNS::Resolver::Base::::_send_tcpNet::DNS::Resolver::Base::_send_tcp
0000s0sNet::DNS::Resolver::Base::::_send_udpNet::DNS::Resolver::Base::_send_udp
0000s0sNet::DNS::Resolver::Base::::answerfromNet::DNS::Resolver::Base::answerfrom
0000s0sNet::DNS::Resolver::Base::::axfrNet::DNS::Resolver::Base::axfr
0000s0sNet::DNS::Resolver::Base::::axfr_nextNet::DNS::Resolver::Base::axfr_next
0000s0sNet::DNS::Resolver::Base::::axfr_startNet::DNS::Resolver::Base::axfr_start
0000s0sNet::DNS::Resolver::Base::::bgbusyNet::DNS::Resolver::Base::bgbusy
0000s0sNet::DNS::Resolver::Base::::bgisreadyNet::DNS::Resolver::Base::bgisready
0000s0sNet::DNS::Resolver::Base::::bgreadNet::DNS::Resolver::Base::bgread
0000s0sNet::DNS::Resolver::Base::::bgsendNet::DNS::Resolver::Base::bgsend
0000s0sNet::DNS::Resolver::Base::::dnssecNet::DNS::Resolver::Base::dnssec
0000s0sNet::DNS::Resolver::Base::::errorstringNet::DNS::Resolver::Base::errorstring
0000s0sNet::DNS::Resolver::Base::::force_v6Net::DNS::Resolver::Base::force_v6
0000s0sNet::DNS::Resolver::Base::::make_query_packetNet::DNS::Resolver::Base::make_query_packet
0000s0sNet::DNS::Resolver::Base::::nameserverNet::DNS::Resolver::Base::nameserver
0000s0sNet::DNS::Resolver::Base::::prefer_v4Net::DNS::Resolver::Base::prefer_v4
0000s0sNet::DNS::Resolver::Base::::prefer_v6Net::DNS::Resolver::Base::prefer_v6
0000s0sNet::DNS::Resolver::Base::::printNet::DNS::Resolver::Base::print
0000s0sNet::DNS::Resolver::Base::::queryNet::DNS::Resolver::Base::query
0000s0sNet::DNS::Resolver::Base::::searchNet::DNS::Resolver::Base::search
0000s0sNet::DNS::Resolver::Base::::sendNet::DNS::Resolver::Base::send
0000s0sNet::DNS::Resolver::Base::::srcaddrNet::DNS::Resolver::Base::srcaddr
0000s0sNet::DNS::Resolver::Base::::stringNet::DNS::Resolver::Base::string
0000s0sNet::DNS::Resolver::Base::::tsigNet::DNS::Resolver::Base::tsig
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Net::DNS::Resolver::Base;
2
3#
4# $Id: Base.pm 1595 2017-09-12 09:10:56Z willem $
5#
613µsour $VERSION = (qw$LastChangedRevision: 1595 $)[1];
7
8
9#
10# Implementation notes wrt IPv6 support when using perl before 5.20.0.
11#
12# In general we try to be gracious to those stacks that do not have IPv6 support.
13# The socket code is conditionally compiled depending upon the availability of
14# IO::Socket::IP or the deprecated IO::Socket::INET6 package.
15#
16# We have chosen not to use mapped IPv4 addresses, there seem to be issues
17# with this; as a result we use separate sockets for each family type.
18#
19# inet_pton is not available on WIN32, so we only use the getaddrinfo
20# call to translate IP addresses to socketaddress.
21#
22# The configuration options force_v4, force_v6, prefer_v4 and prefer_v6
23# are provided to control IPv6 behaviour for test purposes.
24#
25# Olaf Kolkman, RIPE NCC, December 2003.
26# [Revised March 2016]
27
28
292173µs226.7ms
# spent 26.5ms (218µs+26.3) within Net::DNS::Resolver::Base::BEGIN@29 which was called: # once (218µs+26.3ms) by base::import at line 29
use constant USE_SOCKET_IP => defined eval 'use Socket 1.97; use IO::Socket::IP 0.32; 1;';
# spent 26.5ms making 1 call to Net::DNS::Resolver::Base::BEGIN@29 # spent 192µs making 1 call to constant::import
# spent 446µs executing statements in string eval
# includes 9.34ms spent executing 2 calls to 2 subs defined therein.
30
312118µs2430µs
# spent 242µs (54+188) within Net::DNS::Resolver::Base::BEGIN@31 which was called: # once (54µs+188µs) by base::import at line 31
use constant USE_SOCKET_INET => defined eval 'require IO::Socket::INET';
# spent 242µs making 1 call to Net::DNS::Resolver::Base::BEGIN@31 # spent 188µs making 1 call to constant::import
# spent 7µs executing statements in string eval
32
332133µs27.43ms
# spent 7.22ms (5.73+1.49) within Net::DNS::Resolver::Base::BEGIN@33 which was called: # once (5.73ms+1.49ms) by base::import at line 33
use constant USE_SOCKET_INET6 => defined eval 'require IO::Socket::INET6';
# spent 7.22ms making 1 call to Net::DNS::Resolver::Base::BEGIN@33 # spent 215µs making 1 call to constant::import
# spent 247µs executing statements in string eval
34
35278µs2417µs
# spent 220µs (22+198) within Net::DNS::Resolver::Base::BEGIN@35 which was called: # once (22µs+198µs) by base::import at line 35
use constant IPv4 => USE_SOCKET_IP || USE_SOCKET_INET;
# spent 220µs making 1 call to Net::DNS::Resolver::Base::BEGIN@35 # spent 198µs making 1 call to constant::import
36278µs2415µs
# spent 219µs (22+196) within Net::DNS::Resolver::Base::BEGIN@36 which was called: # once (22µs+196µs) by base::import at line 36
use constant IPv6 => USE_SOCKET_IP || USE_SOCKET_INET6;
# spent 219µs making 1 call to Net::DNS::Resolver::Base::BEGIN@36 # spent 196µs making 1 call to constant::import
37
38
39# If SOCKSified Perl, use TCP instead of UDP and keep the socket open.
402226µs26.55ms
# spent 6.37ms (170µs+6.20) within Net::DNS::Resolver::Base::BEGIN@40 which was called: # once (170µs+6.20ms) by base::import at line 40
use constant SOCKS => scalar eval 'require Config; $Config::Config{usesocks}';
# spent 6.37ms making 1 call to Net::DNS::Resolver::Base::BEGIN@40 # spent 184µs making 1 call to constant::import
# spent 25µs executing statements in string eval
41
42
43# Allow taint tests to be optimised away when appropriate.
44288µs2439µs
# spent 236µs (32+204) within Net::DNS::Resolver::Base::BEGIN@44 which was called: # once (32µs+204µs) by base::import at line 44
use constant UNCND => $] < 5.008; ## eval '${^TAINT}' breaks old compilers
# spent 236µs making 1 call to Net::DNS::Resolver::Base::BEGIN@44 # spent 204µs making 1 call to constant::import
452116µs2452µs
# spent 255µs (58+197) within Net::DNS::Resolver::Base::BEGIN@45 which was called: # once (58µs+197µs) by base::import at line 45
use constant TAINT => UNCND || eval '${^TAINT}';
# spent 255µs making 1 call to Net::DNS::Resolver::Base::BEGIN@45 # spent 197µs making 1 call to constant::import
# spent 8µs executing statements in string eval
462149µs23.04ms
# spent 2.82ms (1.91+915µs) within Net::DNS::Resolver::Base::BEGIN@46 which was called: # once (1.91ms+915µs) by base::import at line 46
use constant TESTS => TAINT && defined eval 'require Scalar::Util';
# spent 2.82ms making 1 call to Net::DNS::Resolver::Base::BEGIN@46 # spent 213µs making 1 call to constant::import
# spent 279µs executing statements in string eval
47
48
49288µs262µs
# spent 47µs (32+15) within Net::DNS::Resolver::Base::BEGIN@49 which was called: # once (32µs+15µs) by base::import at line 49
use strict;
# spent 47µs making 1 call to Net::DNS::Resolver::Base::BEGIN@49 # spent 15µs making 1 call to strict::import
50276µs278µs
# spent 50µs (22+28) within Net::DNS::Resolver::Base::BEGIN@50 which was called: # once (22µs+28µs) by base::import at line 50
use warnings;
# spent 50µs making 1 call to Net::DNS::Resolver::Base::BEGIN@50 # spent 28µs making 1 call to warnings::import
51265µs240µs
# spent 32µs (25+8) within Net::DNS::Resolver::Base::BEGIN@51 which was called: # once (25µs+8µs) by base::import at line 51
use integer;
# spent 32µs making 1 call to Net::DNS::Resolver::Base::BEGIN@51 # spent 8µs making 1 call to integer::import
52283µs2408µs
# spent 218µs (27+191) within Net::DNS::Resolver::Base::BEGIN@52 which was called: # once (27µs+191µs) by base::import at line 52
use Carp;
# spent 218µs making 1 call to Net::DNS::Resolver::Base::BEGIN@52 # spent 191µs making 1 call to Exporter::import
532342µs24.12ms
# spent 4.02ms (2.94+1.07) within Net::DNS::Resolver::Base::BEGIN@53 which was called: # once (2.94ms+1.07ms) by base::import at line 53
use IO::Select;
# spent 4.02ms making 1 call to Net::DNS::Resolver::Base::BEGIN@53 # spent 100µs making 1 call to Exporter::import
54280µs213.6ms
# spent 6.80ms (22µs+6.78) within Net::DNS::Resolver::Base::BEGIN@54 which was called: # once (22µs+6.78ms) by base::import at line 54
use IO::Socket;
# spent 6.80ms making 1 call to Net::DNS::Resolver::Base::BEGIN@54 # spent 6.78ms making 1 call to IO::Socket::import
55
562362µs157.6ms
# spent 57.6ms (7.56+50.0) within Net::DNS::Resolver::Base::BEGIN@56 which was called: # once (7.56ms+50.0ms) by base::import at line 56
use Net::DNS::RR;
# spent 57.6ms making 1 call to Net::DNS::Resolver::Base::BEGIN@56
572355µs115.8ms
# spent 15.8ms (6.24+9.61) within Net::DNS::Resolver::Base::BEGIN@57 which was called: # once (6.24ms+9.61ms) by base::import at line 57
use Net::DNS::Packet;
# spent 15.8ms making 1 call to Net::DNS::Resolver::Base::BEGIN@57
58
5925.13ms2580µs
# spent 303µs (26+277) within Net::DNS::Resolver::Base::BEGIN@59 which was called: # once (26µs+277µs) by base::import at line 59
use constant PACKETSZ => 512;
# spent 303µs making 1 call to Net::DNS::Resolver::Base::BEGIN@59 # spent 277µs making 1 call to constant::import
60
61
62#
63# Set up a closure to be our class data.
64#
65{
66122µs my $defaults = bless {
67 nameservers => [qw(::1 127.0.0.1)],
68 nameserver4 => ['127.0.0.1'],
69 nameserver6 => ['::1'],
70 port => 53,
71 srcaddr4 => '0.0.0.0',
72 srcaddr6 => '::',
73 srcport => 0,
74 searchlist => [],
75 retrans => 5,
76 retry => 4,
77 usevc => ( SOCKS ? 1 : 0 ),
78 igntc => 0,
79 recurse => 1,
80 defnames => 1,
81 dnsrch => 1,
82 ndots => 1,
83 debug => 0,
84 tcp_timeout => 120,
85 udp_timeout => 30,
86 persistent_tcp => ( SOCKS ? 1 : 0 ),
87 persistent_udp => 0,
88 dnssec => 0,
89 adflag => 0, # see RFC6840, 5.7
90 cdflag => 0, # see RFC6840, 5.9
91 udppacketsize => 0, # value bounded below by PACKETSZ
92 force_v4 => ( IPv6 ? 0 : 1 ),
93 force_v6 => 0, # only relevant if IPv6 is supported
94 prefer_v4 => 0,
95 prefer_v6 => 0,
96 },
97 __PACKAGE__;
98
99
100556µs
# spent 28µs within Net::DNS::Resolver::Base::_defaults which was called 5 times, avg 6µs/call: # 2 times (12µs+0s) by Net::DNS::Resolver::Base::new at line 117, avg 6µs/call # once (8µs+0s) by base::import at line 106 # once (5µs+0s) by Net::DNS::Resolver::Base::searchlist at line 267 # once (4µs+0s) by Net::DNS::Resolver::UNIX::_init at line 36 of Net/DNS/Resolver/UNIX.pm
sub _defaults { return $defaults; }
101}
102
103
104# These are the attributes that the user may specify in the new() constructor.
10514µsmy %public_attr = (
106285µs18µs map( ( $_ => $_ ), keys %{&_defaults}, qw(domain nameserver srcaddr) ),
# spent 8µs making 1 call to Net::DNS::Resolver::Base::_defaults
107 map( ( $_ => 0 ), qw(nameserver4 nameserver6 srcaddr4 srcaddr6) ),
108 );
109
110
11117µsmy $initial;
112
113
# spent 2.49ms (253µs+2.24) within Net::DNS::Resolver::Base::new which was called 2 times, avg 1.25ms/call: # 2 times (253µs+2.24ms) by Mail::SpamAssassin::DnsResolver::load_resolver at line 130 of Mail/SpamAssassin/DnsResolver.pm, avg 1.25ms/call
sub new {
11429µs my ( $class, %args ) = @_;
115
11623µs my $self;
117222µs212µs my $base = $class->_defaults;
# spent 12µs making 2 calls to Net::DNS::Resolver::Base::_defaults, avg 6µs/call
11825µs my $init = $initial;
119228µs $initial ||= [%$base];
120213µs if ( my $file = $args{config_file} ) {
121 my $conf = bless {@$initial}, $class;
122 $conf->_read_config_file($file); # user specified config
123 $self = bless {_untaint(%$conf)}, $class;
124 %$base = %$self unless $init; # define default configuration
125
126 } elsif ($init) {
127138µs $self = bless {%$base}, $class;
128
129 } else {
130112µs12.18ms $class->_init(); # define default configuration
# spent 2.18ms making 1 call to Net::DNS::Resolver::UNIX::_init
131126µs $self = bless {%$base}, $class;
132 }
133
134227µs while ( my ( $attr, $value ) = each %args ) {
13526µs next unless $public_attr{$attr};
13625µs my $ref = ref($value);
13724µs croak "usage: $class->new( $attr => [...] )"
138 if $ref && ( $ref ne 'ARRAY' );
139225µs244µs $self->$attr( $ref ? @$value : $value );
# spent 44µs making 2 calls to Net::DNS::Resolver::Base::force_v4, avg 22µs/call
140 }
141
142218µs return $self;
143}
144
145
14614µsmy %resolv_conf = ( ## map traditional resolv.conf option names
147 attempts => 'retry',
148 inet6 => 'prefer_v6',
149 timeout => 'retrans',
150 );
151
152128µsmy %res_option = ( ## any resolver attribute plus those listed above
153 %public_attr,
154 %resolv_conf,
155 );
156
157sub _option {
158 my ( $self, $name, @value ) = @_;
159 my $attribute = $res_option{lc $name} || return;
160 push @value, 1 unless scalar @value;
161 $self->$attribute(@value);
162}
163
164
165
# spent 1.32ms (1.06+260µs) within Net::DNS::Resolver::Base::_untaint which was called 5 times, avg 263µs/call: # 4 times (80µs+-80µs) by Net::DNS::Resolver::Base::_untaint at line 166, avg 0s/call # once (976µs+340µs) by Net::DNS::Resolver::UNIX::_init at line 40 of Net/DNS/Resolver/UNIX.pm
sub _untaint {
1661211.32ms62260µs return TAINT ? map ref($_) ? [_untaint(@$_)] : do { /^(.*)$/; $1 }, @_ : @_;
# spent 260µs making 58 calls to Net::DNS::Resolver::Base::CORE:match, avg 4µs/call # spent 92µs making 4 calls to Net::DNS::Resolver::Base::_untaint, avg 23µs/call, recursion: max depth 1, sum of overlapping time 92µs
167}
168
169
170
# spent 26µs within Net::DNS::Resolver::Base::_read_env which was called: # once (26µs+0s) by Net::DNS::Resolver::UNIX::_init at line 44 of Net/DNS/Resolver/UNIX.pm
sub _read_env { ## read resolver config environment variables
17113µs my $self = shift;
172
17314µs $self->nameservers( map split, $ENV{RES_NAMESERVERS} ) if defined $ENV{RES_NAMESERVERS};
174
17513µs $self->domain( $ENV{LOCALDOMAIN} ) if defined $ENV{LOCALDOMAIN};
176
17713µs $self->searchlist( map split, $ENV{RES_SEARCHLIST} ) if defined $ENV{RES_SEARCHLIST};
178
179116µs foreach ( map split, $ENV{RES_OPTIONS} || '' ) {
180 $self->_option( split m/:/ );
181 }
182}
183
184
185
# spent 711µs (255+456) within Net::DNS::Resolver::Base::_read_config_file which was called: # once (255µs+456µs) by Net::DNS::Resolver::UNIX::_init at line 38 of Net/DNS/Resolver/UNIX.pm
sub _read_config_file { ## read resolver config file
18612µs my $self = shift;
18712µs my $file = shift;
188
18914µs local *FILE;
190161µs147µs open( FILE, $file ) or croak "$file: $!";
# spent 47µs making 1 call to Net::DNS::Resolver::Base::CORE:open
191
19212µs my @nameserver;
193 my @searchlist;
194
19512µs local $_;
196198µs365µs while (<FILE>) {
# spent 65µs making 3 calls to Net::DNS::Resolver::Base::CORE:readline, avg 22µs/call
197447µs421µs s/[;#].*$//; # strip comments
# spent 21µs making 4 calls to Net::DNS::Resolver::Base::CORE:subst, avg 5µs/call
198
199443µs416µs /^nameserver/ && do {
# spent 16µs making 4 calls to Net::DNS::Resolver::Base::CORE:match, avg 4µs/call
200222µs my ( $keyword, @ip ) = grep defined, split;
20125µs push @nameserver, @ip;
20226µs next;
203 };
204
205217µs24µs /^domain/ && do {
# spent 4µs making 2 calls to Net::DNS::Resolver::Base::CORE:match, avg 2µs/call
206 my ( $keyword, $domain ) = grep defined, split;
207 $self->domain($domain);
208 next;
209 };
210
211216µs24µs /^search/ && do {
# spent 4µs making 2 calls to Net::DNS::Resolver::Base::CORE:match, avg 2µs/call
212 my ( $keyword, @domain ) = grep defined, split;
213 push @searchlist, @domain;
214 next;
215 };
216
217244µs415µs /^option/ && do {
# spent 11µs making 2 calls to Net::DNS::Resolver::Base::CORE:readline, avg 6µs/call # spent 4µs making 2 calls to Net::DNS::Resolver::Base::CORE:match, avg 2µs/call
218 my ( $keyword, @option ) = grep defined, split;
219 foreach (@option) {
220 $self->_option( split m/:/ );
221 }
222 };
223 }
224
225129µs19µs close(FILE);
# spent 9µs making 1 call to Net::DNS::Resolver::Base::CORE:close
226
227110µs1276µs $self->nameservers(@nameserver) if @nameserver;
# spent 276µs making 1 call to Net::DNS::Resolver::Base::nameservers
228113µs $self->searchlist(@searchlist) if @searchlist;
229}
230
231
232sub string {
233 my $self = shift;
234 $self = $self->_defaults unless ref($self);
235
236 my @nslist = $self->nameservers();
237 my ($force) = ( grep( $self->{$_}, qw(force_v6 force_v4) ), 'force_v4' );
238 my ($prefer) = ( grep( $self->{$_}, qw(prefer_v6 prefer_v4) ), 'prefer_v4' );
239 return <<END;
240;; RESOLVER state:
241;; nameservers = @nslist
242;; searchlist = @{$self->{searchlist}}
243;; defnames = $self->{defnames} dnsrch = $self->{dnsrch}
244;; igntc = $self->{igntc} usevc = $self->{usevc}
245;; recurse = $self->{recurse} port = $self->{port}
246;; retrans = $self->{retrans} retry = $self->{retry}
247;; tcp_timeout = $self->{tcp_timeout} persistent_tcp = $self->{persistent_tcp}
248;; udp_timeout = $self->{udp_timeout} persistent_udp = $self->{persistent_udp}
249;; ${prefer} = $self->{$prefer} ${force} = $self->{$force}
250;; debug = $self->{debug} ndots = $self->{ndots}
251END
252}
253
254
255sub print { print &string; }
256
257
258
# spent 80µs (30+50) within Net::DNS::Resolver::Base::domain which was called: # once (30µs+50µs) by base::import at line 32 of Net/DNS/Resolver/UNIX.pm
sub domain {
25914µs my $self = shift;
260110µs150µs my ($head) = $self->searchlist(@_);
# spent 50µs making 1 call to Net::DNS::Resolver::Base::searchlist
26113µs my @list = grep defined, $head;
262121µs wantarray ? @list : "@list";
263}
264
265
# spent 50µs (45+5) within Net::DNS::Resolver::Base::searchlist which was called: # once (45µs+5µs) by Net::DNS::Resolver::Base::domain at line 260
sub searchlist {
26612µs my $self = shift;
267111µs15µs $self = $self->_defaults unless ref($self);
# spent 5µs making 1 call to Net::DNS::Resolver::Base::_defaults
268
26912µs return $self->{searchlist} = [@_] unless defined wantarray;
27012µs $self->{searchlist} = [@_] if scalar @_;
271223µs my @searchlist = @{$self->{searchlist}};
272}
273
274
275
# spent 872µs (434+438) within Net::DNS::Resolver::Base::nameservers which was called 4 times, avg 218µs/call: # 2 times (248µs+301µs) by Mail::SpamAssassin::DnsResolver::load_resolver at line 162 of Mail/SpamAssassin/DnsResolver.pm, avg 275µs/call # once (139µs+137µs) by Net::DNS::Resolver::Base::_read_config_file at line 227 # once (47µs+0s) by Mail::SpamAssassin::DnsResolver::configured_nameservers at line 212 of Mail/SpamAssassin/DnsResolver.pm
sub nameservers {
27648µs my $self = shift;
27749µs $self = $self->_defaults unless ref($self);
278
27947µs my @ip;
280421µs foreach my $ns ( grep defined, @_ ) {
281661µs6190µs if ( _ipv4($ns) || _ipv6($ns) ) {
# spent 190µs making 6 calls to Net::DNS::Resolver::Base::_ipv4, avg 32µs/call
282617µs push @ip, $ns;
283
284 } else {
285 my $defres = ref($self)->new( debug => $self->{debug} );
286 $defres->{persistent} = $self->{persistent};
287
288 my $names = {};
289 my $packet = $defres->search( $ns, 'A' );
290 my @iplist = _cname_addr( $packet, $names );
291
292 if (IPv6) {
293 $packet = $defres->search( $ns, 'AAAA' );
294 push @iplist, _cname_addr( $packet, $names );
295 }
296
297 my %unique = map( ( $_ => $_ ), @iplist );
298
299 my @address = values(%unique); # tainted
300 carp "unresolvable name: $ns" unless scalar @address;
301
302 push @ip, @address;
303 }
304 }
305
306415µs if ( scalar(@_) || !defined(wantarray) ) {
307346µs6147µs my @ipv4 = grep _ipv4($_), @ip;
# spent 147µs making 6 calls to Net::DNS::Resolver::Base::_ipv4, avg 24µs/call
308353µs6102µs my @ipv6 = grep _ipv6($_), @ip;
# spent 102µs making 6 calls to Net::DNS::Resolver::Base::_ipv6, avg 17µs/call
30939µs $self->{nameservers} = \@ip;
31038µs $self->{nameserver4} = \@ipv4;
31138µs $self->{nameserver6} = \@ipv6;
312 }
313
314831µs my @ns4 = $self->{force_v6} ? () : @{$self->{nameserver4}};
315524µs my @ns6 = $self->{force_v4} ? () : @{$self->{nameserver6}};
316827µs my @nameservers = @{$self->{nameservers}};
317417µs @nameservers = ( @ns4, @ns6 ) if $self->{prefer_v4} || !scalar(@ns6);
318410µs @nameservers = ( @ns6, @ns4 ) if $self->{prefer_v6} || !scalar(@ns4);
319
320457µs return @nameservers if scalar @nameservers;
321
322 my $error = 'no nameservers';
323 $error = 'IPv4 transport disabled' if scalar(@ns4) < scalar @{$self->{nameserver4}};
324 $error = 'IPv6 transport disabled' if scalar(@ns6) < scalar @{$self->{nameserver6}};
325 $self->errorstring($error);
326 return @nameservers;
327}
328
329sub nameserver { &nameservers; } # uncoverable pod
330
331sub _cname_addr {
332
333 # TODO 20081217
334 # This code does not follow CNAME chains, it only looks inside the packet.
335 # Out of bailiwick will fail.
336 my @null;
337 my $packet = shift || return @null;
338 my $names = shift;
339
340 map $names->{lc( $_->qname )}++, $packet->question;
341 map $names->{lc( $_->cname )}++, grep $_->can('cname'), $packet->answer;
342
343 my @addr = grep $_->can('address'), $packet->answer;
344 map $_->address, grep $names->{lc( $_->name )}, @addr;
345}
346
347
348sub answerfrom {
349 my $self = shift;
350 $self->{answerfrom} = shift if scalar @_;
351 return $self->{answerfrom};
352}
353
354sub _reset_errorstring {
355 shift->{errorstring} = '';
356}
357
358sub errorstring {
359 my $self = shift;
360 my $text = shift || return $self->{errorstring};
361 $self->_diag( 'errorstring:', $text );
362 return $self->{errorstring} = $text;
363}
364
365
366sub query {
367 my $self = shift;
368 my $name = shift || '.';
369
370 my @sfix;
371
372 if ( $self->{defnames} && ( ( $name =~ tr/././ ) < $self->{ndots} ) ) {
373 @sfix = $self->domain unless $name =~ m/:|\.\d*$/;
374 }
375
376 my $fqdn = join '.', $name, @sfix;
377 $self->_diag( 'query(', $fqdn, @_, ')' );
378 my $packet = $self->send( $fqdn, @_ ) || return;
379 return $packet->header->ancount ? $packet : undef;
380}
381
382
383sub search {
384 my $self = shift;
385
386 return $self->query(@_) unless $self->{dnsrch};
387
388 my $name = shift || '.';
389
390 my @sfix = ( $name =~ m/:|\.\d*$/ ) ? () : @{$self->{searchlist}};
391 my ( $domain, @etc ) = ( $name =~ tr/././ ) < $self->{ndots} ? (@sfix) : ( undef, @sfix );
392
393 foreach my $suffix ( $domain, @etc ) {
394 my $fqname = $suffix ? join( '.', $name, $suffix ) : $name;
395 $self->_diag( 'search(', $fqname, @_, ')' );
396 my $packet = $self->send( $fqname, @_ ) || next;
397 return $packet->header->ancount ? $packet : next;
398 }
399
400 return undef;
401}
402
403
404sub send {
405 my $self = shift;
406 my $packet = $self->_make_query_packet(@_);
407 my $packet_data = $packet->data;
408
409 return $self->_send_tcp( $packet, $packet_data )
410 if $self->{usevc} || length $packet_data > $self->_packetsz;
411
412 my $ans = $self->_send_udp( $packet, $packet_data ) || return;
413
414 return $ans if $self->{igntc};
415 return $ans unless $ans->header->tc;
416
417 $self->_diag('packet truncated: retrying using TCP');
418 $self->_send_tcp( $packet, $packet_data );
419}
420
421
422sub _send_tcp {
423 my ( $self, $query, $query_data ) = @_;
424
425 $self->_reset_errorstring;
426
427 my $tcp_packet = pack 'n a*', length($query_data), $query_data;
428 my @ns = $self->nameservers();
429 my $lastanswer;
430 my $timeout = $self->{tcp_timeout};
431
432 foreach my $ip (@ns) {
433 my $socket = $self->_create_tcp_socket($ip) || next;
434 my $select = IO::Select->new($socket);
435
436 $self->_diag( 'tcp send', "[$ip]" );
437
438 $socket->send($tcp_packet);
439 $self->errorstring($!);
440
441 next unless $select->can_read($timeout); # uncoverable branch
442
443 my $buffer = _read_tcp($socket);
444 $self->answerfrom($ip);
445 $self->_diag( 'answer from', "[$ip]", length($buffer), 'bytes' );
446
447 my $reply = Net::DNS::Packet->decode( \$buffer, $self->{debug} );
448 $self->errorstring($@);
449 next unless $self->_accept_reply( $reply, $query );
450 $reply->answerfrom($ip);
451
452 if ( $self->{tsig_rr} && !$reply->verify($query) ) {
453 $self->errorstring( $reply->verifyerr );
454 next;
455 }
456
457 $lastanswer = $reply;
458
459 my $rcode = $reply->header->rcode;
460 $self->errorstring($rcode); # historical quirk
461 return $reply if $rcode eq 'NOERROR';
462 return $reply if $rcode eq 'NXDOMAIN';
463 }
464
465 $self->{errorstring} = $lastanswer->header->rcode if $lastanswer;
466 $self->errorstring('query timed out') unless $self->{errorstring};
467 return $lastanswer;
468}
469
470
471sub _send_udp {
472 my ( $self, $query, $query_data ) = @_;
473
474 $self->_reset_errorstring;
475
476 my @ns = $self->nameservers;
477 my $port = $self->{port};
478 my $retrans = $self->{retrans} || 1;
479 my $retry = $self->{retry} || 1;
480 my $servers = scalar(@ns);
4812624µs257µs
# spent 47µs (37+10) within Net::DNS::Resolver::Base::BEGIN@481 which was called: # once (37µs+10µs) by base::import at line 481
my $timeout = $servers ? do { no integer; $retrans / $servers } : 0;
# spent 47µs making 1 call to Net::DNS::Resolver::Base::BEGIN@481 # spent 10µs making 1 call to integer::unimport
482 my $lastanswer;
483
484 # Perform each round of retries.
485RETRY: for ( 1 .. $retry ) { # assumed to be a small number
486
487 # Try each nameserver.
488 my $select = IO::Select->new();
489
490NAMESERVER: foreach my $ns (@ns) {
491
492 # state vector replaces corresponding element of @ns array
493 unless ( ref $ns ) {
494 my $socket = $self->_create_udp_socket($ns) || next;
495 my $dst_sockaddr = $self->_create_dst_sockaddr( $ns, $port );
496 $ns = [$socket, $ns, $dst_sockaddr];
497 }
498
499 my ( $socket, $ip, $dst_sockaddr, $failed ) = @$ns;
500 next if $failed;
501
502 $self->_diag( 'udp send', "[$ip]:$port" );
503
504 $select->add($socket);
505 $socket->send( $query_data, 0, $dst_sockaddr );
506 $self->errorstring( $$ns[3] = $! );
507
508 # handle failure to detect taint inside socket->send()
509 die 'Insecure dependency while running with -T switch'
510 if TESTS && Scalar::Util::tainted($dst_sockaddr);
511
512 my $reply;
513 while ( my ($socket) = $select->can_read($timeout) ) {
514 my $peer = $socket->peerhost;
515 $self->answerfrom($peer);
516
517 my $buffer = _read_udp( $socket, $self->_packetsz );
518 $self->_diag( "answer from [$peer]", length($buffer), 'bytes' );
519
520 my $packet = Net::DNS::Packet->decode( \$buffer, $self->{debug} );
521 $self->errorstring($@);
522 next unless $self->_accept_reply( $packet, $query );
523 $reply = $packet;
524 $reply->answerfrom($peer);
525 last;
526 } #SELECT LOOP
527
528 next unless $reply;
529
530 if ( $self->{tsig_rr} && !$reply->verify($query) ) {
531 $self->errorstring( $$ns[3] = $reply->verifyerr );
532 next;
533 }
534
535 $lastanswer = $reply;
536
537 my $rcode = $reply->header->rcode;
538 $self->errorstring($rcode); # historical quirk
539 return $reply if $rcode eq 'NOERROR';
540 return $reply if $rcode eq 'NXDOMAIN';
541 $$ns[3] = $rcode;
542 } #NAMESERVER LOOP
543
54426.38ms262µs
# spent 47µs (32+15) within Net::DNS::Resolver::Base::BEGIN@544 which was called: # once (32µs+15µs) by base::import at line 544
no integer;
# spent 47µs making 1 call to Net::DNS::Resolver::Base::BEGIN@544 # spent 15µs making 1 call to integer::unimport
545 $timeout += $timeout;
546 } #RETRY LOOP
547
548 $self->{errorstring} = $lastanswer->header->rcode if $lastanswer;
549 $self->errorstring('query timed out') unless $self->{errorstring};
550 return $lastanswer;
551}
552
553
554sub bgsend {
555 my $self = shift;
556 my $packet = $self->_make_query_packet(@_);
557 my $packet_data = $packet->data;
558
559 return $self->_bgsend_tcp( $packet, $packet_data )
560 if $self->{usevc} || length $packet_data > $self->_packetsz;
561
562 return $self->_bgsend_udp( $packet, $packet_data );
563}
564
565
566sub _bgsend_tcp {
567 my ( $self, $packet, $packet_data ) = @_;
568
569 $self->_reset_errorstring;
570
571 my $tcp_packet = pack 'n a*', length($packet_data), $packet_data;
572
573 foreach my $ip ( $self->nameservers ) {
574 my $socket = $self->_create_tcp_socket($ip) || next;
575
576 $self->_diag( 'bgsend', "[$ip]" );
577
578 $socket->blocking(0);
579 $socket->send($tcp_packet);
580 $self->errorstring($!);
581
582 my $expire = time() + $self->{tcp_timeout};
583 ${*$socket}{net_dns_bg} = [$expire, $packet];
584 return $socket;
585 }
586
587 return undef;
588}
589
590
591sub _bgsend_udp {
592 my ( $self, $packet, $packet_data ) = @_;
593
594 $self->_reset_errorstring;
595
596 my $port = $self->{port};
597
598 foreach my $ip ( $self->nameservers ) {
599 my $socket = $self->_create_udp_socket($ip) || next;
600 my $dst_sockaddr = $self->_create_dst_sockaddr( $ip, $port );
601
602 $self->_diag( 'bgsend', "[$ip]:$port" );
603
604 $socket->send( $packet_data, 0, $dst_sockaddr );
605 $self->errorstring($!);
606
607 # handle failure to detect taint inside $socket->send()
608 die 'Insecure dependency while running with -T switch'
609 if TESTS && Scalar::Util::tainted($dst_sockaddr);
610
611 my $expire = time() + $self->{udp_timeout};
612 ${*$socket}{net_dns_bg} = [$expire, $packet];
613 return $socket;
614 }
615
616 return undef;
617}
618
619
620sub bgbusy {
621 my ( $self, $handle ) = @_;
622 return unless $handle;
623
624 my $appendix = ${*$handle}{net_dns_bg} ||= [time() + $self->{udp_timeout}];
625 my ( $expire, $query, $read ) = @$appendix;
626 return if ref($read);
627
628 return time() <= $expire unless IO::Select->new($handle)->can_read(0);
629
630 return if $self->{igntc};
631 return unless $handle->socktype() == SOCK_DGRAM;
632 return unless $query; # SpamAssassin 3.4.1 workaround
633
634 my $ans = $self->_bgread($handle);
635 $$appendix[2] = [$ans];
636 return unless $ans;
637 return unless $ans->header->tc;
638
639 $self->_diag('packet truncated: retrying using TCP');
640 my $tcp = $self->_bgsend_tcp( $query, $query->data ) || return;
641 return defined( $_[1] = $tcp );
642}
643
644
645sub bgisready { ## historical
646 !&bgbusy; # uncoverable pod
647}
648
649
650sub bgread {
651 while (&bgbusy) { # side effect: TCP retry
652 IO::Select->new( $_[1] )->can_read(0.02); # use 3 orders of magnitude less CPU
653 }
654 &_bgread;
655}
656
657
658sub _bgread {
659 my ( $self, $handle ) = @_;
660 return unless $handle;
661
662 my $appendix = ${*$handle}{net_dns_bg};
663 my ( $expire, $query, $read ) = @$appendix;
664 return shift(@$read) if ref($read);
665
666 unless ( IO::Select->new($handle)->can_read(0) ) {
667 $self->errorstring('timed out');
668 return;
669 }
670
671 my $peer = $handle->peerhost;
672 $self->answerfrom($peer);
673
674 my $dgram = $handle->socktype() == SOCK_DGRAM;
675 my $buffer = $dgram ? _read_udp( $handle, $self->_packetsz ) : _read_tcp($handle);
676 $self->_diag( "answer from [$peer]", length($buffer), 'bytes' );
677
678 my $reply = Net::DNS::Packet->decode( \$buffer, $self->{debug} );
679 $self->errorstring($@);
680 return unless $self->_accept_reply( $reply, $query );
681 $reply->answerfrom($peer);
682
683 return $reply unless $self->{tsig_rr} && !$reply->verify($query);
684 $self->errorstring( $reply->verifyerr );
685 return;
686}
687
688
689sub _accept_reply {
690 my ( $self, $reply, $query ) = @_;
691
692 return unless $reply;
693
694 my $header = $reply->header;
695 return unless $header->qr;
696
697 return 1 unless $query; # SpamAssassin 3.4.1 workaround
698 return $header->id == $query->header->id;
699}
700
701
702sub axfr { ## zone transfer
703 eval {
704 my $self = shift;
705
706 # initialise iterator state vector
707 my ( $select, $verify, @rr, $soa ) = $self->_axfr_start(@_);
708
709 my $iterator = sub { ## iterate over RRs
710 my $rr = shift(@rr);
711
712 if ( ref($rr) eq 'Net::DNS::RR::SOA' ) {
713 return $soa = $rr unless $soa;
714 $select = undef;
715 return if $rr->encode eq $soa->encode;
716 croak $self->errorstring('mismatched final SOA');
717 }
718
719 return $rr if scalar @rr;
720
721 my $reply;
722 ( $reply, $verify ) = $self->_axfr_next( $select, $verify );
723 @rr = $reply->answer;
724 return $rr;
725 };
726
727 return $iterator unless wantarray;
728
729 my @zone; ## subvert iterator to assemble entire zone
730 while ( my $rr = $iterator->() ) {
731 push @zone, $rr, @rr; # copy RRs en bloc
732 @rr = pop(@zone); # leave last one in @rr
733 }
734 return @zone;
735 };
736}
737
738
739sub axfr_start { ## historical
740 my $self = shift; # uncoverable pod
741 defined( $self->{axfr_iter} = $self->axfr(@_) );
742}
743
744
745sub axfr_next { ## historical
746 shift->{axfr_iter}->(); # uncoverable pod
747}
748
749
750sub _axfr_start {
751 my $self = shift;
752 my $dname = scalar(@_) ? shift : $self->domain;
753 my @class = @_;
754
755 my $request = $self->_make_query_packet( $dname, 'AXFR', @class );
756 my $content = $request->data;
757 my $TCP_msg = pack 'n a*', length($content), $content;
758
759 $self->_diag("axfr_start( $dname @class )");
760
761 my ( $select, $reply, $rcode );
762 foreach my $ns ( $self->nameservers ) {
763 my $socket = $self->_create_tcp_socket($ns) || next;
764
765 $self->_diag("axfr_start nameserver [$ns]");
766
767 $select = IO::Select->new($socket);
768 $socket->send($TCP_msg);
769 $self->errorstring($!);
770
771 ($reply) = $self->_axfr_next($select);
772 last if ( $rcode = $reply->header->rcode ) eq 'NOERROR';
773 }
774
775 croak $self->errorstring unless $reply;
776
777 $self->errorstring($rcode); # historical quirk
778
779 my $verify = $request->sigrr ? $request : undef;
780 unless ($verify) {
781 croak $self->errorstring unless $rcode eq 'NOERROR';
782 return ( $select, $verify, $reply->answer );
783 }
784
785 my $verifyok = $reply->verify($verify);
786 croak $self->errorstring( $reply->verifyerr ) unless $verifyok;
787 croak $self->errorstring unless $rcode eq 'NOERROR';
788 return ( $select, $verifyok, $reply->answer );
789}
790
791
792sub _axfr_next {
793 my $self = shift;
794 my $select = shift || return;
795 my $verify = shift;
796
797 my ($socket) = $select->can_read( $self->{tcp_timeout} );
798 croak $self->errorstring('timed out') unless $socket;
799
800 $self->answerfrom( $socket->peerhost );
801
802 my $buffer = _read_tcp($socket);
803 $self->_diag( 'received', length($buffer), 'bytes' );
804
805 my $packet = Net::DNS::Packet->new( \$buffer );
806 croak $@, $self->errorstring('corrupt packet') if $@;
807
808 return ( $packet, $verify ) unless $verify;
809
810 my $verifyok = $packet->verify($verify);
811 croak $self->errorstring( $packet->verifyerr ) unless $verifyok;
812 return ( $packet, $verifyok );
813}
814
815
816#
817# Usage: $data = _read_tcp($socket);
818#
819sub _read_tcp {
820 my $socket = shift;
821
822 my ( $s1, $s2 );
823 $socket->recv( $s1, 2 ); # one lump
824 $socket->recv( $s2, 2 - length $s1 ); # or two?
825 my $size = unpack 'n', pack( 'a*a*@2', $s1, $s2 );
826
827 my $buffer = '';
828 while ( ( my $read = length $buffer ) < $size ) {
829
830 # During some of my tests recv() returned undef even
831 # though there was no error. Checking the amount
832 # of data read appears to work around that problem.
833
834 my $recv_buf;
835 $socket->recv( $recv_buf, $size - $read );
836
837 $buffer .= $recv_buf || last;
838 }
839 return $buffer;
840}
841
842
843#
844# Usage: $data = _read_udp($socket, $length);
845#
846sub _read_udp {
847 my $socket = shift;
848 my $buffer = '';
849 $socket->recv( $buffer, shift );
850 return $buffer;
851}
852
853
854sub _create_tcp_socket {
855 my $self = shift;
856 my $ip = shift;
857
858 my $sock_key = "TCP[$ip]";
859 my $socket;
860
861 if ( $socket = $self->{persistent}{$sock_key} ) {
862 $self->_diag( 'using persistent socket', $sock_key );
863 return $socket if $socket->connected;
864 $self->_diag('socket disconnected (trying to connect)');
865 }
866
867 my $ip6_addr = IPv6 && _ipv6($ip);
868
869 $socket = IO::Socket::IP->new(
870 LocalAddr => $ip6_addr ? $self->{srcaddr6} : $self->{srcaddr4},
871 LocalPort => $self->{srcport},
872 PeerAddr => $ip,
873 PeerPort => $self->{port},
874 Proto => 'tcp',
875 Timeout => $self->{tcp_timeout},
876 )
877 if USE_SOCKET_IP;
878
879 unless (USE_SOCKET_IP) {
880 $socket = IO::Socket::INET6->new(
881 LocalAddr => $self->{srcaddr6},
882 LocalPort => $self->{srcport},
883 PeerAddr => $ip,
884 PeerPort => $self->{port},
885 Proto => 'tcp',
886 Timeout => $self->{tcp_timeout},
887 )
888 if USE_SOCKET_INET6 && $ip6_addr;
889
890 $socket = IO::Socket::INET->new(
891 LocalAddr => $self->{srcaddr4},
892 LocalPort => $self->{srcport},
893 PeerAddr => $ip,
894 PeerPort => $self->{port},
895 Proto => 'tcp',
896 Timeout => $self->{tcp_timeout},
897 )
898 unless $ip6_addr;
899 }
900
901 $self->errorstring("no socket $sock_key $!") unless $socket;
902 $self->{persistent}{$sock_key} = $self->{persistent_tcp} ? $socket : undef;
903 return $socket;
904}
905
906
907sub _create_udp_socket {
908 my $self = shift;
909 my $ip = shift;
910
911 my $ip6_addr = IPv6 && _ipv6($ip);
912 my $sock_key = IPv6 && $ip6_addr ? 'UDP/IPv6' : 'UDP/IPv4';
913 my $socket;
914 return $socket if $socket = $self->{persistent}{$sock_key};
915
916 $socket = IO::Socket::IP->new(
917 LocalAddr => $ip6_addr ? $self->{srcaddr6} : $self->{srcaddr4},
918 LocalPort => $self->{srcport},
919 Proto => 'udp',
920 Type => SOCK_DGRAM
921 )
922 if USE_SOCKET_IP;
923
924 unless (USE_SOCKET_IP) {
925 $socket = IO::Socket::INET6->new(
926 LocalAddr => $self->{srcaddr6},
927 LocalPort => $self->{srcport},
928 Proto => 'udp',
929 Type => SOCK_DGRAM
930 )
931 if USE_SOCKET_INET6 && $ip6_addr;
932
933 $socket = IO::Socket::INET->new(
934 LocalAddr => $self->{srcaddr4},
935 LocalPort => $self->{srcport},
936 Proto => 'udp',
937 Type => SOCK_DGRAM
938 )
939 unless $ip6_addr;
940 }
941
942 $self->errorstring("no socket $sock_key $!") unless $socket;
943 $self->{persistent}{$sock_key} = $self->{persistent_udp} ? $socket : undef;
944 return $socket;
945}
946
947
94818µsmy @udp = (
949 flags => Socket::AI_NUMERICHOST,
950 protocol => Socket::IPPROTO_UDP,
951 socktype => SOCK_DGRAM
952 )
953 if USE_SOCKET_IP;
954
95515µsmy $ip4 = USE_SOCKET_IP ? {family => AF_INET, @udp} : {};
95613µsmy $ip6 = USE_SOCKET_IP ? {family => AF_INET6, @udp} : {};
957
958116µs1179µsmy $inet6 = USE_SOCKET_INET6 ? [AF_INET6, SOCK_DGRAM, 0, Socket6::AI_NUMERICHOST()] : [];
# spent 179µs making 1 call to Socket6::AUTOLOAD
959
960sub _create_dst_sockaddr { ## create UDP destination sockaddr structure
961 my ( $self, $ip, $port ) = @_;
962
963 unless (USE_SOCKET_IP) {
964 return sockaddr_in( $port, inet_aton($ip) ) unless _ipv6($ip);
965 return ( Socket6::getaddrinfo( $ip, $port, @$inet6 ) )[3] if USE_SOCKET_INET6;
966 }
967
968 ( grep ref, Socket::getaddrinfo( $ip, $port, _ipv6($ip) ? $ip6 : $ip4 ), {} )[0]->{addr}
969 if USE_SOCKET_IP; # NB: errors raised in socket->send
970}
971
972
973# Lightweight versions of subroutines from Net::IP module, recoded to fix RT#96812
974
975
# spent 337µs (247+90) within Net::DNS::Resolver::Base::_ipv4 which was called 12 times, avg 28µs/call: # 6 times (141µs+49µs) by Net::DNS::Resolver::Base::nameservers at line 281, avg 32µs/call # 6 times (106µs+41µs) by Net::DNS::Resolver::Base::nameservers at line 307, avg 24µs/call
sub _ipv4 {
9761223µs for (shift) {
97712125µs1232µs return if m/[^.0-9]/; # dots and digits only
# spent 32µs making 12 calls to Net::DNS::Resolver::Base::CORE:match, avg 3µs/call
97812208µs1258µs return m/\.\d+\./; # dots separated by digits
# spent 58µs making 12 calls to Net::DNS::Resolver::Base::CORE:match, avg 5µs/call
979 }
980}
981
982
# spent 102µs (89+13) within Net::DNS::Resolver::Base::_ipv6 which was called 6 times, avg 17µs/call: # 6 times (89µs+13µs) by Net::DNS::Resolver::Base::nameservers at line 308, avg 17µs/call
sub _ipv6 {
983612µs for (shift) {
9846105µs613µs return unless m/:.*:/; # must contain two colons
# spent 13µs making 6 calls to Net::DNS::Resolver::Base::CORE:match, avg 2µs/call
985 return 1 unless m/[^:0-9A-Fa-f]/; # colons and hexdigits only
986 return 1 if m/^[:.0-9A-Fa-f]+\%.+$/; # RFC4007 scoped address
987 return m/^[:0-9A-Fa-f]+:[.0-9]+$/; # prefix : dotted digits
988 }
989}
990
991
992sub _make_query_packet {
993 my $self = shift;
994
995 my ($packet) = @_;
996 if ( ref($packet) ) {
997 my $header = $packet->header;
998 $header->rd( $self->{recurse} ) if $header->opcode eq 'QUERY';
999
1000 } else {
1001 $packet = Net::DNS::Packet->new(@_);
1002
1003 my $header = $packet->header;
1004 $header->ad( $self->{adflag} ); # RFC6840, 5.7
1005 $header->cd( $self->{cdflag} ); # RFC6840, 5.9
1006 $header->do(1) if $self->{dnssec};
1007 $header->rd( $self->{recurse} );
1008 }
1009
1010 $packet->edns->size( $self->{udppacketsize} ); # advertise UDPsize for local stack
1011
1012 if ( $self->{tsig_rr} ) {
1013 $packet->sign_tsig( $self->{tsig_rr} ) unless $packet->sigrr;
1014 }
1015
1016 return $packet;
1017}
1018
1019
1020sub dnssec {
1021 my $self = shift;
1022
1023 return $self->{dnssec} unless scalar @_;
1024
1025 # increase default udppacket size if flag set
1026 $self->udppacketsize(2048) if $self->{dnssec} = shift;
1027
1028 return $self->{dnssec};
1029}
1030
1031
1032sub force_v6 {
1033 my $self = shift;
1034 my $value = scalar(@_) ? shift() : $self->{force_v6};
1035 $self->{force_v6} = $value ? do { $self->{force_v4} = 0; 1 } : 0;
1036}
1037
1038
# spent 44µs within Net::DNS::Resolver::Base::force_v4 which was called 2 times, avg 22µs/call: # 2 times (44µs+0s) by Net::DNS::Resolver::Base::new at line 139, avg 22µs/call
sub force_v4 {
103925µs my $self = shift;
104027µs my $value = scalar(@_) ? shift() : $self->{force_v4};
1041640µs $self->{force_v4} = $value ? do { $self->{force_v6} = 0; 1 } : 0;
1042}
1043
1044sub prefer_v6 {
1045 my $self = shift;
1046 my $value = scalar(@_) ? shift() : $self->{prefer_v6};
1047 $self->{prefer_v6} = $value ? do { $self->{prefer_v4} = 0; 1 } : 0;
1048}
1049
1050sub prefer_v4 {
1051 my $self = shift;
1052 my $value = scalar(@_) ? shift() : $self->{prefer_v4};
1053 $self->{prefer_v4} = $value ? do { $self->{prefer_v6} = 0; 1 } : 0;
1054}
1055
1056
1057sub srcaddr {
1058 my $self = shift;
1059 for (@_) {
1060 my $hashkey = _ipv6($_) ? 'srcaddr6' : 'srcaddr4';
1061 $self->{$hashkey} = $_;
1062 }
1063 return shift;
1064}
1065
1066
1067sub tsig {
1068 my $self = shift;
1069 $self->{tsig_rr} = eval {
1070 local $SIG{__DIE__};
1071 require Net::DNS::RR::TSIG;
1072 Net::DNS::RR::TSIG->create(@_);
1073 };
1074 croak "${@}unable to create TSIG record" if $@;
1075}
1076
1077
1078# if ($self->{udppacketsize} > PACKETSZ
1079# then we use EDNS and $self->{udppacketsize}
1080# should be taken as the maximum packet_data length
1081
# spent 20µs within Net::DNS::Resolver::Base::_packetsz which was called 2 times, avg 10µs/call: # 2 times (20µs+0s) by Net::DNS::Resolver::Base::udppacketsize at line 1089, avg 10µs/call
sub _packetsz {
108226µs my $udpsize = shift->{udppacketsize} || 0;
1083219µs return $udpsize > PACKETSZ ? $udpsize : PACKETSZ;
1084}
1085
1086
# spent 64µs (45+20) within Net::DNS::Resolver::Base::udppacketsize which was called 2 times, avg 32µs/call: # 2 times (45µs+20µs) by Mail::SpamAssassin::DnsResolver::load_resolver at line 151 of Mail/SpamAssassin/DnsResolver.pm, avg 32µs/call
sub udppacketsize {
108725µs my $self = shift;
108826µs $self->{udppacketsize} = shift if scalar @_;
1089234µs220µs return $self->_packetsz;
# spent 20µs making 2 calls to Net::DNS::Resolver::Base::_packetsz, avg 10µs/call
1090}
1091
1092
1093#
1094# Keep this method around. Folk depend on it although it is neither documented nor exported.
1095#
109612µsmy $warned;
1097
1098sub make_query_packet { ## historical
1099 unless ( $warned++ ) { # uncoverable pod
1100 local $SIG{__WARN__};
1101 carp 'deprecated method; see RT#37104';
1102 }
1103 &_make_query_packet;
1104}
1105
1106
1107sub _diag { ## debug output
1108 my $self = shift;
1109 print "\n;; @_\n" if $self->{debug};
1110}
1111
1112
1113our $AUTOLOAD;
1114
1115sub DESTROY { } ## Avoid tickling AUTOLOAD (in cleanup)
1116
1117
# spent 382µs (322+60) within Net::DNS::Resolver::Base::AUTOLOAD which was called 8 times, avg 48µs/call: # once (50µs+5µs) by Mail::SpamAssassin::DnsResolver::load_resolver at line 143 of Mail/SpamAssassin/DnsResolver.pm # once (47µs+6µs) by Mail::SpamAssassin::DnsResolver::load_resolver at line 139 of Mail/SpamAssassin/DnsResolver.pm # once (38µs+13µs) by Mail::SpamAssassin::DnsResolver::load_resolver at line 145 of Mail/SpamAssassin/DnsResolver.pm # once (37µs+14µs) by Mail::SpamAssassin::DnsResolver::load_resolver at line 146 of Mail/SpamAssassin/DnsResolver.pm # once (43µs+5µs) by Mail::SpamAssassin::DnsResolver::load_resolver at line 144 of Mail/SpamAssassin/DnsResolver.pm # once (42µs+5µs) by Mail::SpamAssassin::DnsResolver::load_resolver at line 142 of Mail/SpamAssassin/DnsResolver.pm # once (32µs+6µs) by Mail::SpamAssassin::DnsResolver::load_resolver at line 141 of Mail/SpamAssassin/DnsResolver.pm # once (32µs+5µs) by Mail::SpamAssassin::DnsResolver::load_resolver at line 140 of Mail/SpamAssassin/DnsResolver.pm
sub AUTOLOAD { ## Default method
1118814µs my ($self) = @_;
1119
1120827µs my $name = $AUTOLOAD;
11218130µs860µs $name =~ s/.*://;
# spent 60µs making 8 calls to Net::DNS::Resolver::Base::CORE:subst, avg 7µs/call
1122836µs croak "$name: no such method" unless $public_attr{$name};
1123
11242337µs2150µs
# spent 90µs (30+60) within Net::DNS::Resolver::Base::BEGIN@1124 which was called: # once (30µs+60µs) by base::import at line 1124
no strict q/refs/;
# spent 90µs making 1 call to Net::DNS::Resolver::Base::BEGIN@1124 # spent 60µs making 1 call to strict::unimport
1125818µs
# spent 237µs within Net::DNS::Resolver::Base::__ANON__[/usr/local/lib/perl5/site_perl/Net/DNS/Resolver/Base.pm:1130] which was called 16 times, avg 15µs/call: # 8 times (146µs+0s) by Mail::SpamAssassin::DnsResolver::load_resolver at line 1132, avg 18µs/call # once (14µs+0s) by Mail::SpamAssassin::DnsResolver::load_resolver at line 139 of Mail/SpamAssassin/DnsResolver.pm # once (12µs+0s) by Mail::SpamAssassin::DnsResolver::load_resolver at line 140 of Mail/SpamAssassin/DnsResolver.pm # once (11µs+0s) by Mail::SpamAssassin::DnsResolver::load_resolver at line 142 of Mail/SpamAssassin/DnsResolver.pm # once (11µs+0s) by Mail::SpamAssassin::DnsResolver::load_resolver at line 141 of Mail/SpamAssassin/DnsResolver.pm # once (11µs+0s) by Mail::SpamAssassin::DnsResolver::load_resolver at line 146 of Mail/SpamAssassin/DnsResolver.pm # once (11µs+0s) by Mail::SpamAssassin::DnsResolver::load_resolver at line 143 of Mail/SpamAssassin/DnsResolver.pm # once (10µs+0s) by Mail::SpamAssassin::DnsResolver::load_resolver at line 144 of Mail/SpamAssassin/DnsResolver.pm # once (10µs+0s) by Mail::SpamAssassin::DnsResolver::load_resolver at line 145 of Mail/SpamAssassin/DnsResolver.pm
*{$AUTOLOAD} = sub {
11261628µs my $self = shift;
11271631µs $self = $self->_defaults unless ref($self);
11281698µs $self->{$name} = shift || 0 if scalar @_;
112916211µs return $self->{$name};
1130875µs };
1131
113216192µs8146µs goto &{$AUTOLOAD};
# spent 146µs making 8 calls to Net::DNS::Resolver::Base::__ANON__[Net/DNS/Resolver/Base.pm:1130], avg 18µs/call
1133}
1134
1135
1136167µs1;
1137
1138__END__
 
# spent 9µs within Net::DNS::Resolver::Base::CORE:close which was called: # once (9µs+0s) by Net::DNS::Resolver::Base::_read_config_file at line 225
sub Net::DNS::Resolver::Base::CORE:close; # opcode
# spent 390µs within Net::DNS::Resolver::Base::CORE:match which was called 98 times, avg 4µs/call: # 58 times (260µs+0s) by Net::DNS::Resolver::Base::_untaint at line 166, avg 4µs/call # 12 times (58µs+0s) by Net::DNS::Resolver::Base::_ipv4 at line 978, avg 5µs/call # 12 times (32µs+0s) by Net::DNS::Resolver::Base::_ipv4 at line 977, avg 3µs/call # 6 times (13µs+0s) by Net::DNS::Resolver::Base::_ipv6 at line 984, avg 2µs/call # 4 times (16µs+0s) by Net::DNS::Resolver::Base::_read_config_file at line 199, avg 4µs/call # 2 times (4µs+0s) by Net::DNS::Resolver::Base::_read_config_file at line 211, avg 2µs/call # 2 times (4µs+0s) by Net::DNS::Resolver::Base::_read_config_file at line 205, avg 2µs/call # 2 times (4µs+0s) by Net::DNS::Resolver::Base::_read_config_file at line 217, avg 2µs/call
sub Net::DNS::Resolver::Base::CORE:match; # opcode
# spent 47µs within Net::DNS::Resolver::Base::CORE:open which was called: # once (47µs+0s) by Net::DNS::Resolver::Base::_read_config_file at line 190
sub Net::DNS::Resolver::Base::CORE:open; # opcode
# spent 76µs within Net::DNS::Resolver::Base::CORE:readline which was called 5 times, avg 15µs/call: # 3 times (65µs+0s) by Net::DNS::Resolver::Base::_read_config_file at line 196, avg 22µs/call # 2 times (11µs+0s) by Net::DNS::Resolver::Base::_read_config_file at line 217, avg 6µs/call
sub Net::DNS::Resolver::Base::CORE:readline; # opcode
# spent 81µs within Net::DNS::Resolver::Base::CORE:subst which was called 12 times, avg 7µs/call: # 8 times (60µs+0s) by Net::DNS::Resolver::Base::AUTOLOAD at line 1121, avg 7µs/call # 4 times (21µs+0s) by Net::DNS::Resolver::Base::_read_config_file at line 197, avg 5µs/call
sub Net::DNS::Resolver::Base::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.