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.54 by root, Fri May 30 10:06:14 2008 UTC vs.
Revision 1.70 by root, Tue Jul 15 11:44:08 2008 UTC

2 2
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 8
9 my $cv = AnyEvent->condvar; 9 my $cv = AnyEvent->condvar;
10 AnyEvent::DNS::a "www.google.de", $cv; 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
16This module offers both a number of DNS convenience functions as well 16This module offers both a number of DNS convenience functions as well
17as a fully asynchronous and high-performance pure-perl stub resolver. 17as a fully asynchronous and high-performance pure-perl stub resolver.
35 35
36use AnyEvent (); 36use AnyEvent ();
37use AnyEvent::Handle (); 37use AnyEvent::Handle ();
38use AnyEvent::Util qw(AF_INET6); 38use AnyEvent::Util qw(AF_INET6);
39 39
40our $VERSION = '1.0'; 40our $VERSION = 4.160;
41 41
42our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222); 42our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222);
43 43
44=item AnyEvent::DNS::a $domain, $cb->(@addrs) 44=item AnyEvent::DNS::a $domain, $cb->(@addrs)
45 45
65=item AnyEvent::DNS::srv $service, $proto, $domain, $cb->(@srv_rr) 65=item AnyEvent::DNS::srv $service, $proto, $domain, $cb->(@srv_rr)
66 66
67Tries to resolve the given service, protocol and domain name into a list 67Tries to resolve the given service, protocol and domain name into a list
68of service records. 68of service records.
69 69
70Each srv_rr is an array reference with the following contents: 70Each C<$srv_rr> is an array reference with the following contents:
71C<[$priority, $weight, $transport, $target]>. 71C<[$priority, $weight, $transport, $target]>.
72 72
73They will be sorted with lowest priority first, then randomly 73They will be sorted with lowest priority first, then randomly
74distributed by weight as per RFC 2782. 74distributed by weight as per RFC 2782.
75 75
170 my %pri; 170 my %pri;
171 push @{ $pri{$_->[3]} }, [ @$_[3,4,5,6] ] 171 push @{ $pri{$_->[3]} }, [ @$_[3,4,5,6] ]
172 for @_; 172 for @_;
173 173
174 # order by priority 174 # order by priority
175 for my $pri (sort { $a->[0] <=> $b->[0] } keys %pri) { 175 for my $pri (sort { $a <=> $b } keys %pri) {
176 # order by weight 176 # order by weight
177 my @rr = sort { $a->[1] <=> $b->[1] } @{ delete $pri{$pri} }; 177 my @rr = sort { $a->[1] <=> $b->[1] } @{ delete $pri{$pri} };
178 178
179 my $sum; $sum += $_->[1] for @rr; 179 my $sum; $sum += $_->[1] for @rr;
180 180
265 ptr $ptr, sub { 265 ptr $ptr, sub {
266 for my $name (@_) { 266 for my $name (@_) {
267 ++$cnt; 267 ++$cnt;
268 268
269 # () around AF_INET to work around bug in 5.8 269 # () around AF_INET to work around bug in 5.8
270 resolver->resolve ($name => ($af == (AF_INET) ? "a" : "aaaa"), sub { 270 resolver->resolve ("$name." => ($af == (AF_INET) ? "a" : "aaaa"), sub {
271 for (@_) { 271 for (@_) {
272 push @res, $name 272 push @res, $name
273 if $_->[3] eq $ip; 273 if $_->[3] eq $ip;
274 } 274 }
275 $cb->(@res) unless --$cnt; 275 $cb->(@res) unless --$cnt;
397 397
398Resource records are not yet encodable. 398Resource records are not yet encodable.
399 399
400Examples: 400Examples:
401 401
402 # very simple request, using lots of default values: 402 # very simple request, using lots of default values:
403 { rd => 1, qd => [ [ "host.domain", "a"] ] } 403 { rd => 1, qd => [ [ "host.domain", "a"] ] }
404 404
405 # more complex example, showing how flags etc. are named: 405 # more complex example, showing how flags etc. are named:
406 406
407 { 407 {
408 id => 10000, 408 id => 10000,
409 op => "query", 409 op => "query",
410 rc => "nxdomain", 410 rc => "nxdomain",
411 411
412 # flags 412 # flags
413 qr => 1, 413 qr => 1,
414 aa => 0, 414 aa => 0,
415 tc => 0, 415 tc => 0,
416 rd => 0, 416 rd => 0,
417 ra => 0, 417 ra => 0,
418 ad => 0, 418 ad => 0,
419 cd => 0, 419 cd => 0,
420 420
421 qd => [@rr], # query section 421 qd => [@rr], # query section
422 an => [@rr], # answer section 422 an => [@rr], # answer section
423 ns => [@rr], # authority section 423 ns => [@rr], # authority section
424 ar => [@rr], # additional records section 424 ar => [@rr], # additional records section
425 } 425 }
426 426
427=cut 427=cut
428 428
429sub dns_pack($) { 429sub dns_pack($) {
430 my ($req) = @_; 430 my ($req) = @_;
506 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx 506 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx
507 16 => sub { unpack "(C/a*)*", $_ }, # txt 507 16 => sub { unpack "(C/a*)*", $_ }, # txt
508 28 => sub { AnyEvent::Socket::format_address ($_) }, # aaaa 508 28 => sub { AnyEvent::Socket::format_address ($_) }, # aaaa
509 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv 509 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv
510 35 => sub { # naptr 510 35 => sub { # naptr
511 # requires perl 5.10, sorry
511 my ($order, $preference, $flags, $service, $regexp, $offset) = unpack "nn C/a* C/a* C/a* .", $_; 512 my ($order, $preference, $flags, $service, $regexp, $offset) = unpack "nn C/a* C/a* C/a* .", $_;
512 local $ofs = $ofs + $offset - length; 513 local $ofs = $ofs + $offset - length;
513 ($order, $preference, $flags, $service, $regexp, _dec_name) 514 ($order, $preference, $flags, $service, $regexp, _dec_name)
514 }, 515 },
515 99 => sub { unpack "(C/a*)*", $_ }, # spf 516 99 => sub { unpack "(C/a*)*", $_ }, # spf
533 534
534Unpacks a DNS packet into a perl data structure. 535Unpacks a DNS packet into a perl data structure.
535 536
536Examples: 537Examples:
537 538
538 # an unsuccessful reply 539 # an unsuccessful reply
539 { 540 {
540 'qd' => [ 541 'qd' => [
541 [ 'ruth.plan9.de.mach.uni-karlsruhe.de', '*', 'in' ] 542 [ 'ruth.plan9.de.mach.uni-karlsruhe.de', '*', 'in' ]
542 ], 543 ],
543 'rc' => 'nxdomain', 544 'rc' => 'nxdomain',
544 'ar' => [], 545 'ar' => [],
545 'ns' => [ 546 'ns' => [
546 [ 547 [
547 'uni-karlsruhe.de', 548 'uni-karlsruhe.de',
548 'soa', 549 'soa',
549 'in', 550 'in',
550 'netserv.rz.uni-karlsruhe.de', 551 'netserv.rz.uni-karlsruhe.de',
551 'hostmaster.rz.uni-karlsruhe.de', 552 'hostmaster.rz.uni-karlsruhe.de',
552 2008052201, 10800, 1800, 2592000, 86400 553 2008052201, 10800, 1800, 2592000, 86400
553 ] 554 ]
554 ], 555 ],
555 'tc' => '', 556 'tc' => '',
556 'ra' => 1, 557 'ra' => 1,
557 'qr' => 1, 558 'qr' => 1,
558 'id' => 45915, 559 'id' => 45915,
559 'aa' => '', 560 'aa' => '',
560 'an' => [], 561 'an' => [],
561 'rd' => 1, 562 'rd' => 1,
562 'op' => 'query' 563 'op' => 'query'
563 } 564 }
564 565
565 # a successful reply 566 # a successful reply
566 567
567 { 568 {
568 'qd' => [ [ 'www.google.de', 'a', 'in' ] ], 569 'qd' => [ [ 'www.google.de', 'a', 'in' ] ],
569 'rc' => 0, 570 'rc' => 0,
570 'ar' => [ 571 'ar' => [
571 [ 'a.l.google.com', 'a', 'in', '209.85.139.9' ], 572 [ 'a.l.google.com', 'a', 'in', '209.85.139.9' ],
572 [ 'b.l.google.com', 'a', 'in', '64.233.179.9' ], 573 [ 'b.l.google.com', 'a', 'in', '64.233.179.9' ],
573 [ 'c.l.google.com', 'a', 'in', '64.233.161.9' ], 574 [ 'c.l.google.com', 'a', 'in', '64.233.161.9' ],
574 ], 575 ],
575 'ns' => [ 576 'ns' => [
576 [ 'l.google.com', 'ns', 'in', 'a.l.google.com' ], 577 [ 'l.google.com', 'ns', 'in', 'a.l.google.com' ],
577 [ 'l.google.com', 'ns', 'in', 'b.l.google.com' ], 578 [ 'l.google.com', 'ns', 'in', 'b.l.google.com' ],
578 ], 579 ],
579 'tc' => '', 580 'tc' => '',
580 'ra' => 1, 581 'ra' => 1,
581 'qr' => 1, 582 'qr' => 1,
582 'id' => 64265, 583 'id' => 64265,
583 'aa' => '', 584 'aa' => '',
584 'an' => [ 585 'an' => [
585 [ 'www.google.de', 'cname', 'in', 'www.google.com' ], 586 [ 'www.google.de', 'cname', 'in', 'www.google.com' ],
586 [ 'www.google.com', 'cname', 'in', 'www.l.google.com' ], 587 [ 'www.google.com', 'cname', 'in', 'www.l.google.com' ],
587 [ 'www.l.google.com', 'a', 'in', '66.249.93.104' ], 588 [ 'www.l.google.com', 'a', 'in', '66.249.93.104' ],
588 [ 'www.l.google.com', 'a', 'in', '66.249.93.147' ], 589 [ 'www.l.google.com', 'a', 'in', '66.249.93.147' ],
589 ], 590 ],
590 'rd' => 1, 591 'rd' => 1,
591 'op' => 0 592 'op' => 0
592 } 593 }
593 594
594=cut 595=cut
595 596
596sub dns_unpack($) { 597sub dns_unpack($) {
597 local $pkt = shift; 598 local $pkt = shift;
708=cut 709=cut
709 710
710sub new { 711sub new {
711 my ($class, %arg) = @_; 712 my ($class, %arg) = @_;
712 713
713 # try to create a ipv4 and an ipv6 socket
714 # only fail when we cnanot create either
715
716 socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0;
717 socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0;
718
719 $fh4 || $fh6
720 or Carp::croak "unable to create either an IPv6 or an IPv4 socket";
721
722 my $self = bless { 714 my $self = bless {
723 server => [], 715 server => [],
724 timeout => [2, 5, 5], 716 timeout => [2, 5, 5],
725 search => [], 717 search => [],
726 ndots => 1, 718 ndots => 1,
731 }, $class; 723 }, $class;
732 724
733 # search should default to gethostname's domain 725 # search should default to gethostname's domain
734 # but perl lacks a good posix module 726 # but perl lacks a good posix module
735 727
728 # try to create an ipv4 and an ipv6 socket
729 # only fail when we cannot create either
730 my $got_socket;
731
736 Scalar::Util::weaken (my $wself = $self); 732 Scalar::Util::weaken (my $wself = $self);
737 733
738 if ($fh4) { 734 if (socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0) {
735 ++$got_socket;
736
739 AnyEvent::Util::fh_nonblocking $fh4, 1; 737 AnyEvent::Util::fh_nonblocking $fh4, 1;
740 $self->{fh4} = $fh4; 738 $self->{fh4} = $fh4;
741 $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub { 739 $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub {
742 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) { 740 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) {
743 $wself->_recv ($pkt, $peer); 741 $wself->_recv ($pkt, $peer);
744 } 742 }
745 }); 743 });
746 } 744 }
747 745
748 if ($fh6) { 746 if (AF_INET6 && socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0) {
747 ++$got_socket;
748
749 $self->{fh6} = $fh6; 749 $self->{fh6} = $fh6;
750 AnyEvent::Util::fh_nonblocking $fh6, 1; 750 AnyEvent::Util::fh_nonblocking $fh6, 1;
751 $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub { 751 $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub {
752 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) { 752 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) {
753 $wself->_recv ($pkt, $peer); 753 $wself->_recv ($pkt, $peer);
754 } 754 }
755 }); 755 });
756 } 756 }
757
758 $got_socket
759 or Carp::croak "unable to create either an IPv4 or an IPv6 socket";
757 760
758 $self->_compile; 761 $self->_compile;
759 762
760 $self 763 $self
761} 764}
995 998
996 $self->{id}{$req->[2]} = [AnyEvent->timer (after => $timeout, cb => sub { 999 $self->{id}{$req->[2]} = [AnyEvent->timer (after => $timeout, cb => sub {
997 $NOW = time; 1000 $NOW = time;
998 1001
999 # timeout, try next 1002 # timeout, try next
1000 &$do_retry; 1003 &$do_retry if $do_retry;
1001 }), sub { 1004 }), sub {
1002 my ($res) = @_; 1005 my ($res) = @_;
1003 1006
1004 if ($res->{tc}) { 1007 if ($res->{tc}) {
1005 # success, but truncated, so use tcp 1008 # success, but truncated, so use tcp
1126"any" record type. 1129"any" record type.
1127 1130
1128The callback will be invoked with a list of matching result records or 1131The callback will be invoked with a list of matching result records or
1129none on any error or if the name could not be found. 1132none on any error or if the name could not be found.
1130 1133
1131CNAME chains (although illegal) are followed up to a length of 8. 1134CNAME chains (although illegal) are followed up to a length of 10.
1132 1135
1133The callback will be invoked with an result code in string form (noerror, 1136The callback will be invoked with an result code in string form (noerror,
1134formerr, servfail, nxdomain, notimp, refused and so on), or numerical 1137formerr, servfail, nxdomain, notimp, refused and so on), or numerical
1135form if the result code is not supported. The remaining arguments are 1138form if the result code is not supported. The remaining arguments are
1136arraryefs of the form C<[$name, $type, $class, @data>], where C<$name> is 1139arraryefs of the form C<[$name, $type, $class, @data>], where C<$name> is
1137the domain name, C<$type> a type string or number, C<$class> a class name 1140the domain name, C<$type> a type string or number, C<$class> a class name
1138and @data is resource-record-dependent data. For C<a> records, this will 1141and @data is resource-record-dependent data. For C<a> records, this will
1139be the textual IPv4 addresses, for C<ns> or C<cname> records this will be 1142be the textual IPv4 addresses, for C<ns> or C<cname> records this will be
1140a domain name, for C<txt> records these are all the strings and so on. 1143a domain name, for C<txt> records these are all the strings and so on.
1141 1144
1142All types mentioned in RFC 1035, C<aaaa>, C<srv> and C<spf> are 1145All types mentioned in RFC 1035, C<aaaa>, C<srv>, C<naptr> and C<spf> are
1143decoded. All resource records not known to this module will just return 1146decoded. All resource records not known to this module will have
1144the raw C<rdata> field as fourth entry. 1147the raw C<rdata> field as fourth entry.
1145 1148
1146Note that this resolver is just a stub resolver: it requires a name server 1149Note that this resolver is just a stub resolver: it requires a name server
1147supporting recursive queries, will not do any recursive queries itself and 1150supporting recursive queries, will not do any recursive queries itself and
1148is not secure when used against an untrusted name server. 1151is not secure when used against an untrusted name server.
1153 1156
1154=item search => [$suffix...] 1157=item search => [$suffix...]
1155 1158
1156Use the given search list (which might be empty), by appending each one 1159Use the given search list (which might be empty), by appending each one
1157in turn to the C<$qname>. If this option is missing then the configured 1160in turn to the C<$qname>. If this option is missing then the configured
1158C<ndots> and C<search> define its value. If the C<$qname> ends in a dot, 1161C<ndots> and C<search> values define its value (depending on C<ndots>, the
1159then the searchlist will be ignored. 1162empty suffix will be prepended or appended to that C<search> value). If
1163the C<$qname> ends in a dot, then the searchlist will be ignored.
1160 1164
1161=item accept => [$type...] 1165=item accept => [$type...]
1162 1166
1163Lists the acceptable result types: only result types in this set will be 1167Lists the acceptable result types: only result types in this set will be
1164accepted and returned. The default includes the C<$qtype> and nothing 1168accepted and returned. The default includes the C<$qtype> and nothing
1242 $do_search = sub { 1246 $do_search = sub {
1243 @search 1247 @search
1244 or (undef $do_search), (undef $do_req), return $cb->(); 1248 or (undef $do_search), (undef $do_req), return $cb->();
1245 1249
1246 (my $name = lc "$qname." . shift @search) =~ s/\.$//; 1250 (my $name = lc "$qname." . shift @search) =~ s/\.$//;
1247 my $depth = 2; 1251 my $depth = 10;
1248 1252
1249 # advance in cname-chain 1253 # advance in cname-chain
1250 $do_req = sub { 1254 $do_req = sub {
1251 $self->request ({ 1255 $self->request ({
1252 rd => 1, 1256 rd => 1,
1329 1333
1330=back 1334=back
1331 1335
1332=head1 AUTHOR 1336=head1 AUTHOR
1333 1337
1334 Marc Lehmann <schmorp@schmorp.de> 1338 Marc Lehmann <schmorp@schmorp.de>
1335 http://home.schmorp.de/ 1339 http://home.schmorp.de/
1336 1340
1337=cut 1341=cut
1338 1342

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines