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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.94 by root, Fri Jul 17 14:57:03 2009 UTC vs.
Revision 1.143 by root, Thu Mar 1 19:52:15 2012 UTC

…		…
1	=head1 NAME	1	=head1 NAME
2		2
3	AnyEvent::Socket - useful IPv4 and IPv6 stuff.	3	AnyEvent::Socket - useful IPv4 and IPv6 stuff. also unix domain sockets. and stuff.
4		4
5	=head1 SYNOPSIS	5	=head1 SYNOPSIS
6		6
7	use AnyEvent::Socket;	7	use AnyEvent::Socket;
8		8
33		33
34	=cut	34	=cut
35		35
36	package AnyEvent::Socket;	36	package AnyEvent::Socket;
37		37
38	no warnings;
39	use strict;
40
41	use Carp ();	38	use Carp ();
42	use Errno ();	39	use Errno ();
43	use Socket qw(AF_INET AF_UNIX SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR);	40	use Socket qw(AF_INET AF_UNIX SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR);
44		41
45	use AnyEvent ();	42	use AnyEvent (); BEGIN { AnyEvent::common_sense }
46	use AnyEvent::Util qw(guard fh_nonblocking AF_INET6);	43	use AnyEvent::Util qw(guard fh_nonblocking AF_INET6);
47	use AnyEvent::DNS ();	44	use AnyEvent::DNS ();
48		45
49	use base 'Exporter';	46	use base 'Exporter';
50		47
51	our @EXPORT = qw(	48	our @EXPORT = qw(
52	getprotobyname	49	getprotobyname
53	parse_hostport	50	parse_hostport format_hostport
54	parse_ipv4 parse_ipv6	51	parse_ipv4 parse_ipv6
55	parse_ip parse_address	52	parse_ip parse_address
56	format_ipv4 format_ipv6	53	format_ipv4 format_ipv6
57	format_ip format_address	54	format_ip format_address
58	address_family	55	address_family
59	inet_aton	56	inet_aton
60	tcp_server	57	tcp_server
61	tcp_connect	58	tcp_connect
62	);	59	);
63		60
64	our $VERSION = 4.83;	61	our $VERSION = $AnyEvent::VERSION;
65		62
66	=item $ipn = parse_ipv4 $dotted_quad	63	=item $ipn = parse_ipv4 $dotted_quad
67		64
68	Tries to parse the given dotted quad IPv4 address and return it in	65	Tries to parse the given dotted quad IPv4 address and return it in
69	octet form (or undef when it isn't in a parsable format). Supports all	66	octet form (or undef when it isn't in a parsable format). Supports all
…		…
100	forms supported by parse_ipv4). Note that scope-id's are not supported	97	forms supported by parse_ipv4). Note that scope-id's are not supported
101	(and will not parse).	98	(and will not parse).
102		99
103	This function works similarly to C<inet_pton AF_INET6, ...>.	100	This function works similarly to C<inet_pton AF_INET6, ...>.
104		101
		102	Example:
		103
		104	print unpack "H*", parse_ipv6 "2002:5345::10.0.0.1";
		105	# => 2002534500000000000000000a000001
		106
105	=cut	107	=cut
106		108
107	sub parse_ipv6($) {	109	sub parse_ipv6($) {
108	# quick test to avoid longer processing	110	# quick test to avoid longer processing
109	my $n = $_[0] =~ y/://;	111	my $n = $_[0] =~ y/://;
…		…
139		141
140	# and done	142	# and done
141	pack "n*", map hex, @h, @t	143	pack "n*", map hex, @h, @t
142	}	144	}
143		145
		146	=item $token = parse_unix $hostname
		147
		148	This fucntion exists mainly for symmetry to the other C<parse_protocol>
		149	functions - it takes a hostname and, if it is C<unix/>, it returns a
		150	special address token, otherwise C<undef>.
		151
		152	The only use for this function is probably to detect whether a hostname
		153	matches whatever AnyEvent uses for unix domain sockets.
		154
		155	=cut
		156
