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.44 by root, Thu May 29 06:32:46 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
… …
321 187
322=item $AnyEvent::DNS::EDNS0 188=item $AnyEvent::DNS::EDNS0
323 189
324This variable decides whether dns_pack automatically enables EDNS0 190This variable decides whether dns_pack automatically enables EDNS0
325support. By default, this is disabled (C<0>), unless overridden by 191support. By default, this is disabled (C<0>), unless overridden by
326C<$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
327EDNS0 in all requests. 193EDNS0 in all requests.
328 194
329=cut 195=cut
330 196
331our $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
… …
404 "*" => 255, 270 "*" => 255,
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
410sub _enc_qname($) { 275sub _enc_name($) {
411 pack "(C/a)*", (split /\./, shift), "" 276 pack "(C/a*)*", (split /\./, shift), ""
412} 277}
413 278
414sub _enc_qd() { 279sub _enc_qd() {
415 (_enc_qname $_->[0]) . pack "nn", 280 (_enc_name $_->[0]) . pack "nn",
416 ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}), 281 ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}),
417 ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"}) 282 ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"})
418} 283}
419 284
420sub _enc_rr() { 285sub _enc_rr() {
… …
474 + $rcode_id{$req->{rc}} * 0x0001, 339 + $rcode_id{$req->{rc}} * 0x0001,
475 340
476 scalar @{ $req->{qd} || [] }, 341 scalar @{ $req->{qd} || [] },
477 scalar @{ $req->{an} || [] }, 342 scalar @{ $req->{an} || [] },
478 scalar @{ $req->{ns} || [] }, 343 scalar @{ $req->{ns} || [] },
479 $EDNS0 + scalar @{ $req->{ar} || [] }, # include EDNS0 option here 344 $EDNS0 + scalar @{ $req->{ar} || [] }, # EDNS0 option included here
480 345
481 (join "", map _enc_qd, @{ $req->{qd} || [] }), 346 (join "", map _enc_qd, @{ $req->{qd} || [] }),
482 (join "", map _enc_rr, @{ $req->{an} || [] }), 347 (join "", map _enc_rr, @{ $req->{an} || [] }),
483 (join "", map _enc_rr, @{ $req->{ns} || [] }), 348 (join "", map _enc_rr, @{ $req->{ns} || [] }),
484 (join "", map _enc_rr, @{ $req->{ar} || [] }), 349 (join "", map _enc_rr, @{ $req->{ar} || [] }),
485 350
486 ($EDNS0 ? pack "C nnNn", 0, 41, 4096, 0, 0 : "") # EDNS0, 4kiB udp payload size 351 ($EDNS0 ? pack "C nnNn", 0, 41, MAX_PKT, 0, 0 : "") # EDNS0 option
487} 352}
488 353
489our $ofs; 354our $ofs;
490our $pkt; 355our $pkt;
491 356
492# bitches 357# bitches
493sub _dec_qname { 358sub _dec_name {
494 my @res; 359 my @res;
495 my $redir; 360 my $redir;
496 my $ptr = $ofs; 361 my $ptr = $ofs;
497 my $cnt; 362 my $cnt;
498 363
499 while () { 364 while () {
500 return undef if ++$cnt >= 256; # to avoid DoS attacks 365 return undef if ++$cnt >= 256; # to avoid DoS attacks
501 366
502 my $len = ord substr $pkt, $ptr++, 1; 367 my $len = ord substr $pkt, $ptr++, 1;
503 368
504 if ($len & 0xc0) { 369 if ($len >= 0xc0) {
505 $ptr++; 370 $ptr++;
506 $ofs = $ptr if $ptr > $ofs; 371 $ofs = $ptr if $ptr > $ofs;
507 $ptr = (unpack "n", substr $pkt, $ptr - 2, 2) & 0x3fff; 372 $ptr = (unpack "n", substr $pkt, $ptr - 2, 2) & 0x3fff;
508 } elsif ($len) { 373 } elsif ($len) {
509 push @res, substr $pkt, $ptr, $len; 374 push @res, substr $pkt, $ptr, $len;
… …
514 } 379 }
515 } 380 }
516} 381}
517 382
518sub _dec_qd { 383sub _dec_qd {
519 my $qname = _dec_qname; 384 my $qname = _dec_name;
520 my ($qt, $qc) = unpack "nn", substr $pkt, $ofs; $ofs += 4; 385 my ($qt, $qc) = unpack "nn", substr $pkt, $ofs; $ofs += 4;
521 [$qname, $type_str{$qt} || $qt, $class_str{$qc} || $qc] 386 [$qname, $type_str{$qt} || $qt, $class_str{$qc} || $qc]
522} 387}
523 388
524our %dec_rr = ( 389our %dec_rr = (
525 1 => sub { join ".", unpack "C4" }, # a 390 1 => sub { join ".", unpack "C4", $_ }, # a
526 2 => sub { local $ofs = $ofs - length; _dec_qname }, # ns 391 2 => sub { local $ofs = $ofs - length; _dec_name }, # ns
527 5 => sub { local $ofs = $ofs - length; _dec_qname }, # cname 392 5 => sub { local $ofs = $ofs - length; _dec_name }, # cname
528 6 => sub { 393 6 => sub {
529 local $ofs = $ofs - length; 394 local $ofs = $ofs - length;
530 my $mname = _dec_qname; 395 my $mname = _dec_name;
531 my $rname = _dec_qname; 396 my $rname = _dec_name;
532 ($mname, $rname, unpack "NNNNN", substr $pkt, $ofs) 397 ($mname, $rname, unpack "NNNNN", substr $pkt, $ofs)
533 }, # soa 398 }, # soa
534 11 => sub { ((join ".", unpack "C4"), unpack "C a*", substr $_, 4) }, # wks 399 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks
535 12 => sub { local $ofs = $ofs - length; _dec_qname }, # ptr 400 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr
536 13 => sub { unpack "C/a C/a", $_ }, # hinfo 401 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo
537 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_qname) }, # mx 402 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx
538 16 => sub { unpack "(C/a)*", $_ }, # txt 403 16 => sub { unpack "(C/a*)*", $_ }, # txt
539 28 => sub { AnyEvent::Socket::format_ip ($_) }, # aaaa 404 28 => sub { AnyEvent::Socket::format_address ($_) }, # aaaa
540 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_qname) }, # srv 405 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv
541 99 => sub { unpack "(C/a)*", $_ }, # spf 406 99 => sub { unpack "(C/a*)*", $_ }, # spf
542); 407);
543 408
544sub _dec_rr { 409sub _dec_rr {
545 my $qname = _dec_qname; 410 my $name = _dec_name;
546 411
547 my ($rt, $rc, $ttl, $rdlen) = unpack "nn N n", substr $pkt, $ofs; $ofs += 10; 412 my ($rt, $rc, $ttl, $rdlen) = unpack "nn N n", substr $pkt, $ofs; $ofs += 10;
548 local $_ = substr $pkt, $ofs, $rdlen; $ofs += $rdlen; 413 local $_ = substr $pkt, $ofs, $rdlen; $ofs += $rdlen;
549 414
550 [ 415 [
551 $qname, 416 $name,
552 $type_str{$rt} || $rt, 417 $type_str{$rt} || $rt,
553 $class_str{$rc} || $rc, 418 $class_str{$rc} || $rc,
554 ($dec_rr{$rt} || sub { $_ })->(), 419 ($dec_rr{$rt} || sub { $_ })->(),
555 ] 420 ]
556} 421}
… …
694 559
695=over 4 560=over 4
696 561
697=item server => [...] 562=item server => [...]
698 563
699A list of server addresses (default: C<v127.0.0.1>) in network format (4 564A list of server addresses (default: C<v127.0.0.1>) in network format
700octets for IPv4, 16 octets for IPv6 - not yet supported). 565(i.e. as returned by C<AnyEvent::Socket::parse_address> - both IPv4 and
566IPv6 are supported).
701 567
702=item timeout => [...] 568=item timeout => [...]
703 569
704A list of timeouts to use (also determines the number of retries). To make 570A list of timeouts to use (also determines the number of retries). To make
705three retries with individual time-outs of 2, 5 and 5 seconds, use C<[2, 571three retries with individual time-outs of 2, 5 and 5 seconds, use C<[2,
… …
714The number of dots (default: C<1>) that a name must have so that the resolver 580The number of dots (default: C<1>) that a name must have so that the resolver
715tries to resolve the name without any suffixes first. 581tries to resolve the name without any suffixes first.
716 582
717=item max_outstanding => $integer 583=item max_outstanding => $integer
718 584
719Most name servers do not handle many parallel requests very well. This option 585Most name servers do not handle many parallel requests very well. This
720limits the number of outstanding requests to C<$n> (default: C<10>), that means 586option limits the number of outstanding requests to C<$integer>
721if you request more than this many requests, then the additional requests will be queued 587(default: C<10>), that means if you request more than this many requests,
722until some other requests have been resolved. 588then the additional requests will be queued until some other requests have
589been resolved.
723 590
724=item reuse => $seconds 591=item reuse => $seconds
725 592
726The number of seconds (default: C<300>) that a query id cannot be re-used 593The number of seconds (default: C<300>) that a query id cannot be re-used
727after a timeout. If there as no time-out then query id's can be reused 594after a timeout. If there as no time-out then query id's can be reused
… …
732=cut 599=cut
733 600
734sub new { 601sub new {
735 my ($class, %arg) = @_; 602 my ($class, %arg) = @_;
736 603
604 # try to create a ipv4 and an ipv6 socket
605 # only fail when we cnanot create either
606
737 socket my $fh, &Socket::AF_INET, &Socket::SOCK_DGRAM, 0 607 socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0;
738 or Carp::croak "socket: $!"; 608 socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0;
739 609
740 AnyEvent::Util::fh_nonblocking $fh, 1; 610 $fh4 || $fh6
611 or Carp::croak "unable to create either an IPv6 or an IPv4 socket";
741 612
742 my $self = bless { 613 my $self = bless {
743 server => [v127.0.0.1], 614 server => [],
744 timeout => [2, 5, 5], 615 timeout => [2, 5, 5],
745 search => [], 616 search => [],
746 ndots => 1, 617 ndots => 1,
747 max_outstanding => 10, 618 max_outstanding => 10,
748 reuse => 300, # reuse id's after 5 minutes only, if possible 619 reuse => 300, # reuse id's after 5 minutes only, if possible
749 %arg, 620 %arg,
750 fh => $fh,
751 reuse_q => [], 621 reuse_q => [],
752 }, $class; 622 }, $class;
753 623
754 # search should default to gethostname's domain 624 # search should default to gethostname's domain
755 # but perl lacks a good posix module 625 # but perl lacks a good posix module
756 626
757 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;
758 $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 }
759 648
760 $self->_compile; 649 $self->_compile;
761 650
762 $self 651 $self
763} 652}
… …
785 for (split /\n/, $resolvconf) { 674 for (split /\n/, $resolvconf) {
786 if (/^\s*#/) { 675 if (/^\s*#/) {
787 # comment 676 # comment
788 } elsif (/^\s*nameserver\s+(\S+)\s*$/i) { 677 } elsif (/^\s*nameserver\s+(\S+)\s*$/i) {
789 my $ip = $1; 678 my $ip = $1;
790 if (AnyEvent::Util::dotted_quad $ip) { 679 if (my $ipn = AnyEvent::Socket::parse_address ($ip)) {
791 push @{ $self->{server} }, AnyEvent::Util::socket_inet_aton $ip; 680 push @{ $self->{server} }, $ipn;
792 } else { 681 } else {
793 warn "nameserver $ip invalid and ignored\n"; 682 warn "nameserver $ip invalid and ignored\n";
794 } 683 }
795 } elsif (/^\s*domain\s+(\S*)\s+$/i) { 684 } elsif (/^\s*domain\s+(\S*)\s+$/i) {
796 $self->{search} = [$1]; 685 $self->{search} = [$1];
… …
827=cut 716=cut
828 717
829sub os_config { 718sub os_config {
830 my ($self) = @_; 719 my ($self) = @_;
831 720
832 if ($^O =~ /mswin32|cygwin/i) { 721 $self->{server} = [];
833 # 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.
834 737
835 if (open my $fh, "ipconfig /all |") { 738 if (open my $fh, "ipconfig /all |") {
836 delete $self->{server}; 739 # parsing strategy: we go through the output and look for
837 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).
838 743
744 my $dns;
839 while (<$fh>) { 745 while (<$fh>) {
840 # first DNS.* is suffix list 746 if (s/^\s.*\bdns\b.*://i) {
841 if (/^\s*DNS/) { 747 $dns = 1;
842 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 {
843 push @{ $self->{search} }, $1; 757 push @{ $self->{search} }, $s;
844 $_ = <$fh>;
845 } 758 }
846 last;
847 } 759 }
848 } 760 }
849 761
850 while (<$fh>) { 762 # always add one fallback server
851 # second DNS.* is server address list 763 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 764
863 $self->_compile; 765 $self->_compile;
864 } 766 }
865 } else { 767 } else {
866 # try resolv.conf everywhere 768 # try resolv.conf everywhere
… …
873} 775}
874 776
875sub _compile { 777sub _compile {
876 my $self = shift; 778 my $self = shift;
877 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
878 my @retry; 788 my @retry;
879 789
880 for my $timeout (@{ $self->{timeout} }) { 790 for my $timeout (@{ $self->{timeout} }) {
881 for my $server (@{ $self->{server} }) { 791 for my $server (@{ $self->{server} }) {
882 push @retry, [$server, $timeout]; 792 push @retry, [$server, $timeout];
… …
899 $NOW = time; 809 $NOW = time;
900 $id->[1]->($res); 810 $id->[1]->($res);
901} 811}
902 812
903sub _recv { 813sub _recv {
904 my ($self) = @_; 814 my ($self, $pkt, $peer) = @_;
905 815
906 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
907 my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer); 819 my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer);
908 820
909 return unless $port == 53 && grep $_ eq $host, @{ $self->{server} }; 821 return unless $port == 53 && grep $_ eq $host, @{ $self->{server} };
910 822
911 $self->_feed ($res); 823 $self->_feed ($pkt);
912 }
913} 824}
914 825
915sub _free_id { 826sub _free_id {
916 my ($self, $id, $timeout) = @_; 827 my ($self, $id, $timeout) = @_;
917 828
… …
953 }), sub { 864 }), sub {
954 my ($res) = @_; 865 my ($res) = @_;
955 866
956 if ($res->{tc}) { 867 if ($res->{tc}) {
957 # success, but truncated, so use tcp 868 # success, but truncated, so use tcp
958 AnyEvent::Socket::tcp_connect ((Socket::inet_ntoa $server), 53, sub { 869 AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub {
959 my ($fh) = @_ 870 my ($fh) = @_
960 or return &$do_retry; 871 or return &$do_retry;
961 872
962 my $handle = new AnyEvent::Handle 873 my $handle = new AnyEvent::Handle
963 fh => $fh, 874 fh => $fh,
… …
965 # failure, try next 876 # failure, try next
966 &$do_retry; 877 &$do_retry;
967 }; 878 };
968 879
969 $handle->push_write (pack "n/a", $req->[0]); 880 $handle->push_write (pack "n/a", $req->[0]);
970 $handle->push_read_chunk (2, sub { 881 $handle->push_read (chunk => 2, sub {
971 $handle->unshift_read_chunk ((unpack "n", $_[1]), sub { 882 $handle->unshift_read (chunk => (unpack "n", $_[1]), sub {
972 $self->_feed ($_[1]); 883 $self->_feed ($_[1]);
973 }); 884 });
974 }); 885 });
975 shutdown $fh, 1; 886 shutdown $fh, 1;
976 887
… …
980 # success 891 # success
981 $self->_free_id ($req->[2], $retry > 1); 892 $self->_free_id ($req->[2], $retry > 1);
982 undef $do_retry; return $req->[1]->($res); 893 undef $do_retry; return $req->[1]->($res);
983 } 894 }
984 }]; 895 }];
896
897 my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server);
985 898
986 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;
987 }; 904 };
988 905
989 &$do_retry; 906 &$do_retry;
990} 907}
991 908
… …
1041 $self->_scheduler; 958 $self->_scheduler;
1042} 959}
1043 960
1044=item $resolver->resolve ($qname, $qtype, %options, $cb->($rcode, @rr)) 961=item $resolver->resolve ($qname, $qtype, %options, $cb->($rcode, @rr))
1045 962
1046Queries the DNS for the given domain name C<$qname> of type C<$qtype> (a 963Queries the DNS for the given domain name C<$qname> of type C<$qtype>.
1047qtype of "*" is supported and means "any"). 964
965A C<$qtype> is either a numerical query type (e.g. C<1> for A recods) or
966a lowercase name (you have to look at the source to see which aliases are
967supported, but all types from RFC 1034, C<aaaa>, C<srv>, C<spf> and a few
968more are known to this module). A qtype of "*" is supported and means
969"any" record type.
1048 970
1049The callback will be invoked with a list of matching result records or 971The callback will be invoked with a list of matching result records or
1050none on any error or if the name could not be found. 972none on any error or if the name could not be found.
1051 973
1052CNAME chains (although illegal) are followed up to a length of 8. 974CNAME chains (although illegal) are followed up to a length of 8.
975
976The callback will be invoked with an result code in string form (noerror,
977formerr, servfail, nxdomain, notimp, refused and so on), or numerical
978form if the result code is not supported. The remaining arguments are
979arraryefs of the form C<[$name, $type, $class, @data>], where C<$name> is
980the domain name, C<$type> a type string or number, C<$class> a class name
981and @data is resource-record-dependent data. For C<a> records, this will
982be the textual IPv4 addresses, for C<ns> or C<cname> records this will be
983a domain name, for C<txt> records these are all the strings and so on.
984
985All types mentioned in RFC 1034, C<aaaa>, C<srv> and C<spf> are
986decoded. All resource records not known to this module will just return
987the raw C<rdata> field as fourth entry.
1053 988
1054Note that this resolver is just a stub resolver: it requires a name server 989Note that this resolver is just a stub resolver: it requires a name server
1055supporting recursive queries, will not do any recursive queries itself and 990supporting recursive queries, will not do any recursive queries itself and
1056is not secure when used against an untrusted name server. 991is not secure when used against an untrusted name server.
1057 992
… …
1068 1003
1069=item accept => [$type...] 1004=item accept => [$type...]
1070 1005
1071Lists the acceptable result types: only result types in this set will be 1006Lists the acceptable result types: only result types in this set will be
1072accepted and returned. The default includes the C<$qtype> and nothing 1007accepted and returned. The default includes the C<$qtype> and nothing
1073else. 1008else. If this list includes C<cname>, then CNAME-chains will not be
1009followed (because you asked for the CNAME record).
1074 1010
1075=item class => "class" 1011=item class => "class"
1076 1012
1077Specify the query class ("in" for internet, "ch" for chaosnet and "hs" for 1013Specify the query class ("in" for internet, "ch" for chaosnet and "hs" for
1078hesiod are the only ones making sense). The default is "in", of course. 1014hesiod are the only ones making sense). The default is "in", of course.

Diff Legend

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