[ViewVC] Diff of: cvs/AnyEvent/lib/AnyEvent/DNS.pm

Comparing AnyEvent/lib/AnyEvent/DNS.pm (file contents):
Revision 1.31 by root, Sun May 25 23:55:28 2008 UTC vs.
Revision 1.55 by root, Fri May 30 10:37:34 2008 UTC

…		…
14	=head1 DESCRIPTION	14	=head1 DESCRIPTION
15		15
16	This module offers both a number of DNS convenience functions as well	16	This module offers both a number of DNS convenience functions as well
17	as a fully asynchronous and high-performance pure-perl stub resolver.	17	as a fully asynchronous and high-performance pure-perl stub resolver.
18		18
19	The stub resolver supports DNS over UDP, optional EDNS0 support for up to	19	The stub resolver supports DNS over IPv4 and IPv6, UDP and TCP, optional
20	4kiB datagrams and automatically falls back to virtual circuit mode for	20	EDNS0 support for up to 4kiB datagrams and automatically falls back to
21	large responses.	21	virtual circuit mode for large responses.
22		22
23	=head2 CONVENIENCE FUNCTIONS	23	=head2 CONVENIENCE FUNCTIONS
24		24
25	=over 4	25	=over 4
26		26
…		…
31	no warnings;	31	no warnings;
32	use strict;	32	use strict;
33		33
34	use Socket qw(AF_INET SOCK_DGRAM SOCK_STREAM);	34	use Socket qw(AF_INET SOCK_DGRAM SOCK_STREAM);
35		35
		36	use AnyEvent ();
36	use AnyEvent::Handle ();	37	use AnyEvent::Handle ();
		38	use AnyEvent::Util qw(AF_INET6);
37		39
38	=item AnyEvent::DNS::addr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...)	40	our $VERSION = '1.0';
39		41
40	Tries to resolve the given nodename and service name into protocol families	42	our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222);
41	and sockaddr structures usable to connect to this node and service in a
42	protocol-independent way. It works remotely similar to the getaddrinfo
43	posix function.
44
45	C<$node> is either an IPv4 or IPv6 address or a hostname, C<$service> is
46	either a service name (port name from F</etc/services>) or a numerical
47	port number. If both C<$node> and C<$service> are names, then SRV records
48	will be consulted to find the real service, otherwise they will be
49	used as-is. If you know that the service name is not in your services
50	database, then you can specify the service in the format C<name=port>
51	(e.g. C<http=80>).
52
53	C<$proto> must be a protocol name, currently C<tcp>, C<udp> or
54	C<sctp>. The default is C<tcp>.
55
56	C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use
57	only IPv4) or C<6> (use only IPv6). This setting might be influenced by
58	C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.
59
60	C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or
61	C<undef> in which case it gets automatically chosen).
62
63	The callback will receive zero or more array references that contain
64	C<$family, $type, $proto> for use in C<socket> and a binary
65	C<$sockaddr> for use in C<connect> (or C<bind>).
66
67	The application should try these in the order given.
68
69	Example:
70
71	AnyEvent::DNS::addr "google.com", "http", 0, undef, undef, sub { ... };
72		43
73	=item AnyEvent::DNS::a $domain, $cb->(@addrs)	44	=item AnyEvent::DNS::a $domain, $cb->(@addrs)
74		45
75	Tries to resolve the given domain to IPv4 address(es).	46	Tries to resolve the given domain to IPv4 address(es).
76		47
…		…
97	of service records.	68	of service records.
98		69
99	Each srv_rr is an array reference with the following contents:	70	Each srv_rr is an array reference with the following contents:
100	C<[$priority, $weight, $transport, $target]>.	71	C<[$priority, $weight, $transport, $target]>.
101		72
102	They will be sorted with lowest priority, highest weight first (TODO:	73	They will be sorted with lowest priority first, then randomly
103	should use the RFC algorithm to reorder same-priority records for weight).	74	distributed by weight as per RFC 2782.
104		75
105	Example:	76	Example:
106		77
107	AnyEvent::DNS::srv "sip", "udp", "schmorp.de", sub { ...	78	AnyEvent::DNS::srv "sip", "udp", "schmorp.de", sub { ...
108	# @_ = ( [10, 10, 5060, "sip1.schmorp.de" ] )	79	# @_ = ( [10, 10, 5060, "sip1.schmorp.de" ] )
109		80
110	=item AnyEvent::DNS::ptr $ipv4_or_6, $cb->(@hostnames)	81	=item AnyEvent::DNS::ptr $domain, $cb->(@hostnames)
		82
		83	Tries to make a PTR lookup on the given domain. See C<reverse_lookup>
		84	and C<reverse_verify> if you want to resolve an IP address to a hostname
		85	instead.
		86
		87	=item AnyEvent::DNS::any $domain, $cb->(@rrs)
		88
		89	Tries to resolve the given domain and passes all resource records found to
		90	the callback.
		91
		92	=item AnyEvent::DNS::reverse_lookup $ipv4_or_6, $cb->(@hostnames)
111		93
112	Tries to reverse-resolve the given IPv4 or IPv6 address (in textual form)	94	Tries to reverse-resolve the given IPv4 or IPv6 address (in textual form)
113	into it's hostname(s).	95	into it's hostname(s). Handles V4MAPPED and V4COMPAT IPv6 addresses
		96	transparently.
		97
		98	=item AnyEvent::DNS::reverse_verify $ipv4_or_6, $cb->(@hostnames)
		99
		100	The same as C<reverse_lookup>, but does forward-lookups to verify that
		101	the resolved hostnames indeed point to the address, which makes spoofing
		102	harder.
		103
		104	If you want to resolve an address into a hostname, this is the preferred
		105	method: The DNS records could still change, but at least this function
		106	verified that the hostname, at one point in the past, pointed at the IP
		107	address you originally resolved.
114		108
115	Example:	109	Example:
116		110
117	AnyEvent::DNS::ptr "2001:500:2f::f", sub { print shift };	111	AnyEvent::DNS::ptr "2001:500:2f::f", sub { print shift };
118	# => f.root-servers.net	112	# => f.root-servers.net
119		113
120	=item AnyEvent::DNS::any $domain, $cb->(@rrs)
121
122	Tries to resolve the given domain and passes all resource records found to
123	the callback.
124
125	=cut	114	=cut
		115
		116	sub MAX_PKT() { 4096 } # max packet size we advertise and accept
		117
		118	sub DOMAIN_PORT() { 53 } # if this changes drop me a note
126		119
127	sub resolver;	120	sub resolver;
128		121
129	sub a($$) {	122	sub a($$) {
130	my ($domain, $cb) = @_;	123	my ($domain, $cb) = @_;
…		…
169	sub srv($$$$) {	162	sub srv($$$$) {
170	my ($service, $proto, $domain, $cb) = @_;	163	my ($service, $proto, $domain, $cb) = @_;
171		164
172	# todo, ask for any and check glue records	165	# todo, ask for any and check glue records
173	resolver->resolve ("_$service._$proto.$domain" => "srv", sub {	166	resolver->resolve ("_$service._$proto.$domain" => "srv", sub {
174	$cb->(map [@$_[3,4,5,6]], sort { $a->[3] <=> $b->[3] \|\| $b->[4] <=> $a->[4] } @_);	167	my @res;
		168
		169	# classify by priority
		170	my %pri;
		171	push @{ $pri{$_->[3]} }, [ @$_[3,4,5,6] ]
		172	for @_;
		173
		174	# order by priority
		175	for my $pri (sort { $a->[0] <=> $b->[0] } keys %pri) {
		176	# order by weight
		177	my @rr = sort { $a->[1] <=> $b->[1] } @{ delete $pri{$pri} };
		178
		179	my $sum; $sum += $_->[1] for @rr;
		180
		181	while (@rr) {
		182	my $w = int rand $sum + 1;
		183	for (0 .. $#rr) {
		184	if (($w -= $rr[$_][1]) <= 0) {
		185	$sum -= $rr[$_][1];
		186	push @res, splice @rr, $_, 1, ();
		187	last;
		188	}
		189	}
		190	}
		191	}
		192
		193	$cb->(@res);
175	});	194	});
176	}	195	}
177		196
178	sub ptr($$) {	197	sub ptr($$) {
		198	my ($domain, $cb) = @_;
		199
		200	resolver->resolve ($domain => "ptr", sub {
		201	$cb->(map $_->[3], @_);
		202	});
		203	}
		204
		205	sub any($$) {
		206	my ($domain, $cb) = @_;
		207
		208	resolver->resolve ($domain => "*", $cb);
		209	}
		210
		211	# convert textual ip address into reverse lookup form
		212	sub _munge_ptr($) {
		213	my $ipn = $_[0]
		214	or return;
		215
		216	my $ptr;
		217
		218	my $af = AnyEvent::Socket::address_family ($ipn);
		219
		220	if ($af == AF_INET6) {
		221	$ipn = substr $ipn, 0, 16; # anticipate future expansion
		222
		223	# handle v4mapped and v4compat
		224	if ($ipn =~ s/^\x00{10}(?:\xff\xff\|\x00\x00)//) {
		225	$af = AF_INET;
		226	} else {
		227	$ptr = join ".", (reverse split //, unpack "H32", $ipn), "ip6.arpa.";
		228	}
		229	}
		230
		231	if ($af == AF_INET) {
		232	$ptr = join ".", (reverse unpack "C4", $ipn), "in-addr.arpa.";
		233	}
		234
		235	$ptr
		236	}
		237
		238	sub reverse_lookup($$) {
179	my ($ip, $cb) = @_;	239	my ($ip, $cb) = @_;
180		240
181	$ip = AnyEvent::Socket::parse_ip ($ip)	241	$ip = _munge_ptr AnyEvent::Socket::parse_address ($ip)
182	or return $cb->();	242	or return $cb->();
183
184	if (4 == length $ip) {
185	$ip = join ".", (reverse split /\./, $ip), "in-addr.arpa.";
186	} else {
187	$ip = join ".", (reverse split //, unpack "H*", $ip), "ip6.arpa.";
188	}
189		243
190	resolver->resolve ($ip => "ptr", sub {	244	resolver->resolve ($ip => "ptr", sub {
191	$cb->(map $_->[3], @_);	245	$cb->(map $_->[3], @_);
192	});	246	});
193	}	247	}
194		248
195	sub any($$) {	249	sub reverse_verify($$) {
196	my ($domain, $cb) = @_;	250	my ($ip, $cb) = @_;
197		251
198	resolver->resolve ($domain => "*", $cb);	252	my $ipn = AnyEvent::Socket::parse_address ($ip)
199	}
200
201	#############################################################################
202
203	sub addr($$$$$$) {
204	my ($node, $service, $proto, $family, $type, $cb) = @_;
205
206	unless (&AnyEvent::Util::AF_INET6) {
207	$family != 6
208	or return $cb->();	253	or return $cb->();
209		254
210	$family \|\|= 4;	255	my $af = AnyEvent::Socket::address_family ($ipn);
211	}
212		256
213	$cb->() if $family == 4 && !$AnyEvent::PROTOCOL{ipv4};
214	$cb->() if $family == 6 && !$AnyEvent::PROTOCOL{ipv6};
215
216	$family \|\|=4 unless $AnyEvent::PROTOCOL{ipv6};
217	$family \|\|=6 unless $AnyEvent::PROTOCOL{ipv4};
218
219	$proto \|\|= "tcp";
220	$type \|\|= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
221
222	my $proton = (getprotobyname $proto)[2]
223	or Carp::croak "$proto: protocol unknown";
224
225	my $port;
226
227	if ($service =~ /^(\S+)=(\d+)$/) {
228	($service, $port) = ($1, $2);
229	} elsif ($service =~ /^\d+$/) {
230	($service, $port) = (undef, $service);
231	} else {
232	$port = (getservbyname $service, $proto)[2]
233	or Carp::croak "$service/$proto: service unknown";
234	}
235
236	my @target = [$node, $port];
237
238	# resolve a records / provide sockaddr structures
239	my $resolve = sub {
240	my @res;	257	my @res;
241	my $cv = AnyEvent->condvar (cb => sub {	258	my $cnt;
		259
		260	my $ptr = _munge_ptr $ipn
		261	or return $cb->();
		262
		263	$ip = AnyEvent::Socket::format_address ($ipn); # normalise into the same form
		264
		265	ptr $ptr, sub {
		266	for my $name (@_) {
		267	++$cnt;
242	$cb->(	268
243	map $_->[2],	269	# () around AF_INET to work around bug in 5.8
		270	resolver->resolve ("$name." => ($af == (AF_INET) ? "a" : "aaaa"), sub {
244	sort {	271	for (@_) {
245	$AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}	272	push @res, $name
246	or $a->[0] <=> $b->[0]	273	if $_->[3] eq $ip;
247	}	274	}
248	@res	275	$cb->(@res) unless --$cnt;
249	)	276	});
250	});
251
252	$cv->begin;
253	for my $idx (0 .. $#target) {
254	my ($node, $port) = @{ $target[$idx] };
255
256	if (my $noden = AnyEvent::Socket::parse_ip ($node)) {
257	if (4 == length $noden && $family != 6) {
258	push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
259	AnyEvent::Socket::pack_sockaddr ($port, $noden)]]
260	}
261
262	if (16 == length $noden && $family != 4) {
263	push @res, [$idx, "ipv6", [&AnyEvent::Util::AF_INET6, $type, $proton,
264	AnyEvent::Socket::pack_sockaddr ( $port, $noden)]]
265	}
266	} else {
267	# ipv4
268	if ($family != 6) {
269	$cv->begin;
270	a $node, sub {
271	push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
272	AnyEvent::Socket::pack_sockaddr ($port, AnyEvent::Socket::parse_ipv4 ($_))]]
273	for @_;
274	$cv->end;
275	};
276	}
277
278	# ipv6
279	if ($family != 4) {
280	$cv->begin;
281	aaaa $node, sub {
282	push @res, [$idx, "ipv6", [&AnyEvent::Socket::AF_INET6, $type, $proton,
283	AnyEvent::Socket::pack_sockaddr ($port, AnyEvent::Socket::parse_ipv6 ($_))]]
284	for @_;
285	$cv->end;
286	};
287	}
288	}
289	}	277	}
290	$cv->end;	278
		279	$cb->() unless $cnt;
291	};	280	};
292
293	# try srv records, if applicable
294	if ($node eq "localhost") {
295	@target = (["127.0.0.1", $port], ["::1", $port]);
296	&$resolve;
297	} elsif (defined $service && !AnyEvent::Socket::parse_ip ($node)) {
298	srv $service, $proto, $node, sub {
299	my (@srv) = @_;
300
301	# no srv records, continue traditionally
302	@srv
303	or return &$resolve;
304
305	# only srv record has "." => abort
306	$srv[0][2] ne "." \|\| $#srv
307	or return $cb->();
308
309	# use srv records then
310	@target = map ["$_->[3].", $_->[2]],
311	grep $_->[3] ne ".",
312	@srv;
313
314	&$resolve;
315	};
316	} else {
317	&$resolve;
318	}
319	}	281	}
320		282
321	#############################################################################	283	#################################################################################
322		284
323	=back	285	=back
324		286
325	=head2 LOW-LEVEL DNS EN-/DECODING FUNCTIONS	287	=head2 LOW-LEVEL DNS EN-/DECODING FUNCTIONS
326		288
…		…
328		290
329	=item $AnyEvent::DNS::EDNS0	291	=item $AnyEvent::DNS::EDNS0
330		292
331	This variable decides whether dns_pack automatically enables EDNS0	293	This variable decides whether dns_pack automatically enables EDNS0
332	support. By default, this is disabled (C<0>), unless overridden by	294	support. By default, this is disabled (C<0>), unless overridden by
333	C<$ENV{PERL_ANYEVENT_EDNS0>), but when set to C<1>, AnyEvent::DNS will use	295	C<$ENV{PERL_ANYEVENT_EDNS0}>, but when set to C<1>, AnyEvent::DNS will use
334	EDNS0 in all requests.	296	EDNS0 in all requests.
335		297
336	=cut	298	=cut
337		299
338	our $EDNS0 = $ENV{PERL_ANYEVENT_EDNS0} * 1; # set to 1 to enable (partial) edns0	300	our $EDNS0 = $ENV{PERL_ANYEVENT_EDNS0} * 1; # set to 1 to enable (partial) edns0
…		…
389	minfo => 14,	351	minfo => 14,
390	mx => 15,	352	mx => 15,
391	txt => 16,	353	txt => 16,
392	aaaa => 28,	354	aaaa => 28,
393	srv => 33,	355	srv => 33,
		356	naptr => 35, # rfc2915
394	opt => 41,	357	opt => 41,
395	spf => 99,	358	spf => 99,
396	tkey => 249,	359	tkey => 249,
397	tsig => 250,	360	tsig => 250,
398	ixfr => 251,	361	ixfr => 251,
…		…
411	"*" => 255,	374	"*" => 255,
412	);	375	);
413		376
414	our %class_str = reverse %class_id;	377	our %class_str = reverse %class_id;
415		378
416	# names MUST have a trailing dot
417	sub _enc_qname($) {	379	sub _enc_name($) {
418	pack "(C/a)", (split /\./, shift), ""	380	pack "(C/a)", (split /\./, shift), ""
419	}	381	}
420		382
421	sub _enc_qd() {	383	sub _enc_qd() {
422	(_enc_qname $_->[0]) . pack "nn",	384	(_enc_name $_->[0]) . pack "nn",
423	($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}),	385	($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}),
424	($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] \|\| "in"})	386	($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] \|\| "in"})
425	}	387	}
426		388
427	sub _enc_rr() {	389	sub _enc_rr() {
428	die "encoding of resource records is not supported";	390	die "encoding of resource records is not supported";
429	}	391	}
430		392
431	=item $pkt = AnyEvent::DNS::dns_pack $dns	393	=item $pkt = AnyEvent::DNS::dns_pack $dns
432		394
433	Packs a perl data structure into a DNS packet. Reading RFC1034 is strongly	395	Packs a perl data structure into a DNS packet. Reading RFC 1035 is strongly
434	recommended, then everything will be totally clear. Or maybe not.	396	recommended, then everything will be totally clear. Or maybe not.
435		397
436	Resource records are not yet encodable.	398	Resource records are not yet encodable.
437		399
438	Examples:	400	Examples:
…		…
481	+ $rcode_id{$req->{rc}} * 0x0001,	443	+ $rcode_id{$req->{rc}} * 0x0001,
482		444
483	scalar @{ $req->{qd} \|\| [] },	445	scalar @{ $req->{qd} \|\| [] },
484	scalar @{ $req->{an} \|\| [] },	446	scalar @{ $req->{an} \|\| [] },
485	scalar @{ $req->{ns} \|\| [] },	447	scalar @{ $req->{ns} \|\| [] },
486	$EDNS0 + scalar @{ $req->{ar} \|\| [] }, # include EDNS0 option here	448	$EDNS0 + scalar @{ $req->{ar} \|\| [] }, # EDNS0 option included here
487		449
488	(join "", map _enc_qd, @{ $req->{qd} \|\| [] }),	450	(join "", map _enc_qd, @{ $req->{qd} \|\| [] }),
489	(join "", map _enc_rr, @{ $req->{an} \|\| [] }),	451	(join "", map _enc_rr, @{ $req->{an} \|\| [] }),
490	(join "", map _enc_rr, @{ $req->{ns} \|\| [] }),	452	(join "", map _enc_rr, @{ $req->{ns} \|\| [] }),
491	(join "", map _enc_rr, @{ $req->{ar} \|\| [] }),	453	(join "", map _enc_rr, @{ $req->{ar} \|\| [] }),
492		454
493	($EDNS0 ? pack "C nnNn", 0, 41, 4096, 0, 0 : "") # EDNS0, 4kiB udp payload size	455	($EDNS0 ? pack "C nnNn", 0, 41, MAX_PKT, 0, 0 : "") # EDNS0 option
494	}	456	}
495		457
496	our $ofs;	458	our $ofs;
497	our $pkt;	459	our $pkt;
498		460
499	# bitches	461	# bitches
500	sub _dec_qname {	462	sub _dec_name {
501	my @res;	463	my @res;
502	my $redir;	464	my $redir;
503	my $ptr = $ofs;	465	my $ptr = $ofs;
504	my $cnt;	466	my $cnt;
505		467
506	while () {	468	while () {
507	return undef if ++$cnt >= 256; # to avoid DoS attacks	469	return undef if ++$cnt >= 256; # to avoid DoS attacks
508		470
509	my $len = ord substr $pkt, $ptr++, 1;	471	my $len = ord substr $pkt, $ptr++, 1;
510		472
511	if ($len & 0xc0) {	473	if ($len >= 0xc0) {
512	$ptr++;	474	$ptr++;
513	$ofs = $ptr if $ptr > $ofs;	475	$ofs = $ptr if $ptr > $ofs;
514	$ptr = (unpack "n", substr $pkt, $ptr - 2, 2) & 0x3fff;	476	$ptr = (unpack "n", substr $pkt, $ptr - 2, 2) & 0x3fff;
515	} elsif ($len) {	477	} elsif ($len) {
516	push @res, substr $pkt, $ptr, $len;	478	push @res, substr $pkt, $ptr, $len;
…		…
521	}	483	}
522	}	484	}
523	}	485	}
524		486
525	sub _dec_qd {	487	sub _dec_qd {
526	my $qname = _dec_qname;	488	my $qname = _dec_name;
527	my ($qt, $qc) = unpack "nn", substr $pkt, $ofs; $ofs += 4;	489	my ($qt, $qc) = unpack "nn", substr $pkt, $ofs; $ofs += 4;
528	[$qname, $type_str{$qt} \|\| $qt, $class_str{$qc} \|\| $qc]	490	[$qname, $type_str{$qt} \|\| $qt, $class_str{$qc} \|\| $qc]
529	}	491	}
530		492
531	our %dec_rr = (	493	our %dec_rr = (
532	1 => sub { join ".", unpack "C4", $_ }, # a	494	1 => sub { join ".", unpack "C4", $_ }, # a
533	2 => sub { local $ofs = $ofs - length; _dec_qname }, # ns	495	2 => sub { local $ofs = $ofs - length; _dec_name }, # ns
534	5 => sub { local $ofs = $ofs - length; _dec_qname }, # cname	496	5 => sub { local $ofs = $ofs - length; _dec_name }, # cname
535	6 => sub {	497	6 => sub {
536	local $ofs = $ofs - length;	498	local $ofs = $ofs - length;
537	my $mname = _dec_qname;	499	my $mname = _dec_name;
538	my $rname = _dec_qname;	500	my $rname = _dec_name;
539	($mname, $rname, unpack "NNNNN", substr $pkt, $ofs)	501	($mname, $rname, unpack "NNNNN", substr $pkt, $ofs)
540	}, # soa	502	}, # soa
541	11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks	503	11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks
542	12 => sub { local $ofs = $ofs - length; _dec_qname }, # ptr	504	12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr
543	13 => sub { unpack "C/a* C/a*", $_ }, # hinfo	505	13 => sub { unpack "C/a* C/a*", $_ }, # hinfo
544	15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_qname) }, # mx	506	15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx
545	16 => sub { unpack "(C/a)", $_ }, # txt	507	16 => sub { unpack "(C/a)", $_ }, # txt
546	28 => sub { AnyEvent::Socket::format_ip ($_) }, # aaaa	508	28 => sub { AnyEvent::Socket::format_address ($_) }, # aaaa
547	33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_qname) }, # srv	509	33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv
		510	35 => sub { # naptr
		511	my ($order, $preference, $flags, $service, $regexp, $offset) = unpack "nn C/a* C/a* C/a* .", $_;
		512	local $ofs = $ofs + $offset - length;
		513	($order, $preference, $flags, $service, $regexp, _dec_name)
		514	},
