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.59 by root, Sat May 31 13:41:55 2008 UTC vs.
Revision 1.75 by root, Thu Aug 21 23:48:35 2008 UTC

… …
35 35
36use AnyEvent (); 36use AnyEvent ();
37use AnyEvent::Handle (); 37use AnyEvent::Handle ();
38use AnyEvent::Util qw(AF_INET6); 38use AnyEvent::Util qw(AF_INET6);
39 39
40our $VERSION = 4.1; 40our $VERSION = 4.233;
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
… …
170 my %pri; 170 my %pri;
171 push @{ $pri{$_->[3]} }, [ @$_[3,4,5,6] ] 171 push @{ $pri{$_->[3]} }, [ @$_[3,4,5,6] ]
172 for @_; 172 for @_;
173 173
174 # order by priority 174 # order by priority
175 for my $pri (sort { $a->[0] <=> $b->[0] } keys %pri) { 175 for my $pri (sort { $a <=> $b } keys %pri) {
176 # order by weight 176 # order by weight
177 my @rr = sort { $a->[1] <=> $b->[1] } @{ delete $pri{$pri} }; 177 my @rr = sort { $a->[1] <=> $b->[1] } @{ delete $pri{$pri} };
178 178
179 my $sum; $sum += $_->[1] for @rr; 179 my $sum; $sum += $_->[1] for @rr;
180 180
… …
506 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx 506 15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx
507 16 => sub { unpack "(C/a*)*", $_ }, # txt 507 16 => sub { unpack "(C/a*)*", $_ }, # txt
508 28 => sub { AnyEvent::Socket::format_address ($_) }, # aaaa 508 28 => sub { AnyEvent::Socket::format_address ($_) }, # aaaa
509 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv 509 33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv
510 35 => sub { # naptr 510 35 => sub { # naptr
511 # requires perl 5.10, sorry
511 my ($order, $preference, $flags, $service, $regexp, $offset) = unpack "nn C/a* C/a* C/a* .", $_; 512 my ($order, $preference, $flags, $service, $regexp, $offset) = unpack "nn C/a* C/a* C/a* .", $_;
512 local $ofs = $ofs + $offset - length; 513 local $ofs = $ofs + $offset - length;
513 ($order, $preference, $flags, $service, $regexp, _dec_name) 514 ($order, $preference, $flags, $service, $regexp, _dec_name)
514 }, 515 },
515 99 => sub { unpack "(C/a*)*", $_ }, # spf 516 99 => sub { unpack "(C/a*)*", $_ }, # spf
… …
708=cut 709=cut
709 710
710sub new { 711sub new {
711 my ($class, %arg) = @_; 712 my ($class, %arg) = @_;
712 713
713 # try to create a ipv4 and an ipv6 socket
714 # only fail when we cnanot create either
715
716 socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0;
717 socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0;
718
719 $fh4 || $fh6
720 or Carp::croak "unable to create either an IPv6 or an IPv4 socket";
721
722 my $self = bless { 714 my $self = bless {
723 server => [], 715 server => [],
724 timeout => [2, 5, 5], 716 timeout => [2, 5, 5],
725 search => [], 717 search => [],
726 ndots => 1, 718 ndots => 1,
… …
731 }, $class; 723 }, $class;
732 724
733 # search should default to gethostname's domain 725 # search should default to gethostname's domain
734 # but perl lacks a good posix module 726 # but perl lacks a good posix module
735 727
728 # try to create an ipv4 and an ipv6 socket
729 # only fail when we cannot create either
730 my $got_socket;
731
736 Scalar::Util::weaken (my $wself = $self); 732 Scalar::Util::weaken (my $wself = $self);
737 733
738 if ($fh4) { 734 if (socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0) {
735 ++$got_socket;
736
739 AnyEvent::Util::fh_nonblocking $fh4, 1; 737 AnyEvent::Util::fh_nonblocking $fh4, 1;
740 $self->{fh4} = $fh4; 738 $self->{fh4} = $fh4;
741 $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub { 739 $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub {
742 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) { 740 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) {
743 $wself->_recv ($pkt, $peer); 741 $wself->_recv ($pkt, $peer);
744 } 742 }
745 }); 743 });
746 } 744 }
747 745
748 if ($fh6) { 746 if (AF_INET6 && socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0) {
747 ++$got_socket;
748
749 $self->{fh6} = $fh6; 749 $self->{fh6} = $fh6;
750 AnyEvent::Util::fh_nonblocking $fh6, 1; 750 AnyEvent::Util::fh_nonblocking $fh6, 1;
751 $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub { 751 $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub {
752 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) { 752 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) {
753 $wself->_recv ($pkt, $peer); 753 $wself->_recv ($pkt, $peer);
754 } 754 }
755 }); 755 });
756 } 756 }
757
758 $got_socket
759 or Carp::croak "unable to create either an IPv4 or an IPv6 socket";
757 760
758 $self->_compile; 761 $self->_compile;
759 762
760 $self 763 $self
761} 764}
… …
995 998
996 $self->{id}{$req->[2]} = [AnyEvent->timer (after => $timeout, cb => sub { 999 $self->{id}{$req->[2]} = [AnyEvent->timer (after => $timeout, cb => sub {
997 $NOW = time; 1000 $NOW = time;
998 1001
999 # timeout, try next 1002 # timeout, try next
1000 &$do_retry; 1003 &$do_retry if $do_retry;
1001 }), sub { 1004 }), sub {
1002 my ($res) = @_; 1005 my ($res) = @_;
1003 1006
1004 if ($res->{tc}) { 1007 if ($res->{tc}) {
1005 # success, but truncated, so use tcp 1008 # success, but truncated, so use tcp
… …
1126"any" record type. 1129"any" record type.
1127 1130
1128The callback will be invoked with a list of matching result records or 1131The callback will be invoked with a list of matching result records or
1129none on any error or if the name could not be found. 1132none on any error or if the name could not be found.
1130 1133
1131CNAME chains (although illegal) are followed up to a length of 8. 1134CNAME chains (although illegal) are followed up to a length of 10.
1132 1135
1133The callback will be invoked with an result code in string form (noerror, 1136The callback will be invoked with an result code in string form (noerror,
1134formerr, servfail, nxdomain, notimp, refused and so on), or numerical 1137formerr, servfail, nxdomain, notimp, refused and so on), or numerical
1135form if the result code is not supported. The remaining arguments are 1138form if the result code is not supported. The remaining arguments are
1136arraryefs of the form C<[$name, $type, $class, @data>], where C<$name> is 1139arraryefs of the form C<[$name, $type, $class, @data>], where C<$name> is
… …
1243 $do_search = sub { 1246 $do_search = sub {
1244 @search 1247 @search
1245 or (undef $do_search), (undef $do_req), return $cb->(); 1248 or (undef $do_search), (undef $do_req), return $cb->();
1246 1249
1247 (my $name = lc "$qname." . shift @search) =~ s/\.$//; 1250 (my $name = lc "$qname." . shift @search) =~ s/\.$//;
1248 my $depth = 2; 1251 my $depth = 10;
1249 1252
1250 # advance in cname-chain 1253 # advance in cname-chain
1251 $do_req = sub { 1254 $do_req = sub {
1252 $self->request ({ 1255 $self->request ({
1253 rd => 1, 1256 rd => 1,

Diff Legend

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