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.24 by root, Sat May 24 02:50:45 2008 UTC vs.
Revision 1.39 by root, Thu May 29 03:45:37 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", $cv;
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.
… …
24package AnyEvent::DNS; 29package AnyEvent::DNS;
25 30
26no warnings; 31no warnings;
27use strict; 32use strict;
28 33
34use Socket qw(AF_INET SOCK_DGRAM SOCK_STREAM);
35
36use AnyEvent ();
29use AnyEvent::Handle (); 37use AnyEvent::Handle ();
38use AnyEvent::Util qw(AF_INET6);
30 39
31=item AnyEvent::DNS::addr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...) 40our $VERSION = '1.0';
32 41
33Tries to resolve the given nodename and service name into protocol families 42our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222);
34and sockaddr structures usable to connect to this node and service in a
35protocol-independent way. It works remotely similar to the getaddrinfo
36posix function.
37
38C<$node> is either an IPv4 or IPv6 address or a hostname, C<$service> is
39either a service name (port name from F</etc/services>) or a numerical
40port number. If both C<$node> and C<$service> are names, then SRV records
41will be consulted to find the real service, otherwise they will be
42used as-is. If you know that the service name is not in your services
43database, then you can specify the service in the format C<name=port>
44(e.g. C<http=80>).
45
46C<$proto> must be a protocol name, currently C<tcp>, C<udp> or
47C<sctp>. The default is C<tcp>.
48
49C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use
50only IPv4) or C<6> (use only IPv6). This setting might be influenced by
51C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.
52
53C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or
54C<undef> in which case it gets automatically chosen).
55
56The callback will receive zero or more array references that contain
57C<$family, $type, $proto> for use in C<socket> and a binary
58C<$sockaddr> for use in C<connect> (or C<bind>).
59
60The application should try these in the order given.
61
62Example:
63
64 AnyEvent::DNS::addr "google.com", "http", 0, undef, undef, sub { ... };
65 43
66=item AnyEvent::DNS::a $domain, $cb->(@addrs) 44=item AnyEvent::DNS::a $domain, $cb->(@addrs)
67 45
68Tries to resolve the given domain to IPv4 address(es). 46Tries to resolve the given domain to IPv4 address(es).
69 47
… …
114 92
115Tries to resolve the given domain and passes all resource records found to 93Tries to resolve the given domain and passes all resource records found to
116the callback. 94the callback.
117 95
118=cut 96=cut
97
98sub MAX_PKT() { 4096 } # max packet size we advertise and accept
99
100sub DOMAIN_PORT() { 53 } # if this changes drop me a note
119 101
120sub resolver; 102sub resolver;
121 103
122sub a($$) { 104sub a($$) {
123 my ($domain, $cb) = @_; 105 my ($domain, $cb) = @_;
… …
169} 151}
170 152
171sub ptr($$) { 153sub ptr($$) {
172 my ($ip, $cb) = @_; 154 my ($ip, $cb) = @_;
173 155
174 $ip = AnyEvent::Socket::parse_ip ($ip) 156 $ip = AnyEvent::Socket::parse_address ($ip)
175 or return $cb->(); 157 or return $cb->();
176 158
177 if (4 == length $ip) { 159 my $af = AnyEvent::Socket::address_family ($ip);
160
161 if ($af == AF_INET) {
178 $ip = join ".", (reverse split /\./, $ip), "in-addr.arpa."; 162 $ip = join ".", (reverse split /\./, $ip), "in-addr.arpa.";
163 } elsif ($af == AF_INET6) {
164 $ip = join ".", (reverse split //, unpack "H*", $ip), "ip6.arpa.";
179 } else { 165 } else {
180 $ip = join ".", (reverse split //, unpack "H*", $ip), "ip6.arpa."; 166 return $cb->();
181 } 167 }
182 168
183 resolver->resolve ($ip => "ptr", sub { 169 resolver->resolve ($ip => "ptr", sub {
184 $cb->(map $_->[3], @_); 170 $cb->(map $_->[3], @_);
185 }); 171 });
… …
189 my ($domain, $cb) = @_; 175 my ($domain, $cb) = @_;
190 176
191 resolver->resolve ($domain => "*", $cb); 177 resolver->resolve ($domain => "*", $cb);
192} 178}
193 179
194############################################################################# 180#################################################################################
195
196sub addr($$$$$$) {
197 my ($node, $service, $proto, $family, $type, $cb) = @_;
198
199 unless (&AnyEvent::Socket::AF_INET6) {
200 $family != 6
201 or return $cb->();
202
203 $family ||= 4;
204 }
205
206 $cb->() if $family == 4 && !$AnyEvent::PROTOCOL{ipv4};
207 $cb->() if $family == 6 && !$AnyEvent::PROTOCOL{ipv6};
208
209 $family ||=4 unless $AnyEvent::PROTOCOL{ipv6};
210 $family ||=6 unless $AnyEvent::PROTOCOL{ipv4};
211
212 $proto ||= "tcp";
213 $type ||= $proto eq "udp" ? Socket::SOCK_DGRAM : Socket::SOCK_STREAM;
214
215 my $proton = (getprotobyname $proto)[2]
216 or Carp::croak "$proto: protocol unknown";
217
218 my $port;
219
220 if ($service =~ /^(\S+)=(\d+)$/) {
221 ($service, $port) = ($1, $2);
222 } elsif ($service =~ /^\d+$/) {
223 ($service, $port) = (undef, $service);
224 } else {
225 $port = (getservbyname $service, $proto)[2]
226 or Carp::croak "$service/$proto: service unknown";
227 }
228
229 my @target = [$node, $port];
230
231 # resolve a records / provide sockaddr structures
232 my $resolve = sub {
233 my @res;
234 my $cv = AnyEvent->condvar (cb => sub {
235 $cb->(
236 map $_->[1],
237 sort {
238 $AnyEvent::PROTOCOL{$a->[1][0]} <=> $AnyEvent::PROTOCOL{$b->[1][0]}
239 or $a->[0] <=> $b->[0]
240 }
241 @res
242 )
243 });
244
245 $cv->begin;
246 for my $idx (0 .. $#target) {
247 my ($node, $port) = @{ $target[$idx] };
248
249 if (my $noden = AnyEvent::Socket::parse_ip ($node)) {
250 if (4 == length $noden && $family != 6) {
251 push @res, [$idx, [Socket::AF_INET, $type, $proton,
252 AnyEvent::Socket::pack_sockaddr ($port, $noden)]]
253 }
254
255 if (16 == length $noden && $family != 4) {
256 push @res, [$idx, [&AnyEvent::Socket::AF_INET6, $type, $proton,
257 AnyEvent::Socket::pack_sockaddr ( $port, $noden)]]
258 }
259 } else {
260 # ipv4
261 if ($family != 6) {
262 $cv->begin;
263 a $node, sub {
264 push @res, [$idx, [Socket::AF_INET, $type, $proton,
265 AnyEvent::Socket::pack_sockaddr ($port, AnyEvent::Socket::parse_ipv4 ($_))]]
266 for @_;
267 $cv->end;
268 };
269 }
270
271 # ipv6
272 if ($family != 4) {
273 $cv->begin;
274 aaaa $node, sub {
275 push @res, [$idx, [&AnyEvent::Socket::AF_INET6, $type, $proton,
276 AnyEvent::Socket::pack_sockaddr ($port, AnyEvent::Socket::parse_ipv6 ($_))]]
277 for @_;
278 $cv->end;
279 };
280 }
281 }
282 }
283 $cv->end;
284 };
285
286 # try srv records, if applicable
287 if ($node eq "localhost") {
288 @target = (["127.0.0.1", $port], ["::1", $port]);
289 &$resolve;
290 } elsif (defined $service && !AnyEvent::Socket::parse_ip ($node)) {
291 srv $service, $proto, $node, sub {
292 my (@srv) = @_;
293
294 # no srv records, continue traditionally
295 @srv
296 or return &$resolve;
297
298 # only srv record has "." => abort
299 $srv[0][2] ne "." || $#srv
300 or return $cb->();
301
302 # use srv records then
303 @target = map ["$_->[3].", $_->[2]],
304 grep $_->[3] ne ".",
305 @srv;
306
307 &$resolve;
308 };
309 } else {
310 &$resolve;
311 }
312}
313
314#############################################################################
315 181
316=back 182=back
317 183
318=head2 LOW-LEVEL DNS EN-/DECODING FUNCTIONS 184=head2 LOW-LEVEL DNS EN-/DECODING FUNCTIONS
319 185
… …
405); 271);
406 272
407our %class_str = reverse %class_id; 273our %class_str = reverse %class_id;
408 274
409# names MUST have a trailing dot 275# names MUST have a trailing dot
410sub _enc_qname($) { 276sub _enc_name($) {
411 pack "(C/a)*", (split /\./, shift), "" 277 pack "(C/a*)*", (split /\./, shift), ""
412} 278}
413 279
414sub _enc_qd() { 280sub _enc_qd() {
415 (_enc_qname $_->[0]) . pack "nn", 281 (_enc_name $_->[0]) . pack "nn",
416 ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}), 282 ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}),
417 ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"}) 283 ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"})
418} 284}
419 285
420sub _enc_rr() { 286sub _enc_rr() {
… …
481 (join "", map _enc_qd, @{ $req->{qd} || [] }), 347 (join "", map _enc_qd, @{ $req->{qd} || [] }),
482 (join "", map _enc_rr, @{ $req->{an} || [] }), 348 (join "", map _enc_rr, @{ $req->{an} || [] }),
483 (join "", map _enc_rr, @{ $req->{ns} || [] }), 349 (join "", map _enc_rr, @{ $req->{ns} || [] }),
484 (join "", map _enc_rr, @{ $req->{ar} || [] }), 350 (join "", map _enc_rr, @{ $req->{ar} || [] }),
485 351
486 ($EDNS0 ? pack "C nnNn", 0, 41, 4096, 0, 0 : "") # EDNS0, 4kiB udp payload size 352 ($EDNS0 ? pack "C nnNn", 0, 41, MAX_PKT, 0, 0 : "") # EDNS0, 4kiB udp payload size
487} 353}
488 354
489our $ofs; 355our $ofs;
490our $pkt; 356our $pkt;
491 357
492# bitches 358# bitches
493sub _dec_qname { 359sub _dec_name {
494 my @res; 360 my @res;
495 my $redir; 361 my $redir;
496 my $ptr = $ofs; 362 my $ptr = $ofs;
497 my $cnt; 363 my $cnt;
498 364
499 while () { 365 while () {
500 return undef if ++$cnt >= 256; # to avoid DoS attacks 366 return undef if ++$cnt >= 256; # to avoid DoS attacks
501 367
502 my $len = ord substr $pkt, $ptr++, 1; 368 my $len = ord substr $pkt, $ptr++, 1;
503 369
504 if ($len & 0xc0) { 370 if ($len >= 0xc0) {
505 $ptr++; 371 $ptr++;
506 $ofs = $ptr if $ptr > $ofs; 372 $ofs = $ptr if $ptr > $ofs;
507 $ptr = (unpack "n", substr $pkt, $ptr - 2, 2) & 0x3fff; 373 $ptr = (unpack "n", substr $pkt, $ptr - 2, 2) & 0x3fff;
508 } elsif ($len) { 374 } elsif ($len) {
509 push @res, substr $pkt, $ptr, $len; 375 push @res, substr $pkt, $ptr, $len;
… …
514 } 380 }
515 } 381 }
516} 382}
517 383
518sub _dec_qd { 384sub _dec_qd {
519 my $qname = _dec_qname; 385 my $qname = _dec_name;
520 my ($qt, $qc) = unpack "nn", substr $pkt, $ofs; $ofs += 4; 386 my ($qt, $qc) = unpack "nn", substr $pkt, $ofs; $ofs += 4;
521 [$qname, $type_str{$qt} || $qt, $class_str{$qc} || $qc] 387 [$qname, $type_str{$qt} || $qt, $class_str{$qc} || $qc]
522} 388}
523 389
524our %dec_rr = ( 390our %dec_rr = (
525 1 => sub { join ".", unpack "C4" }, # a 391 1 => sub { join ".", unpack "C4", $_ }, # a
526 2 => sub { local $ofs = $ofs - length; _dec_qname }, # ns 392 2 => sub { local $ofs = $ofs - length; _dec_name }, # ns
527 5 => sub { local $ofs = $ofs - length; _dec_qname }, # cname 393 5 => sub { local $ofs = $ofs - length; _dec_name }, # cname
528 6 => sub { 394 6 => sub {
529 local $ofs = $ofs - length; 395 local $ofs = $ofs - length;
530 my $mname = _dec_qname; 396 my $mname = _dec_name;
531 my $rname = _dec_qname; 397 my $rname = _dec_name;
532 ($mname, $rname, unpack "NNNNN", substr $pkt, $ofs) 398 ($mname, $rname, unpack "NNNNN", substr $pkt, $ofs)
533 }, # soa 399 }, # soa
534 11 => sub { ((join ".", unpack "C4"), unpack "C a*", substr $_, 4) }, # wks 400 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks
535 12 => sub { local $ofs = $ofs - length; _dec_qname }, # ptr 401 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr
536 13 => sub { unpack "C/a C/a", $_ }, # hinfo 402 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo
537 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_qname) }, # mx 403 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx
538 16 => sub { unpack "(C/a)*", $_ }, # txt 404 16 => sub { unpack "(C/a*)*", $_ }, # txt
539 28 => sub { AnyEvent::Socket::format_ip ($_) }, # aaaa 405 28 => sub { AnyEvent::Socket::format_address ($_) }, # aaaa
540 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_qname) }, # srv 406 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv
541 99 => sub { unpack "(C/a)*", $_ }, # spf 407 99 => sub { unpack "(C/a*)*", $_ }, # spf
542); 408);
543 409
544sub _dec_rr { 410sub _dec_rr {
545 my $qname = _dec_qname; 411 my $name = _dec_name;
546 412
547 my ($rt, $rc, $ttl, $rdlen) = unpack "nn N n", substr $pkt, $ofs; $ofs += 10; 413 my ($rt, $rc, $ttl, $rdlen) = unpack "nn N n", substr $pkt, $ofs; $ofs += 10;
548 local $_ = substr $pkt, $ofs, $rdlen; $ofs += $rdlen; 414 local $_ = substr $pkt, $ofs, $rdlen; $ofs += $rdlen;
549 415
550 [ 416 [
551 $qname, 417 $name,
552 $type_str{$rt} || $rt, 418 $type_str{$rt} || $rt,
553 $class_str{$rc} || $rc, 419 $class_str{$rc} || $rc,
554 ($dec_rr{$rt} || sub { $_ })->(), 420 ($dec_rr{$rt} || sub { $_ })->(),
555 ] 421 ]
556} 422}
… …
732=cut 598=cut
733 599
734sub new { 600sub new {
735 my ($class, %arg) = @_; 601 my ($class, %arg) = @_;
736 602
603 # try to create a ipv4 and an ipv6 socket
604 # only fail when we cnanot create either
605
737 socket my $fh, &Socket::AF_INET, &Socket::SOCK_DGRAM, 0 606 socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0;
738 or Carp::croak "socket: $!"; 607 socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0;
739 608
740 AnyEvent::Util::fh_nonblocking $fh, 1; 609 $fh4 || $fh6
610 or Carp::croak "unable to create either an IPv6 or an IPv4 socket";
741 611
742 my $self = bless { 612 my $self = bless {
743 server => [v127.0.0.1], 613 server => [],
744 timeout => [2, 5, 5], 614 timeout => [2, 5, 5],
745 search => [], 615 search => [],
746 ndots => 1, 616 ndots => 1,
747 max_outstanding => 10, 617 max_outstanding => 10,
748 reuse => 300, # reuse id's after 5 minutes only, if possible 618 reuse => 300, # reuse id's after 5 minutes only, if possible
749 %arg, 619 %arg,
750 fh => $fh,
751 reuse_q => [], 620 reuse_q => [],
752 }, $class; 621 }, $class;
753 622
754 # search should default to gethostname's domain 623 # search should default to gethostname's domain
755 # but perl lacks a good posix module 624 # but perl lacks a good posix module
756 625
757 Scalar::Util::weaken (my $wself = $self); 626 Scalar::Util::weaken (my $wself = $self);
627
628 if ($fh4) {
629 AnyEvent::Util::fh_nonblocking $fh4, 1;
630 $self->{fh4} = $fh4;
758 $self->{rw} = AnyEvent->io (fh => $fh, poll => "r", cb => sub { $wself->_recv }); 631 $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub {
632 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) {
633 $wself->_recv ($pkt, $peer);
634 }
635 });
636 }
637
638 if ($fh6) {
639 $self->{fh6} = $fh6;
640 AnyEvent::Util::fh_nonblocking $fh6, 1;
641 $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub {
642 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) {
643 $wself->_recv ($pkt, $peer);
644 }
645 });
646 }
759 647
760 $self->_compile; 648 $self->_compile;
761 649
762 $self 650 $self
763} 651}
… …
785 for (split /\n/, $resolvconf) { 673 for (split /\n/, $resolvconf) {
786 if (/^\s*#/) { 674 if (/^\s*#/) {
787 # comment 675 # comment
788 } elsif (/^\s*nameserver\s+(\S+)\s*$/i) { 676 } elsif (/^\s*nameserver\s+(\S+)\s*$/i) {
789 my $ip = $1; 677 my $ip = $1;
790 if (AnyEvent::Util::dotted_quad $ip) { 678 if (my $ipn = AnyEvent::Socket::parse_address ($ip)) {
791 push @{ $self->{server} }, AnyEvent::Util::socket_inet_aton $ip; 679 push @{ $self->{server} }, $ipn;
792 } else { 680 } else {
793 warn "nameserver $ip invalid and ignored\n"; 681 warn "nameserver $ip invalid and ignored\n";
794 } 682 }
795 } elsif (/^\s*domain\s+(\S*)\s+$/i) { 683 } elsif (/^\s*domain\s+(\S*)\s+$/i) {
796 $self->{search} = [$1]; 684 $self->{search} = [$1];
… …
827=cut 715=cut
828 716
829sub os_config { 717sub os_config {
830 my ($self) = @_; 718 my ($self) = @_;
831 719
832 if ($^O =~ /mswin32|cygwin/i) { 720 $self->{server} = [];
833 # yeah, it suxx... lets hope DNS is DNS in all locales 721 $self->{search} = [];
722
723 if (AnyEvent::WIN32 || $^O =~ /cygwin/i) {
724 no strict 'refs';
725
726 # there are many options to find the current nameservers etc. on windows
727 # all of them don't work consistently:
728 # - the registry thing needs separate code on win32 native vs. cygwin
729 # - the registry layout differs between windows versions
730 # - calling windows api functions doesn't work on cygwin
731 # - ipconfig uses locale-specific messages
732
733 # we use ipconfig parsing because, despite all it's brokenness,
734 # it seems most stable in practise.
735 # for good measure, we append a fallback nameserver to our list.
834 736
835 if (open my $fh, "ipconfig /all |") { 737 if (open my $fh, "ipconfig /all |") {
836 delete $self->{server}; 738 # parsing strategy: we go through the output and look for
837 delete $self->{search}; 739 # :-lines with DNS in them. everything in those is regarded as
740 # either a nameserver (if it parses as an ip address), or a suffix
741 # (all else).
838 742
743 my $dns;
839 while (<$fh>) { 744 while (<$fh>) {
840 # first DNS.* is suffix list 745 if (s/^\s.*\bdns\b.*://i) {
841 if (/^\s*DNS/) { 746 $dns = 1;
842 while (/\s+([[:alnum:].\-]+)\s*$/) { 747 } elsif (/^\S/ || /^\s[^:]{16,}: /) {
748 $dns = 0;
749 }
750 if ($dns && /^\s*(\S+)\s*$/) {
751 my $s = $1;
752 $s =~ s/%\d+(?!\S)//; # get rid of scope id
753 if (my $ipn = AnyEvent::Socket::parse_address ($s)) {
754 push @{ $self->{server} }, $ipn;
755 } else {
843 push @{ $self->{search} }, $1; 756 push @{ $self->{search} }, $s;
844 $_ = <$fh>;
845 } 757 }
846 last;
847 } 758 }
848 } 759 }
849 760
850 while (<$fh>) { 761 # always add one fallback server
851 # second DNS.* is server address list 762 push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK];
852 if (/^\s*DNS/) {
853 while (/\s+(\d+\.\d+\.\d+\.\d+)\s*$/) {
854 my $ip = $1;
855 push @{ $self->{server} }, AnyEvent::Util::socket_inet_aton $ip
856 if AnyEvent::Util::dotted_quad $ip;
857 $_ = <$fh>;
858 }
859 last;
860 }
861 }
862 763
863 $self->_compile; 764 $self->_compile;
864 } 765 }
865 } else { 766 } else {
866 # try resolv.conf everywhere 767 # try resolv.conf everywhere
… …
873} 774}
874 775
875sub _compile { 776sub _compile {
876 my $self = shift; 777 my $self = shift;
877 778
779 my %search; $self->{search} = [grep 0 < length, grep !$search{$_}++, @{ $self->{search} }];
780 my %server; $self->{server} = [grep 0 < length, grep !$server{$_}++, @{ $self->{server} }];
781
782 unless (@{ $self->{server} }) {
783 # use 127.0.0.1 by default, and one opendns nameserver as fallback
784 $self->{server} = [v127.0.0.1, $DNS_FALLBACK[rand @DNS_FALLBACK]];
785 }
786
878 my @retry; 787 my @retry;
879 788
880 for my $timeout (@{ $self->{timeout} }) { 789 for my $timeout (@{ $self->{timeout} }) {
881 for my $server (@{ $self->{server} }) { 790 for my $server (@{ $self->{server} }) {
882 push @retry, [$server, $timeout]; 791 push @retry, [$server, $timeout];
… …
899 $NOW = time; 808 $NOW = time;
900 $id->[1]->($res); 809 $id->[1]->($res);
901} 810}
902 811
903sub _recv { 812sub _recv {
904 my ($self) = @_; 813 my ($self, $pkt, $peer) = @_;
905 814
906 while (my $peer = recv $self->{fh}, my $res, 4096, 0) { 815 # we ignore errors (often one gets port unreachable, but there is
816 # no good way to take advantage of that.
817
907 my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer); 818 my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer);
908 819
909 return unless $port == 53 && grep $_ eq $host, @{ $self->{server} }; 820 return unless $port == 53 && grep $_ eq $host, @{ $self->{server} };
910 821
911 $self->_feed ($res); 822 $self->_feed ($pkt);
912 }
913} 823}
914 824
915sub _free_id { 825sub _free_id {
916 my ($self, $id, $timeout) = @_; 826 my ($self, $id, $timeout) = @_;
917 827
… …
953 }), sub { 863 }), sub {
954 my ($res) = @_; 864 my ($res) = @_;
955 865
956 if ($res->{tc}) { 866 if ($res->{tc}) {
957 # success, but truncated, so use tcp 867 # success, but truncated, so use tcp
958 AnyEvent::Socket::tcp_connect ((Socket::inet_ntoa $server), 53, sub { 868 AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub {
959 my ($fh) = @_ 869 my ($fh) = @_
960 or return &$do_retry; 870 or return &$do_retry;
961 871
962 my $handle = new AnyEvent::Handle 872 my $handle = new AnyEvent::Handle
963 fh => $fh, 873 fh => $fh,
… …
965 # failure, try next 875 # failure, try next
966 &$do_retry; 876 &$do_retry;
967 }; 877 };
968 878
969 $handle->push_write (pack "n/a", $req->[0]); 879 $handle->push_write (pack "n/a", $req->[0]);
970 $handle->push_read_chunk (2, sub { 880 $handle->push_read (chunk => 2, sub {
971 $handle->unshift_read_chunk ((unpack "n", $_[1]), sub { 881 $handle->unshift_read (chunk => (unpack "n", $_[1]), sub {
972 $self->_feed ($_[1]); 882 $self->_feed ($_[1]);
973 }); 883 });
974 }); 884 });
975 shutdown $fh, 1; 885 shutdown $fh, 1;
976 886
… …
980 # success 890 # success
981 $self->_free_id ($req->[2], $retry > 1); 891 $self->_free_id ($req->[2], $retry > 1);
982 undef $do_retry; return $req->[1]->($res); 892 undef $do_retry; return $req->[1]->($res);
983 } 893 }
984 }]; 894 }];
895
896 my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server);
985 897
986 send $self->{fh}, $req->[0], 0, AnyEvent::Socket::pack_sockaddr (53, $server); 898 my $fh = AF_INET == Socket::sockaddr_family ($sa)
899 ? $self->{fh4} : $self->{fh6}
900 or return &$do_retry;
901
902 send $fh, $req->[0], 0, $sa;
987 }; 903 };
988 904
989 &$do_retry; 905 &$do_retry;
990} 906}
991 907

Diff Legend

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