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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.83 by root, Mon Jun 29 21:00:32 2009 UTC vs.
Revision 1.155 by root, Mon Oct 29 18:50:51 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	parse_hostport	49	getprotobyname
		50	parse_hostport format_hostport
53	parse_ipv4 parse_ipv6	51	parse_ipv4 parse_ipv6
54	parse_ip parse_address	52	parse_ip parse_address
		53	format_ipv4 format_ipv6
55	format_ip format_address	54	format_ip format_address
56	address_family	55	address_family
57	inet_aton	56	inet_aton
58	tcp_server	57	tcp_server
59	tcp_connect	58	tcp_connect
60	);	59	);
61		60
62	our $VERSION = 4.45;	61	our $VERSION = $AnyEvent::VERSION;
63		62
64	=item $ipn = parse_ipv4 $dotted_quad	63	=item $ipn = parse_ipv4 $dotted_quad
65		64
66	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
67	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
…		…
98	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
99	(and will not parse).	98	(and will not parse).
100		99
101	This function works similarly to C<inet_pton AF_INET6, ...>.	100	This function works similarly to C<inet_pton AF_INET6, ...>.
102		101
		102	Example:
		103
		104	print unpack "H*", parse_ipv6 "2002:5345::10.0.0.1";
		105	# => 2002534500000000000000000a000001
		106
103	=cut	107	=cut
104		108
105	sub parse_ipv6($) {	109	sub parse_ipv6($) {
106	# quick test to avoid longer processing	110	# quick test to avoid longer processing
107	my $n = $_[0] =~ y/://;	111	my $n = $_[0] =~ y/://;
…		…
137		141
138	# and done	142	# and done
139	pack "n*", map hex, @h, @t	143	pack "n*", map hex, @h, @t
140	}	144	}
141		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
142	sub parse_unix($) {	157	sub parse_unix($) {
143	$_[0] eq "unix/"	158	$_[0] eq "unix/"
144	? pack "S", AF_UNIX	159	? pack "S", AF_UNIX
145	: undef	160	: undef
146		161
…		…
157	socket".	172	socket".
158		173
159	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>),
160	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
161	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
162		182
163	=item $ipn = AnyEvent::Socket::aton $ip	183	=item $ipn = AnyEvent::Socket::aton $ip
164		184
165	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
166	I<without> name resolution).	186	I<without> name resolution).
…		…
178	}	198	}
179	}	199	}
180		200
181	*aton = \&parse_address;	201	*aton = \&parse_address;
182		202
		203	=item ($name, $aliases, $proto) = getprotobyname $name
		204
		205	Works like the builtin function of the same name, except it tries hard to
		206	work even on broken platforms (well, that's windows), where getprotobyname
		207	is traditionally very unreliable.
		208
		209	Example: get the protocol number for TCP (usually 6)
		210
		211	my $proto = getprotobyname "tcp";
		212
		213	=cut
		214
		215	# microsoft can't even get getprotobyname working (the etc/protocols file
		216	# gets lost fairly often on windows), so we have to hardcode some common
		217	# protocol numbers ourselves.
		218	our %PROTO_BYNAME;
		219
		220	$PROTO_BYNAME{tcp} = Socket::IPPROTO_TCP () if defined &Socket::IPPROTO_TCP;
		221	$PROTO_BYNAME{udp} = Socket::IPPROTO_UDP () if defined &Socket::IPPROTO_UDP;
		222	$PROTO_BYNAME{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP;
		223
		224	sub getprotobyname($) {
		225	my $name = lc shift;
		226
		227	defined (my $proton = $PROTO_BYNAME{$name} \|\| (getprotobyname $name)[2])
		228	or return;
		229
		230	($name, uc $name, $proton)
		231	}
		232
183	=item ($host, $service) = parse_hostport $string[, $default_service]	233	=item ($host, $service) = parse_hostport $string[, $default_service]
184		234
185	Splitting a string of the form C<hostname:port> is a common	235	Splitting a string of the form C<hostname:port> is a common
186	problem. Unfortunately, just splitting on the colon makes it hard to	236	problem. Unfortunately, just splitting on the colon makes it hard to
187	specify IPv6 addresses and doesn't support the less common but well	237	specify IPv6 addresses and doesn't support the less common but well
188	standardised C<[ip literal]> syntax.	238	standardised C<[ip literal]> syntax.
189		239
190	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 (at
191	following formats, where C<port> can be a numerical port number of a	241	least) the following formats, where C<port> can be a numerical port
192	service name, or a C<name=port> string, and the C< port> and C<:port>	242	number of a service name, or a C<name=port> string, and the C< port> and
193	parts are optional. Also, everywhere where an IP address is supported	243	C<:port> parts are optional. Also, everywhere where an IP address is
194	a hostname or unix domain socket address is also supported (see	244	supported a hostname or unix domain socket address is also supported (see
195	C<parse_unix>).	245	C<parse_unix>), and strings starting with C</> will also be interpreted as
		246	unix domain sockets.
196		247
197	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",
198	ipv4:port e.g. "198.182.196.56", "127.1:22"	249	ipv4:port e.g. "198.182.196.56", "127.1:22"
199	ipv6 e.g. "::1", "affe::1"	250	ipv6 e.g. "::1", "affe::1"
200	[ipv4or6]:port e.g. "[::1]", "[10.0.1]:80"	251	[ipv4or6]:port e.g. "[::1]", "[10.0.1]:80"
201	[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"
202	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"
203		256
204	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
205	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
206	detected nor a default was specified, then this function returns the	259	detected nor a default was specified, then this function returns the
207	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
208	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).
209		262
210	Example:	263	Example:
211		264
212	print join ",", parse_hostport "localhost:443";	265	print join ",", parse_hostport "localhost:443";
…		…
216	# => "localhost,https"	269	# => "localhost,https"
217		270
218	print join ",", parse_hostport "[::1]";	271	print join ",", parse_hostport "[::1]";
219	# => "," (empty list)	272	# => "," (empty list)
220		273
		274	print join ",", parse_host_port "/tmp/debug.sock";
		275	# => "unix/", "/tmp/debug.sock"
		276
221	=cut	277	=cut
222		278
223	sub parse_hostport($;$) {	279	sub parse_hostport($;$) {
224	my ($host, $port);	280	my ($host, $port);
225		281
226	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
227		283
		284	# shortcut for /path
		285	return ("unix/", $_)
		286	if m%^/%;
		287
228	# parse host, special cases: "ipv6" or "ipv6 port"	288	# parse host, special cases: "ipv6" or "ipv6[#p ]port"
229	unless (	289	unless (
230	($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
231	and parse_ipv6 $host	291	and parse_ipv6 $host
232	) {	292	) {
233	/^\s*/xgc;	293	/^\s*/xgc;
…		…
240	return;	300	return;
241	}	301	}
242	}	302	}
243		303
244	# parse port	304	# parse port
245	if (/\G (?:\s+\|:) ([^:[:space:]]+) \s*$/xgc) {	305	if (/\G (?:\s+\|:\|\#) ([^:[:space:]]+) \s*$/xgc) {
246	$port = $1;	306	$port = $1;
247	} elsif (/\G\s*$/gc && length $_[1]) {	307	} elsif (/\G\s*$/gc && length $_[1]) {
248	$port = $_[1];	308	$port = $_[1];
249	} else {	309	} else {
250	return;	310	return;
251	}	311	}
		312
252	}	313	}
253		314
254	# hostnames must not contain :'s	315	# hostnames must not contain :'s
255	return if $host =~ /:/ && !parse_ipv6 $host;	316	return if $host =~ /:/ && !parse_ipv6 $host;
256		317
257	($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"
258	}	335	}
259		336
260	=item $sa_family = address_family $ipn	337	=item $sa_family = address_family $ipn
261		338
262	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 :)
…		…
298		375
299	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
300	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
301	have to call C<format_ipv6> manually.	378	have to call C<format_ipv6> manually.
302		379
		380	Example:
		381
		382	print format_address "\x01\x02\x03\x05";
		383	=> 1.2.3.5
		384
303	=item $text = AnyEvent::Socket::ntoa $ipn	385	=item $text = AnyEvent::Socket::ntoa $ipn
304		386
305	Same as format_address, but not exported (think C<inet_ntoa>).	387	Same as format_address, but not exported (think C<inet_ntoa>).
306		388
307	=cut	389	=cut
…		…
309	sub format_ipv4($) {	391	sub format_ipv4($) {
310	join ".", unpack "C4", $_[0]	392	join ".", unpack "C4", $_[0]
311	}	393	}
312		394
313	sub format_ipv6($) {	395	sub format_ipv6($) {
		396	if ($_[0] =~ /^\x00\x00\x00\x00\x00\x00\x00\x00/) {
314	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]) {
315	return "::";	398	return "::";
316	} 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]) {
317	return "::1";	400	return "::1";
318	} 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) {
319	# v4compatible	402	# v4compatible
320	return "::" . format_ipv4 substr $_[0], 12;	403	return "::" . format_ipv4 substr $_[0], 12;
321	} 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) {
322	# v4mapped	405	# v4mapped
323	return "::ffff:" . format_ipv4 substr $_[0], 12;	406	return "::ffff:" . format_ipv4 substr $_[0], 12;
324	} 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) {
325	# v4translated	408	# v4translated
326	return "::ffff:0:" . format_ipv4 substr $_[0], 12;	409	return "::ffff:0:" . format_ipv4 substr $_[0], 12;
327	} else {	410	}
		411	}
		412
