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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.34 by root, Wed May 28 21:07:07 2008 UTC vs.
Revision 1.123 by root, Sat Jun 5 10:01:52 2010 UTC

…		…
2		2
3	AnyEvent::Socket - useful IPv4 and IPv6 stuff.	3	AnyEvent::Socket - useful IPv4 and IPv6 stuff.
4		4
5	=head1 SYNOPSIS	5	=head1 SYNOPSIS
6		6
7	use AnyEvent::Socket;	7	use AnyEvent::Socket;
8		8
9	tcp_connect "gameserver.deliantra.net", 13327, sub {	9	tcp_connect "gameserver.deliantra.net", 13327, sub {
10	my ($fh) = @_	10	my ($fh) = @_
11	or die "gameserver.deliantra.net connect failed: $!";	11	or die "gameserver.deliantra.net connect failed: $!";
12		12
13	# enjoy your filehandle	13	# enjoy your filehandle
14	};	14	};
15		15
16	# a simple tcp server	16	# a simple tcp server
17	tcp_server undef, 8888, sub {	17	tcp_server undef, 8888, sub {
18	my ($fh, $host, $port) = @_;	18	my ($fh, $host, $port) = @_;
19		19
20	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";	20	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
21	};	21	};
22		22
23	=head1 DESCRIPTION	23	=head1 DESCRIPTION
24		24
25	This module implements various utility functions for handling internet	25	This module implements various utility functions for handling internet
26	protocol addresses and sockets, in an as transparent and simple way as	26	protocol addresses and sockets, in an as transparent and simple way as
…		…
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(
		49	getprotobyname
		50	parse_hostport format_hostport
52	parse_ipv4 parse_ipv6	51	parse_ipv4 parse_ipv6
53	parse_ip parse_address	52	parse_ip parse_address
		53	format_ipv4 format_ipv6
54	format_ip format_address	54	format_ip format_address
55	address_family	55	address_family
56	inet_aton	56	inet_aton
57	tcp_server	57	tcp_server
58	tcp_connect	58	tcp_connect
59	);	59	);
60		60
61	our $VERSION = '1.0';	61	our $VERSION = $AnyEvent::VERSION;
		62
		63	# used in cases where we may return immediately but want the
		64	# caller to do stuff first
		65	sub _postpone {
		66	my ($cb, @args) = (@_, $!);
		67
		68	my $w; $w = AE::timer 0, 0, sub {
		69	undef $w;
		70	$! = pop @args;
		71	$cb->(@args);
		72	};
		73	}
