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.27 by root, Sat May 24 23:10:18 2008 UTC vs.
Revision 1.39 by root, Thu May 29 03:45:37 2008 UTC

… …
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use AnyEvent::DNS; 7 use AnyEvent::DNS;
8 8
9 my $cv = AnyEvent->condvar; 9 my $cv = AnyEvent->condvar;
10 AnyEvent::DNS::a "www.google.de", sub { $cv->send (@_) }; 10 AnyEvent::DNS::a "www.google.de", $cv;
11 # ... later 11 # ... later
12 my @addrs = $cv->recv; 12 my @addrs = $cv->recv;
13 13
14=head1 DESCRIPTION 14=head1 DESCRIPTION
15 15
… …
29package AnyEvent::DNS; 29package AnyEvent::DNS;
30 30
31no warnings; 31no warnings;
32use strict; 32use strict;
33 33
34use Socket qw(AF_INET SOCK_DGRAM SOCK_STREAM);
35
36use AnyEvent ();
34use AnyEvent::Handle (); 37use AnyEvent::Handle ();
38use AnyEvent::Util qw(AF_INET6);
35 39
36=item AnyEvent::DNS::addr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...) 40our $VERSION = '1.0';
37 41
38Tries to resolve the given nodename and service name into protocol families 42our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222);
39and sockaddr structures usable to connect to this node and service in a
40protocol-independent way. It works remotely similar to the getaddrinfo
41posix function.
42
43C<$node> is either an IPv4 or IPv6 address or a hostname, C<$service> is
44either a service name (port name from F</etc/services>) or a numerical
45port number. If both C<$node> and C<$service> are names, then SRV records
46will be consulted to find the real service, otherwise they will be
47used as-is. If you know that the service name is not in your services
48database, then you can specify the service in the format C<name=port>
49(e.g. C<http=80>).
50
51C<$proto> must be a protocol name, currently C<tcp>, C<udp> or
52C<sctp>. The default is C<tcp>.
53
54C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use
55only IPv4) or C<6> (use only IPv6). This setting might be influenced by
56C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.
57
58C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or
59C<undef> in which case it gets automatically chosen).
60
61The callback will receive zero or more array references that contain
62C<$family, $type, $proto> for use in C<socket> and a binary
63C<$sockaddr> for use in C<connect> (or C<bind>).
64
65The application should try these in the order given.
66
67Example:
68
69 AnyEvent::DNS::addr "google.com", "http", 0, undef, undef, sub { ... };
70 43
71=item AnyEvent::DNS::a $domain, $cb->(@addrs) 44=item AnyEvent::DNS::a $domain, $cb->(@addrs)
72 45
73Tries to resolve the given domain to IPv4 address(es). 46Tries to resolve the given domain to IPv4 address(es).
74 47
… …
119 92
120Tries 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
121the callback. 94the callback.
122 95
123=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
124 101
125sub resolver; 102sub resolver;
126 103
127sub a($$) { 104sub a($$) {
128 my ($domain, $cb) = @_; 105 my ($domain, $cb) = @_;
… …
174} 151}
175 152
176sub ptr($$) { 153sub ptr($$) {
177 my ($ip, $cb) = @_; 154 my ($ip, $cb) = @_;
178 155
179 $ip = AnyEvent::Socket::parse_ip ($ip) 156 $ip = AnyEvent::Socket::parse_address ($ip)
180 or return $cb->(); 157 or return $cb->();
181 158
182 if (4 == length $ip) { 159 my $af = AnyEvent::Socket::address_family ($ip);
160
161 if ($af == AF_INET) {
183 $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.";
184 } else { 165 } else {
185 $ip = join ".", (reverse split //, unpack "H*", $ip), "ip6.arpa."; 166 return $cb->();
186 } 167 }
187 168
188 resolver->resolve ($ip => "ptr", sub { 169 resolver->resolve ($ip => "ptr", sub {
189 $cb->(map $_->[3], @_); 170 $cb->(map $_->[3], @_);
190 }); 171 });
… …
194 my ($domain, $cb) = @_; 175 my ($domain, $cb) = @_;
195 176
196 resolver->resolve ($domain => "*", $cb); 177 resolver->resolve ($domain => "*", $cb);
197} 178}
198 179
199############################################################################# 180#################################################################################
200
201sub addr($$$$$$) {
202 my ($node, $service, $proto, $family, $type, $cb) = @_;
203
204 unless (&AnyEvent::Socket::AF_INET6) {
205 $family != 6
206 or return $cb->();
207
208 $family ||= 4;
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
217 $proto ||= "tcp";
218 $type ||= $proto eq "udp" ? Socket::SOCK_DGRAM : Socket::SOCK_STREAM;
219
220 my $proton = (getprotobyname $proto)[2]
221 or Carp::croak "$proto: protocol unknown";
222
223 my $port;
224
225 if ($service =~ /^(\S+)=(\d+)$/) {
226 ($service, $port) = ($1, $2);
227 } elsif ($service =~ /^\d+$/) {
228 ($service, $port) = (undef, $service);
229 } else {
230 $port = (getservbyname $service, $proto)[2]
231 or Carp::croak "$service/$proto: service unknown";
232 }
233
234 my @target = [$node, $port];
235
236 # resolve a records / provide sockaddr structures
237 my $resolve = sub {
238 my @res;
239 my $cv = AnyEvent->condvar (cb => sub {
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 )
248 });
249
250 $cv->begin;
251 for my $idx (0 .. $#target) {
252 my ($node, $port) = @{ $target[$idx] };
253
254 if (my $noden = AnyEvent::Socket::parse_ip ($node)) {
255 if (4 == length $noden && $family != 6) {
256 push @res, [$idx, "ipv4", [Socket::AF_INET, $type, $proton,
257 AnyEvent::Socket::pack_sockaddr ($port, $noden)]]
258 }
259
260 if (16 == length $noden && $family != 4) {
261 push @res, [$idx, "ipv6", [&AnyEvent::Socket::AF_INET6, $type, $proton,
262 AnyEvent::Socket::pack_sockaddr ( $port, $noden)]]
263 }
264 } else {
265 # ipv4
266 if ($family != 6) {
267 $cv->begin;
268 a $node, sub {
269 push @res, [$idx, "ipv4", [Socket::AF_INET, $type, $proton,
270 AnyEvent::Socket::pack_sockaddr ($port, AnyEvent::Socket::parse_ipv4 ($_))]]
271 for @_;
272 $cv->end;
273 };
274 }
275
276 # ipv6
277 if ($family != 4) {
278 $cv->begin;
279 aaaa $node, sub {
280 push @res, [$idx, "ipv6", [&AnyEvent::Socket::AF_INET6, $type, $proton,
281 AnyEvent::Socket::pack_sockaddr ($port, AnyEvent::Socket::parse_ipv6 ($_))]]
282 for @_;
283 $cv->end;
284 };
285 }
286 }
287 }
288 $cv->end;
289 };
290
291 # try srv records, if applicable
292 if ($node eq "localhost") {
293 @target = (["127.0.0.1", $port], ["::1", $port]);
294 &$resolve;
295 } elsif (defined $service && !AnyEvent::Socket::parse_ip ($node)) {
296 srv $service, $proto, $node, sub {
297 my (@srv) = @_;
298
299 # no srv records, continue traditionally
300 @srv
301 or return &$resolve;
302
303 # only srv record has "." => abort
304 $srv[0][2] ne "." || $#srv
305 or return $cb->();
306
307 # use srv records then
308 @target = map ["$_->[3].", $_->[2]],
309 grep $_->[3] ne ".",
310 @srv;
311
312 &$resolve;
313 };
314 } else {
315 &$resolve;
316 }
317}
318
319#############################################################################
320 181
321=back 182=back
322 183
323=head2 LOW-LEVEL DNS EN-/DECODING FUNCTIONS 184=head2 LOW-LEVEL DNS EN-/DECODING FUNCTIONS
324 185
… …
410); 271);
411 272
412our %class_str = reverse %class_id; 273our %class_str = reverse %class_id;
413 274
414# names MUST have a trailing dot 275# names MUST have a trailing dot
415sub _enc_qname($) { 276sub _enc_name($) {
416 pack "(C/a)*", (split /\./, shift), "" 277 pack "(C/a*)*", (split /\./, shift), ""
417} 278}
418 279
419sub _enc_qd() { 280sub _enc_qd() {
420 (_enc_qname $_->[0]) . pack "nn", 281 (_enc_name $_->[0]) . pack "nn",
421 ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}), 282 ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}),
422 ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"}) 283 ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"})
423} 284}
424 285
425sub _enc_rr() { 286sub _enc_rr() {
… …
486 (join "", map _enc_qd, @{ $req->{qd} || [] }), 347 (join "", map _enc_qd, @{ $req->{qd} || [] }),
487 (join "", map _enc_rr, @{ $req->{an} || [] }), 348 (join "", map _enc_rr, @{ $req->{an} || [] }),
488 (join "", map _enc_rr, @{ $req->{ns} || [] }), 349 (join "", map _enc_rr, @{ $req->{ns} || [] }),
489 (join "", map _enc_rr, @{ $req->{ar} || [] }), 350 (join "", map _enc_rr, @{ $req->{ar} || [] }),
490 351
491 ($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
492} 353}
493 354
494our $ofs; 355our $ofs;
495our $pkt; 356our $pkt;
496 357
497# bitches 358# bitches
498sub _dec_qname { 359sub _dec_name {
499 my @res; 360 my @res;
500 my $redir; 361 my $redir;
501 my $ptr = $ofs; 362 my $ptr = $ofs;
502 my $cnt; 363 my $cnt;
503 364
504 while () { 365 while () {
505 return undef if ++$cnt >= 256; # to avoid DoS attacks 366 return undef if ++$cnt >= 256; # to avoid DoS attacks
506 367
507 my $len = ord substr $pkt, $ptr++, 1; 368 my $len = ord substr $pkt, $ptr++, 1;
508 369
509 if ($len & 0xc0) { 370 if ($len >= 0xc0) {
510 $ptr++; 371 $ptr++;
511 $ofs = $ptr if $ptr > $ofs; 372 $ofs = $ptr if $ptr > $ofs;
512 $ptr = (unpack "n", substr $pkt, $ptr - 2, 2) & 0x3fff; 373 $ptr = (unpack "n", substr $pkt, $ptr - 2, 2) & 0x3fff;
513 } elsif ($len) { 374 } elsif ($len) {
514 push @res, substr $pkt, $ptr, $len; 375 push @res, substr $pkt, $ptr, $len;
… …
519 } 380 }
520 } 381 }
521} 382}
522 383
523sub _dec_qd { 384sub _dec_qd {
524 my $qname = _dec_qname; 385 my $qname = _dec_name;
525 my ($qt, $qc) = unpack "nn", substr $pkt, $ofs; $ofs += 4; 386 my ($qt, $qc) = unpack "nn", substr $pkt, $ofs; $ofs += 4;
526 [$qname, $type_str{$qt} || $qt, $class_str{$qc} || $qc] 387 [$qname, $type_str{$qt} || $qt, $class_str{$qc} || $qc]
527} 388}
528 389
529our %dec_rr = ( 390our %dec_rr = (
530 1 => sub { join ".", unpack "C4" }, # a 391 1 => sub { join ".", unpack "C4", $_ }, # a
531 2 => sub { local $ofs = $ofs - length; _dec_qname }, # ns 392 2 => sub { local $ofs = $ofs - length; _dec_name }, # ns
532 5 => sub { local $ofs = $ofs - length; _dec_qname }, # cname 393 5 => sub { local $ofs = $ofs - length; _dec_name }, # cname
533 6 => sub { 394 6 => sub {
534 local $ofs = $ofs - length; 395 local $ofs = $ofs - length;
535 my $mname = _dec_qname; 396 my $mname = _dec_name;
536 my $rname = _dec_qname; 397 my $rname = _dec_name;
537 ($mname, $rname, unpack "NNNNN", substr $pkt, $ofs) 398 ($mname, $rname, unpack "NNNNN", substr $pkt, $ofs)
538 }, # soa 399 }, # soa
539 11 => sub { ((join ".", unpack "C4"), unpack "C a*", substr $_, 4) }, # wks 400 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks
540 12 => sub { local $ofs = $ofs - length; _dec_qname }, # ptr 401 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr
541 13 => sub { unpack "C/a C/a", $_ }, # hinfo 402 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo
542 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
543 16 => sub { unpack "(C/a)*", $_ }, # txt 404 16 => sub { unpack "(C/a*)*", $_ }, # txt
544 28 => sub { AnyEvent::Socket::format_ip ($_) }, # aaaa 405 28 => sub { AnyEvent::Socket::format_address ($_) }, # aaaa
545 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
546 99 => sub { unpack "(C/a)*", $_ }, # spf 407 99 => sub { unpack "(C/a*)*", $_ }, # spf
547); 408);
548 409
549sub _dec_rr { 410sub _dec_rr {
550 my $qname = _dec_qname; 411 my $name = _dec_name;
551 412
552 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;
553 local $_ = substr $pkt, $ofs, $rdlen; $ofs += $rdlen; 414 local $_ = substr $pkt, $ofs, $rdlen; $ofs += $rdlen;
554 415
555 [ 416 [
556 $qname, 417 $name,
557 $type_str{$rt} || $rt, 418 $type_str{$rt} || $rt,
558 $class_str{$rc} || $rc, 419 $class_str{$rc} || $rc,
559 ($dec_rr{$rt} || sub { $_ })->(), 420 ($dec_rr{$rt} || sub { $_ })->(),
560 ] 421 ]
561} 422}
… …
737=cut 598=cut
738 599
739sub new { 600sub new {
740 my ($class, %arg) = @_; 601 my ($class, %arg) = @_;
741 602
603 # try to create a ipv4 and an ipv6 socket
604 # only fail when we cnanot create either
605
742 socket my $fh, &Socket::AF_INET, &Socket::SOCK_DGRAM, 0 606 socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0;
743 or Carp::croak "socket: $!"; 607 socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0;
744 608
745 AnyEvent::Util::fh_nonblocking $fh, 1; 609 $fh4 || $fh6
610 or Carp::croak "unable to create either an IPv6 or an IPv4 socket";
746 611
747 my $self = bless { 612 my $self = bless {
748 server => [v127.0.0.1], 613 server => [],
749 timeout => [2, 5, 5], 614 timeout => [2, 5, 5],
750 search => [], 615 search => [],
751 ndots => 1, 616 ndots => 1,
752 max_outstanding => 10, 617 max_outstanding => 10,
753 reuse => 300, # reuse id's after 5 minutes only, if possible 618 reuse => 300, # reuse id's after 5 minutes only, if possible
754 %arg, 619 %arg,
755 fh => $fh,
756 reuse_q => [], 620 reuse_q => [],
757 }, $class; 621 }, $class;
758 622
759 # search should default to gethostname's domain 623 # search should default to gethostname's domain
760 # but perl lacks a good posix module 624 # but perl lacks a good posix module
761 625
762 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;
763 $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 }
764 647
765 $self->_compile; 648 $self->_compile;
766 649
767 $self 650 $self
768} 651}
… …
790 for (split /\n/, $resolvconf) { 673 for (split /\n/, $resolvconf) {
791 if (/^\s*#/) { 674 if (/^\s*#/) {
792 # comment 675 # comment
793 } elsif (/^\s*nameserver\s+(\S+)\s*$/i) { 676 } elsif (/^\s*nameserver\s+(\S+)\s*$/i) {
794 my $ip = $1; 677 my $ip = $1;
795 if (my $ipn = AnyEvent::Socket::parse_ip ($ip)) { 678 if (my $ipn = AnyEvent::Socket::parse_address ($ip)) {
796 push @{ $self->{server} }, $ipn; 679 push @{ $self->{server} }, $ipn;
797 } else { 680 } else {
798 warn "nameserver $ip invalid and ignored\n"; 681 warn "nameserver $ip invalid and ignored\n";
799 } 682 }
800 } elsif (/^\s*domain\s+(\S*)\s+$/i) { 683 } elsif (/^\s*domain\s+(\S*)\s+$/i) {
… …
832=cut 715=cut
833 716
834sub os_config { 717sub os_config {
835 my ($self) = @_; 718 my ($self) = @_;
836 719
837 if ($^O =~ /mswin32|cygwin/i) { 720 $self->{server} = [];
838 # 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.
839 736
840 if (open my $fh, "ipconfig /all |") { 737 if (open my $fh, "ipconfig /all |") {
841 delete $self->{server}; 738 # parsing strategy: we go through the output and look for
842 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).
843 742
743 my $dns;
844 while (<$fh>) { 744 while (<$fh>) {
845 # first DNS.* is suffix list 745 if (s/^\s.*\bdns\b.*://i) {
846 if (/^\s*DNS/) { 746 $dns = 1;
847 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 {
848 push @{ $self->{search} }, $1; 756 push @{ $self->{search} }, $s;
849 $_ = <$fh>;
850 } 757 }
851 last;
852 } 758 }
853 } 759 }
854 760
855 while (<$fh>) { 761 # always add one fallback server
856 # second DNS.* is server address list 762 push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK];
857 if (/^\s*DNS/) {
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
861 if $ipn;
862 $_ = <$fh>;
863 }
864 last;
865 }
866 }
867 763
868 $self->_compile; 764 $self->_compile;
869 } 765 }
870 } else { 766 } else {
871 # try resolv.conf everywhere 767 # try resolv.conf everywhere
… …
878} 774}
879 775
880sub _compile { 776sub _compile {
881 my $self = shift; 777 my $self = shift;
882 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
883 my @retry; 787 my @retry;
884 788
885 for my $timeout (@{ $self->{timeout} }) { 789 for my $timeout (@{ $self->{timeout} }) {
886 for my $server (@{ $self->{server} }) { 790 for my $server (@{ $self->{server} }) {
887 push @retry, [$server, $timeout]; 791 push @retry, [$server, $timeout];
… …
904 $NOW = time; 808 $NOW = time;
905 $id->[1]->($res); 809 $id->[1]->($res);
906} 810}
907 811
908sub _recv { 812sub _recv {
909 my ($self) = @_; 813 my ($self, $pkt, $peer) = @_;
910 814
911 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
912 my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer); 818 my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer);
913 819
914 return unless $port == 53 && grep $_ eq $host, @{ $self->{server} }; 820 return unless $port == 53 && grep $_ eq $host, @{ $self->{server} };
915 821
916 $self->_feed ($res); 822 $self->_feed ($pkt);
917 }
918} 823}
919 824
920sub _free_id { 825sub _free_id {
921 my ($self, $id, $timeout) = @_; 826 my ($self, $id, $timeout) = @_;
922 827
… …
958 }), sub { 863 }), sub {
959 my ($res) = @_; 864 my ($res) = @_;
960 865
961 if ($res->{tc}) { 866 if ($res->{tc}) {
962 # success, but truncated, so use tcp 867 # success, but truncated, so use tcp
963 AnyEvent::Socket::tcp_connect ((Socket::inet_ntoa $server), 53, sub { 868 AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub {
964 my ($fh) = @_ 869 my ($fh) = @_
965 or return &$do_retry; 870 or return &$do_retry;
966 871
967 my $handle = new AnyEvent::Handle 872 my $handle = new AnyEvent::Handle
968 fh => $fh, 873 fh => $fh,
… …
985 # success 890 # success
986 $self->_free_id ($req->[2], $retry > 1); 891 $self->_free_id ($req->[2], $retry > 1);
987 undef $do_retry; return $req->[1]->($res); 892 undef $do_retry; return $req->[1]->($res);
988 } 893 }
989 }]; 894 }];
895
896 my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server);
990 897
991 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;
992 }; 903 };
993 904
994 &$do_retry; 905 &$do_retry;
995} 906}
996 907

Diff Legend

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