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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.11 by root, Fri May 23 20:09:56 2008 UTC vs.
Revision 1.157 by root, Wed Oct 31 15:42:06 2012 UTC

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

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents): Revision 1.11 by root, Fri May 23 20:09:56 2008 UTC vs. Revision 1.157 by root, Wed Oct 31 15:42:06 2012 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.11 by root, Fri May 23 20:09:56 2008 UTC vs.
Revision 1.157 by root, Wed Oct 31 15:42:06 2012 UTC