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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.37 by root, Wed May 28 21:52:20 2008 UTC vs.
Revision 1.130 by root, Fri Jan 14 17:43:11 2011 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]), pack "S", AF_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	}	586	}
325		587
…		…
328	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
329	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
330	protocol-independent way. It works remotely similar to the getaddrinfo	592	protocol-independent way. It works remotely similar to the getaddrinfo
331	posix function.	593	posix function.
332		594
333	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
334	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
335	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
336	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
337	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
338	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
339	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>).
340		603
341	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
342	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,
343	C<$proto> will be ignored.	606	C<$proto> will be ignored.
344		607
…		…
346	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
347	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
348	type and any SRV records it might find.	611	type and any SRV records it might find.
349		612
350	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
351	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
352	C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.	615	C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.
353		616
354	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
355	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>).
356		620
357	The callback will receive zero or more array references that contain	621	The callback will receive zero or more array references that contain
358	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
359	C<$sockaddr> for use in C<connect> (or C<bind>).	623	C<$sockaddr> for use in C<connect> (or C<bind>).
360		624
…		…
368		632
369	sub resolve_sockaddr($$$$$$) {	633	sub resolve_sockaddr($$$$$$) {
370	my ($node, $service, $proto, $family, $type, $cb) = @_;	634	my ($node, $service, $proto, $family, $type, $cb) = @_;
371		635
372	if ($node eq "unix/") {	636	if ($node eq "unix/") {
373	return $cb->() if $family \|\| !/^\//; # no can do	637	return $cb->() if $family \|\| $service !~ /^\//; # no can do
374		638
375	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]);
376	}	640	}
377		641
378	unless (AF_INET6) {	642	unless (AF_INET6) {
379	$family != 6	643	$family != 6
380	or return $cb->();	644	or return $cb->();
…		…
389	$family \|\|= 6 unless $AnyEvent::PROTOCOL{ipv4};	653	$family \|\|= 6 unless $AnyEvent::PROTOCOL{ipv4};
390		654
391	$proto \|\|= "tcp";	655	$proto \|\|= "tcp";
392	$type \|\|= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;	656	$type \|\|= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
393		657
394	my $proton = (getprotobyname $proto)[2]	658	my $proton = AnyEvent::Socket::getprotobyname $proto
395	or Carp::croak "$proto: protocol unknown";	659	or Carp::croak "$proto: protocol unknown";
396		660
397	my $port;	661	my $port;
398		662
399	if ($service =~ /^(\S+)=(\d+)$/) {	663	if ($service =~ /^(\S+)=(\d+)$/) {
…		…
403	} else {	667	} else {
404	$port = (getservbyname $service, $proto)[2]	668	$port = (getservbyname $service, $proto)[2]
405	or Carp::croak "$service/$proto: service unknown";	669	or Carp::croak "$service/$proto: service unknown";
406	}	670	}
407		671
408	my @target = [$node, $port];
409
410	# resolve a records / provide sockaddr structures	672	# resolve a records / provide sockaddr structures
411	my $resolve = sub {	673	my $resolve = sub {
		674	my @target = @_;
		675
412	my @res;	676	my @res;
413	my $cv = AnyEvent->condvar (cb => sub {	677	my $cv = AE::cv {
414	$cb->(	678	$cb->(
415	map $_->[2],	679	map $_->[2],
416	sort {	680	sort {
417	$AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}	681	$AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}
418	or $a->[0] <=> $b->[0]	682	or $a->[0] <=> $b->[0]
419	}	683	}
420	@res	684	@res
421	)	685	)
422	});	686	};
423		687
424	$cv->begin;	688	$cv->begin;
425	for my $idx (0 .. $#target) {	689	for my $idx (0 .. $#target) {
426	my ($node, $port) = @{ $target[$idx] };	690	my ($node, $port) = @{ $target[$idx] };
427		691
428	if (my $noden = parse_address $node) {	692	if (my $noden = parse_address $node) {
		693	my $af = address_family $noden;
		694
429	if (4 == length $noden && $family != 6) {	695	if ($af == AF_INET && $family != 6) {
430	push @res, [$idx, "ipv4", [AF_INET, $type, $proton,	696	push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
431	pack_sockaddr $port, $noden]]	697	pack_sockaddr $port, $noden]]
432	}	698	}
433		699
434	if (16 == length $noden && $family != 4) {	700	if ($af == AF_INET6 && $family != 4) {
435	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,	701	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
436	pack_sockaddr $port, $noden]]	702	pack_sockaddr $port, $noden]]
437	}	703	}
438	} else {	704	} else {
439	# ipv4	705	# ipv4
440	if ($family != 6) {	706	if ($family != 6) {
441	$cv->begin;	707	$cv->begin;
442	a $node, sub {	708	AnyEvent::DNS::a $node, sub {
443	push @res, [$idx, "ipv4", [AF_INET, $type, $proton,	709	push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
444	pack_sockaddr $port, parse_ipv4 $_]]	710	pack_sockaddr $port, parse_ipv4 $_]]
445	for @_;	711	for @_;
446	$cv->end;	712	$cv->end;
447	};	713	};
448	}	714	}
449		715
450	# ipv6	716	# ipv6
451	if ($family != 4) {	717	if ($family != 4) {
452	$cv->begin;	718	$cv->begin;
453	aaaa $node, sub {	719	AnyEvent::DNS::aaaa $node, sub {
454	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,	720	push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
455	pack_sockaddr $port, parse_ipv6 $_]]	721	pack_sockaddr $port, parse_ipv6 $_]]
456	for @_;	722	for @_;
457	$cv->end;	723	$cv->end;
458	};	724	};
…		…
460	}	726	}
461	}	727	}
462	$cv->end;	728	$cv->end;
463	};	729	};
464		730
		731	$node = AnyEvent::Util::idn_to_ascii $node
		732	if $node =~ /[^\x00-\x7f]/;
		733