62		74
63	=item $ipn = parse_ipv4 $dotted_quad	75	=item $ipn = parse_ipv4 $dotted_quad
64		76
65	Tries to parse the given dotted quad IPv4 address and return it in	77	Tries to parse the given dotted quad IPv4 address and return it in
66	octet form (or undef when it isn't in a parsable format). Supports all	78	octet form (or undef when it isn't in a parsable format). Supports all
…		…
78		90
79	# check leading parts against range	91	# check leading parts against range
80	return undef if grep $_ >= 256, @_[0 .. @_ - 2];	92	return undef if grep $_ >= 256, @_[0 .. @_ - 2];
81		93
82	# check trailing part against range	94	# check trailing part against range
83	return undef if $_[-1] >= 1 << (8 * (4 - $#_));	95	return undef if $_[-1] >= 2 ** (8 * (4 - $#_));
84		96
85	pack "N", (pop)	97	pack "N", (pop)
86	+ ($_[0] << 24)	98	+ ($_[0] << 24)
87	+ ($_[1] << 16)	99	+ ($_[1] << 16)
88	+ ($_[2] << 8);	100	+ ($_[2] << 8);
…		…
97	forms supported by parse_ipv4). Note that scope-id's are not supported	109	forms supported by parse_ipv4). Note that scope-id's are not supported
98	(and will not parse).	110	(and will not parse).
99		111
100	This function works similarly to C<inet_pton AF_INET6, ...>.	112	This function works similarly to C<inet_pton AF_INET6, ...>.
101		113
		114	Example:
		115
		116	print unpack "H*", parse_ipv6 "2002:5345::10.0.0.1";
		117	# => 2002534500000000000000000a000001
		118
102	=cut	119	=cut
103		120
104	sub parse_ipv6($) {	121	sub parse_ipv6($) {
105	# quick test to avoid longer processing	122	# quick test to avoid longer processing
106	my $n = $_[0] =~ y/://;	123	my $n = $_[0] =~ y/://;
…		…
143	? pack "S", AF_UNIX	160	? pack "S", AF_UNIX
144	: undef	161	: undef
145		162
146	}	163	}
147		164
148	=item $ipn = parse_address $text	165	=item $ipn = parse_address $ip
149		166
150	Combines C<parse_ipv4> and C<parse_ipv6> in one function. The address	167	Combines C<parse_ipv4> and C<parse_ipv6> in one function. The address
151	here refers to the host address (not socket address) in network form	168	here refers to the host address (not socket address) in network form
152	(binary).	169	(binary).
153		170
154	If the C<$text> is C<unix/>, then this function returns a special token	171	If the C<$text> is C<unix/>, then this function returns a special token
155	recognised by the other functions in this module to mean "UNIX domain	172	recognised by the other functions in this module to mean "UNIX domain
156	socket".	173	socket".
157		174
		175	If the C<$text> to parse is a mapped IPv4 in IPv6 address (:ffff::<ipv4>),
		176	then it will be treated as an IPv4 address. If you don't want that, you
		177	have to call C<parse_ipv4> and/or C<parse_ipv6> manually.
		178
		179	Example:
		180
		181	print unpack "H*", parse_address "10.1.2.3";
		182	# => 0a010203
		183
		184	=item $ipn = AnyEvent::Socket::aton $ip
		185
		186	Same as C<parse_address>, but not exported (think C<Socket::inet_aton> but
		187	I<without> name resolution).
		188
158	=cut	189	=cut
159		190
160	sub parse_address($) {	191	sub parse_address($) {
161	&parse_ipv4 \|\| &parse_ipv6 \|\| &parse_unix	192	for (&parse_ipv6) {
		193	if ($_) {
		194	s/^\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff//;
		195	return $_;
		196	} else {
		197	return &parse_ipv4 \|\| &parse_unix
		198	}
		199	}
162	}	200	}
163		201
164	*parse_ip =\&parse_address; #d#	202	*aton = \&parse_address;
		203
		204	=item ($name, $aliases, $proto) = getprotobyname $name
		205
		206	Works like the builtin function of the same name, except it tries hard to
		207	work even on broken platforms (well, that's windows), where getprotobyname
		208	is traditionally very unreliable.
		209
		210	Example: get the protocol number for TCP (usually 6)
		211
		212	my $proto = getprotobyname "tcp";
		213
		214	=cut
		215
		216	# microsoft can't even get getprotobyname working (the etc/protocols file
		217	# gets lost fairly often on windows), so we have to hardcode some common
		218	# protocol numbers ourselves.
		219	our %PROTO_BYNAME;
		220
		221	$PROTO_BYNAME{tcp} = Socket::IPPROTO_TCP () if defined &Socket::IPPROTO_TCP;
		222	$PROTO_BYNAME{udp} = Socket::IPPROTO_UDP () if defined &Socket::IPPROTO_UDP;
		223	$PROTO_BYNAME{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP;
		224
		225	sub getprotobyname($) {
		226	my $name = lc shift;
		227
		228	defined (my $proton = $PROTO_BYNAME{$name} \|\| (getprotobyname $name)[2])
		229	or return;
		230
		231	($name, uc $name, $proton)
		232	}
		233
		234	=item ($host, $service) = parse_hostport $string[, $default_service]
		235
		236	Splitting a string of the form C<hostname:port> is a common
		237	problem. Unfortunately, just splitting on the colon makes it hard to
		238	specify IPv6 addresses and doesn't support the less common but well
		239	standardised C<[ip literal]> syntax.
		240
		241	This function tries to do this job in a better way, it supports the
		242	following formats, where C<port> can be a numerical port number of a
		243	service name, or a C<name=port> string, and the C< port> and C<:port>
		244	parts are optional. Also, everywhere where an IP address is supported
		245	a hostname or unix domain socket address is also supported (see
		246	C<parse_unix>).
		247
		248	hostname:port e.g. "www.linux.org", "www.x.de:443", "www.x.de:https=443"
		249	ipv4:port e.g. "198.182.196.56", "127.1:22"
		250	ipv6 e.g. "::1", "affe::1"
		251	[ipv4or6]:port e.g. "[::1]", "[10.0.1]:80"
		252	[ipv4or6] port e.g. "[127.0.0.1]", "[www.x.org] 17"
		253	ipv4or6 port e.g. "::1 443", "10.0.0.1 smtp"
		254
		255	It also supports defaulting the service name in a simple way by using
		256	C<$default_service> if no service was detected. If neither a service was
		257	detected nor a default was specified, then this function returns the
		258	empty list. The same happens when a parse error was detected, such as a
		259	hostname with a colon in it (the function is rather conservative, though).
		260
		261	Example:
		262
		263	print join ",", parse_hostport "localhost:443";
		264	# => "localhost,443"
		265
		266	print join ",", parse_hostport "localhost", "https";
		267	# => "localhost,https"
		268
		269	print join ",", parse_hostport "[::1]";
		270	# => "," (empty list)
		271
		272	=cut
		273
		274	sub parse_hostport($;$) {
		275	my ($host, $port);
		276
		277	for ("$_[0]") { # work on a copy, just in case, and also reset pos
		278
		279	# parse host, special cases: "ipv6" or "ipv6 port"
		280	unless (
		281	($host) = /^\s* ([0-9a-fA-F:]:[0-9a-fA-F:]:[0-9a-fA-F\.:]*)/xgc
		282	and parse_ipv6 $host
		283	) {
		284	/^\s*/xgc;
		285
		286	if (/^ \[ ([^\[\]]+) \]/xgc) {
		287	$host = $1;
		288	} elsif (/^ ([^\[\]:\ ]+) /xgc) {
		289	$host = $1;
		290	} else {
		291	return;
		292	}
		293	}
		294
		295	# parse port
		296	if (/\G (?:\s+\|:) ([^:[:space:]]+) \s*$/xgc) {
		297	$port = $1;
		298	} elsif (/\G\s*$/gc && length $_[1]) {
		299	$port = $_[1];
		300	} else {
		301	return;
		302	}
		303	}
		304
		305	# hostnames must not contain :'s
		306	return if $host =~ /:/ && !parse_ipv6 $host;
		307
		308	($host, $port)
		309	}
		310
		311	=item $string = format_hostport $host, $port
		312
		313	Takes a host (in textual form) and a port and formats in unambigiously in
		314	a way that C<parse_hostport> can parse it again. C<$port> can be C<undef>.
		315
		316	=cut
		317
		318	sub format_hostport($;$) {
		319	my ($host, $port) = @_;
		320
		321	$port = ":$port" if length $port;
		322	$host = "[$host]" if $host =~ /:/;
		323
		324	"$host$port"
		325	}
165		326
166	=item $sa_family = address_family $ipn	327	=item $sa_family = address_family $ipn
167		328
168	Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :)	329	Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :)
169	of the given host address in network format.	330	of the given host address in network format.
…		…
176	: 16 == length $_[0]	337	: 16 == length $_[0]
177	? AF_INET6	338	? AF_INET6
178	: unpack "S", $_[0]	339	: unpack "S", $_[0]
179	}	340	}
180		341
		342	=item $text = format_ipv4 $ipn
		343
		344	Expects a four octet string representing a binary IPv4 address and returns
		345	its textual format. Rarely used, see C<format_address> for a nicer
		346	interface.
		347
		348	=item $text = format_ipv6 $ipn
		349
		350	Expects a sixteen octet string representing a binary IPv6 address and
		351	returns its textual format. Rarely used, see C<format_address> for a
		352	nicer interface.
		353
181	=item $text = format_address $ipn	354	=item $text = format_address $ipn
182		355
183	Covnvert a host address in network format (e.g. 4 octets for IPv4 or 16	356	Covnvert a host address in network format (e.g. 4 octets for IPv4 or 16
184	octets for IPv6) and convert it into textual form.	357	octets for IPv6) and convert it into textual form.
185		358
…		…
188	This function works similarly to C<inet_ntop AF_INET \|\| AF_INET6, ...>,	361	This function works similarly to C<inet_ntop AF_INET \|\| AF_INET6, ...>,
189	except it automatically detects the address type.	362	except it automatically detects the address type.
190		363
191	Returns C<undef> if it cannot detect the type.	364	Returns C<undef> if it cannot detect the type.
192		365
193	=cut	366	If the C<$ipn> is a mapped IPv4 in IPv6 address (:ffff::<ipv4>), then just
		367	the contained IPv4 address will be returned. If you do not want that, you
		368	have to call C<format_ipv6> manually.