548	99 => sub { unpack "(C/a)", $_ }, # spf	515	99 => sub { unpack "(C/a)", $_ }, # spf
549	);	516	);
550		517
551	sub _dec_rr {	518	sub _dec_rr {
552	my $qname = _dec_qname;	519	my $name = _dec_name;
553		520
554	my ($rt, $rc, $ttl, $rdlen) = unpack "nn N n", substr $pkt, $ofs; $ofs += 10;	521	my ($rt, $rc, $ttl, $rdlen) = unpack "nn N n", substr $pkt, $ofs; $ofs += 10;
555	local $_ = substr $pkt, $ofs, $rdlen; $ofs += $rdlen;	522	local $_ = substr $pkt, $ofs, $rdlen; $ofs += $rdlen;
556		523
557	[	524	[
558	$qname,	525	$name,
559	$type_str{$rt} \|\| $rt,	526	$type_str{$rt} \|\| $rt,
560	$class_str{$rc} \|\| $rc,	527	$class_str{$rc} \|\| $rc,
561	($dec_rr{$rt} \|\| sub { $_ })->(),	528	($dec_rr{$rt} \|\| sub { $_ })->(),
562	]	529	]
563	}	530	}
…		…
701		668
702	=over 4	669	=over 4
703		670
704	=item server => [...]	671	=item server => [...]
705		672
706	A list of server addresses (default: C<v127.0.0.1>) in network format (4	673	A list of server addresses (default: C<v127.0.0.1>) in network format
707	octets for IPv4, 16 octets for IPv6 - not yet supported).	674	(i.e. as returned by C<AnyEvent::Socket::parse_address> - both IPv4 and
		675	IPv6 are supported).