144	sub parse_unix($) {	157	sub parse_unix($) {
145	$_[0] eq "unix/"	158	$_[0] eq "unix/"
146	? pack "S", AF_UNIX	159	? pack "S", AF_UNIX
147	: undef	160	: undef
148		161
…		…
159	socket".	172	socket".
160		173
161	If the C<$text> to parse is a mapped IPv4 in IPv6 address (:ffff::<ipv4>),	174	If the C<$text> to parse is a mapped IPv4 in IPv6 address (:ffff::<ipv4>),
162	then it will be treated as an IPv4 address. If you don't want that, you	175	then it will be treated as an IPv4 address. If you don't want that, you
163	have to call C<parse_ipv4> and/or C<parse_ipv6> manually.	176	have to call C<parse_ipv4> and/or C<parse_ipv6> manually.
		177
		178	Example:
		179
		180	print unpack "H*", parse_address "10.1.2.3";
		181	# => 0a010203
164		182
165	=item $ipn = AnyEvent::Socket::aton $ip	183	=item $ipn = AnyEvent::Socket::aton $ip
166		184
167	Same as C<parse_address>, but not exported (think C<Socket::inet_aton> but	185	Same as C<parse_address>, but not exported (think C<Socket::inet_aton> but
168	I<without> name resolution).	186	I<without> name resolution).
…		…
186		204
187	Works like the builtin function of the same name, except it tries hard to	205	Works like the builtin function of the same name, except it tries hard to
188	work even on broken platforms (well, that's windows), where getprotobyname	206	work even on broken platforms (well, that's windows), where getprotobyname
189	is traditionally very unreliable.	207	is traditionally very unreliable.
190		208
		209	Example: get the protocol number for TCP (usually 6)
		210
		211	my $proto = getprotobyname "tcp";
		212
191	=cut	213	=cut
192		214
193	# microsoft can't even get getprotobyname working (the etc/protocols file	215	# microsoft can't even get getprotobyname working (the etc/protocols file
194	# gets lost fairly often on windows), so we have to hardcode some common	216	# gets lost fairly often on windows), so we have to hardcode some common
195	# protocol numbers ourselves.	217	# protocol numbers ourselves.
…		…
218	This function tries to do this job in a better way, it supports the	240	This function tries to do this job in a better way, it supports the
219	following formats, where C<port> can be a numerical port number of a	241	following formats, where C<port> can be a numerical port number of a
220	service name, or a C<name=port> string, and the C< port> and C<:port>	242	service name, or a C<name=port> string, and the C< port> and C<:port>
221	parts are optional. Also, everywhere where an IP address is supported	243	parts are optional. Also, everywhere where an IP address is supported
222	a hostname or unix domain socket address is also supported (see	244	a hostname or unix domain socket address is also supported (see
223	C<parse_unix>).	245	C<parse_unix>), and strings starting with C</> will also be interpreted as
		246	unix domain sockets.
224		247
225	hostname:port e.g. "www.linux.org", "www.x.de:443", "www.x.de:https=443"	248	hostname:port e.g. "www.linux.org", "www.x.de:443", "www.x.de:https=443",
226	ipv4:port e.g. "198.182.196.56", "127.1:22"	249	ipv4:port e.g. "198.182.196.56", "127.1:22"
227	ipv6 e.g. "::1", "affe::1"	250	ipv6 e.g. "::1", "affe::1"
228	[ipv4or6]:port e.g. "[::1]", "[10.0.1]:80"	251	[ipv4or6]:port e.g. "[::1]", "[10.0.1]:80"
229	[ipv4or6] port e.g. "[127.0.0.1]", "[www.x.org] 17"	252	[ipv4or6] port e.g. "[127.0.0.1]", "[www.x.org] 17"
230	ipv4or6 port e.g. "::1 443", "10.0.0.1 smtp"	253	ipv4or6 port e.g. "::1 443", "10.0.0.1 smtp"
		254	unix/:path e.g. "unix/:/path/to/socket"
		255	/path e.g. "/path/to/socket"
231		256
232	It also supports defaulting the service name in a simple way by using	257	It also supports defaulting the service name in a simple way by using
233	C<$default_service> if no service was detected. If neither a service was	258	C<$default_service> if no service was detected. If neither a service was
234	detected nor a default was specified, then this function returns the	259	detected nor a default was specified, then this function returns the
235	empty list. The same happens when a parse error weas detected, such as a	260	empty list. The same happens when a parse error was detected, such as a
236	hostname with a colon in it (the function is rather conservative, though).	261	hostname with a colon in it (the function is rather conservative, though).
237		262
238	Example:	263	Example:
239		264
240	print join ",", parse_hostport "localhost:443";	265	print join ",", parse_hostport "localhost:443";
…		…
244	# => "localhost,https"	269	# => "localhost,https"
245		270
246	print join ",", parse_hostport "[::1]";	271	print join ",", parse_hostport "[::1]";
247	# => "," (empty list)	272	# => "," (empty list)
248		273
		274	print join ",", parse_host_port "/tmp/debug.sock";
		275	# => "unix/", "/tmp/debug.sock"
		276
249	=cut	277	=cut
250		278
251	sub parse_hostport($;$) {	279	sub parse_hostport($;$) {
252	my ($host, $port);	280	my ($host, $port);
253		281
254	for ("$_[0]") { # work on a copy, just in case, and also reset pos	282	for ("$_[0]") { # work on a copy, just in case, and also reset pos
		283
		284	# shortcut for /path
		285	return ("unix/", $_)
		286	if m%^/%;
255		287
256	# parse host, special cases: "ipv6" or "ipv6 port"	288	# parse host, special cases: "ipv6" or "ipv6 port"
257	unless (	289	unless (
258	($host) = /^\s* ([0-9a-fA-F:]:[0-9a-fA-F:]:[0-9a-fA-F\.:]*)/xgc	290	($host) = /^\s* ([0-9a-fA-F:]:[0-9a-fA-F:]:[0-9a-fA-F\.:]*)/xgc
259	and parse_ipv6 $host	291	and parse_ipv6 $host
…		…
275	} elsif (/\G\s*$/gc && length $_[1]) {	307	} elsif (/\G\s*$/gc && length $_[1]) {
276	$port = $_[1];	308	$port = $_[1];
277	} else {	309	} else {
278	return;	310	return;
279	}	311	}
		312
280	}	313	}
281		314
282	# hostnames must not contain :'s	315	# hostnames must not contain :'s
283	return if $host =~ /:/ && !parse_ipv6 $host;	316	return if $host =~ /:/ && !parse_ipv6 $host;
284		317
285	($host, $port)	318	($host, $port)
		319	}
		320
		321	=item $string = format_hostport $host, $port
		322
		323	Takes a host (in textual form) and a port and formats in unambigiously in
		324	a way that C<parse_hostport> can parse it again. C<$port> can be C<undef>.
		325
		326	=cut
		327
		328	sub format_hostport($;$) {
		329	my ($host, $port) = @_;
		330
		331	$port = ":$port" if length $port;
		332	$host = "[$host]" if $host =~ /:/;
		333
		334	"$host$port"
286	}	335	}
287		336
288	=item $sa_family = address_family $ipn	337	=item $sa_family = address_family $ipn
289		338
290	Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :)	339	Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :)
…		…
326		375
327	If the C<$ipn> is a mapped IPv4 in IPv6 address (:ffff::<ipv4>), then just	376	If the C<$ipn> is a mapped IPv4 in IPv6 address (:ffff::<ipv4>), then just
328	the contained IPv4 address will be returned. If you do not want that, you	377	the contained IPv4 address will be returned. If you do not want that, you
329	have to call C<format_ipv6> manually.	378	have to call C<format_ipv6> manually.
330		379
		380	Example:
		381
		382	print format_address "\x01\x02\x03\x05";
		383	=> 1.2.3.5
		384
331	=item $text = AnyEvent::Socket::ntoa $ipn	385	=item $text = AnyEvent::Socket::ntoa $ipn
332		386
333	Same as format_address, but not exported (think C<inet_ntoa>).	387	Same as format_address, but not exported (think C<inet_ntoa>).
334		388
335	=cut	389	=cut
…		…
337	sub format_ipv4($) {	391	sub format_ipv4($) {
338	join ".", unpack "C4", $_[0]	392	join ".", unpack "C4", $_[0]
339	}	393	}
340		394
341	sub format_ipv6($) {	395	sub format_ipv6($) {
		396	if ($_[0] =~ /^\x00\x00\x00\x00\x00\x00\x00\x00/) {
342	if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) {	397	if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) {
343	return "::";	398	return "::";
344	} elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) {	399	} elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) {
345	return "::1";	400	return "::1";
346	} elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {	401	} elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {
347	# v4compatible	402	# v4compatible
348	return "::" . format_ipv4 substr $_[0], 12;	403	return "::" . format_ipv4 substr $_[0], 12;
349	} elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {	404	} elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {
350	# v4mapped	405	# v4mapped
351	return "::ffff:" . format_ipv4 substr $_[0], 12;	406	return "::ffff:" . format_ipv4 substr $_[0], 12;
352	} elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) {	407	} elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) {
353	# v4translated	408	# v4translated
354	return "::ffff:0:" . format_ipv4 substr $_[0], 12;	409	return "::ffff:0:" . format_ipv4 substr $_[0], 12;
355	} else {	410	}
		411	}
		412