328	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];
329		414
330	# this is rather sucky, I admit	415	# this is admittedly rather sucky
331	$ip =~ s/^0:(?:0:)*(0$)?/::/	416	$ip =~ s/(?:^\|:) 0:0:0:0:0:0:0 (?:$\|:)/::/x
332	or $ip =~ s/(:0){7}$/::/ or $ip =~ s/(:0){7}/:/	417	or $ip =~ s/(?:^\|:) 0:0:0:0:0:0 (?:$\|:)/::/x
333	or $ip =~ s/(:0){6}$/::/ or $ip =~ s/(:0){6}/:/	418	or $ip =~ s/(?:^\|:) 0:0:0:0:0 (?:$\|:)/::/x
334	or $ip =~ s/(:0){5}$/::/ or $ip =~ s/(:0){5}/:/	419	or $ip =~ s/(?:^\|:) 0:0:0:0 (?:$\|:)/::/x
335	or $ip =~ s/(:0){4}$/::/ or $ip =~ s/(:0){4}/:/	420	or $ip =~ s/(?:^\|:) 0:0:0 (?:$\|:)/::/x
336	or $ip =~ s/(:0){3}$/::/ or $ip =~ s/(:0){3}/:/	421	or $ip =~ s/(?:^\|:) 0:0 (?:$\|:)/::/x
337	or $ip =~ s/(:0){2}$/::/ or $ip =~ s/(:0){2}/:/	422	or $ip =~ s/(?:^\|:) 0 (?:$\|:)/::/x;
338	or $ip =~ s/(:0){1}$/::/ or $ip =~ s/(:0){1}/:/;	423
339	return $ip	424	$ip
340	}
341	}	425	}
342		426
343	sub format_address($) {	427	sub format_address($) {
344	my $af = address_family $_[0];	428	if (4 == length $_[0]) {
345	if ($af == AF_INET) {
346	return &format_ipv4;	429	return &format_ipv4;
347	} elsif ($af == AF_INET6) {	430	} elsif (16 == length $_[0]) {
348	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
349	? format_ipv4 substr $_[0], 12	432	? format_ipv4 $1
350	: &format_ipv6;	433	: &format_ipv6;
351	} elsif ($af == AF_UNIX) {	434	} elsif (AF_UNIX == address_family $_[0]) {
352	return "unix/"	435	return "unix/"
353	} else {	436	} else {
354	return undef	437	return undef
355	}	438	}
356	}	439	}
…		…
358	*ntoa = \&format_address;	441	*ntoa = \&format_address;
359		442
360	=item inet_aton $name_or_address, $cb->(@addresses)	443	=item inet_aton $name_or_address, $cb->(@addresses)
361		444
362	Works similarly to its Socket counterpart, except that it uses a	445	Works similarly to its Socket counterpart, except that it uses a
363	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
364	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
365	for IPv6).	448	readable format.
366		449
367	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,
368	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
369		467
370	=cut	468	=cut
371		469
372	sub inet_aton {	470	sub inet_aton {
373	my ($name, $cb) = @_;	471	my ($name, $cb) = @_;
…		…
377	} elsif (my $ipn = &parse_ipv6) {	475	} elsif (my $ipn = &parse_ipv6) {
378	$cb->($ipn);	476	$cb->($ipn);
379	} elsif ($name eq "localhost") { # rfc2606 et al.	477	} elsif ($name eq "localhost") { # rfc2606 et al.
380	$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);
381	} else {	479	} else {
382	require AnyEvent::DNS;	480	require AnyEvent::DNS unless $AnyEvent::DNS::VERSION;
383		481
384	# 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;
385	AnyEvent::DNS::a ($name, sub {	495	AnyEvent::DNS::a ($name, sub {
386	if (@_) {	496	$res[$ipv4] = [map { parse_ipv4 $_ } @_];
387	$cb->(map +(parse_ipv4 $_), @_);
388	} else {
389	$cb->();	497	$cv->end;
390	#AnyEvent::DNS::aaaa ($name, $cb); need inet_pton
391	}	498	});
392	});	499	};
393	}
394	}
395		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
396	# check for broken platforms with extra field in sockaddr structure	523	# check for broken platforms with an extra field in sockaddr structure
397	# 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
398	# 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
399	# correctness vs. bsd issue.	526	# correctness vs. bsd issue.)
400	my $pack_family = (0x55 == Socket::sockaddr_family "\x55\x55")	527	my $pack_family = 0x55 == sockaddr_family ("\x55\x55")
401	? "xC" : "S";	528	? "xC" : "S";
402		529
403	=item $sa = AnyEvent::Socket::pack_sockaddr $service, $host	530	=item $sa = AnyEvent::Socket::pack_sockaddr $service, $host
404		531
405	Pack the given port/host combination into a binary sockaddr	532	Pack the given port/host combination into a binary sockaddr
406	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
407	domain sockets (C<$host> == C<unix/> and C<$service> == absolute	534	domain sockets (C<$host> == C<unix/> and C<$service> == absolute
408	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: $!";
409		542
410	=cut	543	=cut
411		544
412	sub pack_sockaddr($$) {	545	sub pack_sockaddr($$) {
413	my $af = address_family $_[1];	546	my $af = address_family $_[1];
…		…
440	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
441	module (C<format_address> converts it to C<unix/>).	574	module (C<format_address> converts it to C<unix/>).
442		575
443	=cut	576	=cut
444		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
445	sub unpack_sockaddr($) {	584	sub unpack_sockaddr($) {
446	my $af = Socket::sockaddr_family $_[0];	585	my $af = sockaddr_family $_[0];
447		586
448	if ($af == AF_INET) {	587	if ($af == AF_INET) {
449	Socket::unpack_sockaddr_in $_[0]	588	Socket::unpack_sockaddr_in $_[0]
450	} elsif ($af == AF_INET6) {	589	} elsif ($af == AF_INET6) {
451	unpack "x2 n x4 a16", $_[0]	590	unpack "x2 n x4 a16", $_[0]
452	} elsif ($af == AF_UNIX) {	591	} elsif ($af == AF_UNIX) {
453	((Socket::unpack_sockaddr_un $_[0]), pack "S", AF_UNIX)	592	((Socket::unpack_sockaddr_un $_[0] ^ $sa_un_zero), pack "S", AF_UNIX)
454	} else {	593	} else {
455	Carp::croak "unpack_sockaddr: unsupported protocol family $af";	594	Carp::croak "unpack_sockaddr: unsupported protocol family $af";
456	}	595	}
457	}	596	}
458		597
…		…
461	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
462	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
463	protocol-independent way. It works remotely similar to the getaddrinfo	602	protocol-independent way. It works remotely similar to the getaddrinfo
464	posix function.	603	posix function.
465		604
466	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
467	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
468	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
469	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
470	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
471	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
472	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.
473		619
474	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
475	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,
476	C<$proto> will be ignored.	622	C<$proto> will be ignored.
477		623
…		…
498		644
499	resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... };	645	resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... };
500		646
501	=cut	647	=cut
502		648
503	# microsoft can't even get getprotobyname working (the etc/protocols file	649	our %HOSTS; # $HOSTS{$nodename}[$ipv6] = [@aliases...]
504	# gets lost fairly often on windows), so we have to hardcode some common	650	our @HOSTS_CHECKING; # callbacks to call when hosts have been loaded
505	# protocol numbers ourselves.	651	our $HOSTS_MTIME;
506	our %PROTO_BYNAME;
507		652
508	$PROTO_BYNAME{tcp} = &Socket::IPPROTO_TCP if defined &Socket::IPPROTO_TCP;	653	sub _parse_hosts($) {
509	$PROTO_BYNAME{udp} = &Socket::IPPROTO_UDP if defined &Socket::IPPROTO_UDP;	654	%HOSTS = ();
510	$PROTO_BYNAME{icmp} = &Socket::IPPROTO_ICMP if defined &Socket::IPPROTO_ICMP;	655
		656	for (split /\n/, $_[0]) {
		657	s/#.*$//;
		658	s/^[ \t]+//;
		659	y/A-Z/a-z/;
		660
		661	my ($addr, @aliases) = split /[ \t]+/;
		662	next unless @aliases;
		663
		664	if (my $ip = parse_ipv4 $addr) {
		665	push @{ $HOSTS{$_}[0] }, $ip
		666	for @aliases;
		667	} elsif (my $ip = parse_ipv6 $addr) {
		668	push @{ $HOSTS{$_}[1] }, $ip
		669	for @aliases;
		670	}
		671	}
		672	}
		673
		674	# helper function - unless dns delivered results, check and parse hosts, then clal continuation code
		675	sub _load_hosts_unless(&$@) {
		676	my ($cont, $cv, @dns) = @_;
		677
		678	if (@dns) {
		679	$cv->end;
		680	} else {
		681	my $etc_hosts = length $ENV{PERL_ANYEVENT_HOSTS} ? $ENV{PERL_ANYEVENT_HOSTS}
		682	: AnyEvent::WIN32 ? "$ENV{SystemRoot}/system32/drivers/etc/hosts"
		683	: "/etc/hosts";
		684
		685	push @HOSTS_CHECKING, sub {
		686	$cont->();
		687	$cv->end;
		688	};
		689
		690	unless ($#HOSTS_CHECKING) {
		691	# we are not the first, so we actually have to do the work
		692	require AnyEvent::IO;
		693
		694	AnyEvent::IO::aio_stat ($etc_hosts, sub {
		695	if ((stat _)[9] ne $HOSTS_MTIME) {
		696	AE::log 8 => "(re)loading $etc_hosts.";
		697	$HOSTS_MTIME = (stat _)[9];
		698	# we might load a newer version of hosts,but that's a harmless race,
		699	# as the next call will just load it again.
		700	AnyEvent::IO::aio_load ($etc_hosts, sub {
		701	_parse_hosts $_[0];
		702	(shift @HOSTS_CHECKING)->() while @HOSTS_CHECKING;
		703	});
		704	} else {
		705	(shift @HOSTS_CHECKING)->() while @HOSTS_CHECKING;
		706	}
		707	});
		708	}
		709	}
		710	}
511		711
512	sub resolve_sockaddr($$$$$$) {	712	sub resolve_sockaddr($$$$$$) {
513	my ($node, $service, $proto, $family, $type, $cb) = @_;	713	my ($node, $service, $proto, $family, $type, $cb) = @_;
514		714
515	if ($node eq "unix/") {	715	if ($node eq "unix/") {
…		…
532	$family \|\|= 6 unless $AnyEvent::PROTOCOL{ipv4};	732	$family \|\|= 6 unless $AnyEvent::PROTOCOL{ipv4};
533		733
534	$proto \|\|= "tcp";	734	$proto \|\|= "tcp";
535	$type \|\|= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;	735	$type \|\|= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
536		736
537	my $proton = $PROTO_BYNAME{lc $proto} \|\| (getprotobyname $proto)[2]	737	my $proton = AnyEvent::Socket::getprotobyname $proto
538	or Carp::croak "$proto: protocol unknown";	738	or Carp::croak "$proto: protocol unknown";
539		739
540	my $port;	740	my $port;
541		741
542	if ($service =~ /^(\S+)=(\d+)$/) {	742	if ($service =~ /^(\S+)=(\d+)$/) {
…		…
546	} else {	746	} else {
547	$port = (getservbyname $service, $proto)[2]	747	$port = (getservbyname $service, $proto)[2]
548	or Carp::croak "$service/$proto: service unknown";	748	or Carp::croak "$service/$proto: service unknown";
549	}	749	}
550		750
551	my @target = [$node, $port];
552
553	# resolve a records / provide sockaddr structures	751	# resolve a records / provide sockaddr structures
554	my $resolve = sub {	752	my $resolve = sub {
		753	my @target = @_;
		754
555	my @res;	755	my @res;
556	my $cv = AnyEvent->condvar (cb => sub {	756	my $cv = AE::cv {
557	$cb->(	757	$cb->(
558	map $_->[2],	758	map $_->[2],
559	sort {	759	sort {
560	$AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}	760	$AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}
561	or $a->[0] <=> $b->[0]	761	or $a->[0] <=> $b->[0]
562	}	762	}
563	@res	763	@res
564	)	764	)
565	});	765	};
566		766
567	$cv->begin;	767	$cv->begin;
568	for my $idx (0 .. $#target) {	768	for my $idx (0 .. $#target) {
569	my ($node, $port) = @{ $target[$idx] };	769	my ($node, $port) = @{ $target[$idx] };
570		770
…		…
579	if ($af == AF_INET6 && $family != 4) {	779	if ($af == AF_INET6 && $family != 4) {
580	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,	780	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
581	pack_sockaddr $port, $noden]]	781	pack_sockaddr $port, $noden]]
582	}	782	}
583	} else {	783	} else {
584	# ipv4	784	$node =~ y/A-Z/a-z/;
		785
		786	my $hosts = $HOSTS{$node};
		787
		788	# a records
585	if ($family != 6) {	789	if ($family != 6) {
586	$cv->begin;	790	$cv->begin;
587	AnyEvent::DNS::a $node, sub {	791	AnyEvent::DNS::a $node, sub {
588	push @res, [$idx, "ipv4", [AF_INET, $type, $proton,	792	push @res, [$idx, "ipv4", [AF_INET , $type, $proton, pack_sockaddr $port, parse_ipv4 $_]]
589	pack_sockaddr $port, parse_ipv4 $_]]
590	for @_;	793	for @_;
		794
		795	# dns takes precedence over hosts
		796	_load_hosts_unless {
		797	push @res,
		798	map [$idx, "ipv4", [AF_INET , $type, $proton, pack_sockaddr $port, $_]],
		799	@{ $HOSTS{$node}[0] };
591	$cv->end;	800	} $cv, @_;
592	};	801	};
593	}	802	}
594		803
595	# ipv6	804	# aaaa records
596	if ($family != 4) {	805	if ($family != 4) {
597	$cv->begin;	806	$cv->begin;
598	AnyEvent::DNS::aaaa $node, sub {	807	AnyEvent::DNS::aaaa $node, sub {
599	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,	808	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton, pack_sockaddr $port, parse_ipv6 $_]]
600	pack_sockaddr $port, parse_ipv6 $_]]
601	for @_;	809	for @_;
		810
		811	_load_hosts_unless {
		812	push @res,
		813	map [$idx + 0.5, "ipv6", [AF_INET6, $type, $proton, pack_sockaddr $port, $_]],
		814	@{ $HOSTS{$node}[1] }
602	$cv->end;	815	} $cv, @_;
603	};	816	};
604	}	817	}
605	}	818	}
606	}	819	}
607	$cv->end;	820	$cv->end;
608	};	821	};
609		822
		823	$node = AnyEvent::Util::idn_to_ascii $node
		824	if $node =~ /[^\x00-\x7f]/;
		825