194		369
195	sub format_address;	370	Example:
196	sub format_address($) {	371
197	my $af = address_family $_[0];	372	print format_address "\x01\x02\x03\x05";
198	if ($af == AF_INET) {	373	=> 1.2.3.5
		374
		375	=item $text = AnyEvent::Socket::ntoa $ipn
		376
		377	Same as format_address, but not exported (think C<inet_ntoa>).
		378
		379	=cut
		380
		381	sub format_ipv4($) {
199	return join ".", unpack "C4", $_[0]	382	join ".", unpack "C4", $_[0]
200	} elsif ($af == AF_INET6) {	383	}
		384
		385	sub format_ipv6($) {
		386	if ($_[0] =~ /^\x00\x00\x00\x00\x00\x00\x00\x00/) {
		387	if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) {
		388	return "::";
		389	} elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) {
		390	return "::1";
201	if (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {	391	} elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {
202	# v4compatible	392	# v4compatible
203	return "::" . format_address substr $_[0], 12;	393	return "::" . format_ipv4 substr $_[0], 12;
204	} elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {	394	} elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {
205	# v4mapped	395	# v4mapped
206	return "::ffff:" . format_address substr $_[0], 12;	396	return "::ffff:" . format_ipv4 substr $_[0], 12;
207	} elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) {	397	} elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) {
208	# v4translated	398	# v4translated
209	return "::ffff:0:" . format_address substr $_[0], 12;	399	return "::ffff:0:" . format_ipv4 substr $_[0], 12;
210	} else {
211	my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
212
213	$ip =~ s/^0:(?:0:)*(0$)?/::/
214	or $ip =~ s/(:0)+$/::/
215	or $ip =~ s/(:0)+/:/;
216	return $ip
217	}	400	}
218	} elsif ($af == AF_UNIX) {	401	}
		402
		403	my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
		404
		405	# this is admittedly rather sucky
		406	$ip =~ s/(?:^\|:) 0:0:0:0:0:0:0 (?:$\|:)/::/x
		407	or $ip =~ s/(?:^\|:) 0:0:0:0:0:0 (?:$\|:)/::/x
		408	or $ip =~ s/(?:^\|:) 0:0:0:0:0 (?:$\|:)/::/x
		409	or $ip =~ s/(?:^\|:) 0:0:0:0 (?:$\|:)/::/x
		410	or $ip =~ s/(?:^\|:) 0:0:0 (?:$\|:)/::/x
		411	or $ip =~ s/(?:^\|:) 0:0 (?:$\|:)/::/x
		412	or $ip =~ s/(?:^\|:) 0 (?:$\|:)/::/x;
		413
		414	$ip
		415	}
		416
		417	sub format_address($) {
		418	if (4 == length $_[0]) {
		419	return &format_ipv4;
		420	} elsif (16 == length $_[0]) {
		421	return $_[0] =~ /^\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff(....)$/s
		422	? format_ipv4 $1
		423	: &format_ipv6;
		424	} elsif (AF_UNIX == address_family $_[0]) {
219	return "unix/"	425	return "unix/"
220	} else {	426	} else {
221	return undef	427	return undef
222	}	428	}
223	}	429	}
224		430
225	*format_ip = \&format_address;	431	*ntoa = \&format_address;
226		432
227	=item inet_aton $name_or_address, $cb->(@addresses)	433	=item inet_aton $name_or_address, $cb->(@addresses)
228		434
229	Works similarly to its Socket counterpart, except that it uses a	435	Works similarly to its Socket counterpart, except that it uses a
230	callback. Also, if a host has only an IPv6 address, this might be passed	436	callback. Use the length to distinguish between ipv4 and ipv6 (4 octets
231	to the callback instead (use the length to detect this - 4 for IPv4, 16	437	for IPv4, 16 for IPv6), or use C<format_address> to convert it to a more
232	for IPv6).	438	readable format.
233		439
234	Unlike the L<Socket> function of the same name, you can get multiple IPv4	440	Note that C<resolve_sockaddr>, while initially a more complex interface,
235	and IPv6 addresses as result (and maybe even other adrdess types).	441	resolves host addresses, IDNs, service names and SRV records and gives you
		442	an ordered list of socket addresses to try and should be preferred over
		443	C<inet_aton>.
		444
		445	Example.
		446
		447	inet_aton "www.google.com", my $cv = AE::cv;
		448	say unpack "H*", $_
		449	for $cv->recv;
		450	# => d155e363
		451	# => d155e367 etc.
		452
		453	inet_aton "ipv6.google.com", my $cv = AE::cv;
		454	say unpack "H*", $_
		455	for $cv->recv;
		456	# => 20014860a00300000000000000000068
236		457
237	=cut	458	=cut
238		459
239	sub inet_aton {	460	sub inet_aton {
240	my ($name, $cb) = @_;	461	my ($name, $cb) = @_;
…		…
246	} elsif ($name eq "localhost") { # rfc2606 et al.	467	} elsif ($name eq "localhost") { # rfc2606 et al.
247	$cb->(v127.0.0.1, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1);	468	$cb->(v127.0.0.1, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1);
248	} else {	469	} else {
249	require AnyEvent::DNS;	470	require AnyEvent::DNS;
250		471
251	# simple, bad suboptimal algorithm	472	my $ipv4 = $AnyEvent::PROTOCOL{ipv4};
		473	my $ipv6 = $AnyEvent::PROTOCOL{ipv6};
		474
		475	my @res;
		476
		477	my $cv = AE::cv {
		478	$cb->(map @$_, reverse @res);
		479	};
		480
		481	$cv->begin;
		482
		483	if ($ipv4) {
		484	$cv->begin;
252	AnyEvent::DNS::a ($name, sub {	485	AnyEvent::DNS::a ($name, sub {
253	if (@_) {	486	$res[$ipv4] = [map &parse_ipv4, @_];
254	$cb->(map +(parse_ipv4 $_), @_);
255	} else {
256	$cb->();	487	$cv->end;
257	#AnyEvent::DNS::aaaa ($name, $cb); need inet_pton
258	}	488	});
259	});	489	};
260	}
261	}
262		490
		491	if ($ipv6) {
		492	$cv->begin;
		493	AnyEvent::DNS::aaaa ($name, sub {
		494	$res[$ipv6] = [map &parse_ipv6, @_];
		495	$cv->end;
		496	});
		497	};
		498
		499	$cv->end;
		500	}
		501	}
		502
		503	BEGIN {
		504	*sockaddr_family = $Socket::VERSION >= 1.75
		505	? \&Socket::sockaddr_family
		506	: # for 5.6.x, we need to do something much more horrible
		507	(Socket::pack_sockaddr_in 0x5555, "\x55\x55\x55\x55"
		508	\| eval { Socket::pack_sockaddr_un "U" }) =~ /^\x00/
		509	? sub { unpack "xC", $_[0] }
		510	: sub { unpack "S" , $_[0] };
		511	}
		512