356	my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];	413	my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
357		414
358	# this is rather sucky, I admit	415	# this is admittedly rather sucky
359	$ip =~ s/^0:(?:0:)*(0$)?/::/	416	$ip =~ s/(?:^\|:) 0:0:0:0:0:0:0 (?:$\|:)/::/x
360	or $ip =~ s/(:0){7}$/::/ or $ip =~ s/(:0){7}/:/	417	or $ip =~ s/(?:^\|:) 0:0:0:0:0:0 (?:$\|:)/::/x
361	or $ip =~ s/(:0){6}$/::/ or $ip =~ s/(:0){6}/:/	418	or $ip =~ s/(?:^\|:) 0:0:0:0:0 (?:$\|:)/::/x
362	or $ip =~ s/(:0){5}$/::/ or $ip =~ s/(:0){5}/:/	419	or $ip =~ s/(?:^\|:) 0:0:0:0 (?:$\|:)/::/x
363	or $ip =~ s/(:0){4}$/::/ or $ip =~ s/(:0){4}/:/	420	or $ip =~ s/(?:^\|:) 0:0:0 (?:$\|:)/::/x
364	or $ip =~ s/(:0){3}$/::/ or $ip =~ s/(:0){3}/:/	421	or $ip =~ s/(?:^\|:) 0:0 (?:$\|:)/::/x
365	or $ip =~ s/(:0){2}$/::/ or $ip =~ s/(:0){2}/:/	422	or $ip =~ s/(?:^\|:) 0 (?:$\|:)/::/x;
366	or $ip =~ s/(:0){1}$/::/ or $ip =~ s/(:0){1}/:/;	423
367	return $ip	424	$ip
368	}
369	}	425	}
370		426
371	sub format_address($) {	427	sub format_address($) {
372	my $af = address_family $_[0];	428	if (4 == length $_[0]) {
373	if ($af == AF_INET) {
374	return &format_ipv4;	429	return &format_ipv4;
375	} elsif ($af == AF_INET6) {	430	} elsif (16 == length $_[0]) {
376	return (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12)	431	return $_[0] =~ /^\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff(....)$/s
377	? format_ipv4 substr $_[0], 12	432	? format_ipv4 $1
378	: &format_ipv6;	433	: &format_ipv6;
379	} elsif ($af == AF_UNIX) {	434	} elsif (AF_UNIX == address_family $_[0]) {
380	return "unix/"	435	return "unix/"
381	} else {	436	} else {
382	return undef	437	return undef
383	}	438	}
384	}	439	}
…		…
386	*ntoa = \&format_address;	441	*ntoa = \&format_address;
387		442
388	=item inet_aton $name_or_address, $cb->(@addresses)	443	=item inet_aton $name_or_address, $cb->(@addresses)
389		444
390	Works similarly to its Socket counterpart, except that it uses a	445	Works similarly to its Socket counterpart, except that it uses a
391	callback. Also, if a host has only an IPv6 address, this might be passed	446	callback. Use the length to distinguish between ipv4 and ipv6 (4 octets
392	to the callback instead (use the length to detect this - 4 for IPv4, 16	447	for IPv4, 16 for IPv6), or use C<format_address> to convert it to a more
393	for IPv6).	448	readable format.
394		449
395	Unlike the L<Socket> function of the same name, you can get multiple IPv4	450	Note that C<resolve_sockaddr>, while initially a more complex interface,
396	and IPv6 addresses as result (and maybe even other adrdess types).	451	resolves host addresses, IDNs, service names and SRV records and gives you
		452	an ordered list of socket addresses to try and should be preferred over
		453	C<inet_aton>.
		454
		455	Example.
		456
		457	inet_aton "www.google.com", my $cv = AE::cv;
		458	say unpack "H*", $_
		459	for $cv->recv;
		460	# => d155e363
		461	# => d155e367 etc.
		462
		463	inet_aton "ipv6.google.com", my $cv = AE::cv;
		464	say unpack "H*", $_
		465	for $cv->recv;
		466	# => 20014860a00300000000000000000068
397		467
398	=cut	468	=cut
399		469
400	sub inet_aton {	470	sub inet_aton {
401	my ($name, $cb) = @_;	471	my ($name, $cb) = @_;
…		…
405	} elsif (my $ipn = &parse_ipv6) {	475	} elsif (my $ipn = &parse_ipv6) {
406	$cb->($ipn);	476	$cb->($ipn);
407	} elsif ($name eq "localhost") { # rfc2606 et al.	477	} elsif ($name eq "localhost") { # rfc2606 et al.
408	$cb->(v127.0.0.1, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1);	478	$cb->(v127.0.0.1, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1);
409	} else {	479	} else {
410	require AnyEvent::DNS;	480	require AnyEvent::DNS unless $AnyEvent::DNS::VERSION;
411		481
412	# simple, bad suboptimal algorithm	482	my $ipv4 = $AnyEvent::PROTOCOL{ipv4};
		483	my $ipv6 = $AnyEvent::PROTOCOL{ipv6};
		484
		485	my @res;
		486
		487	my $cv = AE::cv {
		488	$cb->(map @$_, reverse @res);
		489	};
		490
		491	$cv->begin;
		492
		493	if ($ipv4) {
		494	$cv->begin;
413	AnyEvent::DNS::a ($name, sub {	495	AnyEvent::DNS::a ($name, sub {
414	if (@_) {	496	$res[$ipv4] = [map &parse_ipv4, @_];
415	$cb->(map +(parse_ipv4 $_), @_);
416	} else {
417	$cb->();	497	$cv->end;
418	#AnyEvent::DNS::aaaa ($name, $cb); need inet_pton
419	}	498	});
420	});	499	};
421	}
422	}
423		500
		501	if ($ipv6) {
		502	$cv->begin;
		503	AnyEvent::DNS::aaaa ($name, sub {
		504	$res[$ipv6] = [map &parse_ipv6, @_];
		505	$cv->end;
		506	});
		507	};
		508
		509	$cv->end;
		510	}
		511	}
		512
		513	BEGIN {
		514	*sockaddr_family = $Socket::VERSION >= 1.75
		515	? \&Socket::sockaddr_family
		516	: # for 5.6.x, we need to do something much more horrible
		517	(Socket::pack_sockaddr_in 0x5555, "\x55\x55\x55\x55"
		518	\| eval { Socket::pack_sockaddr_un "U" }) =~ /^\x00/
		519	? sub { unpack "xC", $_[0] }
		520	: sub { unpack "S" , $_[0] };
		521	}
		522
424	# check for broken platforms with extra field in sockaddr structure	523	# check for broken platforms with an extra field in sockaddr structure
425	# kind of a rfc vs. bsd issue, as usual (ok, normally it's a	524	# kind of a rfc vs. bsd issue, as usual (ok, normally it's a
426	# unix vs. bsd issue, a iso C vs. bsd issue or simply a	525	# unix vs. bsd issue, a iso C vs. bsd issue or simply a
427	# correctness vs. bsd issue.	526	# correctness vs. bsd issue.)
428	my $pack_family = (0x55 == Socket::sockaddr_family "\x55\x55")	527	my $pack_family = 0x55 == sockaddr_family ("\x55\x55")
429	? "xC" : "S";	528	? "xC" : "S";
430		529
431	=item $sa = AnyEvent::Socket::pack_sockaddr $service, $host	530	=item $sa = AnyEvent::Socket::pack_sockaddr $service, $host
432		531
433	Pack the given port/host combination into a binary sockaddr	532	Pack the given port/host combination into a binary sockaddr
434	structure. Handles both IPv4 and IPv6 host addresses, as well as UNIX	533	structure. Handles both IPv4 and IPv6 host addresses, as well as UNIX
435	domain sockets (C<$host> == C<unix/> and C<$service> == absolute	534	domain sockets (C<$host> == C<unix/> and C<$service> == absolute
436	pathname).	535	pathname).
		536
		537	Example:
		538
		539	my $bind = AnyEvent::Socket::pack_sockaddr 43, v195.234.53.120;
		540	bind $socket, $bind
		541	or die "bind: $!";
437		542
438	=cut	543	=cut
439		544
440	sub pack_sockaddr($$) {	545	sub pack_sockaddr($$) {
441	my $af = address_family $_[1];	546	my $af = address_family $_[1];
…		…
468	is a special token that is understood by the other functions in this	573	is a special token that is understood by the other functions in this
469	module (C<format_address> converts it to C<unix/>).	574	module (C<format_address> converts it to C<unix/>).
470		575
471	=cut	576	=cut
472		577
		578	# perl contains a bug (imho) where it requires that the kernel always returns
		579	# sockaddr_un structures of maximum length (which is not, AFAICS, required
		580	# by any standard). try to 0-pad structures for the benefit of those platforms.
		581
		582	my $sa_un_zero = eval { Socket::pack_sockaddr_un "" }; $sa_un_zero ^= $sa_un_zero;
		583
473	sub unpack_sockaddr($) {	584	sub unpack_sockaddr($) {
474	my $af = Socket::sockaddr_family $_[0];	585	my $af = sockaddr_family $_[0];
475		586
476	if ($af == AF_INET) {	587	if ($af == AF_INET) {
477	Socket::unpack_sockaddr_in $_[0]	588	Socket::unpack_sockaddr_in $_[0]
478	} elsif ($af == AF_INET6) {	589	} elsif ($af == AF_INET6) {
479	unpack "x2 n x4 a16", $_[0]	590	unpack "x2 n x4 a16", $_[0]
480	} elsif ($af == AF_UNIX) {	591	} elsif ($af == AF_UNIX) {
481	((Socket::unpack_sockaddr_un $_[0]), pack "S", AF_UNIX)	592	((Socket::unpack_sockaddr_un $_[0] ^ $sa_un_zero), pack "S", AF_UNIX)
482	} else {	593	} else {
483	Carp::croak "unpack_sockaddr: unsupported protocol family $af";	594	Carp::croak "unpack_sockaddr: unsupported protocol family $af";
484	}	595	}
485	}	596	}
486		597
…		…
489	Tries to resolve the given nodename and service name into protocol families	600	Tries to resolve the given nodename and service name into protocol families
490	and sockaddr structures usable to connect to this node and service in a	601	and sockaddr structures usable to connect to this node and service in a
491	protocol-independent way. It works remotely similar to the getaddrinfo	602	protocol-independent way. It works remotely similar to the getaddrinfo
492	posix function.	603	posix function.
493		604
494	For internet addresses, C<$node> is either an IPv4 or IPv6 address or an	605	For internet addresses, C<$node> is either an IPv4 or IPv6 address, an
495	internet hostname, and C<$service> is either a service name (port name	606	internet hostname (DNS domain name or IDN), and C<$service> is either
496	from F</etc/services>) or a numerical port number. If both C<$node> and	607	a service name (port name from F</etc/services>) or a numerical port
497	C<$service> are names, then SRV records will be consulted to find the real	608	number. If both C<$node> and C<$service> are names, then SRV records
498	service, otherwise they will be used as-is. If you know that the service	609	will be consulted to find the real service, otherwise they will be
499	name is not in your services database, then you can specify the service in	610	used as-is. If you know that the service name is not in your services
500	the format C<name=port> (e.g. C<http=80>).	611	database, then you can specify the service in the format C<name=port>
		612	(e.g. C<http=80>).
		613
		614	If a host cannot be found via DNS, then it will be looked up in
		615	F</etc/hosts> (or the file specified via C<< $ENV{PERL_ANYEVENT_HOSTS}
		616	>>). If they are found, the addresses there will be used. The effect is as
		617	if entries from F</etc/hosts> would yield C<A> and C<AAAA> records for the
		618	host name unless DNS already had records for them.
501		619
502	For UNIX domain sockets, C<$node> must be the string C<unix/> and	620	For UNIX domain sockets, C<$node> must be the string C<unix/> and
503	C<$service> must be the absolute pathname of the socket. In this case,	621	C<$service> must be the absolute pathname of the socket. In this case,
504	C<$proto> will be ignored.	622	C<$proto> will be ignored.
505		623
…		…
526		644
527	resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... };	645	resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... };
528		646
529	=cut	647	=cut
530		648
		649	our %HOSTS;
		650	our $HOSTS;
		651
		652	if (
		653	open my $fh, "<",
		654	length $ENV{PERL_ANYEVENT_HOSTS} ? $ENV{PERL_ANYEVENT_HOSTS}
		655	: AnyEvent::WIN32 ? "$ENV{SystemRoot}/system32/drivers/etc/hosts"
		656	: "/etc/hosts"
		657	) {
		658	local $/;
		659	binmode $fh;
		660	$HOSTS = <$fh>;
		661	} else {
		662	$HOSTS = "";
		663	}
		664
		665	sub _parse_hosts() {
		666	#%HOSTS = ();
		667
		668	for (split /\n/, $HOSTS) {
		669	s/#.*$//;
		670	s/^[ \t]+//;
		671	y/A-Z/a-z/;
		672
		673	my ($addr, @aliases) = split /[ \t]+/;
		674	next unless @aliases;
		675
		676	if (my $ip = parse_ipv4 $addr) {
		677	push @{ $HOSTS{$_}[0] }, $ip
		678	for @aliases;
		679	} elsif (my $ip = parse_ipv6 $addr) {
		680	push @{ $HOSTS{$_}[1] }, $ip
		681	for @aliases;
		682	}
		683	}
		684
		685	undef $HOSTS;
		686	}
		687