610	# try srv records, if applicable	826	# try srv records, if applicable
611	if ($node eq "localhost") {	827	if ($node eq "localhost") {
612	@target = (["127.0.0.1", $port], ["::1", $port]);	828	$resolve->(["127.0.0.1", $port], ["::1", $port]);
613	&$resolve;
614	} elsif (defined $service && !parse_address $node) {	829	} elsif (defined $service && !parse_address $node) {
615	AnyEvent::DNS::srv $service, $proto, $node, sub {	830	AnyEvent::DNS::srv $service, $proto, $node, sub {
616	my (@srv) = @_;	831	my (@srv) = @_;
617		832
618	# no srv records, continue traditionally
619	@srv	833	if (@srv) {
620	or return &$resolve;
621
622	# the only srv record has "." ("" here) => abort	834	# the only srv record has "." ("" here) => abort
623	$srv[0][2] ne "" \|\| $#srv	835	$srv[0][2] ne "" \|\| $#srv
624	or return $cb->();	836	or return $cb->();
625		837
626	# use srv records then	838	# use srv records then
		839	$resolve->(
627	@target = map ["$_->[3].", $_->[2]],	840	map ["$_->[3].", $_->[2]],
628	grep $_->[3] ne ".",	841	grep $_->[3] ne ".",
629	@srv;	842	@srv
630		843	);
631	&$resolve;	844	} else {
		845	# no srv records, continue traditionally
		846	$resolve->([$node, $port]);
		847	}
632	};	848	};
633	} else {	849	} else {
634	&$resolve;	850	# most common case
		851	$resolve->([$node, $port]);
635	}	852	}
636	}	853	}
637		854
638	=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]	855	=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]
639		856
640	This is a convenience function that creates a TCP socket and makes a 100%	857	This is a convenience function that creates a TCP socket and makes a
641	non-blocking connect to the given C<$host> (which can be a hostname or	858	100% non-blocking connect to the given C<$host> (which can be a DNS/IDN
642	a textual IP address, or the string C<unix/> for UNIX domain sockets)	859	hostname or a textual IP address, or the string C<unix/> for UNIX domain
643	and C<$service> (which can be a numeric port number or a service name,	860	sockets) and C<$service> (which can be a numeric port number or a service
644	or a C<servicename=portnumber> string, or the pathname to a UNIX domain	861	name, or a C<servicename=portnumber> string, or the pathname to a UNIX
645	socket).	862	domain socket).
646		863
647	If both C<$host> and C<$port> are names, then this function will use SRV	864	If both C<$host> and C<$port> are names, then this function will use SRV
648	records to locate the real target(s).	865	records to locate the real target(s).
649		866
650	In either case, it will create a list of target hosts (e.g. for multihomed	867	In either case, it will create a list of target hosts (e.g. for multihomed
651	hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to	868	hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to
652	each in turn.	869	each in turn.
653		870
654	If the connect is successful, then the C<$connect_cb> will be invoked with	871	After the connection is established, then the C<$connect_cb> will be
655	the socket file handle (in non-blocking mode) as first and the peer host	872	invoked with the socket file handle (in non-blocking mode) as first, and
656	(as a textual IP address) and peer port as second and third arguments,	873	the peer host (as a textual IP address) and peer port as second and third
657	respectively. The fourth argument is a code reference that you can call	874	arguments, respectively. The fourth argument is a code reference that you
658	if, for some reason, you don't like this connection, which will cause	875	can call if, for some reason, you don't like this connection, which will
659	C<tcp_connect> to try the next one (or call your callback without any	876	cause C<tcp_connect> to try the next one (or call your callback without
660	arguments if there are no more connections). In most cases, you can simply	877	any arguments if there are no more connections). In most cases, you can
661	ignore this argument.	878	simply ignore this argument.
662		879
663	$cb->($filehandle, $host, $port, $retry)	880	$cb->($filehandle, $host, $port, $retry)
664		881
665	If the connect is unsuccessful, then the C<$connect_cb> will be invoked	882	If the connect is unsuccessful, then the C<$connect_cb> will be invoked
666	without any arguments and C<$!> will be set appropriately (with C<ENXIO>	883	without any arguments and C<$!> will be set appropriately (with C<ENXIO>
667	indicating a DNS resolution failure).	884	indicating a DNS resolution failure).
668		885
		886	The callback will I<never> be invoked before C<tcp_connect> returns, even
		887	if C<tcp_connect> was able to connect immediately (e.g. on unix domain
		888	sockets).
		889
669	The file handle is perfect for being plugged into L<AnyEvent::Handle>, but	890	The file handle is perfect for being plugged into L<AnyEvent::Handle>, but
670	can be used as a normal perl file handle as well.	891	can be used as a normal perl file handle as well.
671		892
672	Unless called in void context, C<tcp_connect> returns a guard object that	893	Unless called in void context, C<tcp_connect> returns a guard object that
673	will automatically abort connecting when it gets destroyed (it does not do	894	will automatically cancel the connection attempt when it gets destroyed
		895	- in which case the callback will not be invoked. Destroying it does not
674	anything to the socket after the connect was successful).	896	do anything to the socket after the connect was successful - you cannot
		897	"uncall" a callback that has been invoked already.
675		898
676	Sometimes you need to "prepare" the socket before connecting, for example,	899	Sometimes you need to "prepare" the socket before connecting, for example,
677	to C<bind> it to some port, or you want a specific connect timeout that	900	to C<bind> it to some port, or you want a specific connect timeout that
678	is lower than your kernel's default timeout. In this case you can specify	901	is lower than your kernel's default timeout. In this case you can specify
679	a second callback, C<$prepare_cb>. It will be called with the file handle	902	a second callback, C<$prepare_cb>. It will be called with the file handle
…		…
711	or die "unable to connect: $!";	934	or die "unable to connect: $!";
712		935
713	my $handle; # avoid direct assignment so on_eof has it in scope.	936	my $handle; # avoid direct assignment so on_eof has it in scope.
714	$handle = new AnyEvent::Handle	937	$handle = new AnyEvent::Handle
715	fh => $fh,	938	fh => $fh,
		939	on_error => sub {
		940	AE::log error => $_[2];
		941	$_[0]->destroy;
		942	},
716	on_eof => sub {	943	on_eof => sub {
717	undef $handle; # keep it alive till eof	944	$handle->destroy; # destroy handle
718	warn "done.\n";	945	AE::log info => "Done.";
719	};	946	};
720		947
721	$handle->push_write ("GET / HTTP/1.0\015\012\015\012");	948	$handle->push_write ("GET / HTTP/1.0\015\012\015\012");
722		949
723	$handle->push_read_line ("\015\012\015\012", sub {	950	$handle->push_read (line => "\015\012\015\012", sub {
724	my ($handle, $line) = @_;	951	my ($handle, $line) = @_;
725		952
726	# print response header	953	# print response header
727	print "HEADER\n$line\n\nBODY\n";	954	print "HEADER\n$line\n\nBODY\n";
728		955
…		…
748	=cut	975	=cut
749		976
750	sub tcp_connect($$$;$) {	977	sub tcp_connect($$$;$) {
751	my ($host, $port, $connect, $prepare) = @_;	978	my ($host, $port, $connect, $prepare) = @_;
752		979
753	# see http://cr.yp.to/docs/connect.html for some background	980	# see http://cr.yp.to/docs/connect.html for some tricky aspects
754	# also http://advogato.org/article/672.html	981	# also http://advogato.org/article/672.html
755		982
756	my %state = ( fh => undef );	983	my %state = ( fh => undef );
757		984
758	# name/service to type/sockaddr resolution	985	# name/service to type/sockaddr resolution
…		…
760	my @target = @_;	987	my @target = @_;
761		988
762	$state{next} = sub {	989	$state{next} = sub {
763	return unless exists $state{fh};	990	return unless exists $state{fh};
764		991
		992	my $errno = $!;
765	my $target = shift @target	993	my $target = shift @target
766	or do {	994	or return AE::postpone {
		995	return unless exists $state{fh};
767	%state = ();	996	%state = ();
		997	$! = $errno;
768	return $connect->();	998	$connect->();
769	};	999	};
770		1000
771	my ($domain, $type, $proto, $sockaddr) = @$target;	1001	my ($domain, $type, $proto, $sockaddr) = @$target;
772		1002
773	# socket creation	1003	# socket creation
…		…
778		1008
779	my $timeout = $prepare && $prepare->($state{fh});	1009	my $timeout = $prepare && $prepare->($state{fh});
780		1010
781	$timeout \|\|= 30 if AnyEvent::WIN32;	1011	$timeout \|\|= 30 if AnyEvent::WIN32;
782		1012
783	$state{to} = AnyEvent->timer (after => $timeout, cb => sub {	1013	$state{to} = AE::timer $timeout, 0, sub {
784	$! = &Errno::ETIMEDOUT;	1014	$! = Errno::ETIMEDOUT;
785	$state{next}();	1015	$state{next}();
786	}) if $timeout;	1016	} if $timeout;
787		1017
788	# called when the connect was successful, which,	1018	# now connect
789	# in theory, could be the case immediately (but never is in practise)	1019	if (
790	$state{connected} = sub {	1020	(connect $state{fh}, $sockaddr)
791	delete $state{ww};	1021	\|\| ($! == Errno::EINPROGRESS # POSIX
792	delete $state{to};	1022	\|\| $! == Errno::EWOULDBLOCK
793		1023	# WSAEINPROGRESS intentionally not checked - it means something else entirely
		1024	\|\| $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
		1025	\|\| $! == AnyEvent::Util::WSAEWOULDBLOCK)
		1026	) {
		1027	$state{ww} = AE::io $state{fh}, 1, sub {
794	# we are connected, or maybe there was an error	1028	# we are connected, or maybe there was an error
795	if (my $sin = getpeername $state{fh}) {	1029	if (my $sin = getpeername $state{fh}) {
796	my ($port, $host) = unpack_sockaddr $sin;	1030	my ($port, $host) = unpack_sockaddr $sin;
797		1031
		1032	delete $state{ww}; delete $state{to};
		1033
798	my $guard = guard { %state = () };	1034	my $guard = guard { %state = () };
799		1035
800	$connect->(delete $state{fh}, format_address $host, $port, sub {	1036	$connect->(delete $state{fh}, format_address $host, $port, sub {
801	$guard->cancel;	1037	$guard->cancel;
		1038	$state{next}();
		1039	});
		1040	} else {
		1041	if ($! == Errno::ENOTCONN) {
		1042	# dummy read to fetch real error code if !cygwin
		1043	sysread $state{fh}, my $buf, 1;
		1044
		1045	# cygwin 1.5 continously reports "ready' but never delivers
		1046	# an error with getpeername or sysread.
		1047	# cygwin 1.7 only reports readyness once, but is otherwise
		1048	# the same, which is actually more broken.
		1049	# Work around both by using unportable SO_ERROR for cygwin.
		1050	$! = (unpack "l", getsockopt $state{fh}, Socket::SOL_SOCKET(), Socket::SO_ERROR()) \|\| Errno::EAGAIN
		1051	if AnyEvent::CYGWIN && $! == Errno::EAGAIN;
		1052	}
		1053
		1054	return if $! == Errno::EAGAIN; # skip spurious wake-ups
		1055
		1056	delete $state{ww}; delete $state{to};
		1057
802	$state{next}();	1058	$state{next}();
803	});	1059	}
804	} else {
805	# dummy read to fetch real error code
806	sysread $state{fh}, my $buf, 1 if $! == &Errno::ENOTCONN;
807	$state{next}();
808	}	1060	};
809	};
810
811	# now connect
812	if (connect $state{fh}, $sockaddr) {
813	$state{connected}->();
814	} elsif ($! == &Errno::EINPROGRESS # POSIX
815	\|\| $! == &Errno::EWOULDBLOCK
816	# WSAEINPROGRESS intentionally not checked - it means something else entirely
817	\|\| $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
818	\|\| $! == AnyEvent::Util::WSAEWOULDBLOCK) {
819	$state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $state{connected});
820	} else {	1061	} else {
821	$state{next}();	1062	$state{next}();
822	}	1063	}
823	};	1064	};
824		1065
825	$! = &Errno::ENXIO;	1066	$! = Errno::ENXIO;
826	$state{next}();	1067	$state{next}();
827	};	1068	};
828		1069
829	defined wantarray && guard { %state = () }	1070	defined wantarray && guard { %state = () }
830	}	1071	}
831		1072
832	=item $guard = tcp_server $host, $service, $accept_cb[, $prepare_cb]	1073	=item $guard = tcp_server $host, $service, $accept_cb[, $prepare_cb]
833		1074
834	Create and bind a stream socket to the given host, and port, set the	1075	Create and bind a stream socket to the given host address and port, set
835	SO_REUSEADDR flag (if applicable) and call C<listen>. Unlike the name	1076	the SO_REUSEADDR flag (if applicable) and call C<listen>. Unlike the name
836	implies, this function can also bind on UNIX domain sockets.	1077	implies, this function can also bind on UNIX domain sockets.
837		1078
838	For internet sockets, C<$host> must be an IPv4 or IPv6 address (or	1079	For internet sockets, C<$host> must be an IPv4 or IPv6 address (or
839	C<undef>, in which case it binds either to C<0> or to C<::>, depending	1080	C<undef>, in which case it binds either to C<0> or to C<::>, depending
840	on whether IPv4 or IPv6 is the preferred protocol, and maybe to both in	1081	on whether IPv4 or IPv6 is the preferred protocol, and maybe to both in
841	future versions, as applicable).	1082	future versions, as applicable).
842		1083
843	To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6	1084	To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6
844	wildcard address, use C<::>.	1085	wildcard address, use C<::>.
845		1086
846	The port is specified by C<$service>, which must be either a service name or	1087	The port is specified by C<$service>, which must be either a service name
847	a numeric port number (or C<0> or C<undef>, in which case an ephemeral	1088	or a numeric port number (or C<0> or C<undef>, in which case an ephemeral
848	port will be used).	1089	port will be used).
849		1090
850	For UNIX domain sockets, C<$host> must be C<unix/> and C<$service> must be	1091	For UNIX domain sockets, C<$host> must be C<unix/> and C<$service> must be
851	the absolute pathname of the socket. This function will try to C<unlink>	1092	the absolute pathname of the socket. This function will try to C<unlink>
852	the socket before it tries to bind to it. See SECURITY CONSIDERATIONS,	1093	the socket before it tries to bind to it, and will try to unlink it after
853	below.	1094	it stops using it. See SECURITY CONSIDERATIONS, below.
854		1095
855	For each new connection that could be C<accept>ed, call the C<<	1096	For each new connection that could be C<accept>ed, call the C<<
856	$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking	1097	$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking
857	mode) as first and the peer host and port as second and third arguments	1098	mode) as first, and the peer host and port as second and third arguments
858	(see C<tcp_connect> for details).	1099	(see C<tcp_connect> for details).
859		1100
860	Croaks on any errors it can detect before the listen.	1101	Croaks on any errors it can detect before the listen.
861		1102
862	If called in non-void context, then this function returns a guard object	1103	If called in non-void context, then this function returns a guard object
863	whose lifetime it tied to the TCP server: If the object gets destroyed,	1104	whose lifetime it tied to the TCP server: If the object gets destroyed,
864	the server will be stopped (but existing accepted connections will	1105	the server will be stopped (but existing accepted connections will
865	continue).	1106	not be affected).
		1107
		1108	Regardless, when the function returns to the caller, the socket is bound
		1109	and in listening state.