708		676
709	=item timeout => [...]	677	=item timeout => [...]
710		678
711	A list of timeouts to use (also determines the number of retries). To make	679	A list of timeouts to use (also determines the number of retries). To make
712	three retries with individual time-outs of 2, 5 and 5 seconds, use C<[2,	680	three retries with individual time-outs of 2, 5 and 5 seconds, use C<[2,
…		…
721	The number of dots (default: C<1>) that a name must have so that the resolver	689	The number of dots (default: C<1>) that a name must have so that the resolver
722	tries to resolve the name without any suffixes first.	690	tries to resolve the name without any suffixes first.
723		691
724	=item max_outstanding => $integer	692	=item max_outstanding => $integer
725		693
726	Most name servers do not handle many parallel requests very well. This option	694	Most name servers do not handle many parallel requests very well. This
727	limits the number of outstanding requests to C<$n> (default: C<10>), that means	695	option limits the number of outstanding requests to C<$integer>
728	if you request more than this many requests, then the additional requests will be queued	696	(default: C<10>), that means if you request more than this many requests,
729	until some other requests have been resolved.	697	then the additional requests will be queued until some other requests have
		698	been resolved.
730		699
731	=item reuse => $seconds	700	=item reuse => $seconds
732		701
733	The number of seconds (default: C<300>) that a query id cannot be re-used	702	The number of seconds (default: C<300>) that a query id cannot be re-used
734	after a timeout. If there as no time-out then query id's can be reused	703	after a timeout. If there was no time-out then query ids can be reused
735	immediately.	704	immediately.
736		705
737	=back	706	=back
738		707
739	=cut	708	=cut
740		709
741	sub new {	710	sub new {
742	my ($class, %arg) = @_;	711	my ($class, %arg) = @_;
743		712
		713	# try to create a ipv4 and an ipv6 socket
		714	# only fail when we cnanot create either
		715
744	socket my $fh, AF_INET, &Socket::SOCK_DGRAM, 0	716	socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0;
745	or Carp::croak "socket: $!";	717	socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0;
746		718
747	AnyEvent::Util::fh_nonblocking $fh, 1;	719	$fh4 \|\| $fh6
		720	or Carp::croak "unable to create either an IPv6 or an IPv4 socket";
748		721
749	my $self = bless {	722	my $self = bless {
750	server => [v127.0.0.1],	723	server => [],
751	timeout => [2, 5, 5],	724	timeout => [2, 5, 5],
752	search => [],	725	search => [],
753	ndots => 1,	726	ndots => 1,
754	max_outstanding => 10,	727	max_outstanding => 10,
755	reuse => 300, # reuse id's after 5 minutes only, if possible	728	reuse => 300,
756	%arg,	729	%arg,
757	fh => $fh,
758	reuse_q => [],	730	reuse_q => [],
759	}, $class;	731	}, $class;
760		732
761	# search should default to gethostname's domain	733	# search should default to gethostname's domain
762	# but perl lacks a good posix module	734	# but perl lacks a good posix module
763		735
764	Scalar::Util::weaken (my $wself = $self);	736	Scalar::Util::weaken (my $wself = $self);
		737
		738	if ($fh4) {
		739	AnyEvent::Util::fh_nonblocking $fh4, 1;
		740	$self->{fh4} = $fh4;
765	$self->{rw} = AnyEvent->io (fh => $fh, poll => "r", cb => sub { $wself->_recv });	741	$self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub {
		742	if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) {
		743	$wself->_recv ($pkt, $peer);
		744	}
		745	});
		746	}
		747
		748	if ($fh6) {
		749	$self->{fh6} = $fh6;
		750	AnyEvent::Util::fh_nonblocking $fh6, 1;
		751	$self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub {
		752	if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) {
		753	$wself->_recv ($pkt, $peer);
		754	}
		755	});
		756	}