531	sub resolve_sockaddr($$$$$$) {	688	sub resolve_sockaddr($$$$$$) {
532	my ($node, $service, $proto, $family, $type, $cb) = @_;	689	my ($node, $service, $proto, $family, $type, $cb) = @_;
533		690
534	if ($node eq "unix/") {	691	if ($node eq "unix/") {
535	return $cb->() if $family \|\| $service !~ /^\//; # no can do	692	return $cb->() if $family \|\| $service !~ /^\//; # no can do
…		…
551	$family \|\|= 6 unless $AnyEvent::PROTOCOL{ipv4};	708	$family \|\|= 6 unless $AnyEvent::PROTOCOL{ipv4};
552		709
553	$proto \|\|= "tcp";	710	$proto \|\|= "tcp";
554	$type \|\|= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;	711	$type \|\|= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
555		712
556	my $proton = getprotobyname $proto	713	my $proton = AnyEvent::Socket::getprotobyname $proto
557	or Carp::croak "$proto: protocol unknown";	714	or Carp::croak "$proto: protocol unknown";
558		715
559	my $port;	716	my $port;
560		717
561	if ($service =~ /^(\S+)=(\d+)$/) {	718	if ($service =~ /^(\S+)=(\d+)$/) {
…		…
565	} else {	722	} else {
566	$port = (getservbyname $service, $proto)[2]	723	$port = (getservbyname $service, $proto)[2]
567	or Carp::croak "$service/$proto: service unknown";	724	or Carp::croak "$service/$proto: service unknown";
568	}	725	}
569		726
570	my @target = [$node, $port];
571
572	# resolve a records / provide sockaddr structures	727	# resolve a records / provide sockaddr structures
573	my $resolve = sub {	728	my $resolve = sub {
		729	my @target = @_;
		730
574	my @res;	731	my @res;
575	my $cv = AnyEvent->condvar (cb => sub {	732	my $cv = AE::cv {
576	$cb->(	733	$cb->(
577	map $_->[2],	734	map $_->[2],
578	sort {	735	sort {
579	$AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}	736	$AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}
580	or $a->[0] <=> $b->[0]	737	or $a->[0] <=> $b->[0]
581	}	738	}
582	@res	739	@res
583	)	740	)
584	});	741	};
585		742
586	$cv->begin;	743	$cv->begin;
587	for my $idx (0 .. $#target) {	744	for my $idx (0 .. $#target) {
588	my ($node, $port) = @{ $target[$idx] };	745	my ($node, $port) = @{ $target[$idx] };
589		746
…		…
598	if ($af == AF_INET6 && $family != 4) {	755	if ($af == AF_INET6 && $family != 4) {
599	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,	756	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
600	pack_sockaddr $port, $noden]]	757	pack_sockaddr $port, $noden]]
601	}	758	}
602	} else {	759	} else {
603	# ipv4	760	$node =~ y/A-Z/a-z/;
		761
		762	my $hosts = $HOSTS{$node};
		763
		764	# a records
604	if ($family != 6) {	765	if ($family != 6) {
605	$cv->begin;	766	$cv->begin;
606	AnyEvent::DNS::a $node, sub {	767	AnyEvent::DNS::a $node, sub {
607	push @res, [$idx, "ipv4", [AF_INET, $type, $proton,	768	push @res, [$idx, "ipv4", [AF_INET , $type, $proton, pack_sockaddr $port, parse_ipv4 $_]]
608	pack_sockaddr $port, parse_ipv4 $_]]
609	for @_;	769	for @_;
		770
		771	# dns takes precedence over hosts
		772	push @res,
		773	map [$idx, "ipv4", [AF_INET , $type, $proton, pack_sockaddr $port, $_]],
		774	@{ $hosts->[0] }
		775	unless @_;
		776
610	$cv->end;	777	$cv->end;
611	};	778	};
612	}	779	}
613		780
614	# ipv6	781	# aaaa records
615	if ($family != 4) {	782	if ($family != 4) {
616	$cv->begin;	783	$cv->begin;
617	AnyEvent::DNS::aaaa $node, sub {	784	AnyEvent::DNS::aaaa $node, sub {
618	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,	785	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton, pack_sockaddr $port, parse_ipv6 $_]]
619	pack_sockaddr $port, parse_ipv6 $_]]
620	for @_;	786	for @_;
		787
		788	push @res,
		789	map [$idx + 0.5, "ipv6", [AF_INET6, $type, $proton, pack_sockaddr $port, $_]],
		790	@{ $hosts->[1] }
		791	unless @_;
		792
621	$cv->end;	793	$cv->end;
622	};	794	};
623	}	795	}
624	}	796	}
625	}	797	}
626	$cv->end;	798	$cv->end;
627	};	799	};
628		800
		801	$node = AnyEvent::Util::idn_to_ascii $node
		802	if $node =~ /[^\x00-\x7f]/;
		803
		804	# parse hosts
		805	if (defined $HOSTS) {
		806	_parse_hosts;
		807	undef &_parse_hosts;
		808	}
		809