866		1110
867	If you need more control over the listening socket, you can provide a	1111	If you need more control over the listening socket, you can provide a
868	C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the	1112	C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the
869	C<listen ()> call, with the listen file handle as first argument, and IP	1113	C<listen ()> call, with the listen file handle as first argument, and IP
870	address and port number of the local socket endpoint as second and third	1114	address and port number of the local socket endpoint as second and third
…		…
886	my ($fh, $host, $port) = @_;	1130	my ($fh, $host, $port) = @_;
887		1131
888	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";	1132	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
889	}, sub {	1133	}, sub {
890	my ($fh, $thishost, $thisport) = @_;	1134	my ($fh, $thishost, $thisport) = @_;
891	warn "bound to $thishost, port $thisport\n";	1135	AE::log info => "Bound to $thishost, port $thisport.";
892	};	1136	};
893		1137
894	Example: bind a server on a unix domain socket.	1138	Example: bind a server on a unix domain socket.
895		1139
896	tcp_server "unix/", "/tmp/mydir/mysocket", sub {	1140	tcp_server "unix/", "/tmp/mydir/mysocket", sub {
…		…
934	}	1178	}
935		1179
936	bind $state{fh}, pack_sockaddr $service, $ipn	1180	bind $state{fh}, pack_sockaddr $service, $ipn
937	or Carp::croak "bind: $!";	1181	or Carp::croak "bind: $!";
938		1182
		1183	if ($af == AF_UNIX) {
		1184	my $fh = $state{fh};
		1185	my $ino = (stat $fh)[1];
		1186	$state{unlink} = guard {
		1187	# this is racy, but is not designed to be foolproof, just best-effort
		1188	unlink $service
		1189	if $ino == (stat $fh)[1];
		1190	};
		1191	}
		1192
