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.53 by root, Fri May 30 09:40:41 2008 UTC vs.
Revision 1.63 by root, Wed Jun 4 22:47:27 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.13;
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
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) = @_;
533 533
534Unpacks a DNS packet into a perl data structure. 534Unpacks a DNS packet into a perl data structure.
535 535
536Examples: 536Examples:
537 537
538 # an unsuccessful reply 538 # an unsuccessful reply
539 { 539 {
540 'qd' => [ 540 'qd' => [
541 [ 'ruth.plan9.de.mach.uni-karlsruhe.de', '*', 'in' ] 541 [ 'ruth.plan9.de.mach.uni-karlsruhe.de', '*', 'in' ]
542 ], 542 ],
543 'rc' => 'nxdomain', 543 'rc' => 'nxdomain',
544 'ar' => [], 544 'ar' => [],
545 'ns' => [ 545 'ns' => [
546 [ 546 [
547 'uni-karlsruhe.de', 547 'uni-karlsruhe.de',
548 'soa', 548 'soa',
549 'in', 549 'in',
550 'netserv.rz.uni-karlsruhe.de', 550 'netserv.rz.uni-karlsruhe.de',
551 'hostmaster.rz.uni-karlsruhe.de', 551 'hostmaster.rz.uni-karlsruhe.de',
552 2008052201, 10800, 1800, 2592000, 86400 552 2008052201, 10800, 1800, 2592000, 86400
553 ] 553 ]
554 ], 554 ],
555 'tc' => '', 555 'tc' => '',
556 'ra' => 1, 556 'ra' => 1,
557 'qr' => 1, 557 'qr' => 1,
558 'id' => 45915, 558 'id' => 45915,
559 'aa' => '', 559 'aa' => '',
560 'an' => [], 560 'an' => [],
561 'rd' => 1, 561 'rd' => 1,
562 'op' => 'query' 562 'op' => 'query'
563 } 563 }
564 564
565 # a successful reply 565 # a successful reply
566 566
567 { 567 {
568 'qd' => [ [ 'www.google.de', 'a', 'in' ] ], 568 'qd' => [ [ 'www.google.de', 'a', 'in' ] ],
569 'rc' => 0, 569 'rc' => 0,
570 'ar' => [ 570 'ar' => [
571 [ 'a.l.google.com', 'a', 'in', '209.85.139.9' ], 571 [ 'a.l.google.com', 'a', 'in', '209.85.139.9' ],
572 [ 'b.l.google.com', 'a', 'in', '64.233.179.9' ], 572 [ 'b.l.google.com', 'a', 'in', '64.233.179.9' ],
573 [ 'c.l.google.com', 'a', 'in', '64.233.161.9' ], 573 [ 'c.l.google.com', 'a', 'in', '64.233.161.9' ],
574 ], 574 ],
575 'ns' => [ 575 'ns' => [
576 [ 'l.google.com', 'ns', 'in', 'a.l.google.com' ], 576 [ 'l.google.com', 'ns', 'in', 'a.l.google.com' ],
577 [ 'l.google.com', 'ns', 'in', 'b.l.google.com' ], 577 [ 'l.google.com', 'ns', 'in', 'b.l.google.com' ],
578 ], 578 ],
579 'tc' => '', 579 'tc' => '',
580 'ra' => 1, 580 'ra' => 1,
581 'qr' => 1, 581 'qr' => 1,
582 'id' => 64265, 582 'id' => 64265,
583 'aa' => '', 583 'aa' => '',
584 'an' => [ 584 'an' => [
585 [ 'www.google.de', 'cname', 'in', 'www.google.com' ], 585 [ 'www.google.de', 'cname', 'in', 'www.google.com' ],
586 [ 'www.google.com', 'cname', 'in', 'www.l.google.com' ], 586 [ 'www.google.com', 'cname', 'in', 'www.l.google.com' ],
587 [ 'www.l.google.com', 'a', 'in', '66.249.93.104' ], 587 [ 'www.l.google.com', 'a', 'in', '66.249.93.104' ],
588 [ 'www.l.google.com', 'a', 'in', '66.249.93.147' ], 588 [ 'www.l.google.com', 'a', 'in', '66.249.93.147' ],
589 ], 589 ],
590 'rd' => 1, 590 'rd' => 1,
591 'op' => 0 591 'op' => 0
592 } 592 }
593 593
594=cut 594=cut
595 595
596sub dns_unpack($) { 596sub dns_unpack($) {
597 local $pkt = shift; 597 local $pkt = shift;
698been resolved. 698been resolved.
699 699
700=item reuse => $seconds 700=item reuse => $seconds
701 701
702The number of seconds (default: C<300>) that a query id cannot be re-used 702The number of seconds (default: C<300>) that a query id cannot be re-used
703after a timeout. If there as no time-out then query id's can be reused 703after a timeout. If there was no time-out then query ids can be reused
704immediately. 704immediately.
705 705
706=back 706=back
707 707
708=cut 708=cut
709 709
710sub new { 710sub new {
711 my ($class, %arg) = @_; 711 my ($class, %arg) = @_;
712
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 712
722 my $self = bless { 713 my $self = bless {
723 server => [], 714 server => [],
724 timeout => [2, 5, 5], 715 timeout => [2, 5, 5],
725 search => [], 716 search => [],
726 ndots => 1, 717 ndots => 1,
727 max_outstanding => 10, 718 max_outstanding => 10,
728 reuse => 300, # reuse id's after 5 minutes only, if possible 719 reuse => 300,
729 %arg, 720 %arg,
730 reuse_q => [], 721 reuse_q => [],
731 }, $class; 722 }, $class;
732 723
733 # search should default to gethostname's domain 724 # search should default to gethostname's domain
734 # but perl lacks a good posix module 725 # but perl lacks a good posix module
735 726
727 # try to create an ipv4 and an ipv6 socket
728 # only fail when we cannot create either
729 my $got_socket;
730
736 Scalar::Util::weaken (my $wself = $self); 731 Scalar::Util::weaken (my $wself = $self);
737 732
738 if ($fh4) { 733 if (socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0) {
734 ++$got_socket;
735
739 AnyEvent::Util::fh_nonblocking $fh4, 1; 736 AnyEvent::Util::fh_nonblocking $fh4, 1;
740 $self->{fh4} = $fh4; 737 $self->{fh4} = $fh4;
741 $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub { 738 $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub {
742 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) { 739 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) {
743 $wself->_recv ($pkt, $peer); 740 $wself->_recv ($pkt, $peer);
744 } 741 }
745 }); 742 });
746 } 743 }
747 744
748 if ($fh6) { 745 if (AF_INET6 && socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0) {
746 ++$got_socket;
747
749 $self->{fh6} = $fh6; 748 $self->{fh6} = $fh6;
750 AnyEvent::Util::fh_nonblocking $fh6, 1; 749 AnyEvent::Util::fh_nonblocking $fh6, 1;
751 $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub { 750 $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub {
752 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) { 751 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) {
753 $wself->_recv ($pkt, $peer); 752 $wself->_recv ($pkt, $peer);
754 } 753 }
755 }); 754 });
756 } 755 }
756
757 $got_socket
758 or Carp::croak "unable to create either an IPv4 or an IPv6 socket";
757 759
758 $self->_compile; 760 $self->_compile;
759 761
760 $self 762 $self
761} 763}
838 # - the registry thing needs separate code on win32 native vs. cygwin 840 # - the registry thing needs separate code on win32 native vs. cygwin
839 # - the registry layout differs between windows versions 841 # - the registry layout differs between windows versions
840 # - calling windows api functions doesn't work on cygwin 842 # - calling windows api functions doesn't work on cygwin
841 # - ipconfig uses locale-specific messages 843 # - ipconfig uses locale-specific messages
842 844
843 # we use ipconfig parsing because, despite all it's brokenness, 845 # we use ipconfig parsing because, despite all its brokenness,
844 # it seems most stable in practise. 846 # it seems most stable in practise.
845 # for good measure, we append a fallback nameserver to our list. 847 # for good measure, we append a fallback nameserver to our list.
846 848
847 if (open my $fh, "ipconfig /all |") { 849 if (open my $fh, "ipconfig /all |") {
848 # parsing strategy: we go through the output and look for 850 # parsing strategy: we go through the output and look for
857 } elsif (/^\S/ || /^\s[^:]{16,}: /) { 859 } elsif (/^\S/ || /^\s[^:]{16,}: /) {
858 $dns = 0; 860 $dns = 0;
859 } 861 }
860 if ($dns && /^\s*(\S+)\s*$/) { 862 if ($dns && /^\s*(\S+)\s*$/) {
861 my $s = $1; 863 my $s = $1;
862 $s =~ s/%\d+(?!\S)//; # get rid of scope id 864 $s =~ s/%\d+(?!\S)//; # get rid of ipv6 scope id
863 if (my $ipn = AnyEvent::Socket::parse_address ($s)) { 865 if (my $ipn = AnyEvent::Socket::parse_address ($s)) {
864 push @{ $self->{server} }, $ipn; 866 push @{ $self->{server} }, $ipn;
865 } else { 867 } else {
866 push @{ $self->{search} }, $s; 868 push @{ $self->{search} }, $s;
867 } 869 }
884} 886}
885 887
886=item $resolver->timeout ($timeout, ...) 888=item $resolver->timeout ($timeout, ...)
887 889
888Sets the timeout values. See the C<timeout> constructor argument (and note 890Sets the timeout values. See the C<timeout> constructor argument (and note
889that this method uses the values itselt, not an array-reference). 891that this method uses the values itself, not an array-reference).
890 892
891=cut 893=cut
892 894
893sub timeout { 895sub timeout {
894 my ($self, @timeout) = @_; 896 my ($self, @timeout) = @_;
1094 } 1096 }
1095} 1097}
1096 1098
1097=item $resolver->request ($req, $cb->($res)) 1099=item $resolver->request ($req, $cb->($res))
1098 1100
1101This is the main low-level workhorse for sending DNS requests.
1102
1099Sends a single request (a hash-ref formated as specified for 1103This function sends a single request (a hash-ref formated as specified
1100C<dns_pack>) to the configured nameservers including 1104for C<dns_pack>) to the configured nameservers in turn until it gets a
1105response. It handles timeouts, retries and automatically falls back to
1106virtual circuit mode (TCP) when it receives a truncated reply.
1107
1101retries. Calls the callback with the decoded response packet if a reply 1108Calls the callback with the decoded response packet if a reply was
1102was received, or no arguments on timeout. 1109received, or no arguments in case none of the servers answered.
1103 1110
1104=cut 1111=cut
1105 1112
1106sub request($$) { 1113sub request($$) {
1107 my ($self, $req, $cb) = @_; 1114 my ($self, $req, $cb) = @_;
1112 1119
1113=item $resolver->resolve ($qname, $qtype, %options, $cb->($rcode, @rr)) 1120=item $resolver->resolve ($qname, $qtype, %options, $cb->($rcode, @rr))
1114 1121
1115Queries the DNS for the given domain name C<$qname> of type C<$qtype>. 1122Queries the DNS for the given domain name C<$qname> of type C<$qtype>.
1116 1123
1117A C<$qtype> is either a numerical query type (e.g. C<1> for A recods) or 1124A C<$qtype> is either a numerical query type (e.g. C<1> for A records) or
1118a lowercase name (you have to look at the source to see which aliases are 1125a lowercase name (you have to look at the source to see which aliases are
1119supported, but all types from RFC 1035, C<aaaa>, C<srv>, C<spf> and a few 1126supported, but all types from RFC 1035, C<aaaa>, C<srv>, C<spf> and a few
1120more are known to this module). A qtype of "*" is supported and means 1127more are known to this module). A C<$qtype> of "*" is supported and means
1121"any" record type. 1128"any" record type.
1122 1129
1123The callback will be invoked with a list of matching result records or 1130The callback will be invoked with a list of matching result records or
1124none on any error or if the name could not be found. 1131none on any error or if the name could not be found.
1125 1132
1126CNAME chains (although illegal) are followed up to a length of 8. 1133CNAME chains (although illegal) are followed up to a length of 10.
1127 1134
1128The callback will be invoked with an result code in string form (noerror, 1135The callback will be invoked with an result code in string form (noerror,
1129formerr, servfail, nxdomain, notimp, refused and so on), or numerical 1136formerr, servfail, nxdomain, notimp, refused and so on), or numerical
1130form if the result code is not supported. The remaining arguments are 1137form if the result code is not supported. The remaining arguments are
1131arraryefs of the form C<[$name, $type, $class, @data>], where C<$name> is 1138arraryefs of the form C<[$name, $type, $class, @data>], where C<$name> is
1132the domain name, C<$type> a type string or number, C<$class> a class name 1139the domain name, C<$type> a type string or number, C<$class> a class name
1133and @data is resource-record-dependent data. For C<a> records, this will 1140and @data is resource-record-dependent data. For C<a> records, this will
1134be the textual IPv4 addresses, for C<ns> or C<cname> records this will be 1141be the textual IPv4 addresses, for C<ns> or C<cname> records this will be
1135a domain name, for C<txt> records these are all the strings and so on. 1142a domain name, for C<txt> records these are all the strings and so on.
1136 1143
1137All types mentioned in RFC 1035, C<aaaa>, C<srv> and C<spf> are 1144All types mentioned in RFC 1035, C<aaaa>, C<srv>, C<naptr> and C<spf> are
1138decoded. All resource records not known to this module will just return 1145decoded. All resource records not known to this module will have
1139the raw C<rdata> field as fourth entry. 1146the raw C<rdata> field as fourth entry.
1140 1147
1141Note that this resolver is just a stub resolver: it requires a name server 1148Note that this resolver is just a stub resolver: it requires a name server
1142supporting recursive queries, will not do any recursive queries itself and 1149supporting recursive queries, will not do any recursive queries itself and
1143is not secure when used against an untrusted name server. 1150is not secure when used against an untrusted name server.
1148 1155
1149=item search => [$suffix...] 1156=item search => [$suffix...]
1150 1157
1151Use the given search list (which might be empty), by appending each one 1158Use the given search list (which might be empty), by appending each one
1152in turn to the C<$qname>. If this option is missing then the configured 1159in turn to the C<$qname>. If this option is missing then the configured
1153C<ndots> and C<search> define its value. If the C<$qname> ends in a dot, 1160C<ndots> and C<search> values define its value (depending on C<ndots>, the
1154then the searchlist will be ignored. 1161empty suffix will be prepended or appended to that C<search> value). If
1162the C<$qname> ends in a dot, then the searchlist will be ignored.
1155 1163
1156=item accept => [$type...] 1164=item accept => [$type...]
1157 1165
1158Lists the acceptable result types: only result types in this set will be 1166Lists the acceptable result types: only result types in this set will be
1159accepted and returned. The default includes the C<$qtype> and nothing 1167accepted and returned. The default includes the C<$qtype> and nothing
1237 $do_search = sub { 1245 $do_search = sub {
1238 @search 1246 @search
1239 or (undef $do_search), (undef $do_req), return $cb->(); 1247 or (undef $do_search), (undef $do_req), return $cb->();
1240 1248
1241 (my $name = lc "$qname." . shift @search) =~ s/\.$//; 1249 (my $name = lc "$qname." . shift @search) =~ s/\.$//;
1242 my $depth = 2; 1250 my $depth = 10;
1243 1251
1244 # advance in cname-chain 1252 # advance in cname-chain
1245 $do_req = sub { 1253 $do_req = sub {
1246 $self->request ({ 1254 $self->request ({
1247 rd => 1, 1255 rd => 1,
1324 1332
1325=back 1333=back
1326 1334
1327=head1 AUTHOR 1335=head1 AUTHOR
1328 1336
1329 Marc Lehmann <schmorp@schmorp.de> 1337 Marc Lehmann <schmorp@schmorp.de>
1330 http://home.schmorp.de/ 1338 http://home.schmorp.de/
1331 1339
1332=cut 1340=cut
1333 1341

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines