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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.8 by root, Fri May 23 17:50:15 2008 UTC vs.
Revision 1.27 by root, Mon May 26 04:30:30 2008 UTC

…		…
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
		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
…		…
24	no warnings;	38	no warnings;
25	use strict;	39	use strict;
26		40
27	use Carp ();	41	use Carp ();
28	use Errno ();	42	use Errno ();
29	use Socket ();	43	use Socket qw(AF_INET SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR);
30		44
31	use AnyEvent ();	45	use AnyEvent ();
32	use AnyEvent::Util qw(guard fh_nonblocking);	46	use AnyEvent::Util qw(guard fh_nonblocking AF_INET6);
		47	use AnyEvent::DNS ();
33		48
34	use base 'Exporter';	49	use base 'Exporter';
35		50
36	BEGIN {	51	our @EXPORT = qw(parse_ipv4 parse_ipv6 parse_ip format_ip inet_aton tcp_server tcp_connect);
37	*socket_inet_aton = \&Socket::inet_aton; # take a copy, in case Coro::LWP overrides it
38	}
39
40	our @EXPORT = qw(inet_aton tcp_server tcp_connect);
41		52
42	our $VERSION = '1.0';	53	our $VERSION = '1.0';
43		54
44	sub dotted_quad($) {	55	=item $ipn = parse_ipv4 $dotted_quad
45	$_[0] =~ /^(?:25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)	56
46	\.(?:25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)	57	Tries to parse the given dotted quad IPv4 address and return it in
47	\.(?:25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)	58	octet form (or undef when it isn't in a parsable format). Supports all
48	\.(?:25[0-5]\|2[0-4][0-9]\|1[0-9][0-9]\|[0-9][0-9]?)$/x	59	forms specified by POSIX (e.g. C<10.0.0.1>, C<10.1>, C<10.0x020304>,
		60	C<0x12345678> or C<0377.0377.0377.0377>).
		61
		62	=cut
		63
		64	sub parse_ipv4($) {
		65	$_[0] =~ /^ (?: 0x[0-9a-fA-F]+ \| 0[0-7]* \| [1-9][0-9]* )
		66	(?:\. (?: 0x[0-9a-fA-F]+ \| 0[0-7]* \| [1-9][0-9]* ) ){0,3}$/x
		67	or return undef;
		68
		69	@_ = map /^0/ ? oct : $_, split /\./, $_[0];
		70
		71	# check leading parts against range
		72	return undef if grep $_ >= 256, @_[0 .. @_ - 2];
		73
		74	# check trailing part against range
		75	return undef if $_[-1] >= 1 << (8 * (4 - $#_));
		76
		77	pack "N", (pop)
		78	+ ($_[0] << 24)
		79	+ ($_[1] << 16)
		80	+ ($_[2] << 8);
		81	}
		82
		83	=item $ipn = parse_ipv6 $textual_ipv6_address
		84
		85	Tries to parse the given IPv6 address and return it in
		86	octet form (or undef when it isn't in a parsable format).
		87
		88	Should support all forms specified by RFC 2373 (and additionally all IPv4
		89	forms supported by parse_ipv4). Note that scope-id's are not supported
		90	(and will not parse).
		91
		92	This function works similarly to C<inet_pton AF_INET6, ...>.
		93
		94	=cut
		95
		96	sub parse_ipv6($) {
		97	# quick test to avoid longer processing
		98	my $n = $_[0] =~ y/://;
		99	return undef if $n < 2 \|\| $n > 8;
		100
		101	my ($h, $t) = split /::/, $_[0], 2;
		102
		103	unless (defined $t) {
		104	($h, $t) = (undef, $h);
		105	}
		106
		107	my @h = split /:/, $h;
		108	my @t = split /:/, $t;
		109
		110	# check for ipv4 tail
		111	if (@t && $t[-1]=~ /\./) {
		112	return undef if $n > 6;
		113
		114	my $ipn = parse_ipv4 pop @t
		115	or return undef;
		116
		117	push @t, map +(sprintf "%x", $_), unpack "nn", $ipn;
		118	}
		119
		120	# no :: then we need to have exactly 8 components
		121	return undef unless @h + @t == 8 \|\| $_[0] =~ /::/;
		122
		123	# now check all parts for validity
		124	return undef if grep !/^[0-9a-fA-F]{1,4}$/, @h, @t;
		125
		126	# now pad...
		127	push @h, 0 while @h + @t < 8;
		128
		129	# and done
		130	pack "n*", map hex, @h, @t
		131	}
		132
		133	=item $ipn = parse_ip $text
		134
		135	Combines C<parse_ipv4> and C<parse_ipv6> in one function.
		136
		137	=cut
		138
		139	sub parse_ip($) {
		140	&parse_ipv4 \|\| &parse_ipv6
		141	}
		142
		143	=item $text = format_ip $ipn
		144
		145	Takes either an IPv4 address (4 octets) or and IPv6 address (16 octets)
		146	and converts it into textual form.
		147
		148	This function works similarly to C<inet_ntop AF_INET \|\| AF_INET6, ...>,
		149	except it automatically detects the address type.
		150
		151	=cut
		152
		153	sub format_ip;
		154	sub format_ip($) {
		155	if (4 == length $_[0]) {
		156	return join ".", unpack "C4", $_[0]
		157	} elsif (16 == length $_[0]) {
		158	if (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {
		159	# v4mapped
		160	return "::ffff:" . format_ip substr $_[0], 12;
		161	} else {
		162	my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
		163
		164	$ip =~ s/^0:(?:0:)*(0$)?/::/
		165	or $ip =~ s/(:0)+$/::/
		166	or $ip =~ s/(:0)+/:/;
		167	return $ip
		168	}
		169	} else {
		170	return undef
		171	}
49	}	172	}
50		173
51	=item inet_aton $name_or_address, $cb->(@addresses)	174	=item inet_aton $name_or_address, $cb->(@addresses)
52		175
53	Works similarly to its Socket counterpart, except that it uses a	176	Works similarly to its Socket counterpart, except that it uses a
…		…
61	=cut	184	=cut
62		185
63	sub inet_aton {	186	sub inet_aton {
64	my ($name, $cb) = @_;	187	my ($name, $cb) = @_;
65		188
66	if (&dotted_quad) {	189	if (my $ipn = &parse_ipv4) {
67	$cb->(socket_inet_aton $name);	190	$cb->($ipn);
		191	} elsif (my $ipn = &parse_ipv6) {
		192	$cb->($ipn);
68	} elsif ($name eq "localhost") { # rfc2606 et al.	193	} elsif ($name eq "localhost") { # rfc2606 et al.
69	$cb->(v127.0.0.1);	194	$cb->(v127.0.0.1, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1);
70	} else {	195	} else {
71	require AnyEvent::DNS;	196	require AnyEvent::DNS;
72		197
73	# simple, bad suboptimal algorithm	198	# simple, bad suboptimal algorithm
74	AnyEvent::DNS::a ($name, sub {	199	AnyEvent::DNS::a ($name, sub {
75	if (@_) {	200	if (@_) {
76	$cb->(map +(socket_inet_aton $_), @_);	201	$cb->(map +(parse_ipv4 $_), @_);
77	} else {	202	} else {
78	$cb->();	203	$cb->();
79	#AnyEvent::DNS::aaaa ($name, $cb); need inet_pton	204	#AnyEvent::DNS::aaaa ($name, $cb); need inet_pton
80	}	205	}
81	});	206	});
82	}	207	}
83	}	208	}
84		209
		210	=item $sa = AnyEvent::Socket::pack_sockaddr $port, $host
		211
		212	Pack the given port/host combination into a binary sockaddr structure. Handles
		213	both IPv4 and IPv6 host addresses.
		214
		215	=cut
		216
		217	sub pack_sockaddr($$) {
		218	if (4 == length $_[1]) {
		219	Socket::pack_sockaddr_in $_[0], $_[1]
		220	} elsif (16 == length $_[1]) {
		221	pack "SnL a16 L",
		222	AF_INET6,
		223	$_[0], # port
		224	0, # flowinfo
		225	$_[1], # addr
		226	0 # scope id
		227	} else {
		228	Carp::croak "pack_sockaddr: invalid host";
		229	}
		230	}
		231
		232	=item ($port, $host) = AnyEvent::Socket::unpack_sockaddr $sa
		233
		234	Unpack the given binary sockaddr structure (as used by bind, getpeername
		235	etc.) into a C<$port, $host> combination.
		236
		237	Handles both IPv4 and IPv6 sockaddr structures.
		238
		239	=cut
		240
		241	sub unpack_sockaddr($) {
		242	my $af = unpack "S", $_[0];
		243
		244	if ($af == AF_INET) {
		245	Socket::unpack_sockaddr_in $_[0]
		246	} elsif ($af == AF_INET6) {
		247	unpack "x2 n x4 a16", $_[0]
		248	} else {
		249	Carp::croak "unpack_sockaddr: unsupported protocol family $af";
		250	}
		251	}
		252
85	sub _tcp_port($) {	253	sub _tcp_port($) {
86	$_[0] =~ /^(\d)$/ and return $11;	254	$_[0] =~ /^(\d)$/ and return $11;
87		255
88	(getservbyname $_[0], "tcp")[2]	256	(getservbyname $_[0], "tcp")[2]
89	or Carp::croak "$_[0]: service unknown"	257	or Carp::croak "$_[0]: service unknown"
90	}	258	}
91		259
92	=item $guard = tcp_connect $host, $port, $connect_cb[, $prepare_cb]	260	=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]
93		261
94	This is a convenience function that creates a tcp socket and makes a 100%	262	This is a convenience function that creates a TCP socket and makes a 100%
95	non-blocking connect to the given C<$host> (which can be a hostname or a	263	non-blocking connect to the given C<$host> (which can be a hostname or a
96	textual IP address) and C<$port> (which can be a numeric port number or a	264	textual IP address) and C<$service> (which can be a numeric port number or
97	service name).	265	a service name, or a C<servicename=portnumber> string).
98		266
99	If both C<$host> and C<$port> are names, then this function will use SRV	267	If both C<$host> and C<$port> are names, then this function will use SRV
100	records to locate the real target in a future version.	268	records to locate the real target(s).
101		269
102	Unless called in void context, it returns a guard object that will	270	In either case, it will create a list of target hosts (e.g. for multihomed
103	automatically abort connecting when it gets destroyed (it does not do	271	hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to
104	anything to the socket after the connect was successful).	272	each in turn.
105		273
106	If the connect is successful, then the C<$connect_cb> will be invoked with	274	If the connect is successful, then the C<$connect_cb> will be invoked with
107	the socket filehandle (in non-blocking mode) as first and the peer host	275	the socket file handle (in non-blocking mode) as first and the peer host
108	(as a textual IP address) and peer port as second and third arguments,	276	(as a textual IP address) and peer port as second and third arguments,
109	respectively.	277	respectively. The fourth argument is a code reference that you can call
		278	if, for some reason, you don't like this connection, which will cause
		279	C<tcp_connect> to try the next one (or call your callback without any
		280	arguments if there are no more connections). In most cases, you can simply
		281	ignore this argument.
		282
		283	$cb->($filehandle, $host, $port, $retry)
110		284
111	If the connect is unsuccessful, then the C<$connect_cb> will be invoked	285	If the connect is unsuccessful, then the C<$connect_cb> will be invoked
112	without any arguments and C<$!> will be set appropriately (with C<ENXIO>	286	without any arguments and C<$!> will be set appropriately (with C<ENXIO>
113	indicating a dns resolution failure).	287	indicating a DNS resolution failure).
114		288
115	The filehandle is suitable to be plugged into L<AnyEvent::Handle>, but can	289	The file handle is perfect for being plugged into L<AnyEvent::Handle>, but
116	be used as a normal perl file handle as well.	290	can be used as a normal perl file handle as well.
		291
		292	Unless called in void context, C<tcp_connect> returns a guard object that
		293	will automatically abort connecting when it gets destroyed (it does not do
		294	anything to the socket after the connect was successful).
117		295
118	Sometimes you need to "prepare" the socket before connecting, for example,	296	Sometimes you need to "prepare" the socket before connecting, for example,
119	to C<bind> it to some port, or you want a specific connect timeout that	297	to C<bind> it to some port, or you want a specific connect timeout that
120	is lower than your kernel's default timeout. In this case you can specify	298	is lower than your kernel's default timeout. In this case you can specify
121	a second callback, C<$prepare_cb>. It will be called with the file handle	299	a second callback, C<$prepare_cb>. It will be called with the file handle
122	in not-yet-connected state as only argument and must return the connection	300	in not-yet-connected state as only argument and must return the connection
123	timeout value (or C<0>, C<undef> or the empty list to indicate the default	301	timeout value (or C<0>, C<undef> or the empty list to indicate the default
124	timeout is to be used).	302	timeout is to be used).
125		303
126	Note that the socket could be either a IPv4 TCP socket or an IPv6 tcp	304	Note that the socket could be either a IPv4 TCP socket or an IPv6 TCP
127	socket (although only IPv4 is currently supported by this module).	305	socket (although only IPv4 is currently supported by this module).
		306
		307	Note to Microsoft Windows users: Windows (of course) doesn't correctly
		308	signal connection errors at all, so unless your event library works around
		309	this failed connections will simply hang and time-out. The only event
		310	library that handles this condition correctly is L<EV>, so this is highly
		311	recommended. To lessen the impact of this windows bug, a default timeout
		312	of 30 seconds will be imposed on windows. Cygwin is not affected.
128		313
129	Simple Example: connect to localhost on port 22.	314	Simple Example: connect to localhost on port 22.
130		315
131	tcp_connect localhost => 22, sub {	316	tcp_connect localhost => 22, sub {
132	my $fh = shift	317	my $fh = shift
…		…
180	# see http://cr.yp.to/docs/connect.html for some background	365	# see http://cr.yp.to/docs/connect.html for some background
181		366
182	my %state = ( fh => undef );	367	my %state = ( fh => undef );
183		368
184	# name resolution	369	# name resolution
185	inet_aton $host, sub {	370	AnyEvent::DNS::addr $host, $port, 0, 0, 0, sub {
		371	my @target = @_;
		372
		373	$state{next} = sub {
186	return unless exists $state{fh};	374	return unless exists $state{fh};
187		375
188	my $ipn = shift;	376	my $target = shift @target
189
190	4 == length $ipn
191	or do {	377	or do {
		378	%state = ();
		379	return $connect->();
		380	};
		381
		382	my ($domain, $type, $proto, $sockaddr) = @$target;
		383
		384	# socket creation
		385	socket $state{fh}, $domain, $type, $proto
		386	or return $state{next}();
		387
		388	fh_nonblocking $state{fh}, 1;
		389
		390	my $timeout = $prepare && $prepare->($state{fh});
		391
		392	$timeout \|\|= 30 if $^O =~ /mswin32/i;
		393
		394	$state{to} = AnyEvent->timer (after => $timeout, cb => sub {
		395	$! = &Errno::ETIMEDOUT;
		396	$state{next}();
		397	}) if $timeout;
		398
		399	# called when the connect was successful, which,
		400	# in theory, could be the case immediately (but never is in practise)
		401	my $connected = sub {
		402	delete $state{ww};
		403	delete $state{to};
		404
		405	# we are connected, or maybe there was an error
		406	if (my $sin = getpeername $state{fh}) {
		407	my ($port, $host) = unpack_sockaddr $sin;
		408
		409	my $guard = guard {
		410	%state = ();
		411	};
		412
		413	$connect->($state{fh}, format_ip $host, $port, sub {
		414	$guard->cancel;
		415	$state{next}();
		416	});
		417	} else {
		418	# dummy read to fetch real error code
		419	sysread $state{fh}, my $buf, 1 if $! == &Errno::ENOTCONN;
		420	$state{next}();
		421	}
		422	};
		423
		424	# now connect
		425	if (connect $state{fh}, $sockaddr) {
		426	$connected->();
		427	} elsif ($! == &Errno::EINPROGRESS \|\| $! == &Errno::EWOULDBLOCK) { # EINPROGRESS is POSIX
		428	$state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected);
		429	} else {
192	%state = ();	430	%state = ();
193	$! = &Errno::ENXIO;
194	return $connect->();
195	};
196
197	# socket creation
198	socket $state{fh}, &Socket::AF_INET, &Socket::SOCK_STREAM, 0
199	or do {
200	%state = ();
201	return $connect->();
202	};
203
204	fh_nonblocking $state{fh}, 1;
205
206	# prepare and optional timeout
207	if ($prepare) {
208	my $timeout = $prepare->($state{fh});
209
210	$state{to} = AnyEvent->timer (after => $timeout, cb => sub {
211	%state = ();
212	$! = &Errno::ETIMEDOUT;
213	$connect->();
214	}) if $timeout;
215	}
216
217	# called when the connect was successful, which,
218	# in theory, could be the case immediately (but never is in practise)
219	my $connected = sub {
220	my $fh = delete $state{fh};
221	%state = ();
222
223	# we are connected, or maybe there was an error
224	if (my $sin = getpeername $fh) {
225	my ($port, $host) = Socket::unpack_sockaddr_in $sin;
226	$connect->($fh, (Socket::inet_ntoa $host), $port);
227	} else {
228	# dummy read to fetch real error code
229	sysread $fh, my $buf, 1 if $! == &Errno::ENOTCONN;
230	$connect->();	431	$connect->();
231	}	432	}
232	};	433	};
233		434
234	# now connect	435	$! = &Errno::ENXIO;
235	if (connect $state{fh}, Socket::pack_sockaddr_in _tcp_port $port, $ipn) {	436	$state{next}();
236	$connected->();
237	} elsif ($! == &Errno::EINPROGRESS \|\| $! == &Errno::EWOULDBLOCK) { # EINPROGRESS is POSIX
238	$state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected);
239	} else {
240	%state = ();
241	$connect->();
242	}
243	};	437	};
244		438
245	defined wantarray	439	defined wantarray && guard { %state = () }
246	? guard { %state = () } # break any circular dependencies and unregister watchers
247	: ()
248	}	440	}
249		441
250	=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb]	442	=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb]
251		443
252	Create and bind a tcp socket to the given host (any IPv4 host if undef,	444	Create and bind a TCP socket to the given host, and port, set the
253	otherwise it must be an IPv4 or IPv6 address) and port (service name or
254	numeric port number, or an ephemeral port if given as zero or undef), set
255	the SO_REUSEADDR flag and call C<listen>.	445	SO_REUSEADDR flag and call C<listen>.
256		446
		447	C<$host> must be an IPv4 or IPv6 address (or C<undef>, in which case it
		448	binds either to C<0> or to C<::>, depending on whether IPv4 or IPv6 is the
		449	preferred protocol).
		450
		451	To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6
		452	wildcard address, use C<::>.
		453
		454	The port is specified by C<$port>, which must be either a service name or
		455	a numeric port number (or C<0> or C<undef>, in which case an ephemeral
		456	port will be used).
		457
257	For each new connection that could be C<accept>ed, call the C<$accept_cb>	458	For each new connection that could be C<accept>ed, call the C<<
258	with the filehandle (in non-blocking mode) as first and the peer host and	459	$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking
259	port as second and third arguments (see C<tcp_connect> for details).	460	mode) as first and the peer host and port as second and third arguments
		461	(see C<tcp_connect> for details).
