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.35 by root, Mon May 26 06:18:53 2008 UTC vs.
Revision 1.38 by root, Thu May 29 01:46:56 2008 UTC

… …
33 33
34use Socket qw(AF_INET SOCK_DGRAM SOCK_STREAM); 34use Socket qw(AF_INET SOCK_DGRAM SOCK_STREAM);
35 35
36use AnyEvent (); 36use AnyEvent ();
37use AnyEvent::Handle (); 37use AnyEvent::Handle ();
38use AnyEvent::Util qw(AF_INET6);
38 39
39our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222); 40our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222);
40
41=item AnyEvent::DNS::addr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...)
42
43Tries to resolve the given nodename and service name into protocol families
44and sockaddr structures usable to connect to this node and service in a
45protocol-independent way. It works remotely similar to the getaddrinfo
46posix function.
47
48C<$node> is either an IPv4 or IPv6 address or a hostname, C<$service> is
49either a service name (port name from F</etc/services>) or a numerical
50port number. If both C<$node> and C<$service> are names, then SRV records
51will be consulted to find the real service, otherwise they will be
52used as-is. If you know that the service name is not in your services
53database, then you can specify the service in the format C<name=port>
54(e.g. C<http=80>).
55
56C<$proto> must be a protocol name, currently C<tcp>, C<udp> or
57C<sctp>. The default is C<tcp>.
58
59C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use
60only IPv4) or C<6> (use only IPv6). This setting might be influenced by
61C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.
62
63C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or
64C<undef> in which case it gets automatically chosen).
65
66The callback will receive zero or more array references that contain
67C<$family, $type, $proto> for use in C<socket> and a binary
68C<$sockaddr> for use in C<connect> (or C<bind>).
69
70The application should try these in the order given.
71
72Example:
73
74 AnyEvent::DNS::addr "google.com", "http", 0, undef, undef, sub { ... };
75 41
76=item AnyEvent::DNS::a $domain, $cb->(@addrs) 42=item AnyEvent::DNS::a $domain, $cb->(@addrs)
77 43
78Tries to resolve the given domain to IPv4 address(es). 44Tries to resolve the given domain to IPv4 address(es).
79 45
… …
124 90
125Tries to resolve the given domain and passes all resource records found to 91Tries to resolve the given domain and passes all resource records found to
126the callback. 92the callback.
127 93
128=cut 94=cut
95
96sub MAX_PKT() { 4096 } # max packet size we advertise and accept
97
98sub DOMAIN_PORT() { 53 } # if this changes drop me a note
129 99
130sub resolver; 100sub resolver;
131 101
132sub a($$) { 102sub a($$) {
133 my ($domain, $cb) = @_; 103 my ($domain, $cb) = @_;
… …
179} 149}
180 150
181sub ptr($$) { 151sub ptr($$) {
182 my ($ip, $cb) = @_; 152 my ($ip, $cb) = @_;
183 153
184 $ip = AnyEvent::Socket::parse_ip ($ip) 154 $ip = AnyEvent::Socket::parse_address ($ip)
185 or return $cb->(); 155 or return $cb->();
186 156
187 if (4 == length $ip) { 157 my $af = AnyEvent::Socket::address_family ($ip);
158
159 if ($af == AF_INET) {
188 $ip = join ".", (reverse split /\./, $ip), "in-addr.arpa."; 160 $ip = join ".", (reverse split /\./, $ip), "in-addr.arpa.";
161 } elsif ($af == AF_INET6) {
162 $ip = join ".", (reverse split //, unpack "H*", $ip), "ip6.arpa.";
189 } else { 163 } else {
190 $ip = join ".", (reverse split //, unpack "H*", $ip), "ip6.arpa."; 164 return $cb->();
191 } 165 }
192 166
193 resolver->resolve ($ip => "ptr", sub { 167 resolver->resolve ($ip => "ptr", sub {
194 $cb->(map $_->[3], @_); 168 $cb->(map $_->[3], @_);
195 }); 169 });
… …
199 my ($domain, $cb) = @_; 173 my ($domain, $cb) = @_;
200 174
201 resolver->resolve ($domain => "*", $cb); 175 resolver->resolve ($domain => "*", $cb);
202} 176}
203 177
204############################################################################# 178#################################################################################
205
206sub addr($$$$$$) {
207 my ($node, $service, $proto, $family, $type, $cb) = @_;
208
209 unless (&AnyEvent::Util::AF_INET6) {
210 $family != 6
211 or return $cb->();
212
213 $family ||= 4;
214 }
215
216 $cb->() if $family == 4 && !$AnyEvent::PROTOCOL{ipv4};
217 $cb->() if $family == 6 && !$AnyEvent::PROTOCOL{ipv6};
218
219 $family ||=4 unless $AnyEvent::PROTOCOL{ipv6};
220 $family ||=6 unless $AnyEvent::PROTOCOL{ipv4};
221
222 $proto ||= "tcp";
223 $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
224
225 my $proton = (getprotobyname $proto)[2]
226 or Carp::croak "$proto: protocol unknown";
227
228 my $port;
229
230 if ($service =~ /^(\S+)=(\d+)$/) {
231 ($service, $port) = ($1, $2);
232 } elsif ($service =~ /^\d+$/) {
233 ($service, $port) = (undef, $service);
234 } else {
235 $port = (getservbyname $service, $proto)[2]
236 or Carp::croak "$service/$proto: service unknown";
237 }
238
239 my @target = [$node, $port];
240
241 # resolve a records / provide sockaddr structures
242 my $resolve = sub {
243 my @res;
244 my $cv = AnyEvent->condvar (cb => sub {
245 $cb->(
246 map $_->[2],
247 sort {
248 $AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}
249 or $a->[0] <=> $b->[0]
250 }
251 @res
252 )
253 });
254
255 $cv->begin;
256 for my $idx (0 .. $#target) {
257 my ($node, $port) = @{ $target[$idx] };
258
259 if (my $noden = AnyEvent::Socket::parse_ip ($node)) {
260 if (4 == length $noden && $family != 6) {
261 push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
262 AnyEvent::Socket::pack_sockaddr ($port, $noden)]]
263 }
264
265 if (16 == length $noden && $family != 4) {
266 push @res, [$idx, "ipv6", [&AnyEvent::Util::AF_INET6, $type, $proton,
267 AnyEvent::Socket::pack_sockaddr ( $port, $noden)]]
268 }
269 } else {
270 # ipv4
271 if ($family != 6) {
272 $cv->begin;
273 a $node, sub {
274 push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
275 AnyEvent::Socket::pack_sockaddr ($port, AnyEvent::Socket::parse_ipv4 ($_))]]
276 for @_;
277 $cv->end;
278 };
279 }
280
281 # ipv6
282 if ($family != 4) {
283 $cv->begin;
284 aaaa $node, sub {
285 push @res, [$idx, "ipv6", [&AnyEvent::Socket::AF_INET6, $type, $proton,
286 AnyEvent::Socket::pack_sockaddr ($port, AnyEvent::Socket::parse_ipv6 ($_))]]
287 for @_;
288 $cv->end;
289 };
290 }
291 }
292 }
293 $cv->end;
294 };
295
296 # try srv records, if applicable
297 if ($node eq "localhost") {
298 @target = (["127.0.0.1", $port], ["::1", $port]);
299 &$resolve;
300 } elsif (defined $service && !AnyEvent::Socket::parse_ip ($node)) {
301 srv $service, $proto, $node, sub {
302 my (@srv) = @_;
303
304 # no srv records, continue traditionally
305 @srv
306 or return &$resolve;
307
308 # only srv record has "." => abort
309 $srv[0][2] ne "." || $#srv
310 or return $cb->();
311
312 # use srv records then
313 @target = map ["$_->[3].", $_->[2]],
314 grep $_->[3] ne ".",
315 @srv;
316
317 &$resolve;
318 };
319 } else {
320 &$resolve;
321 }
322}
323
324#############################################################################
325 179
326=back 180=back
327 181
328=head2 LOW-LEVEL DNS EN-/DECODING FUNCTIONS 182=head2 LOW-LEVEL DNS EN-/DECODING FUNCTIONS
329 183
… …
491 (join "", map _enc_qd, @{ $req->{qd} || [] }), 345 (join "", map _enc_qd, @{ $req->{qd} || [] }),
492 (join "", map _enc_rr, @{ $req->{an} || [] }), 346 (join "", map _enc_rr, @{ $req->{an} || [] }),
493 (join "", map _enc_rr, @{ $req->{ns} || [] }), 347 (join "", map _enc_rr, @{ $req->{ns} || [] }),
494 (join "", map _enc_rr, @{ $req->{ar} || [] }), 348 (join "", map _enc_rr, @{ $req->{ar} || [] }),
495 349
496 ($EDNS0 ? pack "C nnNn", 0, 41, 4096, 0, 0 : "") # EDNS0, 4kiB udp payload size 350 ($EDNS0 ? pack "C nnNn", 0, 41, MAX_PKT, 0, 0 : "") # EDNS0, 4kiB udp payload size
497} 351}
498 352
499our $ofs; 353our $ofs;
500our $pkt; 354our $pkt;
501 355
… …
544 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks 398 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks
545 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr 399 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr
546 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo 400 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo
547 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx 401 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx
548 16 => sub { unpack "(C/a*)*", $_ }, # txt 402 16 => sub { unpack "(C/a*)*", $_ }, # txt
549 28 => sub { AnyEvent::Socket::format_ip ($_) }, # aaaa 403 28 => sub { AnyEvent::Socket::format_address ($_) }, # aaaa
550 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv 404 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv
551 99 => sub { unpack "(C/a*)*", $_ }, # spf 405 99 => sub { unpack "(C/a*)*", $_ }, # spf
552); 406);
553 407
554sub _dec_rr { 408sub _dec_rr {
… …
742=cut 596=cut
743 597
744sub new { 598sub new {
745 my ($class, %arg) = @_; 599 my ($class, %arg) = @_;
746 600
601 # try to create a ipv4 and an ipv6 socket
602 # only fail when we cnanot create either
603
747 socket my $fh, AF_INET, &Socket::SOCK_DGRAM, 0 604 socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0;
748 or Carp::croak "socket: $!"; 605 socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0;
749 606
750 AnyEvent::Util::fh_nonblocking $fh, 1; 607 $fh4 || $fh6
608 or Carp::croak "unable to create either an IPv6 or an IPv4 socket";
751 609
752 my $self = bless { 610 my $self = bless {
753 server => [], 611 server => [],
754 timeout => [2, 5, 5], 612 timeout => [2, 5, 5],
755 search => [], 613 search => [],
756 ndots => 1, 614 ndots => 1,
757 max_outstanding => 10, 615 max_outstanding => 10,
758 reuse => 300, # reuse id's after 5 minutes only, if possible 616 reuse => 300, # reuse id's after 5 minutes only, if possible
759 %arg, 617 %arg,
760 fh => $fh,
761 reuse_q => [], 618 reuse_q => [],
762 }, $class; 619 }, $class;
763 620
764 # search should default to gethostname's domain 621 # search should default to gethostname's domain
765 # but perl lacks a good posix module 622 # but perl lacks a good posix module
766 623
767 Scalar::Util::weaken (my $wself = $self); 624 Scalar::Util::weaken (my $wself = $self);
625
626 if ($fh4) {
627 AnyEvent::Util::fh_nonblocking $fh4, 1;
628 $self->{fh4} = $fh4;
768 $self->{rw} = AnyEvent->io (fh => $fh, poll => "r", cb => sub { $wself->_recv }); 629 $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub {
630 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) {
631 $wself->_recv ($pkt, $peer);
632 }
633 });
634 }
635
636 if ($fh6) {
637 $self->{fh6} = $fh6;
638 AnyEvent::Util::fh_nonblocking $fh6, 1;
639 $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub {
640 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) {
641 $wself->_recv ($pkt, $peer);
642 }
643 });
644 }
769 645
770 $self->_compile; 646 $self->_compile;
771 647
772 $self 648 $self
773} 649}
… …
795 for (split /\n/, $resolvconf) { 671 for (split /\n/, $resolvconf) {
796 if (/^\s*#/) { 672 if (/^\s*#/) {
797 # comment 673 # comment
798 } elsif (/^\s*nameserver\s+(\S+)\s*$/i) { 674 } elsif (/^\s*nameserver\s+(\S+)\s*$/i) {
799 my $ip = $1; 675 my $ip = $1;
800 if (my $ipn = AnyEvent::Socket::parse_ip ($ip)) { 676 if (my $ipn = AnyEvent::Socket::parse_address ($ip)) {
801 push @{ $self->{server} }, $ipn; 677 push @{ $self->{server} }, $ipn;
802 } else { 678 } else {
803 warn "nameserver $ip invalid and ignored\n"; 679 warn "nameserver $ip invalid and ignored\n";
804 } 680 }
805 } elsif (/^\s*domain\s+(\S*)\s+$/i) { 681 } elsif (/^\s*domain\s+(\S*)\s+$/i) {
… …
870 $dns = 0; 746 $dns = 0;
871 } 747 }
872 if ($dns && /^\s*(\S+)\s*$/) { 748 if ($dns && /^\s*(\S+)\s*$/) {
873 my $s = $1; 749 my $s = $1;
874 $s =~ s/%\d+(?!\S)//; # get rid of scope id 750 $s =~ s/%\d+(?!\S)//; # get rid of scope id
875 if (my $ipn = AnyEvent::Socket::parse_ip ($s)) { 751 if (my $ipn = AnyEvent::Socket::parse_address ($s)) {
876 push @{ $self->{server} }, $ipn; 752 push @{ $self->{server} }, $ipn;
877 } else { 753 } else {
878 push @{ $self->{search} }, $s; 754 push @{ $self->{search} }, $s;
879 } 755 }
880 } 756 }
… …
896} 772}
897 773
898sub _compile { 774sub _compile {
899 my $self = shift; 775 my $self = shift;
900 776
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} }]; 777 my %search; $self->{search} = [grep 0 < length, grep !$search{$_}++, @{ $self->{search} }];
904 my %server; $self->{server} = [grep 4 == length, grep !$server{$_}++, @{ $self->{server} }]; 778 my %server; $self->{server} = [grep 0 < length, grep !$server{$_}++, @{ $self->{server} }];
905 779
906 unless (@{ $self->{server} }) { 780 unless (@{ $self->{server} }) {
907 # use 127.0.0.1 by default, and one opendns nameserver as fallback 781 # 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]]; 782 $self->{server} = [v127.0.0.1, $DNS_FALLBACK[rand @DNS_FALLBACK]];
909 } 783 }
… …
932 $NOW = time; 806 $NOW = time;
933 $id->[1]->($res); 807 $id->[1]->($res);
934} 808}
935 809
936sub _recv { 810sub _recv {
937 my ($self) = @_; 811 my ($self, $pkt, $peer) = @_;
938 812
939 # we ignore errors (often one gets port unreachable, but there is 813 # we ignore errors (often one gets port unreachable, but there is
940 # no good way to take advantage of that. 814 # no good way to take advantage of that.
941 while (my $peer = recv $self->{fh}, my $res, 4096, 0) { 815
942 my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer); 816 my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer);
943 817
944 return unless $port == 53 && grep $_ eq $host, @{ $self->{server} }; 818 return unless $port == 53 && grep $_ eq $host, @{ $self->{server} };
945 819
946 $self->_feed ($res); 820 $self->_feed ($pkt);
947 }
948} 821}
949 822
950sub _free_id { 823sub _free_id {
951 my ($self, $id, $timeout) = @_; 824 my ($self, $id, $timeout) = @_;
952 825
… …
988 }), sub { 861 }), sub {
989 my ($res) = @_; 862 my ($res) = @_;
990 863
991 if ($res->{tc}) { 864 if ($res->{tc}) {
992 # success, but truncated, so use tcp 865 # success, but truncated, so use tcp
993 AnyEvent::Socket::tcp_connect ((Socket::inet_ntoa $server), 53, sub { 866 AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub {
994 my ($fh) = @_ 867 my ($fh) = @_
995 or return &$do_retry; 868 or return &$do_retry;
996 869
997 my $handle = new AnyEvent::Handle 870 my $handle = new AnyEvent::Handle
998 fh => $fh, 871 fh => $fh,
… …
1015 # success 888 # success
1016 $self->_free_id ($req->[2], $retry > 1); 889 $self->_free_id ($req->[2], $retry > 1);
1017 undef $do_retry; return $req->[1]->($res); 890 undef $do_retry; return $req->[1]->($res);
1018 } 891 }
1019 }]; 892 }];
893
894 my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server);
1020 895
1021 send $self->{fh}, $req->[0], 0, AnyEvent::Socket::pack_sockaddr (53, $server); 896 my $fh = (Socket::sockaddr_family $sa) == AF_INET
897 ? $self->{fh4} : $self->{fh6}
898 or return &$do_retry;
899
900 send $fh, $req->[0], 0, $sa;
1022 }; 901 };
1023 902
1024 &$do_retry; 903 &$do_retry;
1025} 904}
1026 905

Diff Legend

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