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.100 by root, Sun Jul 5 01:38:43 2009 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.
… …
32use strict; 32use strict;
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 ();
38use AnyEvent::Util qw(AF_INET6); 37use AnyEvent::Util qw(AF_INET6);
39 38
40our $VERSION = '1.0'; 39our $VERSION = 4.452;
41 40
42our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222); 41our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222);
43 42
44=item AnyEvent::DNS::a $domain, $cb->(@addrs) 43=item AnyEvent::DNS::a $domain, $cb->(@addrs)
45 44
… …
65=item AnyEvent::DNS::srv $service, $proto, $domain, $cb->(@srv_rr) 64=item AnyEvent::DNS::srv $service, $proto, $domain, $cb->(@srv_rr)
66 65
67Tries to resolve the given service, protocol and domain name into a list 66Tries to resolve the given service, protocol and domain name into a list
68of service records. 67of service records.
69 68
70Each srv_rr is an array reference with the following contents: 69Each C<$srv_rr> is an array reference with the following contents:
71C<[$priority, $weight, $transport, $target]>. 70C<[$priority, $weight, $transport, $target]>.
72 71
73They will be sorted with lowest priority first, then randomly 72They will be sorted with lowest priority first, then randomly
74distributed by weight as per RFC 2782. 73distributed by weight as per RFC 2782.
75 74
… …
170 my %pri; 169 my %pri;
171 push @{ $pri{$_->[3]} }, [ @$_[3,4,5,6] ] 170 push @{ $pri{$_->[3]} }, [ @$_[3,4,5,6] ]
172 for @_; 171 for @_;
173 172
174 # order by priority 173 # order by priority
175 for my $pri (sort { $a->[0] <=> $b->[0] } keys %pri) { 174 for my $pri (sort { $a <=> $b } keys %pri) {
176 # order by weight 175 # order by weight
177 my @rr = sort { $a->[1] <=> $b->[1] } @{ delete $pri{$pri} }; 176 my @rr = sort { $a->[1] <=> $b->[1] } @{ delete $pri{$pri} };
178 177
179 my $sum; $sum += $_->[1] for @rr; 178 my $sum; $sum += $_->[1] for @rr;
180 179
… …
265 ptr $ptr, sub { 264 ptr $ptr, sub {
266 for my $name (@_) { 265 for my $name (@_) {
267 ++$cnt; 266 ++$cnt;
268 267
269 # () around AF_INET to work around bug in 5.8 268 # () around AF_INET to work around bug in 5.8
270 resolver->resolve ($name => ($af == (AF_INET) ? "a" : "aaaa"), sub { 269 resolver->resolve ("$name." => ($af == (AF_INET) ? "a" : "aaaa"), sub {
271 for (@_) { 270 for (@_) {
272 push @res, $name 271 push @res, $name
273 if $_->[3] eq $ip; 272 if $_->[3] eq $ip;
274 } 273 }
275 $cb->(@res) unless --$cnt; 274 $cb->(@res) unless --$cnt;
… …
295C<$ENV{PERL_ANYEVENT_EDNS0}>, but when set to C<1>, AnyEvent::DNS will use 294C<$ENV{PERL_ANYEVENT_EDNS0}>, but when set to C<1>, AnyEvent::DNS will use
296EDNS0 in all requests. 295EDNS0 in all requests.
297 296
298=cut 297=cut
299 298
300our $EDNS0 = $ENV{PERL_ANYEVENT_EDNS0} * 1; # set to 1 to enable (partial) edns0 299our $EDNS0 = $ENV{PERL_ANYEVENT_EDNS0}*1; # set to 1 to enable (partial) edns0
301 300
302our %opcode_id = ( 301our %opcode_id = (
303 query => 0, 302 query => 0,
304 iquery => 1, 303 iquery => 1,
305 status => 2, 304 status => 2,
… …
352 mx => 15, 351 mx => 15,
353 txt => 16, 352 txt => 16,
354 aaaa => 28, 353 aaaa => 28,
355 srv => 33, 354 srv => 33,
356 naptr => 35, # rfc2915 355 naptr => 35, # rfc2915
356 dname => 39, # rfc2672
357 opt => 41, 357 opt => 41,
358 spf => 99, 358 spf => 99,
359 tkey => 249, 359 tkey => 249,
360 tsig => 250, 360 tsig => 250,
361 ixfr => 251, 361 ixfr => 251,
… …
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) = @_;
… …
503 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks 503 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks
504 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr 504 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr
505 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo 505 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo
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_ipv6 ($_) }, # 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 },
516 39 => sub { local $ofs = $ofs - length; _dec_name }, # dname
515 99 => sub { unpack "(C/a*)*", $_ }, # spf 517 99 => sub { unpack "(C/a*)*", $_ }, # spf
516); 518);
517 519
518sub _dec_rr { 520sub _dec_rr {
519 my $name = _dec_name; 521 my $name = _dec_name;
… …
533 535
534Unpacks a DNS packet into a perl data structure. 536Unpacks a DNS packet into a perl data structure.
535 537
536Examples: 538Examples:
537 539
538 # an unsuccessful reply 540 # an unsuccessful reply
539 { 541 {
540 'qd' => [ 542 'qd' => [
541 [ 'ruth.plan9.de.mach.uni-karlsruhe.de', '*', 'in' ] 543 [ 'ruth.plan9.de.mach.uni-karlsruhe.de', '*', 'in' ]
542 ], 544 ],
543 'rc' => 'nxdomain', 545 'rc' => 'nxdomain',
544 'ar' => [], 546 'ar' => [],
545 'ns' => [ 547 'ns' => [
546 [ 548 [
547 'uni-karlsruhe.de', 549 'uni-karlsruhe.de',
548 'soa', 550 'soa',
549 'in', 551 'in',
550 'netserv.rz.uni-karlsruhe.de', 552 'netserv.rz.uni-karlsruhe.de',
551 'hostmaster.rz.uni-karlsruhe.de', 553 'hostmaster.rz.uni-karlsruhe.de',
552 2008052201, 10800, 1800, 2592000, 86400 554 2008052201, 10800, 1800, 2592000, 86400
553 ] 555 ]
554 ], 556 ],
555 'tc' => '', 557 'tc' => '',
556 'ra' => 1, 558 'ra' => 1,
557 'qr' => 1, 559 'qr' => 1,
558 'id' => 45915, 560 'id' => 45915,
559 'aa' => '', 561 'aa' => '',
560 'an' => [], 562 'an' => [],
561 'rd' => 1, 563 'rd' => 1,
562 'op' => 'query' 564 'op' => 'query'
563 } 565 }
564 566
565 # a successful reply 567 # a successful reply
566 568
567 { 569 {
568 'qd' => [ [ 'www.google.de', 'a', 'in' ] ], 570 'qd' => [ [ 'www.google.de', 'a', 'in' ] ],
569 'rc' => 0, 571 'rc' => 0,
570 'ar' => [ 572 'ar' => [
571 [ 'a.l.google.com', 'a', 'in', '209.85.139.9' ], 573 [ 'a.l.google.com', 'a', 'in', '209.85.139.9' ],
572 [ 'b.l.google.com', 'a', 'in', '64.233.179.9' ], 574 [ 'b.l.google.com', 'a', 'in', '64.233.179.9' ],
573 [ 'c.l.google.com', 'a', 'in', '64.233.161.9' ], 575 [ 'c.l.google.com', 'a', 'in', '64.233.161.9' ],
574 ], 576 ],
575 'ns' => [ 577 'ns' => [
576 [ 'l.google.com', 'ns', 'in', 'a.l.google.com' ], 578 [ 'l.google.com', 'ns', 'in', 'a.l.google.com' ],
577 [ 'l.google.com', 'ns', 'in', 'b.l.google.com' ], 579 [ 'l.google.com', 'ns', 'in', 'b.l.google.com' ],
578 ], 580 ],
579 'tc' => '', 581 'tc' => '',
580 'ra' => 1, 582 'ra' => 1,
581 'qr' => 1, 583 'qr' => 1,
582 'id' => 64265, 584 'id' => 64265,
583 'aa' => '', 585 'aa' => '',
584 'an' => [ 586 'an' => [
585 [ 'www.google.de', 'cname', 'in', 'www.google.com' ], 587 [ 'www.google.de', 'cname', 'in', 'www.google.com' ],
586 [ 'www.google.com', 'cname', 'in', 'www.l.google.com' ], 588 [ 'www.google.com', 'cname', 'in', 'www.l.google.com' ],
587 [ 'www.l.google.com', 'a', 'in', '66.249.93.104' ], 589 [ 'www.l.google.com', 'a', 'in', '66.249.93.104' ],
588 [ 'www.l.google.com', 'a', 'in', '66.249.93.147' ], 590 [ 'www.l.google.com', 'a', 'in', '66.249.93.147' ],
589 ], 591 ],
590 'rd' => 1, 592 'rd' => 1,
591 'op' => 0 593 'op' => 0
592 } 594 }
593 595
594=cut 596=cut
595 597
596sub dns_unpack($) { 598sub dns_unpack($) {
597 local $pkt = shift; 599 local $pkt = shift;
… …
652 654
653our $RESOLVER; 655our $RESOLVER;
654 656
655sub resolver() { 657sub resolver() {
656 $RESOLVER || do { 658 $RESOLVER || do {
657 $RESOLVER = new AnyEvent::DNS; 659 $RESOLVER = new AnyEvent::DNS untaint => 1;
658 $RESOLVER->os_config; 660 $RESOLVER->os_config;
659 $RESOLVER 661 $RESOLVER
660 } 662 }
661} 663}
662 664
… …
698been resolved. 700been resolved.
699 701
700=item reuse => $seconds 702=item reuse => $seconds
701 703
702The number of seconds (default: C<300>) that a query id cannot be re-used 704The 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 705after a timeout. If there was no time-out then query ids can be reused
704immediately. 706immediately.
707
708=item untaint => $boolean
709
710When true, then the resolver will automatically untaint results, and might
711also ignore certain environment variables.
705 712
706=back 713=back
707 714
708=cut 715=cut
709 716
710sub new { 717sub new {
711 my ($class, %arg) = @_; 718 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 719
722 my $self = bless { 720 my $self = bless {
723 server => [], 721 server => [],
724 timeout => [2, 5, 5], 722 timeout => [2, 5, 5],
725 search => [], 723 search => [],
726 ndots => 1, 724 ndots => 1,
727 max_outstanding => 10, 725 max_outstanding => 10,
728 reuse => 300, # reuse id's after 5 minutes only, if possible 726 reuse => 300,
729 %arg, 727 %arg,
730 reuse_q => [], 728 reuse_q => [],
731 }, $class; 729 }, $class;
732 730
733 # search should default to gethostname's domain 731 # search should default to gethostname's domain
734 # but perl lacks a good posix module 732 # but perl lacks a good posix module
735 733
734 # try to create an ipv4 and an ipv6 socket
735 # only fail when we cannot create either
736 my $got_socket;
737
736 Scalar::Util::weaken (my $wself = $self); 738 Scalar::Util::weaken (my $wself = $self);
737 739
738 if ($fh4) { 740 if (socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0) {
741 ++$got_socket;
742
739 AnyEvent::Util::fh_nonblocking $fh4, 1; 743 AnyEvent::Util::fh_nonblocking $fh4, 1;
740 $self->{fh4} = $fh4; 744 $self->{fh4} = $fh4;
741 $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub { 745 $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub {
742 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) { 746 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) {
743 $wself->_recv ($pkt, $peer); 747 $wself->_recv ($pkt, $peer);
744 } 748 }
745 }); 749 });
746 } 750 }
747 751
748 if ($fh6) { 752 if (AF_INET6 && socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0) {
753 ++$got_socket;
754
749 $self->{fh6} = $fh6; 755 $self->{fh6} = $fh6;
750 AnyEvent::Util::fh_nonblocking $fh6, 1; 756 AnyEvent::Util::fh_nonblocking $fh6, 1;
751 $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub { 757 $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub {
752 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) { 758 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) {
753 $wself->_recv ($pkt, $peer); 759 $wself->_recv ($pkt, $peer);
754 } 760 }
755 }); 761 });
756 } 762 }
763
764 $got_socket
765 or Carp::croak "unable to create either an IPv4 or an IPv6 socket";
757 766
758 $self->_compile; 767 $self->_compile;
759 768
760 $self 769 $self
761} 770}
… …
817 $self->_compile; 826 $self->_compile;
818} 827}
819 828
820=item $resolver->os_config 829=item $resolver->os_config
821 830
822Tries so load and parse F</etc/resolv.conf> on portable operating systems. Tries various 831Tries so load and parse F</etc/resolv.conf> on portable operating
823egregious hacks on windows to force the DNS servers and searchlist out of the system. 832systems. Tries various egregious hacks on windows to force the DNS servers
833and searchlist out of the system.
824 834
825=cut 835=cut
826 836
827sub os_config { 837sub os_config {
828 my ($self) = @_; 838 my ($self) = @_;
… …
838 # - the registry thing needs separate code on win32 native vs. cygwin 848 # - the registry thing needs separate code on win32 native vs. cygwin
839 # - the registry layout differs between windows versions 849 # - the registry layout differs between windows versions
840 # - calling windows api functions doesn't work on cygwin 850 # - calling windows api functions doesn't work on cygwin
841 # - ipconfig uses locale-specific messages 851 # - ipconfig uses locale-specific messages
842 852
843 # we use ipconfig parsing because, despite all it's brokenness, 853 # we use ipconfig parsing because, despite all its brokenness,
844 # it seems most stable in practise. 854 # it seems most stable in practise.
845 # for good measure, we append a fallback nameserver to our list. 855 # for good measure, we append a fallback nameserver to our list.
846 856
847 if (open my $fh, "ipconfig /all |") { 857 if (open my $fh, "ipconfig /all |") {
848 # parsing strategy: we go through the output and look for 858 # parsing strategy: we go through the output and look for
… …
857 } elsif (/^\S/ || /^\s[^:]{16,}: /) { 867 } elsif (/^\S/ || /^\s[^:]{16,}: /) {
858 $dns = 0; 868 $dns = 0;
859 } 869 }
860 if ($dns && /^\s*(\S+)\s*$/) { 870 if ($dns && /^\s*(\S+)\s*$/) {
861 my $s = $1; 871 my $s = $1;
862 $s =~ s/%\d+(?!\S)//; # get rid of scope id 872 $s =~ s/%\d+(?!\S)//; # get rid of ipv6 scope id
863 if (my $ipn = AnyEvent::Socket::parse_address ($s)) { 873 if (my $ipn = AnyEvent::Socket::parse_address ($s)) {
864 push @{ $self->{server} }, $ipn; 874 push @{ $self->{server} }, $ipn;
865 } else { 875 } else {
866 push @{ $self->{search} }, $s; 876 push @{ $self->{search} }, $s;
867 } 877 }
… …
884} 894}
885 895
886=item $resolver->timeout ($timeout, ...) 896=item $resolver->timeout ($timeout, ...)
887 897
888Sets the timeout values. See the C<timeout> constructor argument (and note 898Sets the timeout values. See the C<timeout> constructor argument (and note
889that this method uses the values itselt, not an array-reference). 899that this method uses the values itself, not an array-reference).
890 900
891=cut 901=cut
892 902
893sub timeout { 903sub timeout {
894 my ($self, @timeout) = @_; 904 my ($self, @timeout) = @_;
… …
933 $self->{retry} = \@retry; 943 $self->{retry} = \@retry;
934} 944}
935 945
936sub _feed { 946sub _feed {
937 my ($self, $res) = @_; 947 my ($self, $res) = @_;
948
949 ($res) = $res =~ /^(.*)$/s
950 if AnyEvent::TAINT && $self->{untaint};
938 951
939 $res = dns_unpack $res 952 $res = dns_unpack $res
940 or return; 953 or return;
941 954
942 my $id = $self->{id}{$res->{id}}; 955 my $id = $self->{id}{$res->{id}};
… …
995 1008
996 $self->{id}{$req->[2]} = [AnyEvent->timer (after => $timeout, cb => sub { 1009 $self->{id}{$req->[2]} = [AnyEvent->timer (after => $timeout, cb => sub {
997 $NOW = time; 1010 $NOW = time;
998 1011
999 # timeout, try next 1012 # timeout, try next
1000 &$do_retry; 1013 &$do_retry if $do_retry;
1001 }), sub { 1014 }), sub {
1002 my ($res) = @_; 1015 my ($res) = @_;
1003 1016
1004 if ($res->{tc}) { 1017 if ($res->{tc}) {
1005 # success, but truncated, so use tcp 1018 # success, but truncated, so use tcp
1006 AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub { 1019 AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub {
1007 return unless $do_retry; # some other request could have invalidated us already 1020 return unless $do_retry; # some other request could have invalidated us already
1008 1021
1009 my ($fh) = @_ 1022 my ($fh) = @_
1010 or return &$do_retry; 1023 or return &$do_retry;
1024
1025 require AnyEvent::Handle;
1011 1026
1012 my $handle; $handle = new AnyEvent::Handle 1027 my $handle; $handle = new AnyEvent::Handle
1013 fh => $fh, 1028 fh => $fh,
1014 timeout => $timeout, 1029 timeout => $timeout,
1015 on_error => sub { 1030 on_error => sub {
… …
1094 } 1109 }
1095} 1110}
1096 1111
1097=item $resolver->request ($req, $cb->($res)) 1112=item $resolver->request ($req, $cb->($res))
1098 1113
1114This is the main low-level workhorse for sending DNS requests.
1115
1099Sends a single request (a hash-ref formated as specified for 1116This function sends a single request (a hash-ref formated as specified
1100C<dns_pack>) to the configured nameservers including 1117for C<dns_pack>) to the configured nameservers in turn until it gets a
1118response. It handles timeouts, retries and automatically falls back to
1119virtual circuit mode (TCP) when it receives a truncated reply.
1120
1101retries. Calls the callback with the decoded response packet if a reply 1121Calls the callback with the decoded response packet if a reply was
1102was received, or no arguments on timeout. 1122received, or no arguments in case none of the servers answered.
1103 1123
1104=cut 1124=cut
1105 1125
1106sub request($$) { 1126sub request($$) {
1107 my ($self, $req, $cb) = @_; 1127 my ($self, $req, $cb) = @_;
1108 1128
1109 push @{ $self->{queue} }, [dns_pack $req, $cb]; 1129 push @{ $self->{queue} }, [dns_pack $req, $cb];
1110 $self->_scheduler; 1130 $self->_scheduler;
1111} 1131}
1112 1132
1113=item $resolver->resolve ($qname, $qtype, %options, $cb->($rcode, @rr)) 1133=item $resolver->resolve ($qname, $qtype, %options, $cb->(@rr))
1114 1134
1115Queries the DNS for the given domain name C<$qname> of type C<$qtype>. 1135Queries the DNS for the given domain name C<$qname> of type C<$qtype>.
1116 1136
1117A C<$qtype> is either a numerical query type (e.g. C<1> for A recods) or 1137A 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 1138a 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 1139supported, 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 1140more are known to this module). A C<$qtype> of "*" is supported and means
1121"any" record type. 1141"any" record type.
1122 1142
1123The callback will be invoked with a list of matching result records or 1143The callback will be invoked with a list of matching result records or
1124none on any error or if the name could not be found. 1144none on any error or if the name could not be found.
1125 1145
1126CNAME chains (although illegal) are followed up to a length of 8. 1146CNAME chains (although illegal) are followed up to a length of 10.
1127 1147
1128The callback will be invoked with an result code in string form (noerror, 1148The callback will be invoked with arraryefs of the form C<[$name, $type,
1129formerr, servfail, nxdomain, notimp, refused and so on), or numerical 1149$class, @data>], where C<$name> is the domain name, C<$type> a type string
1130form if the result code is not supported. The remaining arguments are 1150or number, C<$class> a class name and @data is resource-record-dependent
1131arraryefs of the form C<[$name, $type, $class, @data>], where C<$name> is 1151data. For C<a> records, this will be the textual IPv4 addresses, for C<ns>
1132the domain name, C<$type> a type string or number, C<$class> a class name 1152or C<cname> records this will be a domain name, for C<txt> records these
1133and @data is resource-record-dependent data. For C<a> records, this will 1153are all the strings and so on.
1134be 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.
1136 1154
1137All types mentioned in RFC 1035, C<aaaa>, C<srv> and C<spf> are 1155All 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 1156decoded. All resource records not known to this module will have
1139the raw C<rdata> field as fourth entry. 1157the raw C<rdata> field as fourth entry.
1140 1158
1141Note that this resolver is just a stub resolver: it requires a name server 1159Note that this resolver is just a stub resolver: it requires a name server
1142supporting recursive queries, will not do any recursive queries itself and 1160supporting recursive queries, will not do any recursive queries itself and
1143is not secure when used against an untrusted name server. 1161is not secure when used against an untrusted name server.
… …
1148 1166
1149=item search => [$suffix...] 1167=item search => [$suffix...]
1150 1168
1151Use the given search list (which might be empty), by appending each one 1169Use 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 1170in 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, 1171C<ndots> and C<search> values define its value (depending on C<ndots>, the
1154then the searchlist will be ignored. 1172empty suffix will be prepended or appended to that C<search> value). If
1173the C<$qname> ends in a dot, then the searchlist will be ignored.
1155 1174
1156=item accept => [$type...] 1175=item accept => [$type...]
1157 1176
1158Lists the acceptable result types: only result types in this set will be 1177Lists the acceptable result types: only result types in this set will be
1159accepted and returned. The default includes the C<$qtype> and nothing 1178accepted and returned. The default includes the C<$qtype> and nothing
… …
1237 $do_search = sub { 1256 $do_search = sub {
1238 @search 1257 @search
1239 or (undef $do_search), (undef $do_req), return $cb->(); 1258 or (undef $do_search), (undef $do_req), return $cb->();
1240 1259
1241 (my $name = lc "$qname." . shift @search) =~ s/\.$//; 1260 (my $name = lc "$qname." . shift @search) =~ s/\.$//;
1242 my $depth = 2; 1261 my $depth = 10;
1243 1262
1244 # advance in cname-chain 1263 # advance in cname-chain
1245 $do_req = sub { 1264 $do_req = sub {
1246 $self->request ({ 1265 $self->request ({
1247 rd => 1, 1266 rd => 1,
… …
1265 if (@rr) { 1284 if (@rr) {
1266 $depth-- 1285 $depth--
1267 or return $do_search->(); # cname chain too long 1286 or return $do_search->(); # cname chain too long
1268 1287
1269 $cname = 1; 1288 $cname = 1;
1270 $name = $rr[0][3]; 1289 $name = lc $rr[0][3];
1271 1290
1272 } elsif ($cname) { 1291 } elsif ($cname) {
1273 # follow the cname 1292 # follow the cname
1274 return $do_req->(); 1293 return $do_req->();
1275 1294
… …
1324 1343
1325=back 1344=back
1326 1345
1327=head1 AUTHOR 1346=head1 AUTHOR
1328 1347
1329 Marc Lehmann <schmorp@schmorp.de> 1348 Marc Lehmann <schmorp@schmorp.de>
1330 http://home.schmorp.de/ 1349 http://home.schmorp.de/
1331 1350
1332=cut 1351=cut
1333 1352

Diff Legend

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