263	# check for broken platforms with extra field in sockaddr structure	513	# check for broken platforms with an extra field in sockaddr structure
264	# kind of a rfc vs. bsd issue, as usual (ok, normally it's a	514	# kind of a rfc vs. bsd issue, as usual (ok, normally it's a
265	# unix vs. bsd issue, a iso C vs. bsd issue or simply a	515	# unix vs. bsd issue, a iso C vs. bsd issue or simply a
266	# correctness vs. bsd issue.	516	# correctness vs. bsd issue.)
267	my $pack_family = 0x55 == Socket::sockaddr_family "\x55\x55"	517	my $pack_family = 0x55 == sockaddr_family ("\x55\x55")
268	? "xC" : "S";	518	? "xC" : "S";
269		519
270	=item $sa = AnyEvent::Socket::pack_sockaddr $service, $host	520	=item $sa = AnyEvent::Socket::pack_sockaddr $service, $host
271		521
272	Pack the given port/host combination into a binary sockaddr	522	Pack the given port/host combination into a binary sockaddr
273	structure. Handles both IPv4 and IPv6 host addresses, as well as UNIX	523	structure. Handles both IPv4 and IPv6 host addresses, as well as UNIX
274	domain sockets (C<$host> == C<unix/> and C<$service> == absolute	524	domain sockets (C<$host> == C<unix/> and C<$service> == absolute
275	pathname).	525	pathname).
		526
		527	Example:
		528
		529	my $bind = AnyEvent::Socket::pack_sockaddr 43, v195.234.53.120;
		530	bind $socket, $bind
		531	or die "bind: $!";
276		532
277	=cut	533	=cut
278		534
279	sub pack_sockaddr($$) {	535	sub pack_sockaddr($$) {
280	my $af = address_family $_[1];	536	my $af = address_family $_[1];
…		…
307	is a special token that is understood by the other functions in this	563	is a special token that is understood by the other functions in this
308	module (C<format_address> converts it to C<unix/>).	564	module (C<format_address> converts it to C<unix/>).
309		565
310	=cut	566	=cut
311		567
		568	# perl contains a bug (imho) where it requires that the kernel always returns
		569	# sockaddr_un structures of maximum length (which is not, AFAICS, required
		570	# by any standard). try to 0-pad structures for the benefit of those platforms.
		571
		572	my $sa_un_zero = eval { Socket::pack_sockaddr_un "" }; $sa_un_zero ^= $sa_un_zero;
		573
312	sub unpack_sockaddr($) {	574	sub unpack_sockaddr($) {
313	my $af = Socket::sockaddr_family $_[0];	575	my $af = sockaddr_family $_[0];
314		576
315	if ($af == AF_INET) {	577	if ($af == AF_INET) {
316	Socket::unpack_sockaddr_in $_[0]	578	Socket::unpack_sockaddr_in $_[0]
317	} elsif ($af == AF_INET6) {	579	} elsif ($af == AF_INET6) {
318	unpack "x2 n x4 a16", $_[0]	580	unpack "x2 n x4 a16", $_[0]
319	} elsif ($af == AF_UNIX) {	581	} elsif ($af == AF_UNIX) {
320	((Socket::unpack_sockaddr_un $_[0]), "unix/")	582	((Socket::unpack_sockaddr_un $_[0] ^ $sa_un_zero), pack "S", AF_UNIX)
321	} else {	583	} else {
322	Carp::croak "unpack_sockaddr: unsupported protocol family $af";	584	Carp::croak "unpack_sockaddr: unsupported protocol family $af";
323	}	585	}
324	}
325
326	sub _tcp_port($) {
327	$_[0] =~ /^(\d)$/ and return $11;
328
329	(getservbyname $_[0], "tcp")[2]
330	or Carp::croak "$_[0]: service unknown"
331	}	586	}
332		587
333	=item resolve_sockaddr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...)	588	=item resolve_sockaddr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...)
334		589
335	Tries to resolve the given nodename and service name into protocol families	590	Tries to resolve the given nodename and service name into protocol families
336	and sockaddr structures usable to connect to this node and service in a	591	and sockaddr structures usable to connect to this node and service in a
337	protocol-independent way. It works remotely similar to the getaddrinfo	592	protocol-independent way. It works remotely similar to the getaddrinfo
338	posix function.	593	posix function.
339		594
340	For internet addresses, C<$node> is either an IPv4 or IPv6 address or an	595	For internet addresses, C<$node> is either an IPv4 or IPv6 address, an
341	internet hostname, and C<$service> is either a service name (port name	596	internet hostname (DNS domain name or IDN), and C<$service> is either
342	from F</etc/services>) or a numerical port number. If both C<$node> and	597	a service name (port name from F</etc/services>) or a numerical port
343	C<$service> are names, then SRV records will be consulted to find the real	598	number. If both C<$node> and C<$service> are names, then SRV records
344	service, otherwise they will be used as-is. If you know that the service	599	will be consulted to find the real service, otherwise they will be
345	name is not in your services database, then you can specify the service in	600	used as-is. If you know that the service name is not in your services
346	the format C<name=port> (e.g. C<http=80>).	601	database, then you can specify the service in the format C<name=port>
		602	(e.g. C<http=80>).
347		603
348	For UNIX domain sockets, C<$node> must be the string C<unix/> and	604	For UNIX domain sockets, C<$node> must be the string C<unix/> and
349	C<$service> must be the absolute pathname of the socket. In this case,	605	C<$service> must be the absolute pathname of the socket. In this case,
350	C<$proto> will be ignored.	606	C<$proto> will be ignored.
351		607
…		…
353	C<sctp>. The default is currently C<tcp>, but in the future, this function	609	C<sctp>. The default is currently C<tcp>, but in the future, this function
354	might try to use other protocols such as C<sctp>, depending on the socket	610	might try to use other protocols such as C<sctp>, depending on the socket
355	type and any SRV records it might find.	611	type and any SRV records it might find.
356		612
357	C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use	613	C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use
358	only IPv4) or C<6> (use only IPv6). This setting might be influenced by	614	only IPv4) or C<6> (use only IPv6). The default is influenced by
359	C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.	615	C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.
360		616
361	C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or	617	C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or
362	C<undef> in which case it gets automatically chosen).	618	C<undef> in which case it gets automatically chosen to be C<SOCK_STREAM>
		619	unless C<$proto> is C<udp>).