629	# try srv records, if applicable	810	# try srv records, if applicable
630	if ($node eq "localhost") {	811	if ($node eq "localhost") {
631	@target = (["127.0.0.1", $port], ["::1", $port]);	812	$resolve->(["127.0.0.1", $port], ["::1", $port]);
632	&$resolve;
633	} elsif (defined $service && !parse_address $node) {	813	} elsif (defined $service && !parse_address $node) {
634	AnyEvent::DNS::srv $service, $proto, $node, sub {	814	AnyEvent::DNS::srv $service, $proto, $node, sub {
635	my (@srv) = @_;	815	my (@srv) = @_;
636		816
637	# no srv records, continue traditionally
638	@srv	817	if (@srv) {
639	or return &$resolve;
640
641	# the only srv record has "." ("" here) => abort	818	# the only srv record has "." ("" here) => abort
642	$srv[0][2] ne "" \|\| $#srv	819	$srv[0][2] ne "" \|\| $#srv
643	or return $cb->();	820	or return $cb->();
644		821
645	# use srv records then	822	# use srv records then
		823	$resolve->(
646	@target = map ["$_->[3].", $_->[2]],	824	map ["$_->[3].", $_->[2]],
647	grep $_->[3] ne ".",	825	grep $_->[3] ne ".",
648	@srv;	826	@srv
649		827	);
650	&$resolve;	828	} else {
		829	# no srv records, continue traditionally
		830	$resolve->([$node, $port]);
		831	}
651	};	832	};
652	} else {	833	} else {
653	&$resolve;	834	# most common case
		835	$resolve->([$node, $port]);
654	}	836	}
655	}	837	}
656		838
657	=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]	839	=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]
658		840
659	This is a convenience function that creates a TCP socket and makes a 100%	841	This is a convenience function that creates a TCP socket and makes a
660	non-blocking connect to the given C<$host> (which can be a hostname or	842	100% non-blocking connect to the given C<$host> (which can be a DNS/IDN
661	a textual IP address, or the string C<unix/> for UNIX domain sockets)	843	hostname or a textual IP address, or the string C<unix/> for UNIX domain
662	and C<$service> (which can be a numeric port number or a service name,	844	sockets) and C<$service> (which can be a numeric port number or a service
663	or a C<servicename=portnumber> string, or the pathname to a UNIX domain	845	name, or a C<servicename=portnumber> string, or the pathname to a UNIX
664	socket).	846	domain socket).
665		847
666	If both C<$host> and C<$port> are names, then this function will use SRV	848	If both C<$host> and C<$port> are names, then this function will use SRV
667	records to locate the real target(s).	849	records to locate the real target(s).
668		850
669	In either case, it will create a list of target hosts (e.g. for multihomed	851	In either case, it will create a list of target hosts (e.g. for multihomed
670	hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to	852	hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to
671	each in turn.	853	each in turn.
672		854
673	If the connect is successful, then the C<$connect_cb> will be invoked with	855	After the connection is established, then the C<$connect_cb> will be
674	the socket file handle (in non-blocking mode) as first and the peer host	856	invoked with the socket file handle (in non-blocking mode) as first, and
675	(as a textual IP address) and peer port as second and third arguments,	857	the peer host (as a textual IP address) and peer port as second and third
676	respectively. The fourth argument is a code reference that you can call	858	arguments, respectively. The fourth argument is a code reference that you
677	if, for some reason, you don't like this connection, which will cause	859	can call if, for some reason, you don't like this connection, which will
678	C<tcp_connect> to try the next one (or call your callback without any	860	cause C<tcp_connect> to try the next one (or call your callback without
679	arguments if there are no more connections). In most cases, you can simply	861	any arguments if there are no more connections). In most cases, you can
680	ignore this argument.	862	simply ignore this argument.
681		863
682	$cb->($filehandle, $host, $port, $retry)	864	$cb->($filehandle, $host, $port, $retry)
683		865
684	If the connect is unsuccessful, then the C<$connect_cb> will be invoked	866	If the connect is unsuccessful, then the C<$connect_cb> will be invoked
685	without any arguments and C<$!> will be set appropriately (with C<ENXIO>	867	without any arguments and C<$!> will be set appropriately (with C<ENXIO>
686	indicating a DNS resolution failure).	868	indicating a DNS resolution failure).
687		869
		870	The callback will I<never> be invoked before C<tcp_connect> returns, even
		871	if C<tcp_connect> was able to connect immediately (e.g. on unix domain
		872	sockets).
		873
688	The file handle is perfect for being plugged into L<AnyEvent::Handle>, but	874	The file handle is perfect for being plugged into L<AnyEvent::Handle>, but
689	can be used as a normal perl file handle as well.	875	can be used as a normal perl file handle as well.
690		876
691	Unless called in void context, C<tcp_connect> returns a guard object that	877	Unless called in void context, C<tcp_connect> returns a guard object that
692	will automatically abort connecting when it gets destroyed (it does not do	878	will automatically cancel the connection attempt when it gets destroyed
		879	- in which case the callback will not be invoked. Destroying it does not
693	anything to the socket after the connect was successful).	880	do anything to the socket after the connect was successful - you cannot
		881	"uncall" a callback that has been invoked already.
694		882
695	Sometimes you need to "prepare" the socket before connecting, for example,	883	Sometimes you need to "prepare" the socket before connecting, for example,
696	to C<bind> it to some port, or you want a specific connect timeout that	884	to C<bind> it to some port, or you want a specific connect timeout that
697	is lower than your kernel's default timeout. In this case you can specify	885	is lower than your kernel's default timeout. In this case you can specify
698	a second callback, C<$prepare_cb>. It will be called with the file handle	886	a second callback, C<$prepare_cb>. It will be called with the file handle
…		…
731		919
732	my $handle; # avoid direct assignment so on_eof has it in scope.	920	my $handle; # avoid direct assignment so on_eof has it in scope.
733	$handle = new AnyEvent::Handle	921	$handle = new AnyEvent::Handle
734	fh => $fh,	922	fh => $fh,
735	on_error => sub {	923	on_error => sub {
736	warn "error $_[2]\n";	924	AE::log error => "error $_[2]";
737	$_[0]->destroy;	925	$_[0]->destroy;
738	},	926	},
739	on_eof => sub {	927	on_eof => sub {
740	$handle->destroy; # destroy handle	928	$handle->destroy; # destroy handle
741	warn "done.\n";	929	AE::log info => "done.";
742	};	930	};
743		931
744	$handle->push_write ("GET / HTTP/1.0\015\012\015\012");	932	$handle->push_write ("GET / HTTP/1.0\015\012\015\012");
745		933
746	$handle->push_read_line ("\015\012\015\012", sub {	934	$handle->push_read (line => "\015\012\015\012", sub {
747	my ($handle, $line) = @_;	935	my ($handle, $line) = @_;
748		936
749	# print response header	937	# print response header
750	print "HEADER\n$line\n\nBODY\n";	938	print "HEADER\n$line\n\nBODY\n";
751		939
…		…
771	=cut	959	=cut
772		960
773	sub tcp_connect($$$;$) {	961	sub tcp_connect($$$;$) {
774	my ($host, $port, $connect, $prepare) = @_;	962	my ($host, $port, $connect, $prepare) = @_;
775		963
776	# see http://cr.yp.to/docs/connect.html for some background	964	# see http://cr.yp.to/docs/connect.html for some tricky aspects
777	# also http://advogato.org/article/672.html	965	# also http://advogato.org/article/672.html
778		966
779	my %state = ( fh => undef );	967	my %state = ( fh => undef );
780		968
781	# name/service to type/sockaddr resolution	969	# name/service to type/sockaddr resolution
…		…
783	my @target = @_;	971	my @target = @_;
784		972
785	$state{next} = sub {	973	$state{next} = sub {
786	return unless exists $state{fh};	974	return unless exists $state{fh};
787		975
		976	my $errno = $!;
788	my $target = shift @target	977	my $target = shift @target
789	or return (%state = (), $connect->());	978	or return AE::postpone {
		979	return unless exists $state{fh};
		980	%state = ();
		981	$! = $errno;
		982	$connect->();
		983	};
790		984
791	my ($domain, $type, $proto, $sockaddr) = @$target;	985	my ($domain, $type, $proto, $sockaddr) = @$target;
792		986
793	# socket creation	987	# socket creation
794	socket $state{fh}, $domain, $type, $proto	988	socket $state{fh}, $domain, $type, $proto
…		…
798		992
799	my $timeout = $prepare && $prepare->($state{fh});	993	my $timeout = $prepare && $prepare->($state{fh});
800		994
801	$timeout \|\|= 30 if AnyEvent::WIN32;	995	$timeout \|\|= 30 if AnyEvent::WIN32;
802		996
803	$state{to} = AnyEvent->timer (after => $timeout, cb => sub {	997	$state{to} = AE::timer $timeout, 0, sub {
804	$! = Errno::ETIMEDOUT;	998	$! = Errno::ETIMEDOUT;
805	$state{next}();	999	$state{next}();
806	}) if $timeout;	1000	} if $timeout;
807		1001
808	# called when the connect was successful, which,	1002	# now connect
809	# in theory, could be the case immediately (but never is in practise)	1003	if (
810	$state{connected} = sub {	1004	(connect $state{fh}, $sockaddr)
		1005	\|\| ($! == Errno::EINPROGRESS # POSIX
		1006	\|\| $! == Errno::EWOULDBLOCK
		1007	# WSAEINPROGRESS intentionally not checked - it means something else entirely
		1008	\|\| $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
		1009	\|\| $! == AnyEvent::Util::WSAEWOULDBLOCK)
		1010	) {
		1011	$state{ww} = AE::io $state{fh}, 1, sub {
811	# we are connected, or maybe there was an error	1012	# we are connected, or maybe there was an error
812	if (my $sin = getpeername $state{fh}) {	1013	if (my $sin = getpeername $state{fh}) {
813	my ($port, $host) = unpack_sockaddr $sin;	1014	my ($port, $host) = unpack_sockaddr $sin;
814		1015
815	delete $state{ww}; delete $state{to};	1016	delete $state{ww}; delete $state{to};
816		1017
817	my $guard = guard { %state = () };	1018	my $guard = guard { %state = () };
818		1019
819	$connect->(delete $state{fh}, format_address $host, $port, sub {	1020	$connect->(delete $state{fh}, format_address $host, $port, sub {
820	$guard->cancel;	1021	$guard->cancel;
		1022	$state{next}();
		1023	});
		1024	} else {
		1025	if ($! == Errno::ENOTCONN) {
		1026	# dummy read to fetch real error code if !cygwin
		1027	sysread $state{fh}, my $buf, 1;
		1028
		1029	# cygwin 1.5 continously reports "ready' but never delivers
		1030	# an error with getpeername or sysread.
		1031	# cygwin 1.7 only reports readyness once, but is otherwise
		1032	# the same, which is actually more broken.
		1033	# Work around both by using unportable SO_ERROR for cygwin.
		1034	$! = (unpack "l", getsockopt $state{fh}, Socket::SOL_SOCKET(), Socket::SO_ERROR()) \|\| Errno::EAGAIN
		1035	if AnyEvent::CYGWIN && $! == Errno::EAGAIN;
		1036	}
		1037
		1038	return if $! == Errno::EAGAIN; # skip spurious wake-ups
		1039
		1040	delete $state{ww}; delete $state{to};
		1041
821	$state{next}();	1042	$state{next}();
822	});	1043	}
823	} else {
824	# dummy read to fetch real error code
825	sysread $state{fh}, my $buf, 1 if $! == Errno::ENOTCONN;
826
827	return if $! == Errno::EAGAIN; # skip spurious wake-ups
828
829	delete $state{ww}; delete $state{to};
830
831	$state{next}();
832	}	1044	};
833	};
834
835	# now connect
836	if (connect $state{fh}, $sockaddr) {
837	$state{connected}->();
838	} elsif ($! == Errno::EINPROGRESS # POSIX
839	\|\| $! == Errno::EWOULDBLOCK
840	# WSAEINPROGRESS intentionally not checked - it means something else entirely
841	\|\| $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
842	\|\| $! == AnyEvent::Util::WSAEWOULDBLOCK) {
843	$state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $state{connected});
844	} else {	1045	} else {
845	$state{next}();	1046	$state{next}();
846	}	1047	}
847	};	1048	};
848		1049
…		…
853	defined wantarray && guard { %state = () }	1054	defined wantarray && guard { %state = () }
854	}	1055	}
855		1056
856	=item $guard = tcp_server $host, $service, $accept_cb[, $prepare_cb]	1057	=item $guard = tcp_server $host, $service, $accept_cb[, $prepare_cb]
857		1058
858	Create and bind a stream socket to the given host, and port, set the	1059	Create and bind a stream socket to the given host address and port, set
859	SO_REUSEADDR flag (if applicable) and call C<listen>. Unlike the name	1060	the SO_REUSEADDR flag (if applicable) and call C<listen>. Unlike the name
860	implies, this function can also bind on UNIX domain sockets.	1061	implies, this function can also bind on UNIX domain sockets.
861		1062
862	For internet sockets, C<$host> must be an IPv4 or IPv6 address (or	1063	For internet sockets, C<$host> must be an IPv4 or IPv6 address (or
863	C<undef>, in which case it binds either to C<0> or to C<::>, depending	1064	C<undef>, in which case it binds either to C<0> or to C<::>, depending
864	on whether IPv4 or IPv6 is the preferred protocol, and maybe to both in	1065	on whether IPv4 or IPv6 is the preferred protocol, and maybe to both in
865	future versions, as applicable).	1066	future versions, as applicable).
866		1067
867	To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6	1068	To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6
868	wildcard address, use C<::>.	1069	wildcard address, use C<::>.
869		1070
870	The port is specified by C<$service>, which must be either a service name or	1071	The port is specified by C<$service>, which must be either a service name
871	a numeric port number (or C<0> or C<undef>, in which case an ephemeral	1072	or a numeric port number (or C<0> or C<undef>, in which case an ephemeral
872	port will be used).	1073	port will be used).
873		1074
874	For UNIX domain sockets, C<$host> must be C<unix/> and C<$service> must be	1075	For UNIX domain sockets, C<$host> must be C<unix/> and C<$service> must be
875	the absolute pathname of the socket. This function will try to C<unlink>	1076	the absolute pathname of the socket. This function will try to C<unlink>
876	the socket before it tries to bind to it. See SECURITY CONSIDERATIONS,	1077	the socket before it tries to bind to it, and will try to unlink it after
877	below.	1078	it stops using it. See SECURITY CONSIDERATIONS, below.
878		1079
879	For each new connection that could be C<accept>ed, call the C<<	1080	For each new connection that could be C<accept>ed, call the C<<
880	$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking	1081	$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking
881	mode) as first and the peer host and port as second and third arguments	1082	mode) as first, and the peer host and port as second and third arguments
882	(see C<tcp_connect> for details).	1083	(see C<tcp_connect> for details).
883		1084
884	Croaks on any errors it can detect before the listen.	1085	Croaks on any errors it can detect before the listen.
885		1086
886	If called in non-void context, then this function returns a guard object	1087	If called in non-void context, then this function returns a guard object
887	whose lifetime it tied to the TCP server: If the object gets destroyed,	1088	whose lifetime it tied to the TCP server: If the object gets destroyed,
888	the server will be stopped (but existing accepted connections will	1089	the server will be stopped (but existing accepted connections will
889	continue).	1090	not be affected).
		1091
		1092	Regardless, when the function returns to the caller, the socket is bound
		1093	and in listening state.
890		1094
891	If you need more control over the listening socket, you can provide a	1095	If you need more control over the listening socket, you can provide a
892	C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the	1096	C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the
893	C<listen ()> call, with the listen file handle as first argument, and IP	1097	C<listen ()> call, with the listen file handle as first argument, and IP
894	address and port number of the local socket endpoint as second and third	1098	address and port number of the local socket endpoint as second and third
…		…
910	my ($fh, $host, $port) = @_;	1114	my ($fh, $host, $port) = @_;
911		1115
912	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";	1116	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
913	}, sub {	1117	}, sub {
914	my ($fh, $thishost, $thisport) = @_;	1118	my ($fh, $thishost, $thisport) = @_;
915	warn "bound to $thishost, port $thisport\n";	1119	AE::log info => "bound to $thishost, port $thisport";
916	};	1120	};
917		1121
918	Example: bind a server on a unix domain socket.	1122	Example: bind a server on a unix domain socket.
919		1123
920	tcp_server "unix/", "/tmp/mydir/mysocket", sub {	1124	tcp_server "unix/", "/tmp/mydir/mysocket", sub {
…		…
958	}	1162	}
959		1163
960	bind $state{fh}, pack_sockaddr $service, $ipn	1164	bind $state{fh}, pack_sockaddr $service, $ipn
961	or Carp::croak "bind: $!";	1165	or Carp::croak "bind: $!";
962		1166
		1167	if ($af == AF_UNIX) {
		1168	my $fh = $state{fh};
		1169	my $ino = (stat $fh)[1];
		1170	$state{unlink} = guard {
		1171	# this is racy, but is not designed to be foolproof, just best-effort
		1172	unlink $service
		1173	if $ino == (stat $fh)[1];
		1174	};
		1175	}
		1176
