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.96 by root, Mon Jun 29 21:00:32 2009 UTC vs.
Revision 1.106 by root, Fri Jul 17 18:08:35 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.45; 40our $VERSION = 4.83;
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
… …
379 379
380sub _enc_name($) { 380sub _enc_name($) {
381 pack "(C/a*)*", (split /\./, shift), "" 381 pack "(C/a*)*", (split /\./, shift), ""
382} 382}
383 383
384if ($[ < 5.008) {
385 # special slower 5.6 version
386 *_enc_name = sub {
387 join "", map +(pack "C/a*", $_), (split /\./, shift), ""
388 };
389}
390
384sub _enc_qd() { 391sub _enc_qd() {
385 (_enc_name $_->[0]) . pack "nn", 392 (_enc_name $_->[0]) . pack "nn",
386 ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}), 393 ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}),
387 ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"}) 394 ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"})
388} 395}
… …
504 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks 511 11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks
505 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr 512 12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr
506 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo 513 13 => sub { unpack "C/a* C/a*", $_ }, # hinfo
507 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx 514 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx
508 16 => sub { unpack "(C/a*)*", $_ }, # txt 515 16 => sub { unpack "(C/a*)*", $_ }, # txt
509 28 => sub { AnyEvent::Socket::format_address ($_) }, # aaaa 516 28 => sub { AnyEvent::Socket::format_ipv6 ($_) }, # aaaa
510 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv 517 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv
511 35 => sub { # naptr 518 35 => sub { # naptr
512 # requires perl 5.10, sorry 519 # requires perl 5.10, sorry
513 my ($order, $preference, $flags, $service, $regexp, $offset) = unpack "nn C/a* C/a* C/a* .", $_; 520 my ($order, $preference, $flags, $service, $regexp, $offset) = unpack "nn C/a* C/a* C/a* .", $_;
514 local $ofs = $ofs + $offset - length; 521 local $ofs = $ofs + $offset - length;
… …
649calls. 656calls.
650 657
651Unless you have special needs, prefer this function over creating your own 658Unless you have special needs, prefer this function over creating your own
652resolver object. 659resolver object.
653 660
661The resolver is created with the following parameters:
662
663 untaint enabled
664 max_outstanding $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS}
665
666C<os_config> will be used for OS-specific configuration, unless
667C<$ENV{PERL_ANYEVENT_RESOLV_CONF}> is specified, in which case that file
668gets parsed.
669
654=cut 670=cut
655 671
656our $RESOLVER; 672our $RESOLVER;
657 673
658sub resolver() { 674sub resolver() {
659 $RESOLVER || do { 675 $RESOLVER || do {
660 $RESOLVER = new AnyEvent::DNS untaint => 1; 676 $RESOLVER = new AnyEvent::DNS
677 untaint => 1,
678 exists $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS}
679 ? (max_outstanding => $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS}*1 || 1) : (),
680 ;
681
682 exists $ENV{PERL_ANYEVENT_RESOLV_CONF}
683 ? length $ENV{PERL_ANYEVENT_RESOLV_CONF} && $RESOLVER->_parse_resolv_conf_file ($ENV{PERL_ANYEVENT_RESOLV_CONF})
661 $RESOLVER->os_config; 684 : $RESOLVER->os_config;
685
662 $RESOLVER 686 $RESOLVER
663 } 687 }
664} 688}
665 689
666=item $resolver = new AnyEvent::DNS key => value... 690=item $resolver = new AnyEvent::DNS key => value...
… …
768 $self->_compile; 792 $self->_compile;
769 793
770 $self 794 $self
771} 795}
772 796
773=item $resolver->parse_resolv_conv ($string) 797=item $resolver->parse_resolv_conf ($string)
774 798
775Parses the given string as if it were a F<resolv.conf> file. The following 799Parses the given string as if it were a F<resolv.conf> file. The following
776directives are supported (but not necessarily implemented). 800directives are supported (but not necessarily implemented).
777 801
778C<#>-style comments, C<nameserver>, C<domain>, C<search>, C<sortlist>, 802C<#>-style comments, C<nameserver>, C<domain>, C<search>, C<sortlist>,
… …
825 if $attempts; 849 if $attempts;
826 850
827 $self->_compile; 851 $self->_compile;
828} 852}
829 853
854sub _parse_resolv_conf_file {
855 my ($self, $resolv_conf) = @_;
856
857 open my $fh, "<", $resolv_conf
858 or Carp::croak "$resolv_conf: $!";
859
860 local $/;
861 $self->parse_resolv_conf (<$fh>);
862}
863
830=item $resolver->os_config 864=item $resolver->os_config
831 865
832Tries so load and parse F</etc/resolv.conf> on portable operating 866Tries so load and parse F</etc/resolv.conf> on portable operating
833systems. Tries various egregious hacks on windows to force the DNS servers 867systems. Tries various egregious hacks on windows to force the DNS servers
834and searchlist out of the system. 868and searchlist out of the system.
… …
839 my ($self) = @_; 873 my ($self) = @_;
840 874
841 $self->{server} = []; 875 $self->{server} = [];
842 $self->{search} = []; 876 $self->{search} = [];
843 877
844 if (AnyEvent::WIN32 || $^O =~ /cygwin/i) { 878 if ((AnyEvent::WIN32 || $^O =~ /cygwin/i)) {
845 no strict 'refs'; 879 no strict 'refs';
846 880
847 # there are many options to find the current nameservers etc. on windows 881 # there are many options to find the current nameservers etc. on windows
848 # all of them don't work consistently: 882 # all of them don't work consistently:
849 # - the registry thing needs separate code on win32 native vs. cygwin 883 # - the registry thing needs separate code on win32 native vs. cygwin
… …
883 push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK]; 917 push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK];
884 918
885 $self->_compile; 919 $self->_compile;
886 } 920 }
887 } else { 921 } else {
888 # try resolv.conf everywhere 922 # try resolv.conf everywhere else
889 923
890 if (open my $fh, "</etc/resolv.conf") { 924 $self->_parse_resolv_conf_file ("/etc/resolv.conf")
891 local $/; 925 if -e "/etc/resolv.conf";
892 $self->parse_resolv_conf (<$fh>);
893 }
894 } 926 }
895} 927}
896 928
897=item $resolver->timeout ($timeout, ...) 929=item $resolver->timeout ($timeout, ...)
898 930
… …
1020 AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub { 1052 AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub {
1021 return unless $do_retry; # some other request could have invalidated us already 1053 return unless $do_retry; # some other request could have invalidated us already
1022 1054
1023 my ($fh) = @_ 1055 my ($fh) = @_
1024 or return &$do_retry; 1056 or return &$do_retry;
1057
1058 require AnyEvent::Handle;
1025 1059
1026 my $handle; $handle = new AnyEvent::Handle 1060 my $handle; $handle = new AnyEvent::Handle
1027 fh => $fh, 1061 fh => $fh,
1028 timeout => $timeout, 1062 timeout => $timeout,
1029 on_error => sub { 1063 on_error => sub {
… …
1050 } 1084 }
1051 }]; 1085 }];
1052 1086
1053 my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server); 1087 my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server);
1054 1088
1055 my $fh = AF_INET == Socket::sockaddr_family ($sa) 1089 my $fh = AF_INET == AnyEvent::Socket::sockaddr_family ($sa)
1056 ? $self->{fh4} : $self->{fh6} 1090 ? $self->{fh4} : $self->{fh6}
1057 or return &$do_retry; 1091 or return &$do_retry;
1058 1092
1059 send $fh, $req->[0], 0, $sa; 1093 send $fh, $req->[0], 0, $sa;
1060 }; 1094 };
… …
1283 if (@rr) { 1317 if (@rr) {
1284 $depth-- 1318 $depth--
1285 or return $do_search->(); # cname chain too long 1319 or return $do_search->(); # cname chain too long
1286 1320
1287 $cname = 1; 1321 $cname = 1;
1288 $name = $rr[0][3]; 1322 $name = lc $rr[0][3];
1289 1323
1290 } elsif ($cname) { 1324 } elsif ($cname) {
1291 # follow the cname 1325 # follow the cname
1292 return $do_req->(); 1326 return $do_req->();
1293 1327

Diff Legend

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