260		462
261	Croaks on any errors.	463	Croaks on any errors it can detect before the listen.
262		464
263	If called in non-void context, then this function returns a guard object	465	If called in non-void context, then this function returns a guard object
264	whose lifetime it tied to the tcp server: If the object gets destroyed,	466	whose lifetime it tied to the TCP server: If the object gets destroyed,
265	the server will be stopped (but existing accepted connections will	467	the server will be stopped (but existing accepted connections will
266	continue).	468	continue).
267		469
268	If you need more control over the listening socket, you can provide a	470	If you need more control over the listening socket, you can provide a
269	C<$prepare_cb>, which is called just before the C<listen ()> call, with	471	C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the
270	the listen file handle as first argument.	472	C<listen ()> call, with the listen file handle as first argument, and IP
		473	address and port number of the local socket endpoint as second and third
		474	arguments.
271		475
272	It should return the length of the listen queue (or C<0> for the default).	476	It should return the length of the listen queue (or C<0> for the default).
273		477
274	Example: bind on tcp port 8888 on the local machine and tell each client	478	Example: bind on some TCP port on the local machine and tell each client
275	to go away.	479	to go away.
276		480
277	tcp_server undef, 8888, sub {	481	tcp_server undef, undef, sub {
278	my ($fh, $host, $port) = @_;	482	my ($fh, $host, $port) = @_;
279		483
280	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";	484	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
		485	}, sub {
		486	my ($fh, $thishost, $thisport) = @_;
		487	warn "bound to $thishost, port $thisport\n";
281	};	488	};
282		489
283	=cut	490	=cut
284		491
285	sub tcp_server($$$;$) {	492	sub tcp_server($$$;$) {
286	my ($host, $port, $accept, $prepare) = @_;	493	my ($host, $port, $accept, $prepare) = @_;
287		494
		495	$host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6
		496	? "::" : "0"
		497	unless defined $host;
		498
		499	my $ipn = parse_ip $host
		500	or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as IPv4 or IPv6 address";
		501
		502	my $domain = 4 == length $ipn ? AF_INET : AF_INET6;
		503
288	my %state;	504	my %state;
289		505
290	socket $state{fh}, &Socket::AF_INET, &Socket::SOCK_STREAM, 0	506	socket $state{fh}, $domain, SOCK_STREAM, 0
291	or Carp::croak "socket: $!";	507	or Carp::croak "socket: $!";
292		508
293	setsockopt $state{fh}, &Socket::SOL_SOCKET, &Socket::SO_REUSEADDR, 1	509	setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1
294	or Carp::croak "so_reuseaddr: $!";	510	or Carp::croak "so_reuseaddr: $!";
295		511
296	bind $state{fh}, Socket::pack_sockaddr_in _tcp_port $port, socket_inet_aton ($host \|\| "0.0.0.0")	512	bind $state{fh}, pack_sockaddr _tcp_port $port, $ipn
297	or Carp::croak "bind: $!";	513	or Carp::croak "bind: $!";
298		514
299	fh_nonblocking $state{fh}, 1;	515	fh_nonblocking $state{fh}, 1;
300		516
301	my $len = ($prepare && $prepare->($state{fh})) \|\| 128;	517	my $len;
		518
		519	if ($prepare) {
		520	my ($port, $host) = unpack_sockaddr getsockname $state{fh};
		521	$len = $prepare && $prepare->($state{fh}, format_ip $host, $port);
		522	}
		523
		524	$len \|\|= 128;
302		525
303	listen $state{fh}, $len	526	listen $state{fh}, $len
304	or Carp::croak "listen: $!";	527	or Carp::croak "listen: $!";
305		528
306	$state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {	529	$state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {
307	# this closure keeps $state alive	530	# this closure keeps $state alive
308	while (my $peer = accept my $fh, $state{fh}) {	531	while (my $peer = accept my $fh, $state{fh}) {
309	fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not	532	fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
310	my ($port, $host) = Socket::unpack_sockaddr_in $peer;	533	my ($port, $host) = unpack_sockaddr $peer;
311	$accept->($fh, (Socket::inet_ntoa $host), $port);	534	$accept->($fh, format_ip $host, $port);
312	}	535	}
313	});	536	});
314		537
315	defined wantarray	538	defined wantarray
316	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency	539	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents): Revision 1.8 by root, Fri May 23 17:50:15 2008 UTC vs. Revision 1.27 by root, Mon May 26 04:30:30 2008 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.8 by root, Fri May 23 17:50:15 2008 UTC vs.
Revision 1.27 by root, Mon May 26 04:30:30 2008 UTC