766		757
767	$self->_compile;	758	$self->_compile;
768		759
769	$self	760	$self
770	}	761	}
…		…
792	for (split /\n/, $resolvconf) {	783	for (split /\n/, $resolvconf) {
793	if (/^\s*#/) {	784	if (/^\s*#/) {
794	# comment	785	# comment
795	} elsif (/^\snameserver\s+(\S+)\s$/i) {	786	} elsif (/^\snameserver\s+(\S+)\s$/i) {
796	my $ip = $1;	787	my $ip = $1;
797	if (my $ipn = AnyEvent::Socket::parse_ip ($ip)) {	788	if (my $ipn = AnyEvent::Socket::parse_address ($ip)) {
798	push @{ $self->{server} }, $ipn;	789	push @{ $self->{server} }, $ipn;
799	} else {	790	} else {
800	warn "nameserver $ip invalid and ignored\n";	791	warn "nameserver $ip invalid and ignored\n";
801	}	792	}
802	} elsif (/^\sdomain\s+(\S)\s+$/i) {	793	} elsif (/^\sdomain\s+(\S)\s+$/i) {
…		…
834	=cut	825	=cut
835		826
836	sub os_config {	827	sub os_config {
837	my ($self) = @_;	828	my ($self) = @_;
838		829
839	if ($^O =~ /mswin32\|cygwin/i) {	830	$self->{server} = [];
840	# yeah, it suxx... lets hope DNS is DNS in all locales	831	$self->{search} = [];
		832
		833	if (AnyEvent::WIN32 \|\| $^O =~ /cygwin/i) {
		834	no strict 'refs';
		835
		836	# there are many options to find the current nameservers etc. on windows
		837	# all of them don't work consistently:
		838	# - the registry thing needs separate code on win32 native vs. cygwin
		839	# - the registry layout differs between windows versions
		840	# - calling windows api functions doesn't work on cygwin
		841	# - ipconfig uses locale-specific messages
		842
		843	# we use ipconfig parsing because, despite all its brokenness,
		844	# it seems most stable in practise.
		845	# for good measure, we append a fallback nameserver to our list.
841		846
842	if (open my $fh, "ipconfig /all \|") {	847	if (open my $fh, "ipconfig /all \|") {
843	delete $self->{server};	848	# parsing strategy: we go through the output and look for
844	delete $self->{search};	849	# :-lines with DNS in them. everything in those is regarded as
		850	# either a nameserver (if it parses as an ip address), or a suffix
		851	# (all else).
845		852
		853	my $dns;
846	while (<$fh>) {	854	while (<$fh>) {
847	# first DNS.* is suffix list	855	if (s/^\s.\bdns\b.://i) {
848	if (/^\s*DNS/) {	856	$dns = 1;
849	while (/\s+([[:alnum:].\-]+)\s*$/) {	857	} elsif (/^\S/ \|\| /^\s[^:]{16,}: /) {
		858	$dns = 0;
		859	}
		860	if ($dns && /^\s(\S+)\s$/) {
		861	my $s = $1;
		862	$s =~ s/%\d+(?!\S)//; # get rid of ipv6 scope id
		863	if (my $ipn = AnyEvent::Socket::parse_address ($s)) {
		864	push @{ $self->{server} }, $ipn;
		865	} else {
850	push @{ $self->{search} }, $1;	866	push @{ $self->{search} }, $s;
851	$_ = <$fh>;
852	}	867	}
853	last;
854	}	868	}
855	}	869	}
856		870
857	while (<$fh>) {	871	# always add one fallback server
858	# second DNS.* is server address list	872	push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK];
859	if (/^\s*DNS/) {
860	while (/\s+(\d+\.\d+\.\d+\.\d+)\s*$/) {
861	my $ipn = AnyEvent::Socket::parse_ip ("$1"); # "" is necessary here, apparently
862	push @{ $self->{server} }, $ipn
863	if $ipn;
864	$_ = <$fh>;
865	}
866	last;
867	}
868	}
869		873
870	$self->_compile;	874	$self->_compile;
871	}	875	}
872	} else {	876	} else {
873	# try resolv.conf everywhere	877	# try resolv.conf everywhere
…		…
877	$self->parse_resolv_conf (<$fh>);	881	$self->parse_resolv_conf (<$fh>);
878	}	882	}
879	}	883	}
880	}	884	}
881		885
		886	=item $resolver->timeout ($timeout, ...)
		887
		888	Sets the timeout values. See the C<timeout> constructor argument (and note
		889	that this method uses the values itself, not an array-reference).
		890
		891	=cut
		892
		893	sub timeout {
		894	my ($self, @timeout) = @_;
		895
		896	$self->{timeout} = \@timeout;
		897	$self->_compile;
		898	}
		899
		900	=item $resolver->max_outstanding ($nrequests)
		901
		902	Sets the maximum number of outstanding requests to C<$nrequests>. See the
		903	C<max_outstanding> constructor argument.
		904
		905	=cut
		906
		907	sub max_outstanding {
		908	my ($self, $max) = @_;
		909
		910	$self->{max_outstanding} = $max;
		911	$self->_scheduler;
		912	}
		913
