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.36 by root, Wed May 28 21:07:07 2008 UTC

… …
36use AnyEvent (); 36use AnyEvent ();
37use AnyEvent::Handle (); 37use AnyEvent::Handle ();
38 38
39our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222); 39our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222);
40 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
76=item AnyEvent::DNS::a $domain, $cb->(@addrs) 41=item AnyEvent::DNS::a $domain, $cb->(@addrs)
77 42
78Tries to resolve the given domain to IPv4 address(es). 43Tries to resolve the given domain to IPv4 address(es).
79 44
80=item AnyEvent::DNS::aaaa $domain, $cb->(@addrs) 45=item AnyEvent::DNS::aaaa $domain, $cb->(@addrs)
… …
179} 144}
180 145
181sub ptr($$) { 146sub ptr($$) {
182 my ($ip, $cb) = @_; 147 my ($ip, $cb) = @_;
183 148
184 $ip = AnyEvent::Socket::parse_ip ($ip) 149 $ip = AnyEvent::Socket::parse_address ($ip)
185 or return $cb->(); 150 or return $cb->();
186 151
187 if (4 == length $ip) { 152 if (4 == length $ip) {
188 $ip = join ".", (reverse split /\./, $ip), "in-addr.arpa."; 153 $ip = join ".", (reverse split /\./, $ip), "in-addr.arpa.";
189 } else { 154 } else {
… …
199 my ($domain, $cb) = @_; 164 my ($domain, $cb) = @_;
200 165
201 resolver->resolve ($domain => "*", $cb); 166 resolver->resolve ($domain => "*", $cb);
202} 167}
203 168
204############################################################################# 169#################################################################################
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 170
326=back 171=back
327 172
328=head2 LOW-LEVEL DNS EN-/DECODING FUNCTIONS 173=head2 LOW-LEVEL DNS EN-/DECODING FUNCTIONS
329 174
… …
544 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks 389 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks
545 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr 390 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr
546 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo 391 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo
547 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx 392 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx
548 16 => sub { unpack "(C/a*)*", $_ }, # txt 393 16 => sub { unpack "(C/a*)*", $_ }, # txt
549 28 => sub { AnyEvent::Socket::format_ip ($_) }, # aaaa 394 28 => sub { AnyEvent::Socket::format_address ($_) }, # aaaa
550 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv 395 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv
551 99 => sub { unpack "(C/a*)*", $_ }, # spf 396 99 => sub { unpack "(C/a*)*", $_ }, # spf
552); 397);
553 398
554sub _dec_rr { 399sub _dec_rr {
… …
795 for (split /\n/, $resolvconf) { 640 for (split /\n/, $resolvconf) {
796 if (/^\s*#/) { 641 if (/^\s*#/) {
797 # comment 642 # comment
798 } elsif (/^\s*nameserver\s+(\S+)\s*$/i) { 643 } elsif (/^\s*nameserver\s+(\S+)\s*$/i) {
799 my $ip = $1; 644 my $ip = $1;
800 if (my $ipn = AnyEvent::Socket::parse_ip ($ip)) { 645 if (my $ipn = AnyEvent::Socket::parse_address ($ip)) {
801 push @{ $self->{server} }, $ipn; 646 push @{ $self->{server} }, $ipn;
802 } else { 647 } else {
803 warn "nameserver $ip invalid and ignored\n"; 648 warn "nameserver $ip invalid and ignored\n";
804 } 649 }
805 } elsif (/^\s*domain\s+(\S*)\s+$/i) { 650 } elsif (/^\s*domain\s+(\S*)\s+$/i) {
… …
870 $dns = 0; 715 $dns = 0;
871 } 716 }
872 if ($dns && /^\s*(\S+)\s*$/) { 717 if ($dns && /^\s*(\S+)\s*$/) {
873 my $s = $1; 718 my $s = $1;
874 $s =~ s/%\d+(?!\S)//; # get rid of scope id 719 $s =~ s/%\d+(?!\S)//; # get rid of scope id
875 if (my $ipn = AnyEvent::Socket::parse_ip ($s)) { 720 if (my $ipn = AnyEvent::Socket::parse_address ($s)) {
876 push @{ $self->{server} }, $ipn; 721 push @{ $self->{server} }, $ipn;
877 } else { 722 } else {
878 push @{ $self->{search} }, $s; 723 push @{ $self->{search} }, $s;
879 } 724 }
880 } 725 }

Diff Legend

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