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.92 by root, Sun Jun 7 16:48:38 2009 UTC vs.
Revision 1.112 by root, Tue Jul 28 11:02:19 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.411; 37our $VERSION = 4.881;
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,
… …
379 376
380sub _enc_name($) { 377sub _enc_name($) {
381 pack "(C/a*)*", (split /\./, shift), "" 378 pack "(C/a*)*", (split /\./, shift), ""
382} 379}
383 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
384sub _enc_qd() { 388sub _enc_qd() {
385 (_enc_name $_->[0]) . pack "nn", 389 (_enc_name $_->[0]) . pack "nn",
386 ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}), 390 ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}),
387 ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"}) 391 ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"})
388} 392}
… …
504 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks 508 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks
505 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr 509 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr
506 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo 510 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo
507 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
508 16 => sub { unpack "(C/a*)*", $_ }, # txt 512 16 => sub { unpack "(C/a*)*", $_ }, # txt
509 28 => sub { AnyEvent::Socket::format_address ($_) }, # aaaa 513 28 => sub { AnyEvent::Socket::format_ipv6 ($_) }, # aaaa
510 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
511 35 => sub { # naptr 515 35 => sub { # naptr
512 # requires perl 5.10, sorry 516 # requires perl 5.10, sorry
513 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* .", $_;
514 local $ofs = $ofs + $offset - length; 518 local $ofs = $ofs + $offset - length;
… …
649calls. 653calls.
650 654
651Unless you have special needs, prefer this function over creating your own 655Unless you have special needs, prefer this function over creating your own
652resolver object. 656resolver object.
653 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
654=cut 667=cut
655 668
656our $RESOLVER; 669our $RESOLVER;
657 670
658sub resolver() { 671sub resolver() {
659 $RESOLVER || do { 672 $RESOLVER || do {
660 $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})
661 $RESOLVER->os_config; 681 : $RESOLVER->os_config;
682
662 $RESOLVER 683 $RESOLVER
663 } 684 }
664} 685}
665 686
666=item $resolver = new AnyEvent::DNS key => value... 687=item $resolver = new AnyEvent::DNS key => value...
… …
703=item reuse => $seconds 724=item reuse => $seconds
704 725
705The 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
706after 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
707immediately. 728immediately.
729
730=item untaint => $boolean
731
732When true, then the resolver will automatically untaint results, and might
733also ignore certain environment variables.
708 734
709=back 735=back
710 736
711=cut 737=cut
712 738
… …
763 $self->_compile; 789 $self->_compile;
764 790
765 $self 791 $self
766} 792}
767 793
768=item $resolver->parse_resolv_conv ($string) 794=item $resolver->parse_resolv_conf ($string)
769 795
770Parses 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
771directives are supported (but not necessarily implemented). 797directives are supported (but not necessarily implemented).
772 798
773C<#>-style comments, C<nameserver>, C<domain>, C<search>, C<sortlist>, 799C<#>-style comments, C<nameserver>, C<domain>, C<search>, C<sortlist>,
… …
820 if $attempts; 846 if $attempts;
821 847
822 $self->_compile; 848 $self->_compile;
823} 849}
824 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
825=item $resolver->os_config 861=item $resolver->os_config
826 862
827Tries 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
828egregious 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.
829 866
830=cut 867=cut
831 868
832sub os_config { 869sub os_config {
833 my ($self) = @_; 870 my ($self) = @_;
834 871
835 $self->{server} = []; 872 $self->{server} = [];
836 $self->{search} = []; 873 $self->{search} = [];
837 874
838 if (AnyEvent::WIN32 || $^O =~ /cygwin/i) { 875 if ((AnyEvent::WIN32 || $^O =~ /cygwin/i)) {
839 no strict 'refs'; 876 no strict 'refs';
840 877
841 # 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
842 # all of them don't work consistently: 879 # all of them don't work consistently:
843 # - the registry thing needs separate code on win32 native vs. cygwin 880 # - the registry thing needs separate code on win32 native vs. cygwin
… …
877 push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK]; 914 push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK];
878 915
879 $self->_compile; 916 $self->_compile;
880 } 917 }
881 } else { 918 } else {
882 # try resolv.conf everywhere 919 # try resolv.conf everywhere else
883 920
884 if (open my $fh, "</etc/resolv.conf") { 921 $self->_parse_resolv_conf_file ("/etc/resolv.conf")
885 local $/; 922 if -e "/etc/resolv.conf";
886 $self->parse_resolv_conf (<$fh>);
887 }
888 } 923 }
889} 924}
890 925
891=item $resolver->timeout ($timeout, ...) 926=item $resolver->timeout ($timeout, ...)
892 927
… …
938 $self->{retry} = \@retry; 973 $self->{retry} = \@retry;
939} 974}
940 975
941sub _feed { 976sub _feed {
942 my ($self, $res) = @_; 977 my ($self, $res) = @_;
978
979 ($res) = $res =~ /^(.*)$/s
980 if AnyEvent::TAINT && $self->{untaint};
943 981
944 $res = dns_unpack $res 982 $res = dns_unpack $res
945 or return; 983 or return;
946 984
947 my $id = $self->{id}{$res->{id}}; 985 my $id = $self->{id}{$res->{id}};
… …
1011 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 {
1012 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
1013 1051
1014 my ($fh) = @_ 1052 my ($fh) = @_
1015 or return &$do_retry; 1053 or return &$do_retry;
1054
1055 require AnyEvent::Handle;
1016 1056
1017 my $handle; $handle = new AnyEvent::Handle 1057 my $handle; $handle = new AnyEvent::Handle
1018 fh => $fh, 1058 fh => $fh,
1019 timeout => $timeout, 1059 timeout => $timeout,
1020 on_error => sub { 1060 on_error => sub {
… …
1041 } 1081 }
1042 }]; 1082 }];
1043 1083
1044 my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server); 1084 my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server);
1045 1085
1046 my $fh = AF_INET == Socket::sockaddr_family ($sa) 1086 my $fh = AF_INET == AnyEvent::Socket::sockaddr_family ($sa)
1047 ? $self->{fh4} : $self->{fh6} 1087 ? $self->{fh4} : $self->{fh6}
1048 or return &$do_retry; 1088 or return &$do_retry;
1049 1089
1050 send $fh, $req->[0], 0, $sa; 1090 send $fh, $req->[0], 0, $sa;
1051 }; 1091 };
… …
1274 if (@rr) { 1314 if (@rr) {
1275 $depth-- 1315 $depth--
1276 or return $do_search->(); # cname chain too long 1316 or return $do_search->(); # cname chain too long
1277 1317
1278 $cname = 1; 1318 $cname = 1;
1279 $name = $rr[0][3]; 1319 $name = lc $rr[0][3];
1280 1320
1281 } elsif ($cname) { 1321 } elsif ($cname) {
1282 # follow the cname 1322 # follow the cname
1283 return $do_req->(); 1323 return $do_req->();
1284 1324

Diff Legend

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