882	sub _compile {	914	sub _compile {
883	my $self = shift;	915	my $self = shift;
		916
		917	my %search; $self->{search} = [grep 0 < length, grep !$search{$_}++, @{ $self->{search} }];
		918	my %server; $self->{server} = [grep 0 < length, grep !$server{$_}++, @{ $self->{server} }];
		919
		920	unless (@{ $self->{server} }) {
		921	# use 127.0.0.1 by default, and one opendns nameserver as fallback
		922	$self->{server} = [v127.0.0.1, $DNS_FALLBACK[rand @DNS_FALLBACK]];
		923	}
884		924
885	my @retry;	925	my @retry;
886		926
887	for my $timeout (@{ $self->{timeout} }) {	927	for my $timeout (@{ $self->{timeout} }) {
888	for my $server (@{ $self->{server} }) {	928	for my $server (@{ $self->{server} }) {
…		…
906	$NOW = time;	946	$NOW = time;
907	$id->[1]->($res);	947	$id->[1]->($res);
908	}	948	}
909		949
910	sub _recv {	950	sub _recv {
911	my ($self) = @_;	951	my ($self, $pkt, $peer) = @_;
912		952
913	while (my $peer = recv $self->{fh}, my $res, 4096, 0) {	953	# we ignore errors (often one gets port unreachable, but there is
		954	# no good way to take advantage of that.
		955
914	my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer);	956	my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer);
915		957
916	return unless $port == 53 && grep $_ eq $host, @{ $self->{server} };	958	return unless $port == 53 && grep $_ eq $host, @{ $self->{server} };
917		959
918	$self->_feed ($res);	960	$self->_feed ($pkt);
919	}
920	}	961	}
921		962
922	sub _free_id {	963	sub _free_id {
923	my ($self, $id, $timeout) = @_;	964	my ($self, $id, $timeout) = @_;
924		965
…		…
960	}), sub {	1001	}), sub {
961	my ($res) = @_;	1002	my ($res) = @_;
962		1003
963	if ($res->{tc}) {	1004	if ($res->{tc}) {
964	# success, but truncated, so use tcp	1005	# success, but truncated, so use tcp
965	AnyEvent::Socket::tcp_connect ((Socket::inet_ntoa $server), 53, sub {	1006	AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub {
		1007	return unless $do_retry; # some other request could have invalidated us already
		1008
966	my ($fh) = @_	1009	my ($fh) = @_
967	or return &$do_retry;	1010	or return &$do_retry;
968		1011
969	my $handle = new AnyEvent::Handle	1012	my $handle; $handle = new AnyEvent::Handle
970	fh => $fh,	1013	fh => $fh,
		1014	timeout => $timeout,
971	on_error => sub {	1015	on_error => sub {
		1016	undef $handle;
		1017	return unless $do_retry; # some other request could have invalidated us already
972	# failure, try next	1018	# failure, try next
973	&$do_retry;	1019	&$do_retry;
974	};	1020	};
975		1021
976	$handle->push_write (pack "n/a", $req->[0]);	1022	$handle->push_write (pack "n/a", $req->[0]);
977	$handle->push_read (chunk => 2, sub {	1023	$handle->push_read (chunk => 2, sub {
978	$handle->unshift_read (chunk => (unpack "n", $_[1]), sub {	1024	$handle->unshift_read (chunk => (unpack "n", $_[1]), sub {
		1025	undef $handle;
979	$self->_feed ($_[1]);	1026	$self->_feed ($_[1]);
980	});	1027	});
981	});	1028	});
982	shutdown $fh, 1;
983		1029
984	}, sub { $timeout });	1030	}, sub { $timeout });
985		1031
986	} else {	1032	} else {
987	# success	1033	# success
988	$self->_free_id ($req->[2], $retry > 1);	1034	$self->_free_id ($req->[2], $retry > 1);
989	undef $do_retry; return $req->[1]->($res);	1035	undef $do_retry; return $req->[1]->($res);
990	}	1036	}
991	}];	1037	}];
		1038
		1039	my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server);