465	# try srv records, if applicable	734	# try srv records, if applicable
466	if ($node eq "localhost") {	735	if ($node eq "localhost") {
467	@target = (["127.0.0.1", $port], ["::1", $port]);	736	$resolve->(["127.0.0.1", $port], ["::1", $port]);
468	&$resolve;
469	} elsif (defined $service && !parse_address $node) {	737	} elsif (defined $service && !parse_address $node) {
470	srv $service, $proto, $node, sub {	738	AnyEvent::DNS::srv $service, $proto, $node, sub {
471	my (@srv) = @_;	739	my (@srv) = @_;
472		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 {
473	# no srv records, continue traditionally	753	# no srv records, continue traditionally
		754	$resolve->([$node, $port]);
474	@srv	755	}
475	or return &$resolve;
476
477	# only srv record has "." => abort
478	$srv[0][2] ne "." \|\| $#srv
479	or return $cb->();
480
481	# use srv records then
482	@target = map ["$_->[3].", $_->[2]],
483	grep $_->[3] ne ".",
484	@srv;
485
486	&$resolve;
487	};	756	};
488	} else {	757	} else {
489	&$resolve;	758	# most common case
		759	$resolve->([$node, $port]);
490	}	760	}
491	}	761	}
492		762
493	=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]	763	=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]
494		764
495	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
496	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
497	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
498	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
499	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
500	socket).	770	domain socket).
501		771
502	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
503	records to locate the real target(s).	773	records to locate the real target(s).
504		774
505	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
506	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
507	each in turn.	777	each in turn.
508		778
509	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
510	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
511	(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
512	respectively. The fourth argument is a code reference that you can call	782	arguments, respectively. The fourth argument is a code reference that you
513	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
514	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
515	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
516	ignore this argument.	786	simply ignore this argument.
517		787
518	$cb->($filehandle, $host, $port, $retry)	788	$cb->($filehandle, $host, $port, $retry)
519		789
520	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
521	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>
522	indicating a DNS resolution failure).	792	indicating a DNS resolution failure).
523		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
524	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
525	can be used as a normal perl file handle as well.	799	can be used as a normal perl file handle as well.
526		800
527	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
528	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
529	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.
530		806
531	Sometimes you need to "prepare" the socket before connecting, for example,	807	Sometimes you need to "prepare" the socket before connecting, for example,
532	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
533	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
534	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
…		…
548	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
549	will be imposed on windows. Cygwin is not affected.	825	will be imposed on windows. Cygwin is not affected.
550		826
551	Simple Example: connect to localhost on port 22.	827	Simple Example: connect to localhost on port 22.
552		828
553	tcp_connect localhost => 22, sub {	829	tcp_connect localhost => 22, sub {
554	my $fh = shift	830	my $fh = shift
555	or die "unable to connect: $!";	831	or die "unable to connect: $!";
556	# do something	832	# do something
557	};	833	};
558		834
559	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
560	GET request without much error handling. Also limit the connection timeout	836	GET request without much error handling. Also limit the connection timeout
561	to 15 seconds.	837	to 15 seconds.
562		838
…		…
566	or die "unable to connect: $!";	842	or die "unable to connect: $!";
567		843
568	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.
569	$handle = new AnyEvent::Handle	845	$handle = new AnyEvent::Handle
570	fh => $fh,	846	fh => $fh,
		847	on_error => sub {
		848	warn "error $_[2]\n";
		849	$_[0]->destroy;
		850	},