363		620
364	The callback will receive zero or more array references that contain	621	The callback will receive zero or more array references that contain
365	C<$family, $type, $proto> for use in C<socket> and a binary	622	C<$family, $type, $proto> for use in C<socket> and a binary
366	C<$sockaddr> for use in C<connect> (or C<bind>).	623	C<$sockaddr> for use in C<connect> (or C<bind>).
367		624
…		…
375		632
376	sub resolve_sockaddr($$$$$$) {	633	sub resolve_sockaddr($$$$$$) {
377	my ($node, $service, $proto, $family, $type, $cb) = @_;	634	my ($node, $service, $proto, $family, $type, $cb) = @_;
378		635
379	if ($node eq "unix/") {	636	if ($node eq "unix/") {
380	return $cb->() if $family \|\| !/^\//; # no can do	637	return $cb->() if $family \|\| $service !~ /^\//; # no can do
381		638
382	return $cb->([AF_UNIX, $type, 0, Socket::pack_sockaddr_un $service]);	639	return $cb->([AF_UNIX, defined $type ? $type : SOCK_STREAM, 0, Socket::pack_sockaddr_un $service]);
383	}	640	}
384		641
385	unless (AF_INET6) {	642	unless (AF_INET6) {
386	$family != 6	643	$family != 6
387	or return $cb->();	644	or return $cb->();
…		…
396	$family \|\|= 6 unless $AnyEvent::PROTOCOL{ipv4};	653	$family \|\|= 6 unless $AnyEvent::PROTOCOL{ipv4};
397		654
398	$proto \|\|= "tcp";	655	$proto \|\|= "tcp";
399	$type \|\|= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;	656	$type \|\|= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
400		657
401	my $proton = (getprotobyname $proto)[2]	658	my $proton = getprotobyname $proto
402	or Carp::croak "$proto: protocol unknown";	659	or Carp::croak "$proto: protocol unknown";
403		660
404	my $port;	661	my $port;
405		662
406	if ($service =~ /^(\S+)=(\d+)$/) {	663	if ($service =~ /^(\S+)=(\d+)$/) {
407	($service, $port) = ($1, $2);	664	($service, $port) = ($1, $2);
408	} elsif ($service =~ /^\d+$/) {	665	} elsif ($service =~ /^\d+$/) {
409	($service, $port) = (undef, $service);	666	($service, $port) = (undef, $service);
410	} else {	667	} else {
411	$port = (getservbyname $service, $proto)[2]	668	$port = (getservbyname $service, $proto)[2]
412	or Carp::croak "$service/$proto: service unknown";	669	or Carp::croak "$service/$proto: service unknown";
413	}	670	}
414
415	my @target = [$node, $port];
416		671
417	# resolve a records / provide sockaddr structures	672	# resolve a records / provide sockaddr structures
418	my $resolve = sub {	673	my $resolve = sub {
		674	my @target = @_;
		675
419	my @res;	676	my @res;
420	my $cv = AnyEvent->condvar (cb => sub {	677	my $cv = AE::cv {
421	$cb->(	678	$cb->(
422	map $_->[2],	679	map $_->[2],
423	sort {	680	sort {
424	$AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}	681	$AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}
425	or $a->[0] <=> $b->[0]	682	or $a->[0] <=> $b->[0]
426	}	683	}
427	@res	684	@res
428	)	685	)
429	});	686	};
430		687
431	$cv->begin;	688	$cv->begin;
432	for my $idx (0 .. $#target) {	689	for my $idx (0 .. $#target) {
433	my ($node, $port) = @{ $target[$idx] };	690	my ($node, $port) = @{ $target[$idx] };
434		691
435	if (my $noden = parse_address $node) {	692	if (my $noden = parse_address $node) {
		693	my $af = address_family $noden;
		694
436	if (4 == length $noden && $family != 6) {	695	if ($af == AF_INET && $family != 6) {
437	push @res, [$idx, "ipv4", [AF_INET, $type, $proton,	696	push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
438	pack_sockaddr $port, $noden]]	697	pack_sockaddr $port, $noden]]
439	}	698	}
440		699
441	if (16 == length $noden && $family != 4) {	700	if ($af == AF_INET6 && $family != 4) {
442	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,	701	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
443	pack_sockaddr $port, $noden]]	702	pack_sockaddr $port, $noden]]
444	}	703	}
445	} else {	704	} else {
446	# ipv4	705	# ipv4
447	if ($family != 6) {	706	if ($family != 6) {
448	$cv->begin;	707	$cv->begin;
449	a $node, sub {	708	AnyEvent::DNS::a $node, sub {
450	push @res, [$idx, "ipv4", [AF_INET, $type, $proton,	709	push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
451	pack_sockaddr $port, parse_ipv4 $_]]	710	pack_sockaddr $port, parse_ipv4 $_]]
452	for @_;	711	for @_;
453	$cv->end;	712	$cv->end;
454	};	713	};
455	}	714	}
456		715
457	# ipv6	716	# ipv6
458	if ($family != 4) {	717	if ($family != 4) {
459	$cv->begin;	718	$cv->begin;
460	aaaa $node, sub {	719	AnyEvent::DNS::aaaa $node, sub {
461	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,	720	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
462	pack_sockaddr $port, parse_ipv6 $_]]	721	pack_sockaddr $port, parse_ipv6 $_]]
463	for @_;	722	for @_;
464	$cv->end;	723	$cv->end;
465	};	724	};
…		…
467	}	726	}
468	}	727	}
469	$cv->end;	728	$cv->end;
470	};	729	};
471		730
		731	$node = AnyEvent::Util::idn_to_ascii $node
		732	if $node =~ /[^\x00-\x7f]/;
		733