992		1040
993	send $self->{fh}, $req->[0], 0, AnyEvent::Socket::pack_sockaddr (53, $server);	1041	my $fh = AF_INET == Socket::sockaddr_family ($sa)
		1042	? $self->{fh4} : $self->{fh6}
		1043	or return &$do_retry;
		1044
		1045	send $fh, $req->[0], 0, $sa;
994	};	1046	};
995		1047
996	&$do_retry;	1048	&$do_retry;
997	}	1049	}
998		1050
999	sub _scheduler {	1051	sub _scheduler {
1000	my ($self) = @_;	1052	my ($self) = @_;
		1053
		1054	no strict 'refs';
1001		1055
1002	$NOW = time;	1056	$NOW = time;
1003		1057
1004	# first clear id reuse queue	1058	# first clear id reuse queue
1005	delete $self->{id}{ (shift @{ $self->{reuse_q} })->[1] }	1059	delete $self->{id}{ (shift @{ $self->{reuse_q} })->[1] }
…		…
1014	$self->_scheduler;	1068	$self->_scheduler;
1015	});	1069	});
1016	last;	1070	last;
1017	}	1071	}
1018		1072
1019	my $req = shift @{ $self->{queue} }	1073	if (my $req = shift @{ $self->{queue} }) {
1020	or last;	1074	# found a request in the queue, execute it
1021
1022	while () {	1075	while () {
1023	$req->[2] = int rand 65536;	1076	$req->[2] = int rand 65536;
1024	last unless exists $self->{id}{$req->[2]};	1077	last unless exists $self->{id}{$req->[2]};
		1078	}
		1079
		1080	++$self->{outstanding};
		1081	$self->{id}{$req->[2]} = 1;
		1082	substr $req->[0], 0, 2, pack "n", $req->[2];
		1083
		1084	$self->_exec ($req);
		1085
		1086	} elsif (my $cb = shift @{ $self->{wait} }) {
		1087	# found a wait_for_slot callback, call that one first
		1088	$cb->($self);
		1089
		1090	} else {
		1091	# nothing to do, just exit
		1092	last;
1025	}	1093	}
1026
1027	++$self->{outstanding};
1028	$self->{id}{$req->[2]} = 1;
1029	substr $req->[0], 0, 2, pack "n", $req->[2];
1030
1031	$self->_exec ($req);
1032	}	1094	}
1033	}	1095	}
1034		1096
1035	=item $resolver->request ($req, $cb->($res))	1097	=item $resolver->request ($req, $cb->($res))
1036		1098
		1099	This is the main low-level workhorse for sending DNS requests.
		1100
1037	Sends a single request (a hash-ref formated as specified for	1101	This function sends a single request (a hash-ref formated as specified
1038	C<dns_pack>) to the configured nameservers including	1102	for C<dns_pack>) to the configured nameservers in turn until it gets a
		1103	response. It handles timeouts, retries and automatically falls back to
		1104	virtual circuit mode (TCP) when it receives a truncated reply.
		1105
1039	retries. Calls the callback with the decoded response packet if a reply	1106	Calls the callback with the decoded response packet if a reply was
1040	was received, or no arguments on timeout.	1107	received, or no arguments in case none of the servers answered.
1041		1108
1042	=cut	1109	=cut
1043		1110
1044	sub request($$) {	1111	sub request($$) {
1045	my ($self, $req, $cb) = @_;	1112	my ($self, $req, $cb) = @_;
…		…
1048	$self->_scheduler;	1115	$self->_scheduler;
1049	}	1116	}
1050		1117
1051	=item $resolver->resolve ($qname, $qtype, %options, $cb->($rcode, @rr))	1118	=item $resolver->resolve ($qname, $qtype, %options, $cb->($rcode, @rr))
1052		1119
1053	Queries the DNS for the given domain name C<$qname> of type C<$qtype> (a	1120	Queries the DNS for the given domain name C<$qname> of type C<$qtype>.
1054	qtype of "*" is supported and means "any").	1121
		1122	A C<$qtype> is either a numerical query type (e.g. C<1> for A records) or
		1123	a lowercase name (you have to look at the source to see which aliases are
		1124	supported, but all types from RFC 1035, C<aaaa>, C<srv>, C<spf> and a few
		1125	more are known to this module). A C<$qtype> of "*" is supported and means
		1126	"any" record type.
1055		1127
1056	The callback will be invoked with a list of matching result records or	1128	The callback will be invoked with a list of matching result records or
1057	none on any error or if the name could not be found.	1129	none on any error or if the name could not be found.
1058		1130
1059	CNAME chains (although illegal) are followed up to a length of 8.	1131	CNAME chains (although illegal) are followed up to a length of 8.
		1132
		1133	The callback will be invoked with an result code in string form (noerror,
		1134	formerr, servfail, nxdomain, notimp, refused and so on), or numerical
		1135	form if the result code is not supported. The remaining arguments are
		1136	arraryefs of the form C<[$name, $type, $class, @data>], where C<$name> is
		1137	the domain name, C<$type> a type string or number, C<$class> a class name
		1138	and @data is resource-record-dependent data. For C<a> records, this will
		1139	be the textual IPv4 addresses, for C<ns> or C<cname> records this will be
		1140	a domain name, for C<txt> records these are all the strings and so on.
		1141
		1142	All types mentioned in RFC 1035, C<aaaa>, C<srv>, C<naptr> and C<spf> are
		1143	decoded. All resource records not known to this module will have
		1144	the raw C<rdata> field as fourth entry.