939	fh_nonblocking $state{fh}, 1;	1193	fh_nonblocking $state{fh}, 1;
940		1194
941	my $len;	1195	my $len;
942		1196
943	if ($prepare) {	1197	if ($prepare) {
…		…
948	$len \|\|= 128;	1202	$len \|\|= 128;
949		1203
950	listen $state{fh}, $len	1204	listen $state{fh}, $len
951	or Carp::croak "listen: $!";	1205	or Carp::croak "listen: $!";
952		1206
953	$state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {	1207	$state{aw} = AE::io $state{fh}, 0, sub {
954	# this closure keeps $state alive	1208	# this closure keeps $state alive
955	while (my $peer = accept my $fh, $state{fh}) {	1209	while ($state{fh} && (my $peer = accept my $fh, $state{fh})) {
956	fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not	1210	fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
957		1211
958	my ($service, $host) = unpack_sockaddr $peer;	1212	my ($service, $host) = unpack_sockaddr $peer;
959	$accept->($fh, format_address $host, $service);	1213	$accept->($fh, format_address $host, $service);
960	}	1214	}
961	});	1215	};
962		1216
963	defined wantarray	1217	defined wantarray
964	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency	1218	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
965	: ()	1219	: ()
966	}	1220	}
967		1221
968	1;	1222	=item tcp_nodelay $fh, $enable
		1223
		1224	Enables (or disables) the C<TCP_NODELAY> socket option (also known as
		1225	Nagle's algorithm). Returns false on error, true otherwise.
		1226
		1227	=cut
		1228
		1229	sub tcp_nodelay($$) {
		1230	my $onoff = int ! ! $_[1];
		1231
		1232	setsockopt $_[0], Socket::IPPROTO_TCP (), Socket::TCP_NODELAY (), $onoff
		1233	}
		1234
		1235	=item tcp_congestion $fh, $algorithm
		1236
		1237	Sets the tcp congestion avoidance algorithm (via the C<TCP_CONGESTION>
		1238	socket option). The default is OS-specific, but is usually
		1239	C<reno>. Typical other available choices include C<cubic>, C<lp>, C<bic>,
		1240	C<highspeed>, C<htcp>, C<hybla>, C<illinois>, C<scalable>, C<vegas>,
		1241	C<veno>, C<westwood> and C<yeah>.
		1242
		1243	=cut
		1244
		1245	sub tcp_congestion($$) {
		1246	defined TCP_CONGESTION
		1247	? setsockopt $_[0], Socket::IPPROTO_TCP (), TCP_CONGESTION, "$_[1]"
		1248	: undef
		1249	}
969		1250
970	=back	1251	=back
971		1252
972	=head1 SECURITY CONSIDERATIONS	1253	=head1 SECURITY CONSIDERATIONS
973		1254
…		…
979	harmful in general.	1260	harmful in general.
980		1261
981	=head1 AUTHOR	1262	=head1 AUTHOR
982		1263
983	Marc Lehmann <schmorp@schmorp.de>	1264	Marc Lehmann <schmorp@schmorp.de>
984	http://home.schmorp.de/	1265	http://anyevent.schmorp.de
985		1266
986	=cut	1267	=cut
987		1268
		1269	1
		1270

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents): Revision 1.83 by root, Mon Jun 29 21:00:32 2009 UTC vs. Revision 1.155 by root, Mon Oct 29 18:50:51 2012 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.83 by root, Mon Jun 29 21:00:32 2009 UTC vs.
Revision 1.155 by root, Mon Oct 29 18:50:51 2012 UTC