472	# try srv records, if applicable	734	# try srv records, if applicable
473	if ($node eq "localhost") {	735	if ($node eq "localhost") {
474	@target = (["127.0.0.1", $port], ["::1", $port]);	736	$resolve->(["127.0.0.1", $port], ["::1", $port]);
475	&$resolve;
476	} elsif (defined $service && !parse_address $node) {	737	} elsif (defined $service && !parse_address $node) {
477	srv $service, $proto, $node, sub {	738	AnyEvent::DNS::srv $service, $proto, $node, sub {
478	my (@srv) = @_;	739	my (@srv) = @_;
479		740
		741	if (@srv) {
		742	# the only srv record has "." ("" here) => abort
		743	$srv[0][2] ne "" \|\| $#srv
		744	or return $cb->();
		745
		746	# use srv records then
		747	$resolve->(
		748	map ["$_->[3].", $_->[2]],
		749	grep $_->[3] ne ".",
		750	@srv
		751	);
		752	} else {
480	# no srv records, continue traditionally	753	# no srv records, continue traditionally
		754	$resolve->([$node, $port]);
481	@srv	755	}
482	or return &$resolve;
483
484	# only srv record has "." => abort
485	$srv[0][2] ne "." \|\| $#srv
486	or return $cb->();
487
488	# use srv records then
489	@target = map ["$_->[3].", $_->[2]],
490	grep $_->[3] ne ".",
491	@srv;
492
493	&$resolve;
494	};	756	};
495	} else {	757	} else {
496	&$resolve;	758	# most common case
		759	$resolve->([$node, $port]);
497	}	760	}
498	}	761	}
499		762
500	=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]	763	=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]
501		764
502	This is a convenience function that creates a TCP socket and makes a 100%	765	This is a convenience function that creates a TCP socket and makes a
503	non-blocking connect to the given C<$host> (which can be a hostname or	766	100% non-blocking connect to the given C<$host> (which can be a DNS/IDN
504	a textual IP address, or the string C<unix/> for UNIX domain sockets)	767	hostname or a textual IP address, or the string C<unix/> for UNIX domain
505	and C<$service> (which can be a numeric port number or a service name,	768	sockets) and C<$service> (which can be a numeric port number or a service
506	or a C<servicename=portnumber> string, or the pathname to a UNIX domain	769	name, or a C<servicename=portnumber> string, or the pathname to a UNIX
507	socket).	770	domain socket).
508		771
509	If both C<$host> and C<$port> are names, then this function will use SRV	772	If both C<$host> and C<$port> are names, then this function will use SRV
510	records to locate the real target(s).	773	records to locate the real target(s).
511		774
512	In either case, it will create a list of target hosts (e.g. for multihomed	775	In either case, it will create a list of target hosts (e.g. for multihomed
513	hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to	776	hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to
514	each in turn.	777	each in turn.
515		778
516	If the connect is successful, then the C<$connect_cb> will be invoked with	779	After the connection is established, then the C<$connect_cb> will be
517	the socket file handle (in non-blocking mode) as first and the peer host	780	invoked with the socket file handle (in non-blocking mode) as first and
518	(as a textual IP address) and peer port as second and third arguments,	781	the peer host (as a textual IP address) and peer port as second and third
519	respectively. The fourth argument is a code reference that you can call	782	arguments, respectively. The fourth argument is a code reference that you
520	if, for some reason, you don't like this connection, which will cause	783	can call if, for some reason, you don't like this connection, which will
521	C<tcp_connect> to try the next one (or call your callback without any	784	cause C<tcp_connect> to try the next one (or call your callback without
522	arguments if there are no more connections). In most cases, you can simply	785	any arguments if there are no more connections). In most cases, you can
523	ignore this argument.	786	simply ignore this argument.
524		787
525	$cb->($filehandle, $host, $port, $retry)	788	$cb->($filehandle, $host, $port, $retry)
526		789
527	If the connect is unsuccessful, then the C<$connect_cb> will be invoked	790	If the connect is unsuccessful, then the C<$connect_cb> will be invoked
528	without any arguments and C<$!> will be set appropriately (with C<ENXIO>	791	without any arguments and C<$!> will be set appropriately (with C<ENXIO>
529	indicating a DNS resolution failure).	792	indicating a DNS resolution failure).
530		793
		794	The callback will I<never> be invoked before C<tcp_connect> returns, even
		795	if C<tcp_connect> was able to connect immediately (e.g. on unix domain
		796	sockets).
		797
531	The file handle is perfect for being plugged into L<AnyEvent::Handle>, but	798	The file handle is perfect for being plugged into L<AnyEvent::Handle>, but
532	can be used as a normal perl file handle as well.	799	can be used as a normal perl file handle as well.
533		800
534	Unless called in void context, C<tcp_connect> returns a guard object that	801	Unless called in void context, C<tcp_connect> returns a guard object that
535	will automatically abort connecting when it gets destroyed (it does not do	802	will automatically cancel the connection attempt when it gets destroyed
		803	- in which case the callback will not be invoked. Destroying it does not
536	anything to the socket after the connect was successful).	804	do anything to the socket after the connect was successful - you cannot
		805	"uncall" a callback that has been invoked already.
537		806
538	Sometimes you need to "prepare" the socket before connecting, for example,	807	Sometimes you need to "prepare" the socket before connecting, for example,
539	to C<bind> it to some port, or you want a specific connect timeout that	808	to C<bind> it to some port, or you want a specific connect timeout that
540	is lower than your kernel's default timeout. In this case you can specify	809	is lower than your kernel's default timeout. In this case you can specify
541	a second callback, C<$prepare_cb>. It will be called with the file handle	810	a second callback, C<$prepare_cb>. It will be called with the file handle
…		…
555	lessen the impact of this windows bug, a default timeout of 30 seconds	824	lessen the impact of this windows bug, a default timeout of 30 seconds
556	will be imposed on windows. Cygwin is not affected.	825	will be imposed on windows. Cygwin is not affected.
557		826
558	Simple Example: connect to localhost on port 22.	827	Simple Example: connect to localhost on port 22.
559		828
560	tcp_connect localhost => 22, sub {	829	tcp_connect localhost => 22, sub {
561	my $fh = shift	830	my $fh = shift
562	or die "unable to connect: $!";	831	or die "unable to connect: $!";
563	# do something	832	# do something
564	};	833	};
565		834
566	Complex Example: connect to www.google.com on port 80 and make a simple	835	Complex Example: connect to www.google.com on port 80 and make a simple
567	GET request without much error handling. Also limit the connection timeout	836	GET request without much error handling. Also limit the connection timeout
568	to 15 seconds.	837	to 15 seconds.
569		838
…		…
573	or die "unable to connect: $!";	842	or die "unable to connect: $!";
574		843
575	my $handle; # avoid direct assignment so on_eof has it in scope.	844	my $handle; # avoid direct assignment so on_eof has it in scope.
576	$handle = new AnyEvent::Handle	845	$handle = new AnyEvent::Handle
577	fh => $fh,	846	fh => $fh,
		847	on_error => sub {
		848	warn "error $_[2]\n";
		849	$_[0]->destroy;
		850	},
578	on_eof => sub {	851	on_eof => sub {
579	undef $handle; # keep it alive till eof	852	$handle->destroy; # destroy handle
580	warn "done.\n";	853	warn "done.\n";
581	};	854	};
582		855
583	$handle->push_write ("GET / HTTP/1.0\015\012\015\012");	856	$handle->push_write ("GET / HTTP/1.0\015\012\015\012");
584		857
585	$handle->push_read_line ("\015\012\015\012", sub {	858	$handle->push_read (line => "\015\012\015\012", sub {
586	my ($handle, $line) = @_;	859	my ($handle, $line) = @_;
587		860
588	# print response header	861	# print response header
589	print "HEADER\n$line\n\nBODY\n";	862	print "HEADER\n$line\n\nBODY\n";
590		863
…		…
610	=cut	883	=cut
611		884
612	sub tcp_connect($$$;$) {	885	sub tcp_connect($$$;$) {
613	my ($host, $port, $connect, $prepare) = @_;	886	my ($host, $port, $connect, $prepare) = @_;
614		887
615	# see http://cr.yp.to/docs/connect.html for some background	888	# see http://cr.yp.to/docs/connect.html for some tricky aspects
616	# also http://advogato.org/article/672.html	889	# also http://advogato.org/article/672.html
617		890
618	my %state = ( fh => undef );	891	my %state = ( fh => undef );
619		892
620	# name/service to type/sockaddr resolution	893	# name/service to type/sockaddr resolution
621	resolve_sockaddr $host, $port, 0, 0, 0, sub {	894	resolve_sockaddr $host, $port, 0, 0, undef, sub {
622	my @target = @_;	895	my @target = @_;
623		896
624	$state{next} = sub {	897	$state{next} = sub {
625	return unless exists $state{fh};	898	return unless exists $state{fh};
626		899
627	my $target = shift @target	900	my $target = shift @target
628	or do {	901	or return _postpone sub {
		902	return unless exists $state{fh};
629	%state = ();	903	%state = ();
630	return $connect->();	904	$connect->();
631	};	905	};
632		906
633	my ($domain, $type, $proto, $sockaddr) = @$target;	907	my ($domain, $type, $proto, $sockaddr) = @$target;
634		908
635	# socket creation	909	# socket creation
…		…
640		914
641	my $timeout = $prepare && $prepare->($state{fh});	915	my $timeout = $prepare && $prepare->($state{fh});
642		916
643	$timeout \|\|= 30 if AnyEvent::WIN32;	917	$timeout \|\|= 30 if AnyEvent::WIN32;
644		918
645	$state{to} = AnyEvent->timer (after => $timeout, cb => sub {	919	$state{to} = AE::timer $timeout, 0, sub {
646	$! = &Errno::ETIMEDOUT;	920	$! = Errno::ETIMEDOUT;
647	$state{next}();	921	$state{next}();
648	}) if $timeout;	922	} if $timeout;
649		923
650	# called when the connect was successful, which,	924	# now connect
651	# in theory, could be the case immediately (but never is in practise)	925	if (
652	my $connected = sub {	926	(connect $state{fh}, $sockaddr)
653	delete $state{ww};	927	\|\| ($! == Errno::EINPROGRESS # POSIX
654	delete $state{to};	928	\|\| $! == Errno::EWOULDBLOCK
655		929	# WSAEINPROGRESS intentionally not checked - it means something else entirely
		930	\|\| $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
		931	\|\| $! == AnyEvent::Util::WSAEWOULDBLOCK)
		932	) {
		933	$state{ww} = AE::io $state{fh}, 1, sub {
656	# we are connected, or maybe there was an error	934	# we are connected, or maybe there was an error
657	if (my $sin = getpeername $state{fh}) {	935	if (my $sin = getpeername $state{fh}) {
658	my ($port, $host) = unpack_sockaddr $sin;	936	my ($port, $host) = unpack_sockaddr $sin;
659		937
		938	delete $state{ww}; delete $state{to};
		939
660	my $guard = guard {	940	my $guard = guard { %state = () };
661	%state = ();
662	};
663		941
664	$connect->($state{fh}, format_address $host, $port, sub {	942	$connect->(delete $state{fh}, format_address $host, $port, sub {
665	$guard->cancel;	943	$guard->cancel;
		944	$state{next}();
		945	});
		946	} else {
		947	if ($! == Errno::ENOTCONN) {
		948	# dummy read to fetch real error code if !cygwin
		949	sysread $state{fh}, my $buf, 1;
		950
		951	# cygwin 1.5 continously reports "ready' but never delivers
		952	# an error with getpeername or sysread.
		953	# cygwin 1.7 only reports readyness once, but is otherwise
		954	# the same, which is atcually more broken.
		955	# Work around both by using unportable SO_ERROR for cygwin.
		956	$! = (unpack "l", getsockopt $state{fh}, Socket::SOL_SOCKET(), Socket::SO_ERROR()) \|\| Errno::EAGAIN
		957	if AnyEvent::CYGWIN && $! == Errno::EAGAIN;
		958	}
		959
		960	return if $! == Errno::EAGAIN; # skip spurious wake-ups
		961
		962	delete $state{ww}; delete $state{to};
		963
666	$state{next}();	964	$state{next}();
667	});	965	}
668	} else {
669	# dummy read to fetch real error code
670	sysread $state{fh}, my $buf, 1 if $! == &Errno::ENOTCONN;
671	$state{next}();
672	}	966	};
673	};
674
675	# now connect
676	if (connect $state{fh}, $sockaddr) {
677	$connected->();
678	} elsif ($! == &Errno::EINPROGRESS # POSIX
679	\|\| $! == &Errno::EWOULDBLOCK
680	# WSAEINPROGRESS intentionally not checked - it means something else entirely
681	\|\| $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
682	\|\| $! == AnyEvent::Util::WSAEWOULDBLOCK) {
683	$state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected);
684	} else {	967	} else {
685	$state{next}();	968	$state{next}();
686	}	969	}
687	};	970	};
688		971
689	$! = &Errno::ENXIO;	972	$! = Errno::ENXIO;
690	$state{next}();	973	$state{next}();
691	};	974	};
692		975
693	defined wantarray && guard { %state = () }	976	defined wantarray && guard { %state = () }
694	}	977	}
695		978
696	=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb]	979	=item $guard = tcp_server $host, $service, $accept_cb[, $prepare_cb]
697		980
698	Create and bind a TCP socket to the given host, and port, set the	981	Create and bind a stream socket to the given host, and port, set the
699	SO_REUSEADDR flag and call C<listen>.	982	SO_REUSEADDR flag (if applicable) and call C<listen>. Unlike the name
		983	implies, this function can also bind on UNIX domain sockets.
700		984
701	C<$host> must be an IPv4 or IPv6 address (or C<undef>, in which case it	985	For internet sockets, C<$host> must be an IPv4 or IPv6 address (or
702	binds either to C<0> or to C<::>, depending on whether IPv4 or IPv6 is the	986	C<undef>, in which case it binds either to C<0> or to C<::>, depending
703	preferred protocol).	987	on whether IPv4 or IPv6 is the preferred protocol, and maybe to both in
		988	future versions, as applicable).
704		989
705	To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6	990	To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6
706	wildcard address, use C<::>.	991	wildcard address, use C<::>.
707		992
708	The port is specified by C<$port>, which must be either a service name or	993	The port is specified by C<$service>, which must be either a service name or
709	a numeric port number (or C<0> or C<undef>, in which case an ephemeral	994	a numeric port number (or C<0> or C<undef>, in which case an ephemeral
710	port will be used).	995	port will be used).
		996
		997	For UNIX domain sockets, C<$host> must be C<unix/> and C<$service> must be
		998	the absolute pathname of the socket. This function will try to C<unlink>
		999	the socket before it tries to bind to it. See SECURITY CONSIDERATIONS,
		1000	below.
711		1001
712	For each new connection that could be C<accept>ed, call the C<<	1002	For each new connection that could be C<accept>ed, call the C<<
713	$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking	1003	$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking
714	mode) as first and the peer host and port as second and third arguments	1004	mode) as first and the peer host and port as second and third arguments
715	(see C<tcp_connect> for details).	1005	(see C<tcp_connect> for details).
…		…
727	address and port number of the local socket endpoint as second and third	1017	address and port number of the local socket endpoint as second and third
728	arguments.	1018	arguments.
729		1019
730	It should return the length of the listen queue (or C<0> for the default).	1020	It should return the length of the listen queue (or C<0> for the default).
731		1021
		1022	Note to IPv6 users: RFC-compliant behaviour for IPv6 sockets listening on
		1023	C<::> is to bind to both IPv6 and IPv4 addresses by default on dual-stack
		1024	hosts. Unfortunately, only GNU/Linux seems to implement this properly, so
		1025	if you want both IPv4 and IPv6 listening sockets you should create the
		1026	IPv6 socket first and then attempt to bind on the IPv4 socket, but ignore
		1027	any C<EADDRINUSE> errors.
		1028
732	Example: bind on some TCP port on the local machine and tell each client	1029	Example: bind on some TCP port on the local machine and tell each client
733	to go away.	1030	to go away.
734		1031
735	tcp_server undef, undef, sub {	1032	tcp_server undef, undef, sub {
736	my ($fh, $host, $port) = @_;	1033	my ($fh, $host, $port) = @_;
…		…
739	}, sub {	1036	}, sub {
740	my ($fh, $thishost, $thisport) = @_;	1037	my ($fh, $thishost, $thisport) = @_;
741	warn "bound to $thishost, port $thisport\n";	1038	warn "bound to $thishost, port $thisport\n";
742	};	1039	};
743		1040
		1041	Example: bind a server on a unix domain socket.
		1042
		1043	tcp_server "unix/", "/tmp/mydir/mysocket", sub {
		1044	my ($fh) = @_;
		1045	};
		1046
744	=cut	1047	=cut
745		1048
746	sub tcp_server($$$;$) {	1049	sub tcp_server($$$;$) {
747	my ($host, $port, $accept, $prepare) = @_;	1050	my ($host, $service, $accept, $prepare) = @_;
748		1051
749	$host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6	1052	$host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6
750	? "::" : "0"	1053	? "::" : "0"
751	unless defined $host;	1054	unless defined $host;
752		1055
753	my $ipn = parse_address $host	1056	my $ipn = parse_address $host
754	or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as host address";	1057	or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as host address";
755		1058
756	my $domain = 4 == length $ipn ? AF_INET : AF_INET6;	1059	my $af = address_family $ipn;
757		1060
758	my %state;	1061	my %state;
759		1062
		1063	# win32 perl is too stupid to get this right :/
		1064	Carp::croak "tcp_server/socket: address family not supported"
		1065	if AnyEvent::WIN32 && $af == AF_UNIX;
		1066
760	socket $state{fh}, $domain, SOCK_STREAM, 0	1067	socket $state{fh}, $af, SOCK_STREAM, 0
761	or Carp::croak "socket: $!";	1068	or Carp::croak "tcp_server/socket: $!";
762		1069
		1070	if ($af == AF_INET \|\| $af == AF_INET6) {
763	setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1	1071	setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1
764	or Carp::croak "so_reuseaddr: $!";	1072	or Carp::croak "tcp_server/so_reuseaddr: $!"
		1073	unless AnyEvent::WIN32; # work around windows bug
765		1074
		1075	unless ($service =~ /^\d*$/) {
		1076	$service = (getservbyname $service, "tcp")[2]
		1077	or Carp::croak "$service: service unknown"
		1078	}
		1079	} elsif ($af == AF_UNIX) {
		1080	unlink $service;
		1081	}
		1082
766	bind $state{fh}, pack_sockaddr _tcp_port $port, $ipn	1083	bind $state{fh}, pack_sockaddr $service, $ipn
767	or Carp::croak "bind: $!";	1084	or Carp::croak "bind: $!";
768		1085
769	fh_nonblocking $state{fh}, 1;	1086	fh_nonblocking $state{fh}, 1;
770		1087
771	my $len;	1088	my $len;
772		1089
773	if ($prepare) {	1090	if ($prepare) {
774	my ($port, $host) = unpack_sockaddr getsockname $state{fh};	1091	my ($service, $host) = unpack_sockaddr getsockname $state{fh};
775	$len = $prepare && $prepare->($state{fh}, format_address $host, $port);	1092	$len = $prepare && $prepare->($state{fh}, format_address $host, $service);
776	}	1093	}
777		1094
778	$len \|\|= 128;	1095	$len \|\|= 128;
779		1096
780	listen $state{fh}, $len	1097	listen $state{fh}, $len
781	or Carp::croak "listen: $!";	1098	or Carp::croak "listen: $!";
782		1099
783	$state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {	1100	$state{aw} = AE::io $state{fh}, 0, sub {
784	# this closure keeps $state alive	1101	# this closure keeps $state alive
785	while (my $peer = accept my $fh, $state{fh}) {	1102	while ($state{fh} && (my $peer = accept my $fh, $state{fh})) {
786	fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not	1103	fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
		1104
787	my ($port, $host) = unpack_sockaddr $peer;	1105	my ($service, $host) = unpack_sockaddr $peer;
788	$accept->($fh, format_address $host, $port);	1106	$accept->($fh, format_address $host, $service);
789	}	1107	}
790	});	1108	};
791		1109
792	defined wantarray	1110	defined wantarray
793	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency	1111	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
794	: ()	1112	: ()
795	}	1113	}
796		1114
797	1;	1115	1;
798		1116
799	=back	1117	=back
800		1118
		1119	=head1 SECURITY CONSIDERATIONS
		1120
		1121	This module is quite powerful, with with power comes the ability to abuse
		1122	as well: If you accept "hostnames" and ports from untrusted sources,
		1123	then note that this can be abused to delete files (host=C<unix/>). This
		1124	is not really a problem with this module, however, as blindly accepting
		1125	any address and protocol and trying to bind a server or connect to it is
		1126	harmful in general.
		1127
801	=head1 AUTHOR	1128	=head1 AUTHOR
802		1129
803	Marc Lehmann <schmorp@schmorp.de>	1130	Marc Lehmann <schmorp@schmorp.de>
804	http://home.schmorp.de/	1131	http://home.schmorp.de/
805		1132

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents): Revision 1.34 by root, Wed May 28 21:07:07 2008 UTC vs. Revision 1.123 by root, Sat Jun 5 10:01:52 2010 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.34 by root, Wed May 28 21:07:07 2008 UTC vs.
Revision 1.123 by root, Sat Jun 5 10:01:52 2010 UTC