571	on_eof => sub {	851	on_eof => sub {
572	undef $handle; # keep it alive till eof	852	$handle->destroy; # destroy handle
573	warn "done.\n";	853	warn "done.\n";
574	};	854	};
575		855
576	$handle->push_write ("GET / HTTP/1.0\015\012\015\012");	856	$handle->push_write ("GET / HTTP/1.0\015\012\015\012");
577		857
578	$handle->push_read_line ("\015\012\015\012", sub {	858	$handle->push_read (line => "\015\012\015\012", sub {
579	my ($handle, $line) = @_;	859	my ($handle, $line) = @_;
580		860
581	# print response header	861	# print response header
582	print "HEADER\n$line\n\nBODY\n";	862	print "HEADER\n$line\n\nBODY\n";
583		863
…		…
603	=cut	883	=cut
604		884
605	sub tcp_connect($$$;$) {	885	sub tcp_connect($$$;$) {
606	my ($host, $port, $connect, $prepare) = @_;	886	my ($host, $port, $connect, $prepare) = @_;
607		887
608	# see http://cr.yp.to/docs/connect.html for some background	888	# see http://cr.yp.to/docs/connect.html for some tricky aspects
609	# also http://advogato.org/article/672.html	889	# also http://advogato.org/article/672.html
610		890
611	my %state = ( fh => undef );	891	my %state = ( fh => undef );
612		892
613	# name/service to type/sockaddr resolution	893	# name/service to type/sockaddr resolution
614	resolve_sockaddr $host, $port, 0, 0, 0, sub {	894	resolve_sockaddr $host, $port, 0, 0, undef, sub {
615	my @target = @_;	895	my @target = @_;
616		896
617	$state{next} = sub {	897	$state{next} = sub {
618	return unless exists $state{fh};	898	return unless exists $state{fh};
619		899
620	my $target = shift @target	900	my $target = shift @target
621	or do {	901	or return _postpone sub {
		902	return unless exists $state{fh};
622	%state = ();	903	%state = ();
623	return $connect->();	904	$connect->();
624	};	905	};
625		906
626	my ($domain, $type, $proto, $sockaddr) = @$target;	907	my ($domain, $type, $proto, $sockaddr) = @$target;
627		908
628	# socket creation	909	# socket creation
…		…
633		914
634	my $timeout = $prepare && $prepare->($state{fh});	915	my $timeout = $prepare && $prepare->($state{fh});
635		916
636	$timeout \|\|= 30 if AnyEvent::WIN32;	917	$timeout \|\|= 30 if AnyEvent::WIN32;
637		918
638	$state{to} = AnyEvent->timer (after => $timeout, cb => sub {	919	$state{to} = AE::timer $timeout, 0, sub {
639	$! = &Errno::ETIMEDOUT;	920	$! = Errno::ETIMEDOUT;
640	$state{next}();	921	$state{next}();
641	}) if $timeout;	922	} if $timeout;
642		923
643	# called when the connect was successful, which,	924	# now connect
644	# in theory, could be the case immediately (but never is in practise)	925	if (
645	my $connected = sub {	926	(connect $state{fh}, $sockaddr)
646	delete $state{ww};	927	\|\| ($! == Errno::EINPROGRESS # POSIX
647	delete $state{to};	928	\|\| $! == Errno::EWOULDBLOCK
648		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 {
649	# we are connected, or maybe there was an error	934	# we are connected, or maybe there was an error
650	if (my $sin = getpeername $state{fh}) {	935	if (my $sin = getpeername $state{fh}) {
651	my ($port, $host) = unpack_sockaddr $sin;	936	my ($port, $host) = unpack_sockaddr $sin;
652		937
		938	delete $state{ww}; delete $state{to};
		939
653	my $guard = guard {	940	my $guard = guard { %state = () };
654	%state = ();
655	};
656		941
657	$connect->($state{fh}, format_address $host, $port, sub {	942	$connect->(delete $state{fh}, format_address $host, $port, sub {
658	$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 actually 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
659	$state{next}();	964	$state{next}();
660	});	965	}
661	} else {
662	# dummy read to fetch real error code
663	sysread $state{fh}, my $buf, 1 if $! == &Errno::ENOTCONN;
664	$state{next}();
665	}	966	};
666	};
667
668	# now connect
669	if (connect $state{fh}, $sockaddr) {
670	$connected->();
671	} elsif ($! == &Errno::EINPROGRESS # POSIX
672	\|\| $! == &Errno::EWOULDBLOCK
673	# WSAEINPROGRESS intentionally not checked - it means something else entirely
674	\|\| $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
675	\|\| $! == AnyEvent::Util::WSAEWOULDBLOCK) {
676	$state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected);
677	} else {	967	} else {
678	$state{next}();	968	$state{next}();
679	}	969	}
680	};	970	};
681		971
682	$! = &Errno::ENXIO;	972	$! = Errno::ENXIO;
683	$state{next}();	973	$state{next}();
684	};	974	};
685		975
686	defined wantarray && guard { %state = () }	976	defined wantarray && guard { %state = () }
687	}	977	}
…		…
691	Create and bind a stream socket to the given host, and port, set the	981	Create and bind a stream socket to the given host, and port, set the
692	SO_REUSEADDR flag (if applicable) and call C<listen>. Unlike the name	982	SO_REUSEADDR flag (if applicable) and call C<listen>. Unlike the name
693	implies, this function can also bind on UNIX domain sockets.	983	implies, this function can also bind on UNIX domain sockets.
694		984
695	For internet sockets, C<$host> must be an IPv4 or IPv6 address (or	985	For internet sockets, C<$host> must be an IPv4 or IPv6 address (or
696	C<undef>, in which case it binds either to C<0> or to C<::>, depending on	986	C<undef>, in which case it binds either to C<0> or to C<::>, depending
697	whether IPv4 or IPv6 is the preferred protocol).	987	on whether IPv4 or IPv6 is the preferred protocol, and maybe to both in
		988	future versions, as applicable).
698		989
699	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
700	wildcard address, use C<::>.	991	wildcard address, use C<::>.
701		992
702	The port is specified by C<$service>, which must be either a service name or	993	The port is specified by C<$service>, which must be either a service name or
…		…
708	the socket before it tries to bind to it. See SECURITY CONSIDERATIONS,	999	the socket before it tries to bind to it. See SECURITY CONSIDERATIONS,
709	below.	1000	below.
710		1001
711	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<<
712	$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
713	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
714	(see C<tcp_connect> for details).	1005	(see C<tcp_connect> for details).
715		1006
716	Croaks on any errors it can detect before the listen.	1007	Croaks on any errors it can detect before the listen.
717		1008
718	If called in non-void context, then this function returns a guard object	1009	If called in non-void context, then this function returns a guard object
719	whose lifetime it tied to the TCP server: If the object gets destroyed,	1010	whose lifetime it tied to the TCP server: If the object gets destroyed,
720	the server will be stopped (but existing accepted connections will	1011	the server will be stopped (but existing accepted connections will
721	continue).	1012	not be affected).
722		1013
723	If you need more control over the listening socket, you can provide a	1014	If you need more control over the listening socket, you can provide a
724	C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the	1015	C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the
725	C<listen ()> call, with the listen file handle as first argument, and IP	1016	C<listen ()> call, with the listen file handle as first argument, and IP
726	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
727	arguments.	1018	arguments.
728		1019
729	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).
730		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
731	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
732	to go away.	1030	to go away.
733		1031
734	tcp_server undef, undef, sub {	1032	tcp_server undef, undef, sub {
735	my ($fh, $host, $port) = @_;	1033	my ($fh, $host, $port) = @_;
736		1034
737	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";	1035	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
738	}, sub {	1036	}, sub {
739	my ($fh, $thishost, $thisport) = @_;	1037	my ($fh, $thishost, $thisport) = @_;
740	warn "bound to $thishost, port $thisport\n";	1038	warn "bound to $thishost, port $thisport\n";
		1039	};
		1040
		1041	Example: bind a server on a unix domain socket.
		1042
		1043	tcp_server "unix/", "/tmp/mydir/mysocket", sub {
		1044	my ($fh) = @_;
741	};	1045	};
742		1046
743	=cut	1047	=cut
744		1048
745	sub tcp_server($$$;$) {	1049	sub tcp_server($$$;$) {
…		…
791	$len \|\|= 128;	1095	$len \|\|= 128;
792		1096
793	listen $state{fh}, $len	1097	listen $state{fh}, $len
794	or Carp::croak "listen: $!";	1098	or Carp::croak "listen: $!";
795		1099
796	$state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {	1100	$state{aw} = AE::io $state{fh}, 0, sub {
797	# this closure keeps $state alive	1101	# this closure keeps $state alive
798	while (my $peer = accept my $fh, $state{fh}) {	1102	while ($state{fh} && (my $peer = accept my $fh, $state{fh})) {
799	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
800		1104
801	my ($service, $host) = unpack_sockaddr $peer;	1105	my ($service, $host) = unpack_sockaddr $peer;
802	$accept->($fh, format_address $host, $service);	1106	$accept->($fh, format_address $host, $service);
803	}	1107	}
804	});	1108	};
805		1109
806	defined wantarray	1110	defined wantarray
807	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency	1111	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
808	: ()	1112	: ()
809	}	1113	}
810		1114
		1115	=item tcp_nodelay $fh, $enable
		1116
		1117	Enables (or disables) the C<TCP_NODELAY> socket option (also known as
		1118	Nagle's algorithm). Returns false on error, true otherwise.
		1119
		1120	=cut
		1121
		1122	sub tcp_nodelay($$) {
		1123	my $onoff = int ! ! $_[1];
		1124
		1125	setsockopt $_[0], Socket::IPPROTO_TCP (), Socket::TCP_NODELAY (), $onoff
		1126	}
		1127
		1128	=item tcp_congestion $fh, $algorithm
		1129
		1130	Sets the tcp congestion avoidance algorithm (via the C<TCP_CONGESTION>
		1131	socket option). The default is OS-specific, but is usually
		1132	C<reno>. Typical other available choices include C<cubic>, C<lp>, C<bic>,
		1133	C<highspeed>, C<htcp>, C<hybla>, C<illinois>, C<scalable>, C<vegas>,
		1134	C<veno>, C<westwood> and C<yeah>.
		1135
		1136	=cut
		1137
		1138	sub tcp_congestion($$) {
		1139	defined TCP_CONGESTION
		1140	? setsockopt $_[0], Socket::IPPROTO_TCP (), TCP_CONGESTION, "$_[1]"
		1141	: undef
		1142	}
		1143
811	1;	1144	1;
812		1145
813	=back	1146	=back
		1147
		1148	=head1 SECURITY CONSIDERATIONS
		1149
		1150	This module is quite powerful, with with power comes the ability to abuse
		1151	as well: If you accept "hostnames" and ports from untrusted sources,
		1152	then note that this can be abused to delete files (host=C<unix/>). This
		1153	is not really a problem with this module, however, as blindly accepting
		1154	any address and protocol and trying to bind a server or connect to it is
		1155	harmful in general.
814		1156
815	=head1 AUTHOR	1157	=head1 AUTHOR
816		1158
817	Marc Lehmann <schmorp@schmorp.de>	1159	Marc Lehmann <schmorp@schmorp.de>
818	http://home.schmorp.de/	1160	http://home.schmorp.de/

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents): Revision 1.37 by root, Wed May 28 21:52:20 2008 UTC vs. Revision 1.130 by root, Fri Jan 14 17:43:11 2011 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.37 by root, Wed May 28 21:52:20 2008 UTC vs.
Revision 1.130 by root, Fri Jan 14 17:43:11 2011 UTC