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.3 by root, Fri May 23 03:20:53 2008 UTC vs.
Revision 1.4 by root, Fri May 23 04:10:40 2008 UTC

… …
11This module offers both a number of DNS convenience functions as well 11This module offers both a number of DNS convenience functions as well
12as a fully asynchronous and high-performance pure-perl stub resolver. 12as a fully asynchronous and high-performance pure-perl stub resolver.
13 13
14=head2 CONVENIENCE FUNCTIONS 14=head2 CONVENIENCE FUNCTIONS
15 15
16# none yet
17
18=over 4 16=over 4
19 17
20=cut 18=cut
21 19
22package AnyEvent::DNS; 20package AnyEvent::DNS;
… …
24no warnings; 22no warnings;
25use strict; 23use strict;
26 24
27use AnyEvent::Util (); 25use AnyEvent::Util ();
28 26
29=back 27=item AnyEvent::DNS::addr $node, $service, $family, $type, $cb->(@addrs)
28
29NOT YET IMPLEMENTED
30
31Tries to resolve the given nodename and service name into sockaddr
32structures usable to connect to this node and service in a
33protocol-independent way. It works similarly to the getaddrinfo posix
34function.
35
36Example:
37
38 AnyEvent::DNS::addr "google.com", "http", AF_UNSPEC, SOCK_STREAM, sub { ... };
39
40=item AnyEvent::DNS::a $domain, $cb->(@addrs)
41
42Tries to resolve the given domain to IPv4 address(es).
43
44=item AnyEvent::DNS::mx $domain, $cb->(@hostnames)
45
46Tries to resolve the given domain into a sorted (lower preference value
47first) list of domain names.
48
49=item AnyEvent::DNS::ns $domain, $cb->(@hostnames)
50
51Tries to resolve the given domain name into a list of name servers.
52
53=item AnyEvent::DNS::txt $domain, $cb->(@hostnames)
54
55Tries to resolve the given domain name into a list of text records.
56
57=item AnyEvent::DNS::srv $service, $proto, $domain, $cb->(@srv_rr)
58
59Tries to resolve the given service, protocol and domain name into a list
60of service records.
61
62Each srv_rr is an arrayref with the following contents:
63C<[$priority, $weight, $transport, $target]>.
64
65They will be sorted with lowest priority, highest weight first (TODO:
66should use the rfc algorithm to reorder same-priority records for weight).
67
68Example:
69
70 AnyEvent::DNS::srv "sip", "udp", "schmorp.de", sub { ...
71 # @_ = ( [10, 10, 5060, "sip1.schmorp.de" ] )
72
73=item AnyEvent::DNS::ptr $ipv4_or_6, $cb->(@hostnames)
74
75Tries to reverse-resolve the given IPv4 or IPv6 address (in textual form)
76into it's hostname(s).
77
78Requires the Socket6 module for IPv6 support.
79
80Example:
81
82 AnyEvent::DNS::ptr "2001:500:2f::f", sub { print shift };
83 # => f.root-servers.net
84
85=cut
86
87sub resolver;
88
89sub a($$) {
90 my ($domain, $cb) = @_;
91
92 resolver->resolve ($domain => "a", sub {
93 $cb->(map $_->[3], @_);
94 });
95}
96
97sub mx($$) {
98 my ($domain, $cb) = @_;
99
100 resolver->resolve ($domain => "mx", sub {
101 $cb->(map $_->[4], sort { $a->[3] <=> $b->[3] } @_);
102 });
103}
104
105sub ns($$) {
106 my ($domain, $cb) = @_;
107
108 resolver->resolve ($domain => "ns", sub {
109 $cb->(map $_->[3], @_);
110 });
111}
112
113sub txt($$) {
114 my ($domain, $cb) = @_;
115
116 resolver->resolve ($domain => "txt", sub {
117 $cb->(map $_->[3], @_);
118 });
119}
120
121sub srv($$$$) {
122 my ($service, $proto, $domain, $cb) = @_;
123
124 # todo, ask for any and check glue records
125 resolver->resolve ("_$service._$proto.$domain" => "srv", sub {
126 $cb->(map [@$_[3,4,5,6]], sort { $a->[3] <=> $b->[3] || $b->[4] <=> $a->[4] } @_);
127 });
128}
129
130sub ptr($$) {
131 my ($ip, $cb) = @_;
132
133 my $name;
134
135 if (AnyEvent::Util::dotted_quad $ip) {
136 $name = join ".", (reverse split /\./, $ip), "in-addr.arpa.";
137 } else {
138 require Socket6;
139 $name = join ".",
140 (reverse split //,
141 unpack "H*", Socket6::inet_pton (Socket::AF_INET6, $ip)),
142 "ip6.arpa.";
143 }
144
145 resolver->resolve ($name => "ptr", sub {
146 $cb->(map $_->[3], @_);
147 });
148}
30 149
31=head2 DNS EN-/DECODING FUNCTIONS 150=head2 DNS EN-/DECODING FUNCTIONS
32 151
33=over 4 152=over 4
34 153
… …
42); 161);
43 162
44our %opcode_str = reverse %opcode_id; 163our %opcode_str = reverse %opcode_id;
45 164
46our %rcode_id = ( 165our %rcode_id = (
47 ok => 0, 166 noerror => 0,
48 formerr => 1, 167 formerr => 1,
49 servfail => 2, 168 servfail => 2,
50 nxdomain => 3, 169 nxdomain => 3,
51 notimp => 4, 170 notimp => 4,
52 refused => 5, 171 refused => 5,
… …
719 # advance in searchlist 838 # advance in searchlist
720 my $do_search; $do_search = sub { 839 my $do_search; $do_search = sub {
721 @search 840 @search
722 or return $cb->(); 841 or return $cb->();
723 842
724 (my $name = "$qname." . shift @search) =~ s/\.$//; 843 (my $name = lc "$qname." . shift @search) =~ s/\.$//;
725 my $depth = 2; 844 my $depth = 2;
726 845
727 # advance in cname-chain 846 # advance in cname-chain
728 my $do_req; $do_req = sub { 847 my $do_req; $do_req = sub {
729 $self->request ({ 848 $self->request ({
… …
735 854
736 my $cname; 855 my $cname;
737 856
738 while () { 857 while () {
739 # results found? 858 # results found?
740 my @rr = grep $_->[0] eq $name && ($atype{"*"} || $atype{$_->[1]}), @{ $res->{an} }; 859 my @rr = grep $name eq lc $_->[0] && ($atype{"*"} || $atype{$_->[1]}), @{ $res->{an} };
741 860
742 return $cb->(@rr) 861 return $cb->(@rr)
743 if @rr; 862 if @rr;
744 863
745 # see if there is a cname we can follow 864 # see if there is a cname we can follow
746 my @rr = grep $_->[0] eq $name && $_->[1] eq "cname", @{ $res->{an} }; 865 my @rr = grep $name eq lc $_->[0] && $_->[1] eq "cname", @{ $res->{an} };
747 866
748 if (@rr) { 867 if (@rr) {
749 $depth-- 868 $depth--
750 or return $do_search->(); # cname chain too long 869 or return $do_search->(); # cname chain too long
751 870

Diff Legend

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