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.26 by root, Sat May 24 18:50:40 2008 UTC vs.
Revision 1.35 by root, Mon May 26 06:18:53 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 ();
38
39our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222);
35 40
36=item AnyEvent::DNS::addr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...) 41=item AnyEvent::DNS::addr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...)
37 42
38Tries to resolve the given nodename and service name into protocol families 43Tries to resolve the given nodename and service name into protocol families
39and sockaddr structures usable to connect to this node and service in a 44and sockaddr structures usable to connect to this node and service in a
… …
199############################################################################# 204#############################################################################
200 205
201sub addr($$$$$$) { 206sub addr($$$$$$) {
202 my ($node, $service, $proto, $family, $type, $cb) = @_; 207 my ($node, $service, $proto, $family, $type, $cb) = @_;
203 208
204 unless (&AnyEvent::Socket::AF_INET6) { 209 unless (&AnyEvent::Util::AF_INET6) {
205 $family != 6 210 $family != 6
206 or return $cb->(); 211 or return $cb->();
207 212
208 $family ||= 4; 213 $family ||= 4;
209 } 214 }
… …
213 218
214 $family ||=4 unless $AnyEvent::PROTOCOL{ipv6}; 219 $family ||=4 unless $AnyEvent::PROTOCOL{ipv6};
215 $family ||=6 unless $AnyEvent::PROTOCOL{ipv4}; 220 $family ||=6 unless $AnyEvent::PROTOCOL{ipv4};
216 221
217 $proto ||= "tcp"; 222 $proto ||= "tcp";
218 $type ||= $proto eq "udp" ? Socket::SOCK_DGRAM : Socket::SOCK_STREAM; 223 $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
219 224
220 my $proton = (getprotobyname $proto)[2] 225 my $proton = (getprotobyname $proto)[2]
221 or Carp::croak "$proto: protocol unknown"; 226 or Carp::croak "$proto: protocol unknown";
222 227
223 my $port; 228 my $port;
… …
238 my @res; 243 my @res;
239 my $cv = AnyEvent->condvar (cb => sub { 244 my $cv = AnyEvent->condvar (cb => sub {
240 $cb->( 245 $cb->(
241 map $_->[2], 246 map $_->[2],
242 sort { 247 sort {
243 $AnyEvent::PROTOCOL{$a->[1]} <=> $AnyEvent::PROTOCOL{$b->[1]} 248 $AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}
244 or $a->[0] <=> $b->[0] 249 or $a->[0] <=> $b->[0]
245 } 250 }
246 @res 251 @res
247 ) 252 )
248 }); 253 });
… …
251 for my $idx (0 .. $#target) { 256 for my $idx (0 .. $#target) {
252 my ($node, $port) = @{ $target[$idx] }; 257 my ($node, $port) = @{ $target[$idx] };
253 258
254 if (my $noden = AnyEvent::Socket::parse_ip ($node)) { 259 if (my $noden = AnyEvent::Socket::parse_ip ($node)) {
255 if (4 == length $noden && $family != 6) { 260 if (4 == length $noden && $family != 6) {
256 push @res, [$idx, "ipv4", [Socket::AF_INET, $type, $proton, 261 push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
257 AnyEvent::Socket::pack_sockaddr ($port, $noden)]] 262 AnyEvent::Socket::pack_sockaddr ($port, $noden)]]
258 } 263 }
259 264
260 if (16 == length $noden && $family != 4) { 265 if (16 == length $noden && $family != 4) {
261 push @res, [$idx, "ipv6", [&AnyEvent::Socket::AF_INET6, $type, $proton, 266 push @res, [$idx, "ipv6", [&AnyEvent::Util::AF_INET6, $type, $proton,
262 AnyEvent::Socket::pack_sockaddr ( $port, $noden)]] 267 AnyEvent::Socket::pack_sockaddr ( $port, $noden)]]
263 } 268 }
264 } else { 269 } else {
265 # ipv4 270 # ipv4
266 if ($family != 6) { 271 if ($family != 6) {
267 $cv->begin; 272 $cv->begin;
268 a $node, sub { 273 a $node, sub {
269 push @res, [$idx, "ipv4", [Socket::AF_INET, $type, $proton, 274 push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
270 AnyEvent::Socket::pack_sockaddr ($port, AnyEvent::Socket::parse_ipv4 ($_))]] 275 AnyEvent::Socket::pack_sockaddr ($port, AnyEvent::Socket::parse_ipv4 ($_))]]
271 for @_; 276 for @_;
272 $cv->end; 277 $cv->end;
273 }; 278 };
274 } 279 }
… …
410); 415);
411 416
412our %class_str = reverse %class_id; 417our %class_str = reverse %class_id;
413 418
414# names MUST have a trailing dot 419# names MUST have a trailing dot
415sub _enc_qname($) { 420sub _enc_name($) {
416 pack "(C/a)*", (split /\./, shift), "" 421 pack "(C/a*)*", (split /\./, shift), ""
417} 422}
418 423
419sub _enc_qd() { 424sub _enc_qd() {
420 (_enc_qname $_->[0]) . pack "nn", 425 (_enc_name $_->[0]) . pack "nn",
421 ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}), 426 ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}),
422 ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"}) 427 ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"})
423} 428}
424 429
425sub _enc_rr() { 430sub _enc_rr() {
… …
493 498
494our $ofs; 499our $ofs;
495our $pkt; 500our $pkt;
496 501
497# bitches 502# bitches
498sub _dec_qname { 503sub _dec_name {
499 my @res; 504 my @res;
500 my $redir; 505 my $redir;
501 my $ptr = $ofs; 506 my $ptr = $ofs;
502 my $cnt; 507 my $cnt;
503 508
504 while () { 509 while () {
505 return undef if ++$cnt >= 256; # to avoid DoS attacks 510 return undef if ++$cnt >= 256; # to avoid DoS attacks
506 511
507 my $len = ord substr $pkt, $ptr++, 1; 512 my $len = ord substr $pkt, $ptr++, 1;
508 513
509 if ($len & 0xc0) { 514 if ($len >= 0xc0) {
510 $ptr++; 515 $ptr++;
511 $ofs = $ptr if $ptr > $ofs; 516 $ofs = $ptr if $ptr > $ofs;
512 $ptr = (unpack "n", substr $pkt, $ptr - 2, 2) & 0x3fff; 517 $ptr = (unpack "n", substr $pkt, $ptr - 2, 2) & 0x3fff;
513 } elsif ($len) { 518 } elsif ($len) {
514 push @res, substr $pkt, $ptr, $len; 519 push @res, substr $pkt, $ptr, $len;
… …
519 } 524 }
520 } 525 }
521} 526}
522 527
523sub _dec_qd { 528sub _dec_qd {
524 my $qname = _dec_qname; 529 my $qname = _dec_name;
525 my ($qt, $qc) = unpack "nn", substr $pkt, $ofs; $ofs += 4; 530 my ($qt, $qc) = unpack "nn", substr $pkt, $ofs; $ofs += 4;
526 [$qname, $type_str{$qt} || $qt, $class_str{$qc} || $qc] 531 [$qname, $type_str{$qt} || $qt, $class_str{$qc} || $qc]
527} 532}
528 533
529our %dec_rr = ( 534our %dec_rr = (
530 1 => sub { join ".", unpack "C4" }, # a 535 1 => sub { join ".", unpack "C4", $_ }, # a
531 2 => sub { local $ofs = $ofs - length; _dec_qname }, # ns 536 2 => sub { local $ofs = $ofs - length; _dec_name }, # ns
532 5 => sub { local $ofs = $ofs - length; _dec_qname }, # cname 537 5 => sub { local $ofs = $ofs - length; _dec_name }, # cname
533 6 => sub { 538 6 => sub {
534 local $ofs = $ofs - length; 539 local $ofs = $ofs - length;
535 my $mname = _dec_qname; 540 my $mname = _dec_name;
536 my $rname = _dec_qname; 541 my $rname = _dec_name;
537 ($mname, $rname, unpack "NNNNN", substr $pkt, $ofs) 542 ($mname, $rname, unpack "NNNNN", substr $pkt, $ofs)
538 }, # soa 543 }, # soa
539 11 => sub { ((join ".", unpack "C4"), unpack "C a*", substr $_, 4) }, # wks 544 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks
540 12 => sub { local $ofs = $ofs - length; _dec_qname }, # ptr 545 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr
541 13 => sub { unpack "C/a C/a", $_ }, # hinfo 546 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo
542 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_qname) }, # mx 547 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx
543 16 => sub { unpack "(C/a)*", $_ }, # txt 548 16 => sub { unpack "(C/a*)*", $_ }, # txt
544 28 => sub { AnyEvent::Socket::format_ip ($_) }, # aaaa 549 28 => sub { AnyEvent::Socket::format_ip ($_) }, # aaaa
545 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_qname) }, # srv 550 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv
546 99 => sub { unpack "(C/a)*", $_ }, # spf 551 99 => sub { unpack "(C/a*)*", $_ }, # spf
547); 552);
548 553
549sub _dec_rr { 554sub _dec_rr {
550 my $qname = _dec_qname; 555 my $name = _dec_name;
551 556
552 my ($rt, $rc, $ttl, $rdlen) = unpack "nn N n", substr $pkt, $ofs; $ofs += 10; 557 my ($rt, $rc, $ttl, $rdlen) = unpack "nn N n", substr $pkt, $ofs; $ofs += 10;
553 local $_ = substr $pkt, $ofs, $rdlen; $ofs += $rdlen; 558 local $_ = substr $pkt, $ofs, $rdlen; $ofs += $rdlen;
554 559
555 [ 560 [
556 $qname, 561 $name,
557 $type_str{$rt} || $rt, 562 $type_str{$rt} || $rt,
558 $class_str{$rc} || $rc, 563 $class_str{$rc} || $rc,
559 ($dec_rr{$rt} || sub { $_ })->(), 564 ($dec_rr{$rt} || sub { $_ })->(),
560 ] 565 ]
561} 566}
… …
737=cut 742=cut
738 743
739sub new { 744sub new {
740 my ($class, %arg) = @_; 745 my ($class, %arg) = @_;
741 746
742 socket my $fh, &Socket::AF_INET, &Socket::SOCK_DGRAM, 0 747 socket my $fh, AF_INET, &Socket::SOCK_DGRAM, 0
743 or Carp::croak "socket: $!"; 748 or Carp::croak "socket: $!";
744 749
745 AnyEvent::Util::fh_nonblocking $fh, 1; 750 AnyEvent::Util::fh_nonblocking $fh, 1;
746 751
747 my $self = bless { 752 my $self = bless {
748 server => [v127.0.0.1], 753 server => [],
749 timeout => [2, 5, 5], 754 timeout => [2, 5, 5],
750 search => [], 755 search => [],
751 ndots => 1, 756 ndots => 1,
752 max_outstanding => 10, 757 max_outstanding => 10,
753 reuse => 300, # reuse id's after 5 minutes only, if possible 758 reuse => 300, # reuse id's after 5 minutes only, if possible
… …
832=cut 837=cut
833 838
834sub os_config { 839sub os_config {
835 my ($self) = @_; 840 my ($self) = @_;
836 841
837 if ($^O =~ /mswin32|cygwin/i) { 842 $self->{server} = [];
838 # yeah, it suxx... lets hope DNS is DNS in all locales 843 $self->{search} = [];
844
845 if (AnyEvent::WIN32 || $^O =~ /cygwin/i) {
846 no strict 'refs';
847
848 # there are many options to find the current nameservers etc. on windows
849 # all of them don't work consistently:
850 # - the registry thing needs separate code on win32 native vs. cygwin
851 # - the registry layout differs between windows versions
852 # - calling windows api functions doesn't work on cygwin
853 # - ipconfig uses locale-specific messages
854
855 # we use ipconfig parsing because, despite all it's brokenness,
856 # it seems most stable in practise.
857 # for good measure, we append a fallback nameserver to our list.
839 858
840 if (open my $fh, "ipconfig /all |") { 859 if (open my $fh, "ipconfig /all |") {
841 delete $self->{server}; 860 # parsing strategy: we go through the output and look for
842 delete $self->{search}; 861 # :-lines with DNS in them. everything in those is regarded as
862 # either a nameserver (if it parses as an ip address), or a suffix
863 # (all else).
843 864
865 my $dns;
844 while (<$fh>) { 866 while (<$fh>) {
845 # first DNS.* is suffix list 867 if (s/^\s.*\bdns\b.*://i) {
846 if (/^\s*DNS/) { 868 $dns = 1;
847 while (/\s+([[:alnum:].\-]+)\s*$/) { 869 } elsif (/^\S/ || /^\s[^:]{16,}: /) {
870 $dns = 0;
871 }
872 if ($dns && /^\s*(\S+)\s*$/) {
873 my $s = $1;
874 $s =~ s/%\d+(?!\S)//; # get rid of scope id
875 if (my $ipn = AnyEvent::Socket::parse_ip ($s)) {
876 push @{ $self->{server} }, $ipn;
877 } else {
848 push @{ $self->{search} }, $1; 878 push @{ $self->{search} }, $s;
849 $_ = <$fh>;
850 } 879 }
851 last;
852 } 880 }
853 } 881 }
854 882
855 while (<$fh>) { 883 # always add one fallback server
856 # second DNS.* is server address list 884 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 885
868 $self->_compile; 886 $self->_compile;
869 } 887 }
870 } else { 888 } else {
871 # try resolv.conf everywhere 889 # try resolv.conf everywhere
… …
878} 896}
879 897
880sub _compile { 898sub _compile {
881 my $self = shift; 899 my $self = shift;
882 900
901 # we currently throw away all ipv6 nameservers, we do not yet support those
902
903 my %search; $self->{search} = [grep 0 < length, grep !$search{$_}++, @{ $self->{search} }];
904 my %server; $self->{server} = [grep 4 == length, grep !$server{$_}++, @{ $self->{server} }];
905
906 unless (@{ $self->{server} }) {
907 # use 127.0.0.1 by default, and one opendns nameserver as fallback
908 $self->{server} = [v127.0.0.1, $DNS_FALLBACK[rand @DNS_FALLBACK]];
909 }
910
883 my @retry; 911 my @retry;
884 912
885 for my $timeout (@{ $self->{timeout} }) { 913 for my $timeout (@{ $self->{timeout} }) {
886 for my $server (@{ $self->{server} }) { 914 for my $server (@{ $self->{server} }) {
887 push @retry, [$server, $timeout]; 915 push @retry, [$server, $timeout];
… …
906} 934}
907 935
908sub _recv { 936sub _recv {
909 my ($self) = @_; 937 my ($self) = @_;
910 938
939 # we ignore errors (often one gets port unreachable, but there is
940 # no good way to take advantage of that.
911 while (my $peer = recv $self->{fh}, my $res, 4096, 0) { 941 while (my $peer = recv $self->{fh}, my $res, 4096, 0) {
912 my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer); 942 my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer);
913 943
914 return unless $port == 53 && grep $_ eq $host, @{ $self->{server} }; 944 return unless $port == 53 && grep $_ eq $host, @{ $self->{server} };
915 945
… …
970 # failure, try next 1000 # failure, try next
971 &$do_retry; 1001 &$do_retry;
972 }; 1002 };
973 1003
974 $handle->push_write (pack "n/a", $req->[0]); 1004 $handle->push_write (pack "n/a", $req->[0]);
975 $handle->push_read_chunk (2, sub { 1005 $handle->push_read (chunk => 2, sub {
976 $handle->unshift_read_chunk ((unpack "n", $_[1]), sub { 1006 $handle->unshift_read (chunk => (unpack "n", $_[1]), sub {
977 $self->_feed ($_[1]); 1007 $self->_feed ($_[1]);
978 }); 1008 });
979 }); 1009 });
980 shutdown $fh, 1; 1010 shutdown $fh, 1;
981 1011

Diff Legend

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