1060		1145
1061	Note that this resolver is just a stub resolver: it requires a name server	1146	Note that this resolver is just a stub resolver: it requires a name server
1062	supporting recursive queries, will not do any recursive queries itself and	1147	supporting recursive queries, will not do any recursive queries itself and
1063	is not secure when used against an untrusted name server.	1148	is not secure when used against an untrusted name server.
1064		1149
…		…
1068		1153
1069	=item search => [$suffix...]	1154	=item search => [$suffix...]
1070		1155
1071	Use the given search list (which might be empty), by appending each one	1156	Use the given search list (which might be empty), by appending each one
1072	in turn to the C<$qname>. If this option is missing then the configured	1157	in turn to the C<$qname>. If this option is missing then the configured
1073	C<ndots> and C<search> define its value. If the C<$qname> ends in a dot,	1158	C<ndots> and C<search> values define its value (depending on C<ndots>, the
1074	then the searchlist will be ignored.	1159	empty suffix will be prepended or appended to that C<search> value). If
		1160	the C<$qname> ends in a dot, then the searchlist will be ignored.
1075		1161
1076	=item accept => [$type...]	1162	=item accept => [$type...]
1077		1163
1078	Lists the acceptable result types: only result types in this set will be	1164	Lists the acceptable result types: only result types in this set will be
1079	accepted and returned. The default includes the C<$qtype> and nothing	1165	accepted and returned. The default includes the C<$qtype> and nothing
1080	else.	1166	else. If this list includes C<cname>, then CNAME-chains will not be
		1167	followed (because you asked for the CNAME record).
1081		1168
1082	=item class => "class"	1169	=item class => "class"
1083		1170
1084	Specify the query class ("in" for internet, "ch" for chaosnet and "hs" for	1171	Specify the query class ("in" for internet, "ch" for chaosnet and "hs" for
1085	hesiod are the only ones making sense). The default is "in", of course.	1172	hesiod are the only ones making sense). The default is "in", of course.
1086		1173
1087	=back	1174	=back
1088		1175
1089	Examples:	1176	Examples:
1090		1177
1091	$res->resolve ("ruth.plan9.de", "a", sub {	1178	# full example, you can paste this into perl:
1092	warn Dumper [@_];	1179	use Data::Dumper;
1093	});	1180	use AnyEvent::DNS;
		1181	AnyEvent::DNS::resolver->resolve (
		1182	"google.com", "*", my $cv = AnyEvent->condvar);
		1183	warn Dumper [$cv->recv];
1094		1184
		1185	# shortened result:
1095	[	1186	# [
		1187	# [ 'google.com', 'soa', 'in', 'ns1.google.com', 'dns-admin.google.com',
		1188	# 2008052701, 7200, 1800, 1209600, 300 ],
1096	[	1189	# [
1097	'ruth.schmorp.de',	1190	# 'google.com', 'txt', 'in',
1098	'a',	1191	# 'v=spf1 include:_netblocks.google.com ~all'
1099	'in',	1192	# ],
1100	'129.13.162.95'	1193	# [ 'google.com', 'a', 'in', '64.233.187.99' ],
		1194	# [ 'google.com', 'mx', 'in', 10, 'smtp2.google.com' ],
		1195	# [ 'google.com', 'ns', 'in', 'ns2.google.com' ],
1101	]	1196	# ]
		1197
		1198	# resolve a records:
		1199	$res->resolve ("ruth.plan9.de", "a", sub { warn Dumper [@_] });
		1200
		1201	# result:
		1202	# [
		1203	# [ 'ruth.schmorp.de', 'a', 'in', '129.13.162.95' ]
1102	]	1204	# ]
1103		1205
		1206	# resolve any records, but return only a and aaaa records:
1104	$res->resolve ("test1.laendle", "*",	1207	$res->resolve ("test1.laendle", "*",
1105	accept => ["a", "aaaa"],	1208	accept => ["a", "aaaa"],
1106	sub {	1209	sub {
1107	warn Dumper [@_];	1210	warn Dumper [@_];
1108	}	1211	}
1109	);	1212	);
1110		1213
1111	[	1214	# result:
1112	[	1215	# [
1113	'test1.laendle',	1216	# [ 'test1.laendle', 'a', 'in', '10.0.0.255' ],
1114	'a',	1217	# [ 'test1.laendle', 'aaaa', 'in', '3ffe:1900:4545:0002:0240:0000:0000:f7e1' ]
1115	'in',
1116	'10.0.0.255'
1117	],
1118	[
1119	'test1.laendle',
1120	'aaaa',
1121	'in',
1122	'3ffe:1900:4545:0002:0240:0000:0000:f7e1'
1123	]	1218	# ]
1124	]
1125		1219
1126	=cut	1220	=cut
1127		1221
1128	sub resolve($%) {	1222	sub resolve($%) {
1129	my $cb = pop;	1223	my $cb = pop;
…		…
1197	};	1291	};
1198		1292
1199	$do_search->();	1293	$do_search->();
1200	}	1294	}
1201		1295
		1296	=item $resolver->wait_for_slot ($cb->($resolver))
		1297
		1298	Wait until a free request slot is available and call the callback with the
		1299	resolver object.
		1300
		1301	A request slot is used each time a request is actually sent to the
		1302	nameservers: There are never more than C<max_outstanding> of them.
		1303
		1304	Although you can submit more requests (they will simply be queued until
		1305	a request slot becomes available), sometimes, usually for rate-limiting
		1306	purposes, it is useful to instead wait for a slot before generating the
		1307	request (or simply to know when the request load is low enough so one can
		1308	submit requests again).
		1309
		1310	This is what this method does: The callback will be called when submitting
		1311	a DNS request will not result in that request being queued. The callback
		1312	may or may not generate any requests in response.
		1313
		1314	Note that the callback will only be invoked when the request queue is
		1315	empty, so this does not play well if somebody else keeps the request queue
		1316	full at all times.
		1317
		1318	=cut
		1319
		1320	sub wait_for_slot {
		1321	my ($self, $cb) = @_;
		1322
		1323	push @{ $self->{wait} }, $cb;
		1324	$self->_scheduler;
		1325	}
		1326
1202	use AnyEvent::Socket (); # circular dependency, so do not import anything and do it at the end	1327	use AnyEvent::Socket (); # circular dependency, so do not import anything and do it at the end
1203		1328
1204	1;	1329	1;
1205		1330
1206	=back	1331	=back

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/DNS.pm (file contents): Revision 1.31 by root, Sun May 25 23:55:28 2008 UTC vs. Revision 1.55 by root, Fri May 30 10:37:34 2008 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/DNS.pm (file contents):
Revision 1.31 by root, Sun May 25 23:55:28 2008 UTC vs.
Revision 1.55 by root, Fri May 30 10:37:34 2008 UTC