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

Comparing AnyEvent/lib/AnyEvent/Util.pm (file contents):
Revision 1.5 by root, Sun Apr 27 20:17:46 2008 UTC vs.
Revision 1.13 by root, Sat May 17 19:39:33 2008 UTC

…		…
21		21
22	use strict;	22	use strict;
23		23
24	no warnings "uninitialized";	24	no warnings "uninitialized";
25		25
		26	use Errno;
26	use Socket ();	27	use Socket ();
		28	use IO::Socket::INET ();
27		29
28	use AnyEvent;	30	use AnyEvent;
29		31
30	use base 'Exporter';	32	use base 'Exporter';
31		33
…		…
86	my $has_ev_adns;	88	my $has_ev_adns;
87		89
88	sub has_ev_adns {	90	sub has_ev_adns {
89	($has_ev_adns \|\|= do {	91	($has_ev_adns \|\|= do {
90	my $model = AnyEvent::detect;	92	my $model = AnyEvent::detect;
91	(($model eq "AnyEvent::Impl::CoroEV" or $model eq "AnyEvent::Impl::EV")
92	&& eval { local $SIG{__DIE__}; require EV::ADNS })	93	($model eq "AnyEvent::Impl::EV" && eval { local $SIG{__DIE__}; require EV::ADNS })
93	? 2 : 1 # so that \|\| always detects as true	94	? 2 : 1 # so that \|\| always detects as true
94	}) - 1 # 2 => true, 1 => false	95	}) - 1 # 2 => true, 1 => false
95	}	96	}
96		97
97	=item AnyEvent::Util::inet_aton $name_or_address, $cb->($binary_address_or_undef)	98	=item AnyEvent::Util::inet_aton $name_or_address, $cb->($binary_address_or_undef)
…		…
104	sub inet_aton {	105	sub inet_aton {
105	my ($name, $cb) = @_;	106	my ($name, $cb) = @_;
106		107
107	if (&dotted_quad) {	108	if (&dotted_quad) {
108	$cb->(Socket::inet_aton $name);	109	$cb->(Socket::inet_aton $name);
		110	} elsif ($name eq "localhost") { # rfc2606 et al.
		111	$cb->(v127.0.0.1);
109	} elsif (&has_ev_adns) {	112	} elsif (&has_ev_adns) {
110	EV::ADNS::submit ($name, &EV::ADNS::r_addr, 0, sub {	113	EV::ADNS::submit ($name, &EV::ADNS::r_addr, 0, sub {
111	my (undef, undef, @a) = @_;	114	my (undef, undef, @a) = @_;
112	$cb->(@a ? Socket::inet_aton $a[0] : undef);	115	$cb->(@a ? Socket::inet_aton $a[0] : undef);
113	});	116	});
114	} else {	117	} else {
115	_do_asy $cb, sub { Socket::inet_aton $_[0] }, @_;	118	_do_asy $cb, sub { Socket::inet_aton $_[0] }, @_;
116	}	119	}
117	}	120	}
118		121
		122	=item AnyEvent::Util::fh_nonblocking $fh, $nonblocking
		123
		124	Sets the blocking state of the given filehandle (true == nonblocking,
		125	false == blocking). Uses fcntl on anything sensible and ioctl FIONBIO on
		126	broken (i.e. windows) platforms.
		127
		128	=cut
		129
		130	sub fh_nonblocking($$) {
		131	my ($fh, $nb) = @_;
		132
		133	require Fcntl;
		134
		135	if ($^O eq "MSWin32") {
		136	$nb = (! ! $nb) + 0;
		137	ioctl $fh, 0x8004667e, \$nb; # FIONBIO
		138	} else {
		139	fcntl $fh, &Fcntl::F_SETFL, $nb ? &Fcntl::O_NONBLOCK : 0;
		140	}
		141	}
		142
		143	sub AnyEvent::Util::Guard::DESTROY {
		144	${$_[0]}->();
		145	}
		146
		147	=item $guard = AnyEvent::Util::guard { CODE }
		148
		149	This function creates a special object that, when called, will execute the
		150	code block.
		151
		152	This is often handy in continuation-passing style code to clean up some
		153	resource regardless of where you break out of a process.
		154
		155	=cut
		156
		157	sub guard(&) {
		158	bless \(my $cb = shift), AnyEvent::Util::Guard::
		159	}
		160
		161	=item my $guard = AnyEvent::Util::tcp_connect $host, $port, $connect_cb[, $prepare_cb]
		162
		163	This is a convenience function that creates a tcp socket and makes a 100%
		164	non-blocking connect to the given C<$host> (which can be a hostname or a
		165	textual IP address) and C<$port>.
		166
		167	Unless called in void context, it returns a guard object that will
		168	automatically abort connecting when it gets destroyed (it does not do
		169	anything to the socket after the conenct was successful).
		170
		171	If the connect is successful, then the C<$connect_cb> will be invoked with
		172	the socket filehandle (in non-blocking mode) as first and the peer host
		173	(as a textual IP address) and peer port as second and third arguments,
		174	respectively.
		175
		176	If the connect is unsuccessful, then the C<$connect_cb> will be invoked
		177	without any arguments and C<$!> will be set appropriately (with C<ENXIO>
		178	indicating a dns resolution failure).
		179
		180	The filehandle is suitable to be plugged into L<AnyEvent::Handle>, but can
		181	be used as a normal perl file handle as well.
		182
		183	Sometimes you need to "prepare" the socket before connecting, for example,
		184	to C<bind> it to some port, or you want a specific connect timeout that
		185	is lower than your kernel's default timeout. In this case you can specify
		186	a second callback, C<$prepare_cb>. It will be called with the file handle
		187	in not-yet-connected state as only argument and must return the connection
		188	timeout value (or C<0>, C<undef> or the empty list to indicate the default
		189	timeout is to be used).
		190
		191	Note that the socket could be either a IPv4 TCP socket or an IPv6 tcp
		192	socket (although only IPv4 is currently supported by this module).
		193
		194	Simple Example: connect to localhost on port 22.
		195
		196	AnyEvent::Util::tcp_connect localhost => 22, sub {
		197	my $fh = shift
		198	or die "unable to connect: $!";
		199	# do something
		200	};
		201
		202	Complex Example: connect to www.google.com on port 80 and make a simple
		203	GET request without much error handling. Also limit the connection timeout
		204	to 15 seconds.
		205
		206	AnyEvent::Util::tcp_connect "www.google.com", 80,
		207	sub {
		208	my ($fh) = @_
		209	or die "unable to connect: $!";
		210
		211	my $handle; # avoid direct assignment so on_eof has it in scope.
		212	$handle = new AnyEvent::Handle
		213	fh => $fh,
		214	on_eof => sub {
		215	undef $handle; # keep it alive till eof
		216	warn "done.\n";
		217	};
		218
		219	$handle->push_write ("GET / HTTP/1.0\015\012\015\012");
		220
		221	$handle->push_read_line ("\015\012\015\012", sub {
		222	my ($handle, $line) = @_;
		223
		224	# print response header
		225	print "HEADER\n$line\n\nBODY\n";
		226
		227	$handle->on_read (sub {
		228	# print response body
		229	print $_[0]->rbuf;
		230	$_[0]->rbuf = "";
		231	});
		232	});
		233	}, sub {
		234	my ($fh) = @_;
		235	# could call $fh->bind etc. here
		236
		237	15
		238	};
		239
		240	=cut
		241
		242	sub tcp_connect($$$;$) {
		243	my ($host, $port, $connect, $prepare) = @_;
		244
		245	# see http://cr.yp.to/docs/connect.html for some background
		246
		247	my %state = ( fh => undef );
		248
		249	# name resolution
		250	inet_aton $host, sub {
		251	return unless exists $state{fh};
		252
		253	my $ipn = shift
		254	or do {
		255	%state = ();
		256	$! = &Errno::ENXIO;
		257	return $connect->();
		258	};
		259
		260	# socket creation
		261	socket $state{fh}, &Socket::AF_INET, &Socket::SOCK_STREAM, 0
		262	or do {
		263	%state = ();
		264	return $connect->();
		265	};
		266
		267	fh_nonblocking $state{fh}, 1;
		268
		269	# prepare and optional timeout
		270	if ($prepare) {
		271	my $timeout = $prepare->($state{fh});
		272
		273	$state{to} = AnyEvent->timer (after => $timeout, cb => sub {
		274	%state = ();
		275	$! = &Errno::ETIMEDOUT;
		276	$connect->();
		277	}) if $timeout;
		278	}
		279
		280	# called when the connect was successful, which,
		281	# in theory, could be the case immediately (but never is in practise)
		282	my $connected = sub {
		283	my $fh = delete $state{fh};
		284	%state = ();
		285
		286	# we are connected, or maybe there was an error
		287	if (my $sin = getpeername $fh) {
		288	my ($port, $host) = Socket::unpack_sockaddr_in $sin;
		289	$connect->($fh, (Socket::inet_ntoa $host), $port);
		290	} else {
		291	# dummy read to fetch real error code
		292	sysread $fh, my $buf, 1;
		293	$connect->();
		294	}
		295	};
		296
		297	# now connect
		298	if (connect $state{fh}, Socket::pack_sockaddr_in $port, $ipn) {
		299	$connected->();
		300	} elsif ($! == &Errno::EINPROGRESS \|\| $! == &Errno::EWOULDBLOCK) { # EINPROGRESS is POSIX
		301	$state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected);
		302	} else {
		303	%state = ();
		304	$connect->();
		305	}
		306	};
		307
		308	defined wantarray
		309	? guard { %state = () } # break any circular dependencies and unregister watchers
		310	: ()
		311	}
		312
		313	=item $guard = AnyEvent::Util::tcp_server $host, $port, $accept_cb[, $prepare_cb]
		314
		315	Create and bind a tcp socket to the given host (any IPv4 host if undef,
		316	otherwise it must be an IPv4 or IPv6 address) and port (or an ephemeral
		317	port if given as zero or undef), set the SO_REUSEADDR flag and call
		318	C<listen>.
		319
		320	For each new connection that could be C<accept>ed, call the C<$accept_cb>
		321	with the filehandle (in non-blocking mode) as first and the peer host and
		322	port as second and third arguments (see C<tcp_connect> for details).
		323
		324	Croaks on any errors.
		325
		326	If called in non-void context, then this function returns a guard object
		327	whose lifetime it tied to the tcp server: If the object gets destroyed,
		328	the server will be stopped (but existing accepted connections will
		329	continue).
		330
		331	If you need more control over the listening socket, you can provide a
		332	C<$prepare_cb>, which is called just before the C<listen ()> call, with
		333	the listen file handle as first argument.
		334
		335	It should return the length of the listen queue (or C<0> for the default).
		336
		337	Example: bind on tcp port 8888 on the local machine and tell each client
		338	to go away.
		339
		340	AnyEvent::Util::tcp_server undef, 8888, sub {
		341	my ($fh, $host, $port) = @_;
		342
		343	syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
		344	};
		345
		346	=cut
		347
		348	sub tcp_server($$$;$) {
		349	my ($host, $port, $accept, $prepare) = @_;
		350
		351	my %state;
		352
		353	socket $state{fh}, &Socket::AF_INET, &Socket::SOCK_STREAM, 0
		354	or Carp::croak "socket: $!";
		355
		356	setsockopt $state{fh}, &Socket::SOL_SOCKET, &Socket::SO_REUSEADDR, 1
		357	or Carp::croak "so_reuseaddr: $!";
		358
		359	bind $state{fh}, Socket::pack_sockaddr_in $port, Socket::inet_aton ($host \|\| "0.0.0.0")
		360	or Carp::croak "bind: $!";
		361
		362	fh_nonblocking $state{fh}, 1;
		363
		364	my $len = ($prepare && $prepare->($state{fh})) \|\| 128;
		365
		366	listen $state{fh}, $len
		367	or Carp::croak "listen: $!";
		368
		369	$state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {
		370	# this closure keeps $state alive
		371	while (my $peer = accept my $fh, $state{fh}) {
		372	fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
		373	my ($port, $host) = Socket::unpack_sockaddr_in $peer;
		374	$accept->($fh, (Socket::inet_ntoa $host), $port);
		375	}
		376	});
		377
		378	defined wantarray
		379	? guard { %state = () } # clear fh and watcher, which breaks the circular dependency
		380	: ()
		381	}
		382
119	1;	383	1;
120		384
121	=back	385	=back
122		386
123	=head1 AUTHOR	387	=head1 AUTHOR

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Util.pm (file contents): Revision 1.5 by root, Sun Apr 27 20:17:46 2008 UTC vs. Revision 1.13 by root, Sat May 17 19:39:33 2008 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Util.pm (file contents):
Revision 1.5 by root, Sun Apr 27 20:17:46 2008 UTC vs.
Revision 1.13 by root, Sat May 17 19:39:33 2008 UTC