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.66 by root, Fri Jun 6 10:23:50 2008 UTC vs.
Revision 1.103 by root, Thu Jul 9 08:31:16 2009 UTC

… …
29package AnyEvent::DNS; 29package AnyEvent::DNS;
30 30
31no warnings; 31no warnings;
32use strict; 32use strict;
33 33
34use Carp ();
34use Socket qw(AF_INET SOCK_DGRAM SOCK_STREAM); 35use Socket qw(AF_INET SOCK_DGRAM SOCK_STREAM);
35 36
36use AnyEvent (); 37use AnyEvent ();
37use AnyEvent::Handle ();
38use AnyEvent::Util qw(AF_INET6); 38use AnyEvent::Util qw(AF_INET6);
39 39
40our $VERSION = 4.14; 40our $VERSION = 4.81;
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
… …
295C<$ENV{PERL_ANYEVENT_EDNS0}>, but when set to C<1>, AnyEvent::DNS will use 295C<$ENV{PERL_ANYEVENT_EDNS0}>, but when set to C<1>, AnyEvent::DNS will use
296EDNS0 in all requests. 296EDNS0 in all requests.
297 297
298=cut 298=cut
299 299
300our $EDNS0 = $ENV{PERL_ANYEVENT_EDNS0} * 1; # set to 1 to enable (partial) edns0 300our $EDNS0 = $ENV{PERL_ANYEVENT_EDNS0}*1; # set to 1 to enable (partial) edns0
301 301
302our %opcode_id = ( 302our %opcode_id = (
303 query => 0, 303 query => 0,
304 iquery => 1, 304 iquery => 1,
305 status => 2, 305 status => 2,
… …
352 mx => 15, 352 mx => 15,
353 txt => 16, 353 txt => 16,
354 aaaa => 28, 354 aaaa => 28,
355 srv => 33, 355 srv => 33,
356 naptr => 35, # rfc2915 356 naptr => 35, # rfc2915
357 dname => 39, # rfc2672
357 opt => 41, 358 opt => 41,
358 spf => 99, 359 spf => 99,
359 tkey => 249, 360 tkey => 249,
360 tsig => 250, 361 tsig => 250,
361 ixfr => 251, 362 ixfr => 251,
… …
503 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks 504 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks
504 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr 505 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr
505 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo 506 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo
506 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx 507 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx
507 16 => sub { unpack "(C/a*)*", $_ }, # txt 508 16 => sub { unpack "(C/a*)*", $_ }, # txt
508 28 => sub { AnyEvent::Socket::format_address ($_) }, # aaaa 509 28 => sub { AnyEvent::Socket::format_ipv6 ($_) }, # aaaa
509 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv 510 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv
510 35 => sub { # naptr 511 35 => sub { # naptr
511 # requires perl 5.10, sorry 512 # requires perl 5.10, sorry
512 my ($order, $preference, $flags, $service, $regexp, $offset) = unpack "nn C/a* C/a* C/a* .", $_; 513 my ($order, $preference, $flags, $service, $regexp, $offset) = unpack "nn C/a* C/a* C/a* .", $_;
513 local $ofs = $ofs + $offset - length; 514 local $ofs = $ofs + $offset - length;
514 ($order, $preference, $flags, $service, $regexp, _dec_name) 515 ($order, $preference, $flags, $service, $regexp, _dec_name)
515 }, 516 },
517 39 => sub { local $ofs = $ofs - length; _dec_name }, # dname
516 99 => sub { unpack "(C/a*)*", $_ }, # spf 518 99 => sub { unpack "(C/a*)*", $_ }, # spf
517); 519);
518 520
519sub _dec_rr { 521sub _dec_rr {
520 my $name = _dec_name; 522 my $name = _dec_name;
… …
647calls. 649calls.
648 650
649Unless you have special needs, prefer this function over creating your own 651Unless you have special needs, prefer this function over creating your own
650resolver object. 652resolver object.
651 653
654The resolver is created with the following parameters:
655
656 untaint enabled
657 max_outstanding $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS}
658
659C<os_config> will be used for OS-specific configuration, unless
660C<$ENV{PERL_ANYEVENT_RESOLV_CONF}> is specified, in which case that file
661gets parsed.
662
652=cut 663=cut
653 664
654our $RESOLVER; 665our $RESOLVER;
655 666
656sub resolver() { 667sub resolver() {
657 $RESOLVER || do { 668 $RESOLVER || do {
658 $RESOLVER = new AnyEvent::DNS; 669 $RESOLVER = new AnyEvent::DNS
670 untaint => 1,
671 exists $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS}
672 ? (max_outstanding => $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS}*1 || 1) : (),
673 ;
674
675 exists $ENV{PERL_ANYEVENT_RESOLV_CONF}
676 ? length $ENV{PERL_ANYEVENT_RESOLV_CONF} && $RESOLVER->_parse_resolv_conf_file ($ENV{PERL_ANYEVENT_RESOLV_CONF})
659 $RESOLVER->os_config; 677 : $RESOLVER->os_config;
678
660 $RESOLVER 679 $RESOLVER
661 } 680 }
662} 681}
663 682
664=item $resolver = new AnyEvent::DNS key => value... 683=item $resolver = new AnyEvent::DNS key => value...
… …
701=item reuse => $seconds 720=item reuse => $seconds
702 721
703The number of seconds (default: C<300>) that a query id cannot be re-used 722The number of seconds (default: C<300>) that a query id cannot be re-used
704after a timeout. If there was no time-out then query ids can be reused 723after a timeout. If there was no time-out then query ids can be reused
705immediately. 724immediately.
725
726=item untaint => $boolean
727
728When true, then the resolver will automatically untaint results, and might
729also ignore certain environment variables.
706 730
707=back 731=back
708 732
709=cut 733=cut
710 734
… …
761 $self->_compile; 785 $self->_compile;
762 786
763 $self 787 $self
764} 788}
765 789
766=item $resolver->parse_resolv_conv ($string) 790=item $resolver->parse_resolv_conf ($string)
767 791
768Parses the given string as if it were a F<resolv.conf> file. The following 792Parses the given string as if it were a F<resolv.conf> file. The following
769directives are supported (but not necessarily implemented). 793directives are supported (but not necessarily implemented).
770 794
771C<#>-style comments, C<nameserver>, C<domain>, C<search>, C<sortlist>, 795C<#>-style comments, C<nameserver>, C<domain>, C<search>, C<sortlist>,
… …
818 if $attempts; 842 if $attempts;
819 843
820 $self->_compile; 844 $self->_compile;
821} 845}
822 846
847sub _parse_resolv_conf_file {
848 my ($self, $resolv_conf) = @_;
849
850 open my $fh, "<:perlio", $resolv_conf
851 or Carp::croak "$resolv_conf: $!";
852
853 local $/;
854 $self->parse_resolv_conf (<$fh>);
855}
856
823=item $resolver->os_config 857=item $resolver->os_config
824 858
825Tries so load and parse F</etc/resolv.conf> on portable operating systems. Tries various 859Tries so load and parse F</etc/resolv.conf> on portable operating
826egregious hacks on windows to force the DNS servers and searchlist out of the system. 860systems. Tries various egregious hacks on windows to force the DNS servers
861and searchlist out of the system.
827 862
828=cut 863=cut
829 864
830sub os_config { 865sub os_config {
831 my ($self) = @_; 866 my ($self) = @_;
832 867
833 $self->{server} = []; 868 $self->{server} = [];
834 $self->{search} = []; 869 $self->{search} = [];
835 870
836 if (AnyEvent::WIN32 || $^O =~ /cygwin/i) { 871 if ((AnyEvent::WIN32 || $^O =~ /cygwin/i)) {
837 no strict 'refs'; 872 no strict 'refs';
838 873
839 # there are many options to find the current nameservers etc. on windows 874 # there are many options to find the current nameservers etc. on windows
840 # all of them don't work consistently: 875 # all of them don't work consistently:
841 # - the registry thing needs separate code on win32 native vs. cygwin 876 # - the registry thing needs separate code on win32 native vs. cygwin
… …
875 push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK]; 910 push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK];
876 911
877 $self->_compile; 912 $self->_compile;
878 } 913 }
879 } else { 914 } else {
880 # try resolv.conf everywhere 915 # try resolv.conf everywhere else
881 916
882 if (open my $fh, "</etc/resolv.conf") { 917 $self->_parse_resolv_conf_file ("/etc/resolv.conf")
883 local $/; 918 if -e "/etc/resolv.conf";
884 $self->parse_resolv_conf (<$fh>);
885 }
886 } 919 }
887} 920}
888 921
889=item $resolver->timeout ($timeout, ...) 922=item $resolver->timeout ($timeout, ...)
890 923
… …
936 $self->{retry} = \@retry; 969 $self->{retry} = \@retry;
937} 970}
938 971
939sub _feed { 972sub _feed {
940 my ($self, $res) = @_; 973 my ($self, $res) = @_;
974
975 ($res) = $res =~ /^(.*)$/s
976 if AnyEvent::TAINT && $self->{untaint};
941 977
942 $res = dns_unpack $res 978 $res = dns_unpack $res
943 or return; 979 or return;
944 980
945 my $id = $self->{id}{$res->{id}}; 981 my $id = $self->{id}{$res->{id}};
… …
998 1034
999 $self->{id}{$req->[2]} = [AnyEvent->timer (after => $timeout, cb => sub { 1035 $self->{id}{$req->[2]} = [AnyEvent->timer (after => $timeout, cb => sub {
1000 $NOW = time; 1036 $NOW = time;
1001 1037
1002 # timeout, try next 1038 # timeout, try next
1003 &$do_retry; 1039 &$do_retry if $do_retry;
1004 }), sub { 1040 }), sub {
1005 my ($res) = @_; 1041 my ($res) = @_;
1006 1042
1007 if ($res->{tc}) { 1043 if ($res->{tc}) {
1008 # success, but truncated, so use tcp 1044 # success, but truncated, so use tcp
1009 AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub { 1045 AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub {
1010 return unless $do_retry; # some other request could have invalidated us already 1046 return unless $do_retry; # some other request could have invalidated us already
1011 1047
1012 my ($fh) = @_ 1048 my ($fh) = @_
1013 or return &$do_retry; 1049 or return &$do_retry;
1050
1051 require AnyEvent::Handle;
1014 1052
1015 my $handle; $handle = new AnyEvent::Handle 1053 my $handle; $handle = new AnyEvent::Handle
1016 fh => $fh, 1054 fh => $fh,
1017 timeout => $timeout, 1055 timeout => $timeout,
1018 on_error => sub { 1056 on_error => sub {
… …
1116 1154
1117 push @{ $self->{queue} }, [dns_pack $req, $cb]; 1155 push @{ $self->{queue} }, [dns_pack $req, $cb];
1118 $self->_scheduler; 1156 $self->_scheduler;
1119} 1157}
1120 1158
1121=item $resolver->resolve ($qname, $qtype, %options, $cb->($rcode, @rr)) 1159=item $resolver->resolve ($qname, $qtype, %options, $cb->(@rr))
1122 1160
1123Queries the DNS for the given domain name C<$qname> of type C<$qtype>. 1161Queries the DNS for the given domain name C<$qname> of type C<$qtype>.
1124 1162
1125A C<$qtype> is either a numerical query type (e.g. C<1> for A records) or 1163A C<$qtype> is either a numerical query type (e.g. C<1> for A records) or
1126a lowercase name (you have to look at the source to see which aliases are 1164a lowercase name (you have to look at the source to see which aliases are
… …
1131The callback will be invoked with a list of matching result records or 1169The callback will be invoked with a list of matching result records or
1132none on any error or if the name could not be found. 1170none on any error or if the name could not be found.
1133 1171
1134CNAME chains (although illegal) are followed up to a length of 10. 1172CNAME chains (although illegal) are followed up to a length of 10.
1135 1173
1136The callback will be invoked with an result code in string form (noerror, 1174The callback will be invoked with arraryefs of the form C<[$name, $type,
1137formerr, servfail, nxdomain, notimp, refused and so on), or numerical 1175$class, @data>], where C<$name> is the domain name, C<$type> a type string
1138form if the result code is not supported. The remaining arguments are 1176or number, C<$class> a class name and @data is resource-record-dependent
1139arraryefs of the form C<[$name, $type, $class, @data>], where C<$name> is 1177data. For C<a> records, this will be the textual IPv4 addresses, for C<ns>
1140the domain name, C<$type> a type string or number, C<$class> a class name 1178or C<cname> records this will be a domain name, for C<txt> records these
1141and @data is resource-record-dependent data. For C<a> records, this will 1179are all the strings and so on.
1142be the textual IPv4 addresses, for C<ns> or C<cname> records this will be
1143a domain name, for C<txt> records these are all the strings and so on.
1144 1180
1145All types mentioned in RFC 1035, C<aaaa>, C<srv>, C<naptr> and C<spf> are 1181All types mentioned in RFC 1035, C<aaaa>, C<srv>, C<naptr> and C<spf> are
1146decoded. All resource records not known to this module will have 1182decoded. All resource records not known to this module will have
1147the raw C<rdata> field as fourth entry. 1183the raw C<rdata> field as fourth entry.
1148 1184
… …
1274 if (@rr) { 1310 if (@rr) {
1275 $depth-- 1311 $depth--
1276 or return $do_search->(); # cname chain too long 1312 or return $do_search->(); # cname chain too long
1277 1313
1278 $cname = 1; 1314 $cname = 1;
1279 $name = $rr[0][3]; 1315 $name = lc $rr[0][3];
1280 1316
1281 } elsif ($cname) { 1317 } elsif ($cname) {
1282 # follow the cname 1318 # follow the cname
1283 return $do_req->(); 1319 return $do_req->();
1284 1320

Diff Legend

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