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.28 by root, Sun May 25 01:05:27 2008 UTC vs.
Revision 1.42 by root, Thu May 29 06:17:52 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::Util::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::Util::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
… …
326 187
327=item $AnyEvent::DNS::EDNS0 188=item $AnyEvent::DNS::EDNS0
328 189
329This variable decides whether dns_pack automatically enables EDNS0 190This variable decides whether dns_pack automatically enables EDNS0
330support. By default, this is disabled (C<0>), unless overridden by 191support. By default, this is disabled (C<0>), unless overridden by
331C<$ENV{PERL_ANYEVENT_EDNS0>), but when set to C<1>, AnyEvent::DNS will use 192C<$ENV{PERL_ANYEVENT_EDNS0}>, but when set to C<1>, AnyEvent::DNS will use
332EDNS0 in all requests. 193EDNS0 in all requests.
333 194
334=cut 195=cut
335 196
336our $EDNS0 = $ENV{PERL_ANYEVENT_EDNS0} * 1; # set to 1 to enable (partial) edns0 197our $EDNS0 = $ENV{PERL_ANYEVENT_EDNS0} * 1; # set to 1 to enable (partial) edns0
… …
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}
… …
699 560
700=over 4 561=over 4
701 562
702=item server => [...] 563=item server => [...]
703 564
704A list of server addresses (default: C<v127.0.0.1>) in network format (4 565A list of server addresses (default: C<v127.0.0.1>) in network format
705octets for IPv4, 16 octets for IPv6 - not yet supported). 566(i.e. as returned by C<AnyEvent::Socket::parse_address> - both IPv4 and
567IPv6 are supported).
706 568
707=item timeout => [...] 569=item timeout => [...]
708 570
709A list of timeouts to use (also determines the number of retries). To make 571A list of timeouts to use (also determines the number of retries). To make
710three retries with individual time-outs of 2, 5 and 5 seconds, use C<[2, 572three retries with individual time-outs of 2, 5 and 5 seconds, use C<[2,
… …
737=cut 599=cut
738 600
739sub new { 601sub new {
740 my ($class, %arg) = @_; 602 my ($class, %arg) = @_;
741 603
604 # try to create a ipv4 and an ipv6 socket
605 # only fail when we cnanot create either
606
742 socket my $fh, &Socket::AF_INET, &Socket::SOCK_DGRAM, 0 607 socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0;
743 or Carp::croak "socket: $!"; 608 socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0;
744 609
745 AnyEvent::Util::fh_nonblocking $fh, 1; 610 $fh4 || $fh6
611 or Carp::croak "unable to create either an IPv6 or an IPv4 socket";
746 612
747 my $self = bless { 613 my $self = bless {
748 server => [v127.0.0.1], 614 server => [],
749 timeout => [2, 5, 5], 615 timeout => [2, 5, 5],
750 search => [], 616 search => [],
751 ndots => 1, 617 ndots => 1,
752 max_outstanding => 10, 618 max_outstanding => 10,
753 reuse => 300, # reuse id's after 5 minutes only, if possible 619 reuse => 300, # reuse id's after 5 minutes only, if possible
754 %arg, 620 %arg,
755 fh => $fh,
756 reuse_q => [], 621 reuse_q => [],
757 }, $class; 622 }, $class;
758 623
759 # search should default to gethostname's domain 624 # search should default to gethostname's domain
760 # but perl lacks a good posix module 625 # but perl lacks a good posix module
761 626
762 Scalar::Util::weaken (my $wself = $self); 627 Scalar::Util::weaken (my $wself = $self);
628
629 if ($fh4) {
630 AnyEvent::Util::fh_nonblocking $fh4, 1;
631 $self->{fh4} = $fh4;
763 $self->{rw} = AnyEvent->io (fh => $fh, poll => "r", cb => sub { $wself->_recv }); 632 $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub {
633 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) {
634 $wself->_recv ($pkt, $peer);
635 }
636 });
637 }
638
639 if ($fh6) {
640 $self->{fh6} = $fh6;
641 AnyEvent::Util::fh_nonblocking $fh6, 1;
642 $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub {
643 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) {
644 $wself->_recv ($pkt, $peer);
645 }
646 });
647 }
764 648
765 $self->_compile; 649 $self->_compile;
766 650
767 $self 651 $self
768} 652}
… …
790 for (split /\n/, $resolvconf) { 674 for (split /\n/, $resolvconf) {
791 if (/^\s*#/) { 675 if (/^\s*#/) {
792 # comment 676 # comment
793 } elsif (/^\s*nameserver\s+(\S+)\s*$/i) { 677 } elsif (/^\s*nameserver\s+(\S+)\s*$/i) {
794 my $ip = $1; 678 my $ip = $1;
795 if (my $ipn = AnyEvent::Socket::parse_ip ($ip)) { 679 if (my $ipn = AnyEvent::Socket::parse_address ($ip)) {
796 push @{ $self->{server} }, $ipn; 680 push @{ $self->{server} }, $ipn;
797 } else { 681 } else {
798 warn "nameserver $ip invalid and ignored\n"; 682 warn "nameserver $ip invalid and ignored\n";
799 } 683 }
800 } elsif (/^\s*domain\s+(\S*)\s+$/i) { 684 } elsif (/^\s*domain\s+(\S*)\s+$/i) {
… …
832=cut 716=cut
833 717
834sub os_config { 718sub os_config {
835 my ($self) = @_; 719 my ($self) = @_;
836 720
837 if ($^O =~ /mswin32|cygwin/i) { 721 $self->{server} = [];
838 # yeah, it suxx... lets hope DNS is DNS in all locales 722 $self->{search} = [];
723
724 if (AnyEvent::WIN32 || $^O =~ /cygwin/i) {
725 no strict 'refs';
726
727 # there are many options to find the current nameservers etc. on windows
728 # all of them don't work consistently:
729 # - the registry thing needs separate code on win32 native vs. cygwin
730 # - the registry layout differs between windows versions
731 # - calling windows api functions doesn't work on cygwin
732 # - ipconfig uses locale-specific messages
733
734 # we use ipconfig parsing because, despite all it's brokenness,
735 # it seems most stable in practise.
736 # for good measure, we append a fallback nameserver to our list.
839 737
840 if (open my $fh, "ipconfig /all |") { 738 if (open my $fh, "ipconfig /all |") {
841 delete $self->{server}; 739 # parsing strategy: we go through the output and look for
842 delete $self->{search}; 740 # :-lines with DNS in them. everything in those is regarded as
741 # either a nameserver (if it parses as an ip address), or a suffix
742 # (all else).
843 743
744 my $dns;
844 while (<$fh>) { 745 while (<$fh>) {
845 # first DNS.* is suffix list 746 if (s/^\s.*\bdns\b.*://i) {
846 if (/^\s*DNS/) { 747 $dns = 1;
847 while (/\s+([[:alnum:].\-]+)\s*$/) { 748 } elsif (/^\S/ || /^\s[^:]{16,}: /) {
749 $dns = 0;
750 }
751 if ($dns && /^\s*(\S+)\s*$/) {
752 my $s = $1;
753 $s =~ s/%\d+(?!\S)//; # get rid of scope id
754 if (my $ipn = AnyEvent::Socket::parse_address ($s)) {
755 push @{ $self->{server} }, $ipn;
756 } else {
848 push @{ $self->{search} }, $1; 757 push @{ $self->{search} }, $s;
849 $_ = <$fh>;
850 } 758 }
851 last;
852 } 759 }
853 } 760 }
854 761
855 while (<$fh>) { 762 # always add one fallback server
856 # second DNS.* is server address list 763 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 764
868 $self->_compile; 765 $self->_compile;
869 } 766 }
870 } else { 767 } else {
871 # try resolv.conf everywhere 768 # try resolv.conf everywhere
… …
878} 775}
879 776
880sub _compile { 777sub _compile {
881 my $self = shift; 778 my $self = shift;
882 779
780 my %search; $self->{search} = [grep 0 < length, grep !$search{$_}++, @{ $self->{search} }];
781 my %server; $self->{server} = [grep 0 < length, grep !$server{$_}++, @{ $self->{server} }];
782
783 unless (@{ $self->{server} }) {
784 # use 127.0.0.1 by default, and one opendns nameserver as fallback
785 $self->{server} = [v127.0.0.1, $DNS_FALLBACK[rand @DNS_FALLBACK]];
786 }
787
883 my @retry; 788 my @retry;
884 789
885 for my $timeout (@{ $self->{timeout} }) { 790 for my $timeout (@{ $self->{timeout} }) {
886 for my $server (@{ $self->{server} }) { 791 for my $server (@{ $self->{server} }) {
887 push @retry, [$server, $timeout]; 792 push @retry, [$server, $timeout];
… …
904 $NOW = time; 809 $NOW = time;
905 $id->[1]->($res); 810 $id->[1]->($res);
906} 811}
907 812
908sub _recv { 813sub _recv {
909 my ($self) = @_; 814 my ($self, $pkt, $peer) = @_;
910 815
911 while (my $peer = recv $self->{fh}, my $res, 4096, 0) { 816 # we ignore errors (often one gets port unreachable, but there is
817 # no good way to take advantage of that.
818
912 my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer); 819 my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer);
913 820
914 return unless $port == 53 && grep $_ eq $host, @{ $self->{server} }; 821 return unless $port == 53 && grep $_ eq $host, @{ $self->{server} };
915 822
916 $self->_feed ($res); 823 $self->_feed ($pkt);
917 }
918} 824}
919 825
920sub _free_id { 826sub _free_id {
921 my ($self, $id, $timeout) = @_; 827 my ($self, $id, $timeout) = @_;
922 828
… …
958 }), sub { 864 }), sub {
959 my ($res) = @_; 865 my ($res) = @_;
960 866
961 if ($res->{tc}) { 867 if ($res->{tc}) {
962 # success, but truncated, so use tcp 868 # success, but truncated, so use tcp
963 AnyEvent::Socket::tcp_connect ((Socket::inet_ntoa $server), 53, sub { 869 AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub {
964 my ($fh) = @_ 870 my ($fh) = @_
965 or return &$do_retry; 871 or return &$do_retry;
966 872
967 my $handle = new AnyEvent::Handle 873 my $handle = new AnyEvent::Handle
968 fh => $fh, 874 fh => $fh,
… …
985 # success 891 # success
986 $self->_free_id ($req->[2], $retry > 1); 892 $self->_free_id ($req->[2], $retry > 1);
987 undef $do_retry; return $req->[1]->($res); 893 undef $do_retry; return $req->[1]->($res);
988 } 894 }
989 }]; 895 }];
896
897 my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server);
990 898
991 send $self->{fh}, $req->[0], 0, AnyEvent::Socket::pack_sockaddr (53, $server); 899 my $fh = AF_INET == Socket::sockaddr_family ($sa)
900 ? $self->{fh4} : $self->{fh6}
901 or return &$do_retry;
902
903 send $fh, $req->[0], 0, $sa;
992 }; 904 };
993 905
994 &$do_retry; 906 &$do_retry;
995} 907}
996 908

Diff Legend

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