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.55 by root, Fri May 30 10:37:34 2008 UTC vs.
Revision 1.64 by elmex, Thu Jun 5 07:11:40 2008 UTC

… …
2 2
3AnyEvent::DNS - fully asynchronous DNS resolution 3AnyEvent::DNS - fully asynchronous DNS resolution
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use AnyEvent::DNS; 7 use AnyEvent::DNS;
8 8
9 my $cv = AnyEvent->condvar; 9 my $cv = AnyEvent->condvar;
10 AnyEvent::DNS::a "www.google.de", $cv; 10 AnyEvent::DNS::a "www.google.de", $cv;
11 # ... later 11 # ... later
12 my @addrs = $cv->recv; 12 my @addrs = $cv->recv;
13 13
14=head1 DESCRIPTION 14=head1 DESCRIPTION
15 15
16This module offers both a number of DNS convenience functions as well 16This module offers both a number of DNS convenience functions as well
17as a fully asynchronous and high-performance pure-perl stub resolver. 17as a fully asynchronous and high-performance pure-perl stub resolver.
… …
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 = '1.0'; 40our $VERSION = 4.13;
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
… …
65=item AnyEvent::DNS::srv $service, $proto, $domain, $cb->(@srv_rr) 65=item AnyEvent::DNS::srv $service, $proto, $domain, $cb->(@srv_rr)
66 66
67Tries to resolve the given service, protocol and domain name into a list 67Tries to resolve the given service, protocol and domain name into a list
68of service records. 68of service records.
69 69
70Each srv_rr is an array reference with the following contents: 70Each C<$srv_rr> is an array reference with the following contents:
71C<[$priority, $weight, $transport, $target]>. 71C<[$priority, $weight, $transport, $target]>.
72 72
73They will be sorted with lowest priority first, then randomly 73They will be sorted with lowest priority first, then randomly
74distributed by weight as per RFC 2782. 74distributed by weight as per RFC 2782.
75 75
… …
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
… …
397 397
398Resource records are not yet encodable. 398Resource records are not yet encodable.
399 399
400Examples: 400Examples:
401 401
402 # very simple request, using lots of default values: 402 # very simple request, using lots of default values:
403 { rd => 1, qd => [ [ "host.domain", "a"] ] } 403 { rd => 1, qd => [ [ "host.domain", "a"] ] }
404 404
405 # more complex example, showing how flags etc. are named: 405 # more complex example, showing how flags etc. are named:
406 406
407 { 407 {
408 id => 10000, 408 id => 10000,
409 op => "query", 409 op => "query",
410 rc => "nxdomain", 410 rc => "nxdomain",
411 411
412 # flags 412 # flags
413 qr => 1, 413 qr => 1,
414 aa => 0, 414 aa => 0,
415 tc => 0, 415 tc => 0,
416 rd => 0, 416 rd => 0,
417 ra => 0, 417 ra => 0,
418 ad => 0, 418 ad => 0,
419 cd => 0, 419 cd => 0,
420 420
421 qd => [@rr], # query section 421 qd => [@rr], # query section
422 an => [@rr], # answer section 422 an => [@rr], # answer section
423 ns => [@rr], # authority section 423 ns => [@rr], # authority section
424 ar => [@rr], # additional records section 424 ar => [@rr], # additional records section
425 } 425 }
426 426
427=cut 427=cut
428 428
429sub dns_pack($) { 429sub dns_pack($) {
430 my ($req) = @_; 430 my ($req) = @_;
… …
533 533
534Unpacks a DNS packet into a perl data structure. 534Unpacks a DNS packet into a perl data structure.
535 535
536Examples: 536Examples:
537 537
538 # an unsuccessful reply 538 # an unsuccessful reply
539 { 539 {
540 'qd' => [ 540 'qd' => [
541 [ 'ruth.plan9.de.mach.uni-karlsruhe.de', '*', 'in' ] 541 [ 'ruth.plan9.de.mach.uni-karlsruhe.de', '*', 'in' ]
542 ], 542 ],
543 'rc' => 'nxdomain', 543 'rc' => 'nxdomain',
544 'ar' => [], 544 'ar' => [],
545 'ns' => [ 545 'ns' => [
546 [ 546 [
547 'uni-karlsruhe.de', 547 'uni-karlsruhe.de',
548 'soa', 548 'soa',
549 'in', 549 'in',
550 'netserv.rz.uni-karlsruhe.de', 550 'netserv.rz.uni-karlsruhe.de',
551 'hostmaster.rz.uni-karlsruhe.de', 551 'hostmaster.rz.uni-karlsruhe.de',
552 2008052201, 10800, 1800, 2592000, 86400 552 2008052201, 10800, 1800, 2592000, 86400
553 ] 553 ]
554 ], 554 ],
555 'tc' => '', 555 'tc' => '',
556 'ra' => 1, 556 'ra' => 1,
557 'qr' => 1, 557 'qr' => 1,
558 'id' => 45915, 558 'id' => 45915,
559 'aa' => '', 559 'aa' => '',
560 'an' => [], 560 'an' => [],
561 'rd' => 1, 561 'rd' => 1,
562 'op' => 'query' 562 'op' => 'query'
563 } 563 }
564 564
565 # a successful reply 565 # a successful reply
566 566
567 { 567 {
568 'qd' => [ [ 'www.google.de', 'a', 'in' ] ], 568 'qd' => [ [ 'www.google.de', 'a', 'in' ] ],
569 'rc' => 0, 569 'rc' => 0,
570 'ar' => [ 570 'ar' => [
571 [ 'a.l.google.com', 'a', 'in', '209.85.139.9' ], 571 [ 'a.l.google.com', 'a', 'in', '209.85.139.9' ],
572 [ 'b.l.google.com', 'a', 'in', '64.233.179.9' ], 572 [ 'b.l.google.com', 'a', 'in', '64.233.179.9' ],
573 [ 'c.l.google.com', 'a', 'in', '64.233.161.9' ], 573 [ 'c.l.google.com', 'a', 'in', '64.233.161.9' ],
574 ], 574 ],
575 'ns' => [ 575 'ns' => [
576 [ 'l.google.com', 'ns', 'in', 'a.l.google.com' ], 576 [ 'l.google.com', 'ns', 'in', 'a.l.google.com' ],
577 [ 'l.google.com', 'ns', 'in', 'b.l.google.com' ], 577 [ 'l.google.com', 'ns', 'in', 'b.l.google.com' ],
578 ], 578 ],
579 'tc' => '', 579 'tc' => '',
580 'ra' => 1, 580 'ra' => 1,
581 'qr' => 1, 581 'qr' => 1,
582 'id' => 64265, 582 'id' => 64265,
583 'aa' => '', 583 'aa' => '',
584 'an' => [ 584 'an' => [
585 [ 'www.google.de', 'cname', 'in', 'www.google.com' ], 585 [ 'www.google.de', 'cname', 'in', 'www.google.com' ],
586 [ 'www.google.com', 'cname', 'in', 'www.l.google.com' ], 586 [ 'www.google.com', 'cname', 'in', 'www.l.google.com' ],
587 [ 'www.l.google.com', 'a', 'in', '66.249.93.104' ], 587 [ 'www.l.google.com', 'a', 'in', '66.249.93.104' ],
588 [ 'www.l.google.com', 'a', 'in', '66.249.93.147' ], 588 [ 'www.l.google.com', 'a', 'in', '66.249.93.147' ],
589 ], 589 ],
590 'rd' => 1, 590 'rd' => 1,
591 'op' => 0 591 'op' => 0
592 } 592 }
593 593
594=cut 594=cut
595 595
596sub dns_unpack($) { 596sub dns_unpack($) {
597 local $pkt = shift; 597 local $pkt = shift;
… …
708=cut 708=cut
709 709
710sub new { 710sub new {
711 my ($class, %arg) = @_; 711 my ($class, %arg) = @_;
712 712
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 { 713 my $self = bless {
723 server => [], 714 server => [],
724 timeout => [2, 5, 5], 715 timeout => [2, 5, 5],
725 search => [], 716 search => [],
726 ndots => 1, 717 ndots => 1,
… …
731 }, $class; 722 }, $class;
732 723
733 # search should default to gethostname's domain 724 # search should default to gethostname's domain
734 # but perl lacks a good posix module 725 # but perl lacks a good posix module
735 726
727 # try to create an ipv4 and an ipv6 socket
728 # only fail when we cannot create either
729 my $got_socket;
730
736 Scalar::Util::weaken (my $wself = $self); 731 Scalar::Util::weaken (my $wself = $self);
737 732
738 if ($fh4) { 733 if (socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0) {
734 ++$got_socket;
735
739 AnyEvent::Util::fh_nonblocking $fh4, 1; 736 AnyEvent::Util::fh_nonblocking $fh4, 1;
740 $self->{fh4} = $fh4; 737 $self->{fh4} = $fh4;
741 $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub { 738 $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub {
742 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) { 739 if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) {
743 $wself->_recv ($pkt, $peer); 740 $wself->_recv ($pkt, $peer);
744 } 741 }
745 }); 742 });
746 } 743 }
747 744
748 if ($fh6) { 745 if (AF_INET6 && socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0) {
746 ++$got_socket;
747
749 $self->{fh6} = $fh6; 748 $self->{fh6} = $fh6;
750 AnyEvent::Util::fh_nonblocking $fh6, 1; 749 AnyEvent::Util::fh_nonblocking $fh6, 1;
751 $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub { 750 $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub {
752 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) { 751 if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) {
753 $wself->_recv ($pkt, $peer); 752 $wself->_recv ($pkt, $peer);
754 } 753 }
755 }); 754 });
756 } 755 }
756
757 $got_socket
758 or Carp::croak "unable to create either an IPv4 or an IPv6 socket";
757 759
758 $self->_compile; 760 $self->_compile;
759 761
760 $self 762 $self
761} 763}
… …
1126"any" record type. 1128"any" record type.
1127 1129
1128The callback will be invoked with a list of matching result records or 1130The callback will be invoked with a list of matching result records or
1129none on any error or if the name could not be found. 1131none on any error or if the name could not be found.
1130 1132
1131CNAME chains (although illegal) are followed up to a length of 8. 1133CNAME chains (although illegal) are followed up to a length of 10.
1132 1134
1133The callback will be invoked with an result code in string form (noerror, 1135The callback will be invoked with an result code in string form (noerror,
1134formerr, servfail, nxdomain, notimp, refused and so on), or numerical 1136formerr, servfail, nxdomain, notimp, refused and so on), or numerical
1135form if the result code is not supported. The remaining arguments are 1137form if the result code is not supported. The remaining arguments are
1136arraryefs of the form C<[$name, $type, $class, @data>], where C<$name> is 1138arraryefs of the form C<[$name, $type, $class, @data>], where C<$name> is
… …
1243 $do_search = sub { 1245 $do_search = sub {
1244 @search 1246 @search
1245 or (undef $do_search), (undef $do_req), return $cb->(); 1247 or (undef $do_search), (undef $do_req), return $cb->();
1246 1248
1247 (my $name = lc "$qname." . shift @search) =~ s/\.$//; 1249 (my $name = lc "$qname." . shift @search) =~ s/\.$//;
1248 my $depth = 2; 1250 my $depth = 10;
1249 1251
1250 # advance in cname-chain 1252 # advance in cname-chain
1251 $do_req = sub { 1253 $do_req = sub {
1252 $self->request ({ 1254 $self->request ({
1253 rd => 1, 1255 rd => 1,
… …
1330 1332
1331=back 1333=back
1332 1334
1333=head1 AUTHOR 1335=head1 AUTHOR
1334 1336
1335 Marc Lehmann <schmorp@schmorp.de> 1337 Marc Lehmann <schmorp@schmorp.de>
1336 http://home.schmorp.de/ 1338 http://home.schmorp.de/
1337 1339
1338=cut 1340=cut
1339 1341

Diff Legend

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