ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/DNS.pm
(Generate patch)

Comparing AnyEvent/lib/AnyEvent/DNS.pm (file contents):
Revision 1.18 by root, Fri May 23 22:52:31 2008 UTC vs.
Revision 1.27 by root, Sat May 24 23:10:18 2008 UTC

… …
3AnyEvent::DNS - fully asynchronous DNS resolution 3AnyEvent::DNS - fully asynchronous DNS resolution
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use AnyEvent::DNS; 7 use AnyEvent::DNS;
8
9 my $cv = AnyEvent->condvar;
10 AnyEvent::DNS::a "www.google.de", sub { $cv->send (@_) };
11 # ... later
12 my @addrs = $cv->recv;
8 13
9=head1 DESCRIPTION 14=head1 DESCRIPTION
10 15
11This module offers both a number of DNS convenience functions as well 16This module offers both a number of DNS convenience functions as well
12as a fully asynchronous and high-performance pure-perl stub resolver. 17as a fully asynchronous and high-performance pure-perl stub resolver.
… …
27use strict; 32use strict;
28 33
29use AnyEvent::Handle (); 34use AnyEvent::Handle ();
30 35
31=item AnyEvent::DNS::addr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...) 36=item AnyEvent::DNS::addr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...)
32
33NOT YET IMPLEMENTED
34 37
35Tries to resolve the given nodename and service name into protocol families 38Tries to resolve the given nodename and service name into protocol families
36and sockaddr structures usable to connect to this node and service in a 39and sockaddr structures usable to connect to this node and service in a
37protocol-independent way. It works remotely similar to the getaddrinfo 40protocol-independent way. It works remotely similar to the getaddrinfo
38posix function. 41posix function.
… …
40C<$node> is either an IPv4 or IPv6 address or a hostname, C<$service> is 43C<$node> is either an IPv4 or IPv6 address or a hostname, C<$service> is
41either a service name (port name from F</etc/services>) or a numerical 44either a service name (port name from F</etc/services>) or a numerical
42port number. If both C<$node> and C<$service> are names, then SRV records 45port number. If both C<$node> and C<$service> are names, then SRV records
43will be consulted to find the real service, otherwise they will be 46will be consulted to find the real service, otherwise they will be
44used as-is. If you know that the service name is not in your services 47used as-is. If you know that the service name is not in your services
45database, then you cna specify the service in the format C<name=port> 48database, then you can specify the service in the format C<name=port>
46(e.g. C<http=80>). 49(e.g. C<http=80>).
47 50
48C<$proto> must be a protocol name, currently C<tcp>, C<udp> or 51C<$proto> must be a protocol name, currently C<tcp>, C<udp> or
49C<sctp>. The default is C<tcp>. 52C<sctp>. The default is C<tcp>.
50 53
51C<$family> must be either C<0> (meaning any protocol is ok), C<4> (use 54C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use
52only IPv4) or C<6> (use only IPv6). 55only IPv4) or C<6> (use only IPv6). This setting might be influenced by
56C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.
53 57
54C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or 58C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or
55C<undef> in which case it gets automatically chosen). 59C<undef> in which case it gets automatically chosen).
56 60
57The callback will receive zero or more array references that contain 61The callback will receive zero or more array references that contain
… …
88=item AnyEvent::DNS::srv $service, $proto, $domain, $cb->(@srv_rr) 92=item AnyEvent::DNS::srv $service, $proto, $domain, $cb->(@srv_rr)
89 93
90Tries to resolve the given service, protocol and domain name into a list 94Tries to resolve the given service, protocol and domain name into a list
91of service records. 95of service records.
92 96
93Each srv_rr is an arrayref with the following contents: 97Each srv_rr is an array reference with the following contents:
94C<[$priority, $weight, $transport, $target]>. 98C<[$priority, $weight, $transport, $target]>.
95 99
96They will be sorted with lowest priority, highest weight first (TODO: 100They will be sorted with lowest priority, highest weight first (TODO:
97should use the rfc algorithm to reorder same-priority records for weight). 101should use the RFC algorithm to reorder same-priority records for weight).
98 102
99Example: 103Example:
100 104
101 AnyEvent::DNS::srv "sip", "udp", "schmorp.de", sub { ... 105 AnyEvent::DNS::srv "sip", "udp", "schmorp.de", sub { ...
102 # @_ = ( [10, 10, 5060, "sip1.schmorp.de" ] ) 106 # @_ = ( [10, 10, 5060, "sip1.schmorp.de" ] )
… …
192 resolver->resolve ($domain => "*", $cb); 196 resolver->resolve ($domain => "*", $cb);
193} 197}
194 198
195############################################################################# 199#############################################################################
196 200
197#AnyEvent::DNS::addr $node, $service, $family, $type, $proto, $cb->([$family, $type, $protocol, $sockaddr], ...)
198
199# $port, $host
200sub pack_sockaddr_in6($$) {
201 pack "nnN a16 N",
202 Socket::AF_INET6,
203 $_[0], # port
204 0, # flowinfo
205 $_[1], # addr
206 0 # scope id
207}
208
209sub addr($$$$$$) { 201sub addr($$$$$$) {
210 my ($node, $service, $proto, $family, $type, $cb) = @_; 202 my ($node, $service, $proto, $family, $type, $cb) = @_;
211 203
212 unless (eval { &Socket::AF_INET6 }) { 204 unless (&AnyEvent::Socket::AF_INET6) {
213 $family != 6 205 $family != 6
214 or return $cb->(); 206 or return $cb->();
207
208 $family ||= 4;
215 } 209 }
210
211 $cb->() if $family == 4 && !$AnyEvent::PROTOCOL{ipv4};
212 $cb->() if $family == 6 && !$AnyEvent::PROTOCOL{ipv6};
213
214 $family ||=4 unless $AnyEvent::PROTOCOL{ipv6};
215 $family ||=6 unless $AnyEvent::PROTOCOL{ipv4};
216 216
217 $proto ||= "tcp"; 217 $proto ||= "tcp";
218 $type ||= $proto eq "udp" ? Socket::SOCK_DGRAM : Socket::SOCK_STREAM; 218 $type ||= $proto eq "udp" ? Socket::SOCK_DGRAM : Socket::SOCK_STREAM;
219 219
220 my $proton = (getprotobyname $proto)[2] 220 my $proton = (getprotobyname $proto)[2]
… …
235 235
236 # resolve a records / provide sockaddr structures 236 # resolve a records / provide sockaddr structures
237 my $resolve = sub { 237 my $resolve = sub {
238 my @res; 238 my @res;
239 my $cv = AnyEvent->condvar (cb => sub { 239 my $cv = AnyEvent->condvar (cb => sub {
240 $cb->(map $_->[1], sort { $a->[0] <=> $b->[0] } @res) 240 $cb->(
241 map $_->[2],
242 sort {
243 $AnyEvent::PROTOCOL{$a->[1]} <=> $AnyEvent::PROTOCOL{$b->[1]}
244 or $a->[0] <=> $b->[0]
245 }
246 @res
247 )
241 }); 248 });
242 249
243 $cv->begin; 250 $cv->begin;
244 for my $idx (0 .. $#target) { 251 for my $idx (0 .. $#target) {
245 my ($node, $port) = @{ $target[$idx] }; 252 my ($node, $port) = @{ $target[$idx] };
246 253
247 if (my $noden = AnyEvent::Socket::parse_ip ($node)) { 254 if (my $noden = AnyEvent::Socket::parse_ip ($node)) {
248 if (4 == length $noden && $family != 6) { 255 if (4 == length $noden && $family != 6) {
249 push @res, [$idx, [Socket::AF_INET, $type, $proton, 256 push @res, [$idx, "ipv4", [Socket::AF_INET, $type, $proton,
250 Socket::pack_sockaddr_in $port, $noden]] 257 AnyEvent::Socket::pack_sockaddr ($port, $noden)]]
251 } 258 }
252 259
253 if (16 == length $noden && $family != 4) { 260 if (16 == length $noden && $family != 4) {
254 push @res, [$idx, [Socket::AF_INET6, $type, $proton, 261 push @res, [$idx, "ipv6", [&AnyEvent::Socket::AF_INET6, $type, $proton,
255 pack_sockaddr_in6 $port, $noden]] 262 AnyEvent::Socket::pack_sockaddr ( $port, $noden)]]
256 } 263 }
257 } else { 264 } else {
258 # ipv4 265 # ipv4
259 if ($family != 6) { 266 if ($family != 6) {
260 $cv->begin; 267 $cv->begin;
261 a $node, sub { 268 a $node, sub {
262 push @res, [$idx, [Socket::AF_INET, $type, $proton, 269 push @res, [$idx, "ipv4", [Socket::AF_INET, $type, $proton,
263 Socket::pack_sockaddr_in $port, AnyEvent::Socket::parse_ipv4 ($_)]] 270 AnyEvent::Socket::pack_sockaddr ($port, AnyEvent::Socket::parse_ipv4 ($_))]]
264 for @_; 271 for @_;
265 $cv->end; 272 $cv->end;
266 }; 273 };
267 } 274 }
268 275
269 my $idx = $idx + 0.5; # prefer ipv4 for now
270
271 # ipv6 276 # ipv6
272 if ($family != 4) { 277 if ($family != 4) {
273 $cv->begin; 278 $cv->begin;
274 aaaa $node, sub { 279 aaaa $node, sub {
275 push @res, [$idx, [Socket::AF_INET6, $type, $proton, 280 push @res, [$idx, "ipv6", [&AnyEvent::Socket::AF_INET6, $type, $proton,
276 pack_sockaddr_in6 $port, AnyEvent::Socket::parse_ipv6 ($_)]] 281 AnyEvent::Socket::pack_sockaddr ($port, AnyEvent::Socket::parse_ipv6 ($_))]]
277 for @_; 282 for @_;
278 $cv->end; 283 $cv->end;
279 }; 284 };
280 } 285 }
281 } 286 }
282 } 287 }
283 $cv->end; 288 $cv->end;
284 }; 289 };
285 290
286 # try srv records, if applicable 291 # try srv records, if applicable
292 if ($node eq "localhost") {
293 @target = (["127.0.0.1", $port], ["::1", $port]);
294 &$resolve;
287 if (defined $service && !AnyEvent::Socket::parse_ip ($node)) { 295 } elsif (defined $service && !AnyEvent::Socket::parse_ip ($node)) {
288 srv $service, $proto, $node, sub { 296 srv $service, $proto, $node, sub {
289 my (@srv) = @_; 297 my (@srv) = @_;
290 298
291 # no srv records, continue traditionally 299 # no srv records, continue traditionally
292 @srv 300 @srv
… …
295 # only srv record has "." => abort 303 # only srv record has "." => abort
296 $srv[0][2] ne "." || $#srv 304 $srv[0][2] ne "." || $#srv
297 or return $cb->(); 305 or return $cb->();
298 306
299 # use srv records then 307 # use srv records then
300 @target = map [$_->[3], $_->[2]], 308 @target = map ["$_->[3].", $_->[2]],
301 grep $_->[3] ne ".", 309 grep $_->[3] ne ".",
302 @srv; 310 @srv;
303 311
304 &$resolve; 312 &$resolve;
305 }; 313 };
… …
317=over 4 325=over 4
318 326
319=item $AnyEvent::DNS::EDNS0 327=item $AnyEvent::DNS::EDNS0
320 328
321This variable decides whether dns_pack automatically enables EDNS0 329This variable decides whether dns_pack automatically enables EDNS0
322support. By default, this is disabled (C<0>), but when set to C<1>, 330support. By default, this is disabled (C<0>), unless overridden by
323AnyEvent::DNS will use EDNS0 in all requests. 331C<$ENV{PERL_ANYEVENT_EDNS0>), but when set to C<1>, AnyEvent::DNS will use
332EDNS0 in all requests.
324 333
325=cut 334=cut
326 335
327our $EDNS0 = 0; # set to 1 to enable (partial) edns0 336our $EDNS0 = $ENV{PERL_ANYEVENT_EDNS0} * 1; # set to 1 to enable (partial) edns0
328 337
329our %opcode_id = ( 338our %opcode_id = (
330 query => 0, 339 query => 0,
331 iquery => 1, 340 iquery => 1,
332 status => 2, 341 status => 2,
… …
690 699
691=over 4 700=over 4
692 701
693=item server => [...] 702=item server => [...]
694 703
695A list of server addressses (default: C<v127.0.0.1>) in network format (4 704A list of server addresses (default: C<v127.0.0.1>) in network format (4
696octets for IPv4, 16 octets for IPv6 - not yet supported). 705octets for IPv4, 16 octets for IPv6 - not yet supported).
697 706
698=item timeout => [...] 707=item timeout => [...]
699 708
700A list of timeouts to use (also determines the number of retries). To make 709A list of timeouts to use (also determines the number of retries). To make
… …
711tries to resolve the name without any suffixes first. 720tries to resolve the name without any suffixes first.
712 721
713=item max_outstanding => $integer 722=item max_outstanding => $integer
714 723
715Most name servers do not handle many parallel requests very well. This option 724Most name servers do not handle many parallel requests very well. This option
716limits the numbe rof outstanding requests to C<$n> (default: C<10>), that means 725limits the number of outstanding requests to C<$n> (default: C<10>), that means
717if you request more than this many requests, then the additional requests will be queued 726if you request more than this many requests, then the additional requests will be queued
718until some other requests have been resolved. 727until some other requests have been resolved.
719 728
720=item reuse => $seconds 729=item reuse => $seconds
721 730
722The number of seconds (default: C<60>) that a query id cannot be re-used 731The number of seconds (default: C<300>) that a query id cannot be re-used
723after a request. Since AnyEvent::DNS will only allocate up to 30000 ID's 732after a timeout. If there as no time-out then query id's can be reused
724at the same time, the long-term maximum number of requests per second is 733immediately.
725C<30000 / $seconds> (and thus C<500> requests/s by default).
726 734
727=back 735=back
728 736
729=cut 737=cut
730 738
… …
740 server => [v127.0.0.1], 748 server => [v127.0.0.1],
741 timeout => [2, 5, 5], 749 timeout => [2, 5, 5],
742 search => [], 750 search => [],
743 ndots => 1, 751 ndots => 1,
744 max_outstanding => 10, 752 max_outstanding => 10,
745 reuse => 60, # reuse id's after 5 minutes only, if possible 753 reuse => 300, # reuse id's after 5 minutes only, if possible
746 %arg, 754 %arg,
747 fh => $fh, 755 fh => $fh,
748 reuse_q => [], 756 reuse_q => [],
749 }, $class; 757 }, $class;
750 758
… …
759 $self 767 $self
760} 768}
761 769
762=item $resolver->parse_resolv_conv ($string) 770=item $resolver->parse_resolv_conv ($string)
763 771
764Parses the given string a sif it were a F<resolv.conf> file. The following 772Parses the given string as if it were a F<resolv.conf> file. The following
765directives are supported (but not neecssarily implemented). 773directives are supported (but not necessarily implemented).
766 774
767C<#>-style comments, C<nameserver>, C<domain>, C<search>, C<sortlist>, 775C<#>-style comments, C<nameserver>, C<domain>, C<search>, C<sortlist>,
768C<options> (C<timeout>, C<attempts>, C<ndots>). 776C<options> (C<timeout>, C<attempts>, C<ndots>).
769 777
770Everything else is silently ignored. 778Everything else is silently ignored.
… …
782 for (split /\n/, $resolvconf) { 790 for (split /\n/, $resolvconf) {
783 if (/^\s*#/) { 791 if (/^\s*#/) {
784 # comment 792 # comment
785 } elsif (/^\s*nameserver\s+(\S+)\s*$/i) { 793 } elsif (/^\s*nameserver\s+(\S+)\s*$/i) {
786 my $ip = $1; 794 my $ip = $1;
787 if (AnyEvent::Util::dotted_quad $ip) { 795 if (my $ipn = AnyEvent::Socket::parse_ip ($ip)) {
788 push @{ $self->{server} }, AnyEvent::Util::socket_inet_aton $ip; 796 push @{ $self->{server} }, $ipn;
789 } else { 797 } else {
790 warn "nameserver $ip invalid and ignored\n"; 798 warn "nameserver $ip invalid and ignored\n";
791 } 799 }
792 } elsif (/^\s*domain\s+(\S*)\s+$/i) { 800 } elsif (/^\s*domain\s+(\S*)\s+$/i) {
793 $self->{search} = [$1]; 801 $self->{search} = [$1];
… …
816 $self->_compile; 824 $self->_compile;
817} 825}
818 826
819=item $resolver->os_config 827=item $resolver->os_config
820 828
821Tries so load and parse F</etc/resolv.conf> on portable opertaing systems. Tries various 829Tries so load and parse F</etc/resolv.conf> on portable operating systems. Tries various
822egregious hacks on windows to force the dns servers and searchlist out of the config. 830egregious hacks on windows to force the DNS servers and searchlist out of the system.
823 831
824=cut 832=cut
825 833
826sub os_config { 834sub os_config {
827 my ($self) = @_; 835 my ($self) = @_;
… …
846 854
847 while (<$fh>) { 855 while (<$fh>) {
848 # second DNS.* is server address list 856 # second DNS.* is server address list
849 if (/^\s*DNS/) { 857 if (/^\s*DNS/) {
850 while (/\s+(\d+\.\d+\.\d+\.\d+)\s*$/) { 858 while (/\s+(\d+\.\d+\.\d+\.\d+)\s*$/) {
859 my $ipn = AnyEvent::Socket::parse_ip ("$1"); # "" is necessary here, apparently
860 push @{ $self->{server} }, $ipn
851 my $ip = $1; 861 if $ipn;
852 push @{ $self->{server} }, AnyEvent::Util::socket_inet_aton $ip
853 if AnyEvent::Util::dotted_quad $ip;
854 $_ = <$fh>; 862 $_ = <$fh>;
855 } 863 }
856 last; 864 last;
857 } 865 }
858 } 866 }
… …
899 907
900sub _recv { 908sub _recv {
901 my ($self) = @_; 909 my ($self) = @_;
902 910
903 while (my $peer = recv $self->{fh}, my $res, 4096, 0) { 911 while (my $peer = recv $self->{fh}, my $res, 4096, 0) {
904 my ($port, $host) = Socket::unpack_sockaddr_in $peer; 912 my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer);
905 913
906 return unless $port == 53 && grep $_ eq $host, @{ $self->{server} }; 914 return unless $port == 53 && grep $_ eq $host, @{ $self->{server} };
907 915
908 $self->_feed ($res); 916 $self->_feed ($res);
909 } 917 }
910} 918}
911 919
920sub _free_id {
921 my ($self, $id, $timeout) = @_;
922
923 if ($timeout) {
924 # we need to block the id for a while
925 $self->{id}{$id} = 1;
926 push @{ $self->{reuse_q} }, [$NOW + $self->{reuse}, $id];
927 } else {
928 # we can quickly recycle the id
929 delete $self->{id}{$id};
930 }
931
932 --$self->{outstanding};
933 $self->_scheduler;
934}
935
936# execute a single request, involves sending it with timeouts to multiple servers
912sub _exec { 937sub _exec {
913 my ($self, $req, $retry) = @_; 938 my ($self, $req) = @_;
914 939
940 my $retry; # of retries
941 my $do_retry;
942
943 $do_retry = sub {
915 if (my $retry_cfg = $self->{retry}[$retry]) { 944 my $retry_cfg = $self->{retry}[$retry++]
945 or do {
946 # failure
947 $self->_free_id ($req->[2], $retry > 1);
948 undef $do_retry; return $req->[1]->();
949 };
950
916 my ($server, $timeout) = @$retry_cfg; 951 my ($server, $timeout) = @$retry_cfg;
917 952
918 $self->{id}{$req->[2]} = [AnyEvent->timer (after => $timeout, cb => sub { 953 $self->{id}{$req->[2]} = [AnyEvent->timer (after => $timeout, cb => sub {
919 $NOW = time; 954 $NOW = time;
920 955
921 # timeout, try next 956 # timeout, try next
922 $self->_exec ($req, $retry + 1); 957 &$do_retry;
923 }), sub { 958 }), sub {
924 my ($res) = @_; 959 my ($res) = @_;
925 960
926 if ($res->{tc}) { 961 if ($res->{tc}) {
927 # success, but truncated, so use tcp 962 # success, but truncated, so use tcp
928 AnyEvent::Socket::tcp_connect ((Socket::inet_ntoa $server), 53, sub { 963 AnyEvent::Socket::tcp_connect ((Socket::inet_ntoa $server), 53, sub {
929 my ($fh) = @_ 964 my ($fh) = @_
930 or return $self->_exec ($req, $retry + 1); 965 or return &$do_retry;
931 966
932 my $handle = new AnyEvent::Handle 967 my $handle = new AnyEvent::Handle
933 fh => $fh, 968 fh => $fh,
934 on_error => sub { 969 on_error => sub {
935 # failure, try next 970 # failure, try next
936 $self->_exec ($req, $retry + 1); 971 &$do_retry;
937 }; 972 };
938 973
939 $handle->push_write (pack "n/a", $req->[0]); 974 $handle->push_write (pack "n/a", $req->[0]);
940 $handle->push_read_chunk (2, sub { 975 $handle->push_read (chunk => 2, sub {
941 $handle->unshift_read_chunk ((unpack "n", $_[1]), sub { 976 $handle->unshift_read (chunk => (unpack "n", $_[1]), sub {
942 $self->_feed ($_[1]); 977 $self->_feed ($_[1]);
943 }); 978 });
944 }); 979 });
945 shutdown $fh, 1; 980 shutdown $fh, 1;
946 981
947 }, sub { $timeout }); 982 }, sub { $timeout });
948 983
949 } else { 984 } else {
950 # success 985 # success
951 $self->{id}{$req->[2]} = 1; 986 $self->_free_id ($req->[2], $retry > 1);
952 push @{ $self->{reuse_q} }, [$NOW + $self->{reuse}, $req->[2]]; 987 undef $do_retry; return $req->[1]->($res);
953 --$self->{outstanding};
954 $self->_scheduler;
955
956 $req->[1]->($res);
957 } 988 }
958 }]; 989 }];
959 990
960 send $self->{fh}, $req->[0], 0, Socket::pack_sockaddr_in 53, $server; 991 send $self->{fh}, $req->[0], 0, AnyEvent::Socket::pack_sockaddr (53, $server);
961 } else {
962 # failure
963 $self->{id}{$req->[2]} = 1;
964 push @{ $self->{reuse_q} }, [$NOW + $self->{reuse}, $req->[2]];
965 --$self->{outstanding};
966 $self->_scheduler;
967
968 $req->[1]->();
969 } 992 };
993
994 &$do_retry;
970} 995}
971 996
972sub _scheduler { 997sub _scheduler {
973 my ($self) = @_; 998 my ($self) = @_;
974 999
… …
995 while () { 1020 while () {
996 $req->[2] = int rand 65536; 1021 $req->[2] = int rand 65536;
997 last unless exists $self->{id}{$req->[2]}; 1022 last unless exists $self->{id}{$req->[2]};
998 } 1023 }
999 1024
1025 ++$self->{outstanding};
1000 $self->{id}{$req->[2]} = 1; 1026 $self->{id}{$req->[2]} = 1;
1001 substr $req->[0], 0, 2, pack "n", $req->[2]; 1027 substr $req->[0], 0, 2, pack "n", $req->[2];
1002 1028
1003 ++$self->{outstanding};
1004 $self->_exec ($req, 0); 1029 $self->_exec ($req);
1005 } 1030 }
1006} 1031}
1007 1032
1008=item $resolver->request ($req, $cb->($res)) 1033=item $resolver->request ($req, $cb->($res))
1009 1034
… …
1029The callback will be invoked with a list of matching result records or 1054The callback will be invoked with a list of matching result records or
1030none on any error or if the name could not be found. 1055none on any error or if the name could not be found.
1031 1056
1032CNAME chains (although illegal) are followed up to a length of 8. 1057CNAME chains (although illegal) are followed up to a length of 8.
1033 1058
1034Note that this resolver is just a stub resolver: it requires a nameserver 1059Note that this resolver is just a stub resolver: it requires a name server
1035supporting recursive queries, will not do any recursive queries itself and 1060supporting recursive queries, will not do any recursive queries itself and
1036is not secure when used against an untrusted name server. 1061is not secure when used against an untrusted name server.
1037 1062
1038The following options are supported: 1063The following options are supported:
1039 1064
… …
1115 my %atype = $opt{accept} 1140 my %atype = $opt{accept}
1116 ? map +($_ => 1), @{ $opt{accept} } 1141 ? map +($_ => 1), @{ $opt{accept} }
1117 : ($qtype => 1); 1142 : ($qtype => 1);
1118 1143
1119 # advance in searchlist 1144 # advance in searchlist
1120 my $do_search; $do_search = sub { 1145 my ($do_search, $do_req);
1146
1147 $do_search = sub {
1121 @search 1148 @search
1122 or return $cb->(); 1149 or (undef $do_search), (undef $do_req), return $cb->();
1123 1150
1124 (my $name = lc "$qname." . shift @search) =~ s/\.$//; 1151 (my $name = lc "$qname." . shift @search) =~ s/\.$//;
1125 my $depth = 2; 1152 my $depth = 2;
1126 1153
1127 # advance in cname-chain 1154 # advance in cname-chain
1128 my $do_req; $do_req = sub { 1155 $do_req = sub {
1129 $self->request ({ 1156 $self->request ({
1130 rd => 1, 1157 rd => 1,
1131 qd => [[$name, $qtype, $class]], 1158 qd => [[$name, $qtype, $class]],
1132 }, sub { 1159 }, sub {
1133 my ($res) = @_ 1160 my ($res) = @_
… …
1137 1164
1138 while () { 1165 while () {
1139 # results found? 1166 # results found?
1140 my @rr = grep $name eq lc $_->[0] && ($atype{"*"} || $atype{$_->[1]}), @{ $res->{an} }; 1167 my @rr = grep $name eq lc $_->[0] && ($atype{"*"} || $atype{$_->[1]}), @{ $res->{an} };
1141 1168
1142 return $cb->(@rr) 1169 (undef $do_search), (undef $do_req), return $cb->(@rr)
1143 if @rr; 1170 if @rr;
1144 1171
1145 # see if there is a cname we can follow 1172 # see if there is a cname we can follow
1146 my @rr = grep $name eq lc $_->[0] && $_->[1] eq "cname", @{ $res->{an} }; 1173 my @rr = grep $name eq lc $_->[0] && $_->[1] eq "cname", @{ $res->{an} };
1147 1174

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines