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.100 by root, Sun Jul 5 01:38:43 2009 UTC vs.
Revision 1.116 by root, Thu Aug 6 13:45:04 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::Util qw(AF_INET6); 35use AnyEvent::Util qw(AF_INET6);
38 36
39our $VERSION = 4.452; 37our $VERSION = 4.91;
40 38
41our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222); 39our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222);
42 40
43=item AnyEvent::DNS::a $domain, $cb->(@addrs) 41=item AnyEvent::DNS::a $domain, $cb->(@addrs)
44 42
… …
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}
… …
648calls. 653calls.
649 654
650Unless you have special needs, prefer this function over creating your own 655Unless you have special needs, prefer this function over creating your own
651resolver object. 656resolver object.
652 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
653=cut 667=cut
654 668
655our $RESOLVER; 669our $RESOLVER;
656 670
657sub resolver() { 671sub resolver() {
658 $RESOLVER || do { 672 $RESOLVER || do {
659 $RESOLVER = new AnyEvent::DNS untaint => 1; 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})
660 $RESOLVER->os_config; 681 : $RESOLVER->os_config;
682
661 $RESOLVER 683 $RESOLVER
662 } 684 }
663} 685}
664 686
665=item $resolver = new AnyEvent::DNS key => value... 687=item $resolver = new AnyEvent::DNS key => value...
… …
740 if (socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0) { 762 if (socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0) {
741 ++$got_socket; 763 ++$got_socket;
742 764
743 AnyEvent::Util::fh_nonblocking $fh4, 1; 765 AnyEvent::Util::fh_nonblocking $fh4, 1;
744 $self->{fh4} = $fh4; 766 $self->{fh4} = $fh4;
745 $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub { 767 $self->{rw4} = AE::io $fh4, 0, sub {
746 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) { 768 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) {
747 $wself->_recv ($pkt, $peer); 769 $wself->_recv ($pkt, $peer);
748 } 770 }
749 }); 771 };
750 } 772 }
751 773
752 if (AF_INET6 && socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0) { 774 if (AF_INET6 && socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0) {
753 ++$got_socket; 775 ++$got_socket;
754 776
755 $self->{fh6} = $fh6; 777 $self->{fh6} = $fh6;
756 AnyEvent::Util::fh_nonblocking $fh6, 1; 778 AnyEvent::Util::fh_nonblocking $fh6, 1;
757 $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub { 779 $self->{rw6} = AE::io $fh6, 0, sub {
758 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) { 780 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) {
759 $wself->_recv ($pkt, $peer); 781 $wself->_recv ($pkt, $peer);
760 } 782 }
761 }); 783 };
762 } 784 }
763 785
764 $got_socket 786 $got_socket
765 or Carp::croak "unable to create either an IPv4 or an IPv6 socket"; 787 or Carp::croak "unable to create either an IPv4 or an IPv6 socket";
766 788
767 $self->_compile; 789 $self->_compile;
768 790
769 $self 791 $self
770} 792}
771 793
772=item $resolver->parse_resolv_conv ($string) 794=item $resolver->parse_resolv_conf ($string)
773 795
774Parses 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
775directives are supported (but not necessarily implemented). 797directives are supported (but not necessarily implemented).
776 798
777C<#>-style comments, C<nameserver>, C<domain>, C<search>, C<sortlist>, 799C<#>-style comments, C<nameserver>, C<domain>, C<search>, C<sortlist>,
… …
824 if $attempts; 846 if $attempts;
825 847
826 $self->_compile; 848 $self->_compile;
827} 849}
828 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
829=item $resolver->os_config 861=item $resolver->os_config
830 862
831Tries so load and parse F</etc/resolv.conf> on portable operating 863Tries so load and parse F</etc/resolv.conf> on portable operating
832systems. Tries various egregious hacks on windows to force the DNS servers 864systems. Tries various egregious hacks on windows to force the DNS servers
833and searchlist out of the system. 865and searchlist out of the system.
… …
838 my ($self) = @_; 870 my ($self) = @_;
839 871
840 $self->{server} = []; 872 $self->{server} = [];
841 $self->{search} = []; 873 $self->{search} = [];
842 874
843 if (AnyEvent::WIN32 || $^O =~ /cygwin/i) { 875 if ((AnyEvent::WIN32 || $^O =~ /cygwin/i)) {
844 no strict 'refs'; 876 no strict 'refs';
845 877
846 # 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
847 # all of them don't work consistently: 879 # all of them don't work consistently:
848 # - the registry thing needs separate code on win32 native vs. cygwin 880 # - the registry thing needs separate code on win32 native vs. cygwin
… …
882 push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK]; 914 push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK];
883 915
884 $self->_compile; 916 $self->_compile;
885 } 917 }
886 } else { 918 } else {
887 # try resolv.conf everywhere 919 # try resolv.conf everywhere else
888 920
889 if (open my $fh, "</etc/resolv.conf") { 921 $self->_parse_resolv_conf_file ("/etc/resolv.conf")
890 local $/; 922 if -e "/etc/resolv.conf";
891 $self->parse_resolv_conf (<$fh>);
892 }
893 } 923 }
894} 924}
895 925
896=item $resolver->timeout ($timeout, ...) 926=item $resolver->timeout ($timeout, ...)
897 927
… …
1004 undef $do_retry; return $req->[1]->(); 1034 undef $do_retry; return $req->[1]->();
1005 }; 1035 };
1006 1036
1007 my ($server, $timeout) = @$retry_cfg; 1037 my ($server, $timeout) = @$retry_cfg;
1008 1038
1009 $self->{id}{$req->[2]} = [AnyEvent->timer (after => $timeout, cb => sub { 1039 $self->{id}{$req->[2]} = [(AE::timer $timeout, 0, sub {
1010 $NOW = time; 1040 $NOW = time;
1011 1041
1012 # timeout, try next 1042 # timeout, try next
1013 &$do_retry if $do_retry; 1043 &$do_retry if $do_retry;
1014 }), sub { 1044 }), sub {
… …
1051 } 1081 }
1052 }]; 1082 }];
1053 1083
1054 my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server); 1084 my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server);
1055 1085
1056 my $fh = AF_INET == Socket::sockaddr_family ($sa) 1086 my $fh = AF_INET == AnyEvent::Socket::sockaddr_family ($sa)
1057 ? $self->{fh4} : $self->{fh6} 1087 ? $self->{fh4} : $self->{fh6}
1058 or return &$do_retry; 1088 or return &$do_retry;
1059 1089
1060 send $fh, $req->[0], 0, $sa; 1090 send $fh, $req->[0], 0, $sa;
1061 }; 1091 };
… …
1076 1106
1077 while ($self->{outstanding} < $self->{max_outstanding}) { 1107 while ($self->{outstanding} < $self->{max_outstanding}) {
1078 1108
1079 if (@{ $self->{reuse_q} } >= 30000) { 1109 if (@{ $self->{reuse_q} } >= 30000) {
1080 # we ran out of ID's, wait a bit 1110 # we ran out of ID's, wait a bit
1081 $self->{reuse_to} ||= AnyEvent->timer (after => $self->{reuse_q}[0][0] - $NOW, cb => sub { 1111 $self->{reuse_to} ||= AE::timer $self->{reuse_q}[0][0] - $NOW, 0, sub {
1082 delete $self->{reuse_to}; 1112 delete $self->{reuse_to};
1083 $self->_scheduler; 1113 $self->_scheduler;
1084 }); 1114 };
1085 last; 1115 last;
1086 } 1116 }
1087 1117
1088 if (my $req = shift @{ $self->{queue} }) { 1118 if (my $req = shift @{ $self->{queue} }) {
1089 # found a request in the queue, execute it 1119 # found a request in the queue, execute it

Diff Legend

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