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.55 by root, Fri May 30 10:37:34 2008 UTC vs.
Revision 1.110 by root, Sun Jul 26 00:17:25 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.
… …
26 26
27=cut 27=cut
28 28
29package AnyEvent::DNS; 29package AnyEvent::DNS;
30 30
31no warnings; 31use Carp ();
32use strict;
33
34use Socket qw(AF_INET SOCK_DGRAM SOCK_STREAM); 32use Socket qw(AF_INET SOCK_DGRAM SOCK_STREAM);
35 33
36use AnyEvent (); 34use AnyEvent (); BEGIN { AnyEvent::common_sense }
37use AnyEvent::Handle ();
38use AnyEvent::Util qw(AF_INET6); 35use AnyEvent::Util qw(AF_INET6);
39 36
40our $VERSION = '1.0'; 37our $VERSION = 4.87;
41 38
42our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222); 39our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222);
43 40
44=item AnyEvent::DNS::a $domain, $cb->(@addrs) 41=item AnyEvent::DNS::a $domain, $cb->(@addrs)
45 42
… …
65=item AnyEvent::DNS::srv $service, $proto, $domain, $cb->(@srv_rr) 62=item AnyEvent::DNS::srv $service, $proto, $domain, $cb->(@srv_rr)
66 63
67Tries to resolve the given service, protocol and domain name into a list 64Tries to resolve the given service, protocol and domain name into a list
68of service records. 65of service records.
69 66
70Each srv_rr is an array reference with the following contents: 67Each C<$srv_rr> is an array reference with the following contents:
71C<[$priority, $weight, $transport, $target]>. 68C<[$priority, $weight, $transport, $target]>.
72 69
73They will be sorted with lowest priority first, then randomly 70They will be sorted with lowest priority first, then randomly
74distributed by weight as per RFC 2782. 71distributed by weight as per RFC 2782.
75 72
… …
170 my %pri; 167 my %pri;
171 push @{ $pri{$_->[3]} }, [ @$_[3,4,5,6] ] 168 push @{ $pri{$_->[3]} }, [ @$_[3,4,5,6] ]
172 for @_; 169 for @_;
173 170
174 # order by priority 171 # order by priority
175 for my $pri (sort { $a->[0] <=> $b->[0] } keys %pri) { 172 for my $pri (sort { $a <=> $b } keys %pri) {
176 # order by weight 173 # order by weight
177 my @rr = sort { $a->[1] <=> $b->[1] } @{ delete $pri{$pri} }; 174 my @rr = sort { $a->[1] <=> $b->[1] } @{ delete $pri{$pri} };
178 175
179 my $sum; $sum += $_->[1] for @rr; 176 my $sum; $sum += $_->[1] for @rr;
180 177
… …
295C<$ENV{PERL_ANYEVENT_EDNS0}>, but when set to C<1>, AnyEvent::DNS will use 292C<$ENV{PERL_ANYEVENT_EDNS0}>, but when set to C<1>, AnyEvent::DNS will use
296EDNS0 in all requests. 293EDNS0 in all requests.
297 294
298=cut 295=cut
299 296
300our $EDNS0 = $ENV{PERL_ANYEVENT_EDNS0} * 1; # set to 1 to enable (partial) edns0 297our $EDNS0 = $ENV{PERL_ANYEVENT_EDNS0}*1; # set to 1 to enable (partial) edns0
301 298
302our %opcode_id = ( 299our %opcode_id = (
303 query => 0, 300 query => 0,
304 iquery => 1, 301 iquery => 1,
305 status => 2, 302 status => 2,
… …
352 mx => 15, 349 mx => 15,
353 txt => 16, 350 txt => 16,
354 aaaa => 28, 351 aaaa => 28,
355 srv => 33, 352 srv => 33,
356 naptr => 35, # rfc2915 353 naptr => 35, # rfc2915
354 dname => 39, # rfc2672
357 opt => 41, 355 opt => 41,
358 spf => 99, 356 spf => 99,
359 tkey => 249, 357 tkey => 249,
360 tsig => 250, 358 tsig => 250,
361 ixfr => 251, 359 ixfr => 251,
… …
378 376
379sub _enc_name($) { 377sub _enc_name($) {
380 pack "(C/a*)*", (split /\./, shift), "" 378 pack "(C/a*)*", (split /\./, shift), ""
381} 379}
382 380
381if ($[ < 5.008) {
382 # special slower 5.6 version
383 *_enc_name = sub {
384 join "", map +(pack "C/a*", $_), (split /\./, shift), ""
385 };
386}
387
383sub _enc_qd() { 388sub _enc_qd() {
384 (_enc_name $_->[0]) . pack "nn", 389 (_enc_name $_->[0]) . pack "nn",
385 ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}), 390 ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}),
386 ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"}) 391 ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"})
387} 392}
… …
397 402
398Resource records are not yet encodable. 403Resource records are not yet encodable.
399 404
400Examples: 405Examples:
401 406
402 # very simple request, using lots of default values: 407 # very simple request, using lots of default values:
403 { rd => 1, qd => [ [ "host.domain", "a"] ] } 408 { rd => 1, qd => [ [ "host.domain", "a"] ] }
404 409
405 # more complex example, showing how flags etc. are named: 410 # more complex example, showing how flags etc. are named:
406 411
407 { 412 {
408 id => 10000, 413 id => 10000,
409 op => "query", 414 op => "query",
410 rc => "nxdomain", 415 rc => "nxdomain",
411 416
412 # flags 417 # flags
413 qr => 1, 418 qr => 1,
414 aa => 0, 419 aa => 0,
415 tc => 0, 420 tc => 0,
416 rd => 0, 421 rd => 0,
417 ra => 0, 422 ra => 0,
418 ad => 0, 423 ad => 0,
419 cd => 0, 424 cd => 0,
420 425
421 qd => [@rr], # query section 426 qd => [@rr], # query section
422 an => [@rr], # answer section 427 an => [@rr], # answer section
423 ns => [@rr], # authority section 428 ns => [@rr], # authority section
424 ar => [@rr], # additional records section 429 ar => [@rr], # additional records section
425 } 430 }
426 431
427=cut 432=cut
428 433
429sub dns_pack($) { 434sub dns_pack($) {
430 my ($req) = @_; 435 my ($req) = @_;
… …
503 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks 508 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks
504 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr 509 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr
505 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo 510 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo
506 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx 511 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx
507 16 => sub { unpack "(C/a*)*", $_ }, # txt 512 16 => sub { unpack "(C/a*)*", $_ }, # txt
508 28 => sub { AnyEvent::Socket::format_address ($_) }, # aaaa 513 28 => sub { AnyEvent::Socket::format_ipv6 ($_) }, # aaaa
509 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv 514 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv
510 35 => sub { # naptr 515 35 => sub { # naptr
516 # requires perl 5.10, sorry
511 my ($order, $preference, $flags, $service, $regexp, $offset) = unpack "nn C/a* C/a* C/a* .", $_; 517 my ($order, $preference, $flags, $service, $regexp, $offset) = unpack "nn C/a* C/a* C/a* .", $_;
512 local $ofs = $ofs + $offset - length; 518 local $ofs = $ofs + $offset - length;
513 ($order, $preference, $flags, $service, $regexp, _dec_name) 519 ($order, $preference, $flags, $service, $regexp, _dec_name)
514 }, 520 },
521 39 => sub { local $ofs = $ofs - length; _dec_name }, # dname
515 99 => sub { unpack "(C/a*)*", $_ }, # spf 522 99 => sub { unpack "(C/a*)*", $_ }, # spf
516); 523);
517 524
518sub _dec_rr { 525sub _dec_rr {
519 my $name = _dec_name; 526 my $name = _dec_name;
… …
533 540
534Unpacks a DNS packet into a perl data structure. 541Unpacks a DNS packet into a perl data structure.
535 542
536Examples: 543Examples:
537 544
538 # an unsuccessful reply 545 # an unsuccessful reply
539 { 546 {
540 'qd' => [ 547 'qd' => [
541 [ 'ruth.plan9.de.mach.uni-karlsruhe.de', '*', 'in' ] 548 [ 'ruth.plan9.de.mach.uni-karlsruhe.de', '*', 'in' ]
542 ], 549 ],
543 'rc' => 'nxdomain', 550 'rc' => 'nxdomain',
544 'ar' => [], 551 'ar' => [],
545 'ns' => [ 552 'ns' => [
546 [ 553 [
547 'uni-karlsruhe.de', 554 'uni-karlsruhe.de',
548 'soa', 555 'soa',
549 'in', 556 'in',
550 'netserv.rz.uni-karlsruhe.de', 557 'netserv.rz.uni-karlsruhe.de',
551 'hostmaster.rz.uni-karlsruhe.de', 558 'hostmaster.rz.uni-karlsruhe.de',
552 2008052201, 10800, 1800, 2592000, 86400 559 2008052201, 10800, 1800, 2592000, 86400
553 ] 560 ]
554 ], 561 ],
555 'tc' => '', 562 'tc' => '',
556 'ra' => 1, 563 'ra' => 1,
557 'qr' => 1, 564 'qr' => 1,
558 'id' => 45915, 565 'id' => 45915,
559 'aa' => '', 566 'aa' => '',
560 'an' => [], 567 'an' => [],
561 'rd' => 1, 568 'rd' => 1,
562 'op' => 'query' 569 'op' => 'query'
563 } 570 }
564 571
565 # a successful reply 572 # a successful reply
566 573
567 { 574 {
568 'qd' => [ [ 'www.google.de', 'a', 'in' ] ], 575 'qd' => [ [ 'www.google.de', 'a', 'in' ] ],
569 'rc' => 0, 576 'rc' => 0,
570 'ar' => [ 577 'ar' => [
571 [ 'a.l.google.com', 'a', 'in', '209.85.139.9' ], 578 [ 'a.l.google.com', 'a', 'in', '209.85.139.9' ],
572 [ 'b.l.google.com', 'a', 'in', '64.233.179.9' ], 579 [ 'b.l.google.com', 'a', 'in', '64.233.179.9' ],
573 [ 'c.l.google.com', 'a', 'in', '64.233.161.9' ], 580 [ 'c.l.google.com', 'a', 'in', '64.233.161.9' ],
574 ], 581 ],
575 'ns' => [ 582 'ns' => [
576 [ 'l.google.com', 'ns', 'in', 'a.l.google.com' ], 583 [ 'l.google.com', 'ns', 'in', 'a.l.google.com' ],
577 [ 'l.google.com', 'ns', 'in', 'b.l.google.com' ], 584 [ 'l.google.com', 'ns', 'in', 'b.l.google.com' ],
578 ], 585 ],
579 'tc' => '', 586 'tc' => '',
580 'ra' => 1, 587 'ra' => 1,
581 'qr' => 1, 588 'qr' => 1,
582 'id' => 64265, 589 'id' => 64265,
583 'aa' => '', 590 'aa' => '',
584 'an' => [ 591 'an' => [
585 [ 'www.google.de', 'cname', 'in', 'www.google.com' ], 592 [ 'www.google.de', 'cname', 'in', 'www.google.com' ],
586 [ 'www.google.com', 'cname', 'in', 'www.l.google.com' ], 593 [ 'www.google.com', 'cname', 'in', 'www.l.google.com' ],
587 [ 'www.l.google.com', 'a', 'in', '66.249.93.104' ], 594 [ 'www.l.google.com', 'a', 'in', '66.249.93.104' ],
588 [ 'www.l.google.com', 'a', 'in', '66.249.93.147' ], 595 [ 'www.l.google.com', 'a', 'in', '66.249.93.147' ],
589 ], 596 ],
590 'rd' => 1, 597 'rd' => 1,
591 'op' => 0 598 'op' => 0
592 } 599 }
593 600
594=cut 601=cut
595 602
596sub dns_unpack($) { 603sub dns_unpack($) {
597 local $pkt = shift; 604 local $pkt = shift;
… …
646calls. 653calls.
647 654
648Unless you have special needs, prefer this function over creating your own 655Unless you have special needs, prefer this function over creating your own
649resolver object. 656resolver object.
650 657
658The resolver is created with the following parameters:
659
660 untaint enabled
661 max_outstanding $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS}
662
663C<os_config> will be used for OS-specific configuration, unless
664C<$ENV{PERL_ANYEVENT_RESOLV_CONF}> is specified, in which case that file
665gets parsed.
666
651=cut 667=cut
652 668
653our $RESOLVER; 669our $RESOLVER;
654 670
655sub resolver() { 671sub resolver() {
656 $RESOLVER || do { 672 $RESOLVER || do {
657 $RESOLVER = new AnyEvent::DNS; 673 $RESOLVER = new AnyEvent::DNS
674 untaint => 1,
675 exists $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS}
676 ? (max_outstanding => $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS}*1 || 1) : (),
677 ;
678
679 exists $ENV{PERL_ANYEVENT_RESOLV_CONF}
680 ? length $ENV{PERL_ANYEVENT_RESOLV_CONF} && $RESOLVER->_parse_resolv_conf_file ($ENV{PERL_ANYEVENT_RESOLV_CONF})
658 $RESOLVER->os_config; 681 : $RESOLVER->os_config;
682
659 $RESOLVER 683 $RESOLVER
660 } 684 }
661} 685}
662 686
663=item $resolver = new AnyEvent::DNS key => value... 687=item $resolver = new AnyEvent::DNS key => value...
… …
701 725
702The number of seconds (default: C<300>) that a query id cannot be re-used 726The number of seconds (default: C<300>) that a query id cannot be re-used
703after a timeout. If there was no time-out then query ids can be reused 727after a timeout. If there was no time-out then query ids can be reused
704immediately. 728immediately.
705 729
730=item untaint => $boolean
731
732When true, then the resolver will automatically untaint results, and might
733also ignore certain environment variables.
734
706=back 735=back
707 736
708=cut 737=cut
709 738
710sub new { 739sub new {
711 my ($class, %arg) = @_; 740 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 741
722 my $self = bless { 742 my $self = bless {
723 server => [], 743 server => [],
724 timeout => [2, 5, 5], 744 timeout => [2, 5, 5],
725 search => [], 745 search => [],
… …
731 }, $class; 751 }, $class;
732 752
733 # search should default to gethostname's domain 753 # search should default to gethostname's domain
734 # but perl lacks a good posix module 754 # but perl lacks a good posix module
735 755
756 # try to create an ipv4 and an ipv6 socket
757 # only fail when we cannot create either
758 my $got_socket;
759
736 Scalar::Util::weaken (my $wself = $self); 760 Scalar::Util::weaken (my $wself = $self);
737 761
738 if ($fh4) { 762 if (socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0) {
763 ++$got_socket;
764
739 AnyEvent::Util::fh_nonblocking $fh4, 1; 765 AnyEvent::Util::fh_nonblocking $fh4, 1;
740 $self->{fh4} = $fh4; 766 $self->{fh4} = $fh4;
741 $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub { 767 $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub {
742 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) { 768 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) {
743 $wself->_recv ($pkt, $peer); 769 $wself->_recv ($pkt, $peer);
744 } 770 }
745 }); 771 });
746 } 772 }
747 773
748 if ($fh6) { 774 if (AF_INET6 && socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0) {
775 ++$got_socket;
776
749 $self->{fh6} = $fh6; 777 $self->{fh6} = $fh6;
750 AnyEvent::Util::fh_nonblocking $fh6, 1; 778 AnyEvent::Util::fh_nonblocking $fh6, 1;
751 $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub { 779 $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub {
752 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) { 780 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) {
753 $wself->_recv ($pkt, $peer); 781 $wself->_recv ($pkt, $peer);
754 } 782 }
755 }); 783 });
756 } 784 }
757 785
786 $got_socket
787 or Carp::croak "unable to create either an IPv4 or an IPv6 socket";
788
758 $self->_compile; 789 $self->_compile;
759 790
760 $self 791 $self
761} 792}
762 793
763=item $resolver->parse_resolv_conv ($string) 794=item $resolver->parse_resolv_conf ($string)
764 795
765Parses the given string as if it were a F<resolv.conf> file. The following 796Parses the given string as if it were a F<resolv.conf> file. The following
766directives are supported (but not necessarily implemented). 797directives are supported (but not necessarily implemented).
767 798
768C<#>-style comments, C<nameserver>, C<domain>, C<search>, C<sortlist>, 799C<#>-style comments, C<nameserver>, C<domain>, C<search>, C<sortlist>,
… …
815 if $attempts; 846 if $attempts;
816 847
817 $self->_compile; 848 $self->_compile;
818} 849}
819 850
851sub _parse_resolv_conf_file {
852 my ($self, $resolv_conf) = @_;
853
854 open my $fh, "<", $resolv_conf
855 or Carp::croak "$resolv_conf: $!";
856
857 local $/;
858 $self->parse_resolv_conf (<$fh>);
859}
860
820=item $resolver->os_config 861=item $resolver->os_config
821 862
822Tries so load and parse F</etc/resolv.conf> on portable operating systems. Tries various 863Tries 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. 864systems. Tries various egregious hacks on windows to force the DNS servers
865and searchlist out of the system.
824 866
825=cut 867=cut
826 868
827sub os_config { 869sub os_config {
828 my ($self) = @_; 870 my ($self) = @_;
829 871
830 $self->{server} = []; 872 $self->{server} = [];
831 $self->{search} = []; 873 $self->{search} = [];
832 874
833 if (AnyEvent::WIN32 || $^O =~ /cygwin/i) { 875 if ((AnyEvent::WIN32 || $^O =~ /cygwin/i)) {
834 no strict 'refs'; 876 no strict 'refs';
835 877
836 # there are many options to find the current nameservers etc. on windows 878 # there are many options to find the current nameservers etc. on windows
837 # all of them don't work consistently: 879 # all of them don't work consistently:
838 # - the registry thing needs separate code on win32 native vs. cygwin 880 # - the registry thing needs separate code on win32 native vs. cygwin
… …
872 push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK]; 914 push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK];
873 915
874 $self->_compile; 916 $self->_compile;
875 } 917 }
876 } else { 918 } else {
877 # try resolv.conf everywhere 919 # try resolv.conf everywhere else
878 920
879 if (open my $fh, "</etc/resolv.conf") { 921 $self->_parse_resolv_conf_file ("/etc/resolv.conf")
880 local $/; 922 if -e "/etc/resolv.conf";
881 $self->parse_resolv_conf (<$fh>);
882 }
883 } 923 }
884} 924}
885 925
886=item $resolver->timeout ($timeout, ...) 926=item $resolver->timeout ($timeout, ...)
887 927
… …
933 $self->{retry} = \@retry; 973 $self->{retry} = \@retry;
934} 974}
935 975
936sub _feed { 976sub _feed {
937 my ($self, $res) = @_; 977 my ($self, $res) = @_;
978
979 ($res) = $res =~ /^(.*)$/s
980 if AnyEvent::TAINT && $self->{untaint};
938 981
939 $res = dns_unpack $res 982 $res = dns_unpack $res
940 or return; 983 or return;
941 984
942 my $id = $self->{id}{$res->{id}}; 985 my $id = $self->{id}{$res->{id}};
… …
995 1038
996 $self->{id}{$req->[2]} = [AnyEvent->timer (after => $timeout, cb => sub { 1039 $self->{id}{$req->[2]} = [AnyEvent->timer (after => $timeout, cb => sub {
997 $NOW = time; 1040 $NOW = time;
998 1041
999 # timeout, try next 1042 # timeout, try next
1000 &$do_retry; 1043 &$do_retry if $do_retry;
1001 }), sub { 1044 }), sub {
1002 my ($res) = @_; 1045 my ($res) = @_;
1003 1046
1004 if ($res->{tc}) { 1047 if ($res->{tc}) {
1005 # success, but truncated, so use tcp 1048 # success, but truncated, so use tcp
1006 AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub { 1049 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 1050 return unless $do_retry; # some other request could have invalidated us already
1008 1051
1009 my ($fh) = @_ 1052 my ($fh) = @_
1010 or return &$do_retry; 1053 or return &$do_retry;
1054
1055 require AnyEvent::Handle;
1011 1056
1012 my $handle; $handle = new AnyEvent::Handle 1057 my $handle; $handle = new AnyEvent::Handle
1013 fh => $fh, 1058 fh => $fh,
1014 timeout => $timeout, 1059 timeout => $timeout,
1015 on_error => sub { 1060 on_error => sub {
… …
1036 } 1081 }
1037 }]; 1082 }];
1038 1083
1039 my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server); 1084 my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server);
1040 1085
1041 my $fh = AF_INET == Socket::sockaddr_family ($sa) 1086 my $fh = AF_INET == AnyEvent::Socket::sockaddr_family ($sa)
1042 ? $self->{fh4} : $self->{fh6} 1087 ? $self->{fh4} : $self->{fh6}
1043 or return &$do_retry; 1088 or return &$do_retry;
1044 1089
1045 send $fh, $req->[0], 0, $sa; 1090 send $fh, $req->[0], 0, $sa;
1046 }; 1091 };
… …
1113 1158
1114 push @{ $self->{queue} }, [dns_pack $req, $cb]; 1159 push @{ $self->{queue} }, [dns_pack $req, $cb];
1115 $self->_scheduler; 1160 $self->_scheduler;
1116} 1161}
1117 1162
1118=item $resolver->resolve ($qname, $qtype, %options, $cb->($rcode, @rr)) 1163=item $resolver->resolve ($qname, $qtype, %options, $cb->(@rr))
1119 1164
1120Queries the DNS for the given domain name C<$qname> of type C<$qtype>. 1165Queries the DNS for the given domain name C<$qname> of type C<$qtype>.
1121 1166
1122A C<$qtype> is either a numerical query type (e.g. C<1> for A records) or 1167A C<$qtype> is either a numerical query type (e.g. C<1> for A records) or
1123a lowercase name (you have to look at the source to see which aliases are 1168a lowercase name (you have to look at the source to see which aliases are
… …
1126"any" record type. 1171"any" record type.
1127 1172
1128The callback will be invoked with a list of matching result records or 1173The callback will be invoked with a list of matching result records or
1129none on any error or if the name could not be found. 1174none on any error or if the name could not be found.
1130 1175
1131CNAME chains (although illegal) are followed up to a length of 8. 1176CNAME chains (although illegal) are followed up to a length of 10.
1132 1177
1133The callback will be invoked with an result code in string form (noerror, 1178The callback will be invoked with arraryefs of the form C<[$name, $type,
1134formerr, servfail, nxdomain, notimp, refused and so on), or numerical 1179$class, @data>], where C<$name> is the domain name, C<$type> a type string
1135form if the result code is not supported. The remaining arguments are 1180or number, C<$class> a class name and @data is resource-record-dependent
1136arraryefs of the form C<[$name, $type, $class, @data>], where C<$name> is 1181data. For C<a> records, this will be the textual IPv4 addresses, for C<ns>
1137the domain name, C<$type> a type string or number, C<$class> a class name 1182or C<cname> records this will be a domain name, for C<txt> records these
1138and @data is resource-record-dependent data. For C<a> records, this will 1183are all the strings and so on.
1139be 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.
1141 1184
1142All types mentioned in RFC 1035, C<aaaa>, C<srv>, C<naptr> and C<spf> are 1185All 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 have 1186decoded. All resource records not known to this module will have
1144the raw C<rdata> field as fourth entry. 1187the raw C<rdata> field as fourth entry.
1145 1188
… …
1243 $do_search = sub { 1286 $do_search = sub {
1244 @search 1287 @search
1245 or (undef $do_search), (undef $do_req), return $cb->(); 1288 or (undef $do_search), (undef $do_req), return $cb->();
1246 1289
1247 (my $name = lc "$qname." . shift @search) =~ s/\.$//; 1290 (my $name = lc "$qname." . shift @search) =~ s/\.$//;
1248 my $depth = 2; 1291 my $depth = 10;
1249 1292
1250 # advance in cname-chain 1293 # advance in cname-chain
1251 $do_req = sub { 1294 $do_req = sub {
1252 $self->request ({ 1295 $self->request ({
1253 rd => 1, 1296 rd => 1,
… …
1271 if (@rr) { 1314 if (@rr) {
1272 $depth-- 1315 $depth--
1273 or return $do_search->(); # cname chain too long 1316 or return $do_search->(); # cname chain too long
1274 1317
1275 $cname = 1; 1318 $cname = 1;
1276 $name = $rr[0][3]; 1319 $name = lc $rr[0][3];
1277 1320
1278 } elsif ($cname) { 1321 } elsif ($cname) {
1279 # follow the cname 1322 # follow the cname
1280 return $do_req->(); 1323 return $do_req->();
1281 1324
… …
1330 1373
1331=back 1374=back
1332 1375
1333=head1 AUTHOR 1376=head1 AUTHOR
1334 1377
1335 Marc Lehmann <schmorp@schmorp.de> 1378 Marc Lehmann <schmorp@schmorp.de>
1336 http://home.schmorp.de/ 1379 http://home.schmorp.de/
1337 1380
1338=cut 1381=cut
1339 1382

Diff Legend

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