--- AnyEvent/lib/AnyEvent/DNS.pm 2008/05/24 02:50:45 1.24 +++ AnyEvent/lib/AnyEvent/DNS.pm 2008/05/29 03:45:37 1.39 @@ -6,6 +6,11 @@ use AnyEvent::DNS; + my $cv = AnyEvent->condvar; + AnyEvent::DNS::a "www.google.de", $cv; + # ... later + my @addrs = $cv->recv; + =head1 DESCRIPTION This module offers both a number of DNS convenience functions as well @@ -26,42 +31,15 @@ no warnings; use strict; -use AnyEvent::Handle (); - -=item AnyEvent::DNS::addr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...) +use Socket qw(AF_INET SOCK_DGRAM SOCK_STREAM); -Tries to resolve the given nodename and service name into protocol families -and sockaddr structures usable to connect to this node and service in a -protocol-independent way. It works remotely similar to the getaddrinfo -posix function. - -C<$node> is either an IPv4 or IPv6 address or a hostname, C<$service> is -either a service name (port name from F) or a numerical -port number. If both C<$node> and C<$service> are names, then SRV records -will be consulted to find the real service, otherwise they will be -used as-is. If you know that the service name is not in your services -database, then you can specify the service in the format C -(e.g. C). - -C<$proto> must be a protocol name, currently C, C or -C. The default is C. - -C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use -only IPv4) or C<6> (use only IPv6). This setting might be influenced by -C<$ENV{PERL_ANYEVENT_PROTOCOLS}>. - -C<$type> must be C, C or C (or -C in which case it gets automatically chosen). - -The callback will receive zero or more array references that contain -C<$family, $type, $proto> for use in C and a binary -C<$sockaddr> for use in C (or C). +use AnyEvent (); +use AnyEvent::Handle (); +use AnyEvent::Util qw(AF_INET6); -The application should try these in the order given. +our $VERSION = '1.0'; -Example: - - AnyEvent::DNS::addr "google.com", "http", 0, undef, undef, sub { ... }; +our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222); =item AnyEvent::DNS::a $domain, $cb->(@addrs) @@ -117,6 +95,10 @@ =cut +sub MAX_PKT() { 4096 } # max packet size we advertise and accept + +sub DOMAIN_PORT() { 53 } # if this changes drop me a note + sub resolver; sub a($$) { @@ -171,13 +153,17 @@ sub ptr($$) { my ($ip, $cb) = @_; - $ip = AnyEvent::Socket::parse_ip ($ip) + $ip = AnyEvent::Socket::parse_address ($ip) or return $cb->(); - if (4 == length $ip) { + my $af = AnyEvent::Socket::address_family ($ip); + + if ($af == AF_INET) { $ip = join ".", (reverse split /\./, $ip), "in-addr.arpa."; - } else { + } elsif ($af == AF_INET6) { $ip = join ".", (reverse split //, unpack "H*", $ip), "ip6.arpa."; + } else { + return $cb->(); } resolver->resolve ($ip => "ptr", sub { @@ -191,127 +177,7 @@ resolver->resolve ($domain => "*", $cb); } -############################################################################# - -sub addr($$$$$$) { - my ($node, $service, $proto, $family, $type, $cb) = @_; - - unless (&AnyEvent::Socket::AF_INET6) { - $family != 6 - or return $cb->(); - - $family ||= 4; - } - - $cb->() if $family == 4 && !$AnyEvent::PROTOCOL{ipv4}; - $cb->() if $family == 6 && !$AnyEvent::PROTOCOL{ipv6}; - - $family ||=4 unless $AnyEvent::PROTOCOL{ipv6}; - $family ||=6 unless $AnyEvent::PROTOCOL{ipv4}; - - $proto ||= "tcp"; - $type ||= $proto eq "udp" ? Socket::SOCK_DGRAM : Socket::SOCK_STREAM; - - my $proton = (getprotobyname $proto)[2] - or Carp::croak "$proto: protocol unknown"; - - my $port; - - if ($service =~ /^(\S+)=(\d+)$/) { - ($service, $port) = ($1, $2); - } elsif ($service =~ /^\d+$/) { - ($service, $port) = (undef, $service); - } else { - $port = (getservbyname $service, $proto)[2] - or Carp::croak "$service/$proto: service unknown"; - } - - my @target = [$node, $port]; - - # resolve a records / provide sockaddr structures - my $resolve = sub { - my @res; - my $cv = AnyEvent->condvar (cb => sub { - $cb->( - map $_->[1], - sort { - $AnyEvent::PROTOCOL{$a->[1][0]} <=> $AnyEvent::PROTOCOL{$b->[1][0]} - or $a->[0] <=> $b->[0] - } - @res - ) - }); - - $cv->begin; - for my $idx (0 .. $#target) { - my ($node, $port) = @{ $target[$idx] }; - - if (my $noden = AnyEvent::Socket::parse_ip ($node)) { - if (4 == length $noden && $family != 6) { - push @res, [$idx, [Socket::AF_INET, $type, $proton, - AnyEvent::Socket::pack_sockaddr ($port, $noden)]] - } - - if (16 == length $noden && $family != 4) { - push @res, [$idx, [&AnyEvent::Socket::AF_INET6, $type, $proton, - AnyEvent::Socket::pack_sockaddr ( $port, $noden)]] - } - } else { - # ipv4 - if ($family != 6) { - $cv->begin; - a $node, sub { - push @res, [$idx, [Socket::AF_INET, $type, $proton, - AnyEvent::Socket::pack_sockaddr ($port, AnyEvent::Socket::parse_ipv4 ($_))]] - for @_; - $cv->end; - }; - } - - # ipv6 - if ($family != 4) { - $cv->begin; - aaaa $node, sub { - push @res, [$idx, [&AnyEvent::Socket::AF_INET6, $type, $proton, - AnyEvent::Socket::pack_sockaddr ($port, AnyEvent::Socket::parse_ipv6 ($_))]] - for @_; - $cv->end; - }; - } - } - } - $cv->end; - }; - - # try srv records, if applicable - if ($node eq "localhost") { - @target = (["127.0.0.1", $port], ["::1", $port]); - &$resolve; - } elsif (defined $service && !AnyEvent::Socket::parse_ip ($node)) { - srv $service, $proto, $node, sub { - my (@srv) = @_; - - # no srv records, continue traditionally - @srv - or return &$resolve; - - # only srv record has "." => abort - $srv[0][2] ne "." || $#srv - or return $cb->(); - - # use srv records then - @target = map ["$_->[3].", $_->[2]], - grep $_->[3] ne ".", - @srv; - - &$resolve; - }; - } else { - &$resolve; - } -} - -############################################################################# +################################################################################# =back @@ -407,12 +273,12 @@ our %class_str = reverse %class_id; # names MUST have a trailing dot -sub _enc_qname($) { - pack "(C/a)*", (split /\./, shift), "" +sub _enc_name($) { + pack "(C/a*)*", (split /\./, shift), "" } sub _enc_qd() { - (_enc_qname $_->[0]) . pack "nn", + (_enc_name $_->[0]) . pack "nn", ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}), ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"}) } @@ -483,14 +349,14 @@ (join "", map _enc_rr, @{ $req->{ns} || [] }), (join "", map _enc_rr, @{ $req->{ar} || [] }), - ($EDNS0 ? pack "C nnNn", 0, 41, 4096, 0, 0 : "") # EDNS0, 4kiB udp payload size + ($EDNS0 ? pack "C nnNn", 0, 41, MAX_PKT, 0, 0 : "") # EDNS0, 4kiB udp payload size } our $ofs; our $pkt; # bitches -sub _dec_qname { +sub _dec_name { my @res; my $redir; my $ptr = $ofs; @@ -501,7 +367,7 @@ my $len = ord substr $pkt, $ptr++, 1; - if ($len & 0xc0) { + if ($len >= 0xc0) { $ptr++; $ofs = $ptr if $ptr > $ofs; $ptr = (unpack "n", substr $pkt, $ptr - 2, 2) & 0x3fff; @@ -516,39 +382,39 @@ } sub _dec_qd { - my $qname = _dec_qname; + my $qname = _dec_name; my ($qt, $qc) = unpack "nn", substr $pkt, $ofs; $ofs += 4; [$qname, $type_str{$qt} || $qt, $class_str{$qc} || $qc] } our %dec_rr = ( - 1 => sub { join ".", unpack "C4" }, # a - 2 => sub { local $ofs = $ofs - length; _dec_qname }, # ns - 5 => sub { local $ofs = $ofs - length; _dec_qname }, # cname + 1 => sub { join ".", unpack "C4", $_ }, # a + 2 => sub { local $ofs = $ofs - length; _dec_name }, # ns + 5 => sub { local $ofs = $ofs - length; _dec_name }, # cname 6 => sub { local $ofs = $ofs - length; - my $mname = _dec_qname; - my $rname = _dec_qname; + my $mname = _dec_name; + my $rname = _dec_name; ($mname, $rname, unpack "NNNNN", substr $pkt, $ofs) }, # soa - 11 => sub { ((join ".", unpack "C4"), unpack "C a*", substr $_, 4) }, # wks - 12 => sub { local $ofs = $ofs - length; _dec_qname }, # ptr - 13 => sub { unpack "C/a C/a", $_ }, # hinfo - 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_qname) }, # mx - 16 => sub { unpack "(C/a)*", $_ }, # txt - 28 => sub { AnyEvent::Socket::format_ip ($_) }, # aaaa - 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_qname) }, # srv - 99 => sub { unpack "(C/a)*", $_ }, # spf + 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks + 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr + 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo + 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx + 16 => sub { unpack "(C/a*)*", $_ }, # txt + 28 => sub { AnyEvent::Socket::format_address ($_) }, # aaaa + 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv + 99 => sub { unpack "(C/a*)*", $_ }, # spf ); sub _dec_rr { - my $qname = _dec_qname; + my $name = _dec_name; my ($rt, $rc, $ttl, $rdlen) = unpack "nn N n", substr $pkt, $ofs; $ofs += 10; local $_ = substr $pkt, $ofs, $rdlen; $ofs += $rdlen; [ - $qname, + $name, $type_str{$rt} || $rt, $class_str{$rc} || $rc, ($dec_rr{$rt} || sub { $_ })->(), @@ -734,20 +600,23 @@ sub new { my ($class, %arg) = @_; - socket my $fh, &Socket::AF_INET, &Socket::SOCK_DGRAM, 0 - or Carp::croak "socket: $!"; + # try to create a ipv4 and an ipv6 socket + # only fail when we cnanot create either + + socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0; + socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0; - AnyEvent::Util::fh_nonblocking $fh, 1; + $fh4 || $fh6 + or Carp::croak "unable to create either an IPv6 or an IPv4 socket"; my $self = bless { - server => [v127.0.0.1], + server => [], timeout => [2, 5, 5], search => [], ndots => 1, max_outstanding => 10, reuse => 300, # reuse id's after 5 minutes only, if possible %arg, - fh => $fh, reuse_q => [], }, $class; @@ -755,7 +624,26 @@ # but perl lacks a good posix module Scalar::Util::weaken (my $wself = $self); - $self->{rw} = AnyEvent->io (fh => $fh, poll => "r", cb => sub { $wself->_recv }); + + if ($fh4) { + AnyEvent::Util::fh_nonblocking $fh4, 1; + $self->{fh4} = $fh4; + $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub { + if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) { + $wself->_recv ($pkt, $peer); + } + }); + } + + if ($fh6) { + $self->{fh6} = $fh6; + AnyEvent::Util::fh_nonblocking $fh6, 1; + $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub { + if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) { + $wself->_recv ($pkt, $peer); + } + }); + } $self->_compile; @@ -787,8 +675,8 @@ # comment } elsif (/^\s*nameserver\s+(\S+)\s*$/i) { my $ip = $1; - if (AnyEvent::Util::dotted_quad $ip) { - push @{ $self->{server} }, AnyEvent::Util::socket_inet_aton $ip; + if (my $ipn = AnyEvent::Socket::parse_address ($ip)) { + push @{ $self->{server} }, $ipn; } else { warn "nameserver $ip invalid and ignored\n"; } @@ -829,37 +717,50 @@ sub os_config { my ($self) = @_; - if ($^O =~ /mswin32|cygwin/i) { - # yeah, it suxx... lets hope DNS is DNS in all locales + $self->{server} = []; + $self->{search} = []; + + if (AnyEvent::WIN32 || $^O =~ /cygwin/i) { + no strict 'refs'; + + # there are many options to find the current nameservers etc. on windows + # all of them don't work consistently: + # - the registry thing needs separate code on win32 native vs. cygwin + # - the registry layout differs between windows versions + # - calling windows api functions doesn't work on cygwin + # - ipconfig uses locale-specific messages + + # we use ipconfig parsing because, despite all it's brokenness, + # it seems most stable in practise. + # for good measure, we append a fallback nameserver to our list. if (open my $fh, "ipconfig /all |") { - delete $self->{server}; - delete $self->{search}; + # parsing strategy: we go through the output and look for + # :-lines with DNS in them. everything in those is regarded as + # either a nameserver (if it parses as an ip address), or a suffix + # (all else). + my $dns; while (<$fh>) { - # first DNS.* is suffix list - if (/^\s*DNS/) { - while (/\s+([[:alnum:].\-]+)\s*$/) { - push @{ $self->{search} }, $1; - $_ = <$fh>; - } - last; + if (s/^\s.*\bdns\b.*://i) { + $dns = 1; + } elsif (/^\S/ || /^\s[^:]{16,}: /) { + $dns = 0; } - } - - while (<$fh>) { - # second DNS.* is server address list - if (/^\s*DNS/) { - while (/\s+(\d+\.\d+\.\d+\.\d+)\s*$/) { - my $ip = $1; - push @{ $self->{server} }, AnyEvent::Util::socket_inet_aton $ip - if AnyEvent::Util::dotted_quad $ip; - $_ = <$fh>; + if ($dns && /^\s*(\S+)\s*$/) { + my $s = $1; + $s =~ s/%\d+(?!\S)//; # get rid of scope id + if (my $ipn = AnyEvent::Socket::parse_address ($s)) { + push @{ $self->{server} }, $ipn; + } else { + push @{ $self->{search} }, $s; } - last; } } + # always add one fallback server + push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK]; + $self->_compile; } } else { @@ -875,6 +776,14 @@ sub _compile { my $self = shift; + my %search; $self->{search} = [grep 0 < length, grep !$search{$_}++, @{ $self->{search} }]; + my %server; $self->{server} = [grep 0 < length, grep !$server{$_}++, @{ $self->{server} }]; + + unless (@{ $self->{server} }) { + # use 127.0.0.1 by default, and one opendns nameserver as fallback + $self->{server} = [v127.0.0.1, $DNS_FALLBACK[rand @DNS_FALLBACK]]; + } + my @retry; for my $timeout (@{ $self->{timeout} }) { @@ -901,15 +810,16 @@ } sub _recv { - my ($self) = @_; + my ($self, $pkt, $peer) = @_; - while (my $peer = recv $self->{fh}, my $res, 4096, 0) { - my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer); + # we ignore errors (often one gets port unreachable, but there is + # no good way to take advantage of that. - return unless $port == 53 && grep $_ eq $host, @{ $self->{server} }; + my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer); - $self->_feed ($res); - } + return unless $port == 53 && grep $_ eq $host, @{ $self->{server} }; + + $self->_feed ($pkt); } sub _free_id { @@ -955,7 +865,7 @@ if ($res->{tc}) { # success, but truncated, so use tcp - AnyEvent::Socket::tcp_connect ((Socket::inet_ntoa $server), 53, sub { + AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub { my ($fh) = @_ or return &$do_retry; @@ -967,8 +877,8 @@ }; $handle->push_write (pack "n/a", $req->[0]); - $handle->push_read_chunk (2, sub { - $handle->unshift_read_chunk ((unpack "n", $_[1]), sub { + $handle->push_read (chunk => 2, sub { + $handle->unshift_read (chunk => (unpack "n", $_[1]), sub { $self->_feed ($_[1]); }); }); @@ -982,8 +892,14 @@ undef $do_retry; return $req->[1]->($res); } }]; + + my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server); + + my $fh = AF_INET == Socket::sockaddr_family ($sa) + ? $self->{fh4} : $self->{fh6} + or return &$do_retry; - send $self->{fh}, $req->[0], 0, AnyEvent::Socket::pack_sockaddr (53, $server); + send $fh, $req->[0], 0, $sa; }; &$do_retry;