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.85 by root, Wed Mar 25 17:33:11 2009 UTC vs.
Revision 1.109 by root, Mon Jul 20 22:39:57 2009 UTC

… …
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 = 4.341; 37our $VERSION = 4.86;
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
… …
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,
… …
376 374
377our %class_str = reverse %class_id; 375our %class_str = reverse %class_id;
378 376
379sub _enc_name($) { 377sub _enc_name($) {
380 pack "(C/a*)*", (split /\./, shift), "" 378 pack "(C/a*)*", (split /\./, shift), ""
379}
380
381if ($[ < 5.008) {
382 # special slower 5.6 version
383 *_enc_name = sub {
384 join "", map +(pack "C/a*", $_), (split /\./, shift), ""
385 };
381} 386}
382 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]}),
… …
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
511 # requires perl 5.10, sorry 516 # requires perl 5.10, sorry
512 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* .", $_;
513 local $ofs = $ofs + $offset - length; 518 local $ofs = $ofs + $offset - length;
514 ($order, $preference, $flags, $service, $regexp, _dec_name) 519 ($order, $preference, $flags, $service, $regexp, _dec_name)
515 }, 520 },
521 39 => sub { local $ofs = $ofs - length; _dec_name }, # dname
516 99 => sub { unpack "(C/a*)*", $_ }, # spf 522 99 => sub { unpack "(C/a*)*", $_ }, # spf
517); 523);
518 524
519sub _dec_rr { 525sub _dec_rr {
520 my $name = _dec_name; 526 my $name = _dec_name;
… …
647calls. 653calls.
648 654
649Unless you have special needs, prefer this function over creating your own 655Unless you have special needs, prefer this function over creating your own
650resolver object. 656resolver object.
651 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
652=cut 667=cut
653 668
654our $RESOLVER; 669our $RESOLVER;
655 670
656sub resolver() { 671sub resolver() {
657 $RESOLVER || do { 672 $RESOLVER || do {
658 $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})
659 $RESOLVER->os_config; 681 : $RESOLVER->os_config;
682
660 $RESOLVER 683 $RESOLVER
661 } 684 }
662} 685}
663 686
664=item $resolver = new AnyEvent::DNS key => value... 687=item $resolver = new AnyEvent::DNS key => value...
… …
701=item reuse => $seconds 724=item reuse => $seconds
702 725
703The 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
704after 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
705immediately. 728immediately.
729
730=item untaint => $boolean
731
732When true, then the resolver will automatically untaint results, and might
733also ignore certain environment variables.
706 734
707=back 735=back
708 736
709=cut 737=cut
710 738
… …
761 $self->_compile; 789 $self->_compile;
762 790
763 $self 791 $self
764} 792}
765 793
766=item $resolver->parse_resolv_conv ($string) 794=item $resolver->parse_resolv_conf ($string)
767 795
768Parses 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
769directives are supported (but not necessarily implemented). 797directives are supported (but not necessarily implemented).
770 798
771C<#>-style comments, C<nameserver>, C<domain>, C<search>, C<sortlist>, 799C<#>-style comments, C<nameserver>, C<domain>, C<search>, C<sortlist>,
… …
818 if $attempts; 846 if $attempts;
819 847
820 $self->_compile; 848 $self->_compile;
821} 849}
822 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
823=item $resolver->os_config 861=item $resolver->os_config
824 862
825Tries 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
826egregious 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.
827 866
828=cut 867=cut
829 868
830sub os_config { 869sub os_config {
831 my ($self) = @_; 870 my ($self) = @_;
832 871
833 $self->{server} = []; 872 $self->{server} = [];
834 $self->{search} = []; 873 $self->{search} = [];
835 874
836 if (AnyEvent::WIN32 || $^O =~ /cygwin/i) { 875 if ((AnyEvent::WIN32 || $^O =~ /cygwin/i)) {
837 no strict 'refs'; 876 no strict 'refs';
838 877
839 # 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
840 # all of them don't work consistently: 879 # all of them don't work consistently:
841 # - the registry thing needs separate code on win32 native vs. cygwin 880 # - the registry thing needs separate code on win32 native vs. cygwin
… …
875 push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK]; 914 push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK];
876 915
877 $self->_compile; 916 $self->_compile;
878 } 917 }
879 } else { 918 } else {
880 # try resolv.conf everywhere 919 # try resolv.conf everywhere else
881 920
882 if (open my $fh, "</etc/resolv.conf") { 921 $self->_parse_resolv_conf_file ("/etc/resolv.conf")
883 local $/; 922 if -e "/etc/resolv.conf";
884 $self->parse_resolv_conf (<$fh>);
885 }
886 } 923 }
887} 924}
888 925
889=item $resolver->timeout ($timeout, ...) 926=item $resolver->timeout ($timeout, ...)
890 927
… …
936 $self->{retry} = \@retry; 973 $self->{retry} = \@retry;
937} 974}
938 975
939sub _feed { 976sub _feed {
940 my ($self, $res) = @_; 977 my ($self, $res) = @_;
978
979 ($res) = $res =~ /^(.*)$/s
980 if AnyEvent::TAINT && $self->{untaint};
941 981
942 $res = dns_unpack $res 982 $res = dns_unpack $res
943 or return; 983 or return;
944 984
945 my $id = $self->{id}{$res->{id}}; 985 my $id = $self->{id}{$res->{id}};
… …
1009 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 {
1010 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
1011 1051
1012 my ($fh) = @_ 1052 my ($fh) = @_
1013 or return &$do_retry; 1053 or return &$do_retry;
1054
1055 require AnyEvent::Handle;
1014 1056
1015 my $handle; $handle = new AnyEvent::Handle 1057 my $handle; $handle = new AnyEvent::Handle
1016 fh => $fh, 1058 fh => $fh,
1017 timeout => $timeout, 1059 timeout => $timeout,
1018 on_error => sub { 1060 on_error => sub {
… …
1039 } 1081 }
1040 }]; 1082 }];
1041 1083
1042 my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server); 1084 my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server);
1043 1085
1044 my $fh = AF_INET == Socket::sockaddr_family ($sa) 1086 my $fh = AF_INET == AnyEvent::Socket::sockaddr_family ($sa)
1045 ? $self->{fh4} : $self->{fh6} 1087 ? $self->{fh4} : $self->{fh6}
1046 or return &$do_retry; 1088 or return &$do_retry;
1047 1089
1048 send $fh, $req->[0], 0, $sa; 1090 send $fh, $req->[0], 0, $sa;
1049 }; 1091 };
… …
1272 if (@rr) { 1314 if (@rr) {
1273 $depth-- 1315 $depth--
1274 or return $do_search->(); # cname chain too long 1316 or return $do_search->(); # cname chain too long
1275 1317
1276 $cname = 1; 1318 $cname = 1;
1277 $name = $rr[0][3]; 1319 $name = lc $rr[0][3];
1278 1320
1279 } elsif ($cname) { 1321 } elsif ($cname) {
1280 # follow the cname 1322 # follow the cname
1281 return $do_req->(); 1323 return $do_req->();
1282 1324

Diff Legend

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