963	fh_nonblocking $state{fh}, 1;	1177	fh_nonblocking $state{fh}, 1;
964		1178
965	my $len;	1179	my $len;
966		1180
967	if ($prepare) {	1181	if ($prepare) {
…		…
972	$len \|\|= 128;	1186	$len \|\|= 128;
973		1187
974	listen $state{fh}, $len	1188	listen $state{fh}, $len
975	or Carp::croak "listen: $!";	1189	or Carp::croak "listen: $!";
976		1190
977	$state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {	1191	$state{aw} = AE::io $state{fh}, 0, sub {
978	# this closure keeps $state alive	1192	# this closure keeps $state alive
979	while (my $peer = accept my $fh, $state{fh}) {	1193	while ($state{fh} && (my $peer = accept my $fh, $state{fh})) {
980	fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not	1194	fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
981		1195
982	my ($service, $host) = unpack_sockaddr $peer;	1196	my ($service, $host) = unpack_sockaddr $peer;
983	$accept->($fh, format_address $host, $service);	1197	$accept->($fh, format_address $host, $service);
984	}	1198	}
985	});	1199	};
986		1200
987	defined wantarray	1201	defined wantarray
988	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency	1202	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
989	: ()	1203	: ()
		1204	}
		1205
		1206	=item tcp_nodelay $fh, $enable
		1207
		1208	Enables (or disables) the C<TCP_NODELAY> socket option (also known as
		1209	Nagle's algorithm). Returns false on error, true otherwise.
		1210
		1211	=cut
		1212
		1213	sub tcp_nodelay($$) {
		1214	my $onoff = int ! ! $_[1];
		1215
		1216	setsockopt $_[0], Socket::IPPROTO_TCP (), Socket::TCP_NODELAY (), $onoff
		1217	}
		1218
		1219	=item tcp_congestion $fh, $algorithm
		1220
		1221	Sets the tcp congestion avoidance algorithm (via the C<TCP_CONGESTION>
		1222	socket option). The default is OS-specific, but is usually
		1223	C<reno>. Typical other available choices include C<cubic>, C<lp>, C<bic>,
		1224	C<highspeed>, C<htcp>, C<hybla>, C<illinois>, C<scalable>, C<vegas>,
		1225	C<veno>, C<westwood> and C<yeah>.
		1226
		1227	=cut
		1228
		1229	sub tcp_congestion($$) {
		1230	defined TCP_CONGESTION
		1231	? setsockopt $_[0], Socket::IPPROTO_TCP (), TCP_CONGESTION, "$_[1]"
		1232	: undef
990	}	1233	}
991		1234
992	1;	1235	1;
993		1236
994	=back	1237	=back

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents): Revision 1.94 by root, Fri Jul 17 14:57:03 2009 UTC vs. Revision 1.143 by root, Thu Mar 1 19:52:15 2012 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.94 by root, Fri Jul 17 14:57:03 2009 UTC vs.
Revision 1.143 by root, Thu Mar 1 19:52:15 2012 UTC