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

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents):
Revision 1.158 by root, Fri Jul 24 08:40:35 2009 UTC vs.
Revision 1.185 by root, Thu Sep 3 19:48:27 2009 UTC

…		…
1	package AnyEvent::Handle;
2
3	use Scalar::Util ();
4	use Carp ();
5	use Errno qw(EAGAIN EINTR);
6
7	use AnyEvent (); BEGIN { AnyEvent::common_sense }
8	use AnyEvent::Util qw(WSAEWOULDBLOCK);
9
10	=head1 NAME	1	=head1 NAME
11		2
12	AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent	3	AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
13
14	=cut
15
16	our $VERSION = 4.86;
17		4
18	=head1 SYNOPSIS	5	=head1 SYNOPSIS
19		6
20	use AnyEvent;	7	use AnyEvent;
21	use AnyEvent::Handle;	8	use AnyEvent::Handle;
44	$cv->recv;	31	$cv->recv;
45		32
46	=head1 DESCRIPTION	33	=head1 DESCRIPTION
47		34
48	This module is a helper module to make it easier to do event-based I/O on	35	This module is a helper module to make it easier to do event-based I/O on
49	filehandles. For utility functions for doing non-blocking connects and accepts	36	filehandles.
50	on sockets see L<AnyEvent::Util>.
51		37
52	The L<AnyEvent::Intro> tutorial contains some well-documented	38	The L<AnyEvent::Intro> tutorial contains some well-documented
53	AnyEvent::Handle examples.	39	AnyEvent::Handle examples.
54		40
55	In the following, when the documentation refers to of "bytes" then this	41	In the following, when the documentation refers to of "bytes" then this
56	means characters. As sysread and syswrite are used for all I/O, their	42	means characters. As sysread and syswrite are used for all I/O, their
57	treatment of characters applies to this module as well.	43	treatment of characters applies to this module as well.
58		44
		45	At the very minimum, you should specify C<fh> or C<connect>, and the
		46	C<on_error> callback.
		47
59	All callbacks will be invoked with the handle object as their first	48	All callbacks will be invoked with the handle object as their first
60	argument.	49	argument.
61		50
		51	=cut
		52
		53	package AnyEvent::Handle;
		54
		55	use Scalar::Util ();
		56	use List::Util ();
		57	use Carp ();
		58	use Errno qw(EAGAIN EINTR);
		59
		60	use AnyEvent (); BEGIN { AnyEvent::common_sense }
		61	use AnyEvent::Util qw(WSAEWOULDBLOCK);
		62
		63	our $VERSION = $AnyEvent::VERSION;
		64
		65	sub _load_func($) {
		66	my $func = $_[0];
		67
		68	unless (defined &$func) {
		69	my $pkg = $func;
		70	do {
		71	$pkg =~ s/::[^:]+$//
		72	or return;
		73	eval "require $pkg";
		74	} until defined &$func;
		75	}
		76
		77	\&$func
		78	}
		79
62	=head1 METHODS	80	=head1 METHODS
63		81
64	=over 4	82	=over 4
65		83
66	=item $handle = B<new> AnyEvent::TLS fh => $filehandle, key => value...	84	=item $handle = B<new> AnyEvent::TLS fh => $filehandle, key => value...
67		85
68	The constructor supports these arguments (all as C<< key => value >> pairs).	86	The constructor supports these arguments (all as C<< key => value >> pairs).
69		87
70	=over 4	88	=over 4
71		89
72	=item fh => $filehandle [MANDATORY]
73
74	#=item fh => $filehandle [C<fh> or C<connect> MANDATORY]	90	=item fh => $filehandle [C<fh> or C<connect> MANDATORY]
75		91
76	The filehandle this L<AnyEvent::Handle> object will operate on.	92	The filehandle this L<AnyEvent::Handle> object will operate on.
77	NOTE: The filehandle will be set to non-blocking mode (using	93	NOTE: The filehandle will be set to non-blocking mode (using
78	C<AnyEvent::Util::fh_nonblocking>) by the constructor and needs to stay in	94	C<AnyEvent::Util::fh_nonblocking>) by the constructor and needs to stay in
79	that mode.	95	that mode.
80		96
81	#=item connect => [$host, $service]	97	=item connect => [$host, $service] [C<fh> or C<connect> MANDATORY]
82	#	98
83	# You have to specify either this parameter, or C<connect>, below.
84	#Try to connect to the specified host and service (port), using	99	Try to connect to the specified host and service (port), using
85	#C<AnyEvent::Socket::tcp_connect>.	100	C<AnyEvent::Socket::tcp_connect>. The C<$host> additionally becomes the
86	#	101	default C<peername>.
87	#When this	102
		103	You have to specify either this parameter, or C<fh>, above.
		104
		105	It is possible to push requests on the read and write queues, and modify
		106	properties of the stream, even while AnyEvent::Handle is connecting.
		107
		108	When this parameter is specified, then the C<on_prepare>,
		109	C<on_connect_error> and C<on_connect> callbacks will be called under the
		110	appropriate circumstances:
		111
		112	=over 4
		113
		114	=item on_prepare => $cb->($handle)
		115
		116	This (rarely used) callback is called before a new connection is
		117	attempted, but after the file handle has been created. It could be used to
		118	prepare the file handle with parameters required for the actual connect
		119	(as opposed to settings that can be changed when the connection is already
		120	established).
		121
		122	The return value of this callback should be the connect timeout value in
		123	seconds (or C<0>, or C<undef>, or the empty list, to indicate the default
		124	timeout is to be used).
		125
		126	=item on_connect => $cb->($handle, $host, $port, $retry->())
		127
		128	This callback is called when a connection has been successfully established.
		129
		130	The actual numeric host and port (the socket peername) are passed as
		131	parameters, together with a retry callback.
		132
		133	When, for some reason, the handle is not acceptable, then calling
		134	C<$retry> will continue with the next conenction target (in case of
		135	multi-homed hosts or SRV records there can be multiple connection
		136	endpoints). When it is called then the read and write queues, eof status,
		137	tls status and similar properties of the handle are being reset.
		138
		139	In most cases, ignoring the C<$retry> parameter is the way to go.
		140
		141	=item on_connect_error => $cb->($handle, $message)
		142
		143	This callback is called when the conenction could not be
		144	established. C<$!> will contain the relevant error code, and C<$message> a
		145	message describing it (usually the same as C<"$!">).
		146
		147	If this callback isn't specified, then C<on_error> will be called with a
		148	fatal error instead.
		149
		150	=back
		151
		152	=item on_error => $cb->($handle, $fatal, $message)
		153
		154	This is the error callback, which is called when, well, some error
		155	occured, such as not being able to resolve the hostname, failure to
		156	connect or a read error.
		157
		158	Some errors are fatal (which is indicated by C<$fatal> being true). On
		159	fatal errors the handle object will be destroyed (by a call to C<< ->
		160	destroy >>) after invoking the error callback (which means you are free to
		161	examine the handle object). Examples of fatal errors are an EOF condition
		162	with active (but unsatisifable) read watchers (C<EPIPE>) or I/O errors. In
		163	cases where the other side can close the connection at their will it is
		164	often easiest to not report C<EPIPE> errors in this callback.
		165
		166	AnyEvent::Handle tries to find an appropriate error code for you to check
		167	against, but in some cases (TLS errors), this does not work well. It is
		168	recommended to always output the C<$message> argument in human-readable
		169	error messages (it's usually the same as C<"$!">).
		170
		171	Non-fatal errors can be retried by simply returning, but it is recommended
		172	to simply ignore this parameter and instead abondon the handle object
		173	when this callback is invoked. Examples of non-fatal errors are timeouts
		174	C<ETIMEDOUT>) or badly-formatted data (C<EBADMSG>).
		175
		176	On callback entrance, the value of C<$!> contains the operating system
		177	error code (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT>, C<EBADMSG> or
		178	C<EPROTO>).
		179
		180	While not mandatory, it is I<highly> recommended to set this callback, as
		181	you will not be notified of errors otherwise. The default simply calls
		182	C<croak>.
		183
		184	=item on_read => $cb->($handle)
		185
		186	This sets the default read callback, which is called when data arrives
		187	and no read request is in the queue (unlike read queue callbacks, this
		188	callback will only be called when at least one octet of data is in the
		189	read buffer).
		190
		191	To access (and remove data from) the read buffer, use the C<< ->rbuf >>
		192	method or access the C<< $handle->{rbuf} >> member directly. Note that you
		193	must not enlarge or modify the read buffer, you can only remove data at
		194	the beginning from it.
		195
		196	When an EOF condition is detected then AnyEvent::Handle will first try to
		197	feed all the remaining data to the queued callbacks and C<on_read> before
		198	calling the C<on_eof> callback. If no progress can be made, then a fatal
		199	error will be raised (with C<$!> set to C<EPIPE>).
		200
		201	Note that, unlike requests in the read queue, an C<on_read> callback
		202	doesn't mean you I<require> some data: if there is an EOF and there
		203	are outstanding read requests then an error will be flagged. With an
		204	C<on_read> callback, the C<on_eof> callback will be invoked.
88		205
89	=item on_eof => $cb->($handle)	206	=item on_eof => $cb->($handle)
90		207
91	Set the callback to be called when an end-of-file condition is detected,	208	Set the callback to be called when an end-of-file condition is detected,
92	i.e. in the case of a socket, when the other side has closed the	209	i.e. in the case of a socket, when the other side has closed the
…		…
100	down.	217	down.
101		218
102	If an EOF condition has been detected but no C<on_eof> callback has been	219	If an EOF condition has been detected but no C<on_eof> callback has been
103	set, then a fatal error will be raised with C<$!> set to <0>.	220	set, then a fatal error will be raised with C<$!> set to <0>.
104		221
105	=item on_error => $cb->($handle, $fatal, $message)
106
107	This is the error callback, which is called when, well, some error
108	occured, such as not being able to resolve the hostname, failure to
109	connect or a read error.
110
111	Some errors are fatal (which is indicated by C<$fatal> being true). On
112	fatal errors the handle object will be destroyed (by a call to C<< ->
113	destroy >>) after invoking the error callback (which means you are free to
114	examine the handle object). Examples of fatal errors are an EOF condition
115	with active (but unsatisifable) read watchers (C<EPIPE>) or I/O errors.
116
117	AnyEvent::Handle tries to find an appropriate error code for you to check
118	against, but in some cases (TLS errors), this does not work well. It is
119	recommended to always output the C<$message> argument in human-readable
120	error messages (it's usually the same as C<"$!">).
121
122	Non-fatal errors can be retried by simply returning, but it is recommended
123	to simply ignore this parameter and instead abondon the handle object
124	when this callback is invoked. Examples of non-fatal errors are timeouts
125	C<ETIMEDOUT>) or badly-formatted data (C<EBADMSG>).
126
127	On callback entrance, the value of C<$!> contains the operating system
128	error code (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT>, C<EBADMSG> or
129	C<EPROTO>).
130
131	While not mandatory, it is I<highly> recommended to set this callback, as
132	you will not be notified of errors otherwise. The default simply calls
133	C<croak>.
134
135	=item on_read => $cb->($handle)
136
137	This sets the default read callback, which is called when data arrives
138	and no read request is in the queue (unlike read queue callbacks, this
139	callback will only be called when at least one octet of data is in the
140	read buffer).
141
142	To access (and remove data from) the read buffer, use the C<< ->rbuf >>
143	method or access the C<< $handle->{rbuf} >> member directly. Note that you
144	must not enlarge or modify the read buffer, you can only remove data at
145	the beginning from it.
146
147	When an EOF condition is detected then AnyEvent::Handle will first try to
148	feed all the remaining data to the queued callbacks and C<on_read> before
149	calling the C<on_eof> callback. If no progress can be made, then a fatal
150	error will be raised (with C<$!> set to C<EPIPE>).
151
152	Note that, unlike requests in the read queue, an C<on_read> callback
153	doesn't mean you I<require> some data: if there is an EOF and there
154	are outstanding read requests then an error will be flagged. With an
155	C<on_read> callback, the C<on_eof> callback will be invoked.
156
157	=item on_drain => $cb->($handle)	222	=item on_drain => $cb->($handle)
158		223
159	This sets the callback that is called when the write buffer becomes empty	224	This sets the callback that is called when the write buffer becomes empty
160	(or when the callback is set and the buffer is empty already).	225	(or when the callback is set and the buffer is empty already).
161		226
…		…
167	memory and push it into the queue, but instead only read more data from	232	memory and push it into the queue, but instead only read more data from
168	the file when the write queue becomes empty.	233	the file when the write queue becomes empty.
169		234
170	=item timeout => $fractional_seconds	235	=item timeout => $fractional_seconds
171		236
		237	=item rtimeout => $fractional_seconds
		238
		239	=item wtimeout => $fractional_seconds
		240
172	If non-zero, then this enables an "inactivity" timeout: whenever this many	241	If non-zero, then these enables an "inactivity" timeout: whenever this
173	seconds pass without a successful read or write on the underlying file	242	many seconds pass without a successful read or write on the underlying
174	handle, the C<on_timeout> callback will be invoked (and if that one is	243	file handle (or a call to C<timeout_reset>), the C<on_timeout> callback
175	missing, a non-fatal C<ETIMEDOUT> error will be raised).	244	will be invoked (and if that one is missing, a non-fatal C<ETIMEDOUT>
		245	error will be raised).
		246
		247	There are three variants of the timeouts that work fully independent
		248	of each other, for both read and write, just read, and just write:
		249	C<timeout>, C<rtimeout> and C<wtimeout>, with corresponding callbacks
		250	C<on_timeout>, C<on_rtimeout> and C<on_wtimeout>, and reset functions
		251	C<timeout_reset>, C<rtimeout_reset>, and C<wtimeout_reset>.
176		252
177	Note that timeout processing is also active when you currently do not have	253	Note that timeout processing is also active when you currently do not have
178	any outstanding read or write requests: If you plan to keep the connection	254	any outstanding read or write requests: If you plan to keep the connection
179	idle then you should disable the timout temporarily or ignore the timeout	255	idle then you should disable the timout temporarily or ignore the timeout
180	in the C<on_timeout> callback, in which case AnyEvent::Handle will simply	256	in the C<on_timeout> callback, in which case AnyEvent::Handle will simply
…		…
224	accomplishd by setting this option to a true value.	300	accomplishd by setting this option to a true value.
225		301
226	The default is your opertaing system's default behaviour (most likely	302	The default is your opertaing system's default behaviour (most likely
227	enabled), this option explicitly enables or disables it, if possible.	303	enabled), this option explicitly enables or disables it, if possible.
228		304
		305	=item keepalive => <boolean>
		306
		307	Enables (default disable) the SO_KEEPALIVE option on the stream socket:
		308	normally, TCP connections have no time-out once established, so TCP
		309	conenctions, once established, can stay alive forever even when the other
		310	side has long gone. TCP keepalives are a cheap way to take down long-lived
		311	TCP connections whent he other side becomes unreachable. While the default
		312	is OS-dependent, TCP keepalives usually kick in after around two hours,
		313	and, if the other side doesn't reply, take down the TCP connection some 10
		314	to 15 minutes later.
		315
		316	It is harmless to specify this option for file handles that do not support
		317	keepalives, and enabling it on connections that are potentially long-lived
		318	is usually a good idea.
		319
		320	=item oobinline => <boolean>
		321
		322	BSD majorly fucked up the implementation of TCP urgent data. The result
		323	is that almost no OS implements TCP according to the specs, and every OS
		324	implements it slightly differently.
		325
		326	If you want to handle TCP urgent data, then setting this flag (the default
		327	is enabled) gives you the most portable way of getting urgent data, by
		328	putting it into the stream.
		329
		330	Since BSD emulation of OOB data on top of TCP's urgent data can have
		331	security implications, AnyEvent::Handle sets this flag automatically
		332	unless explicitly specified. Note that setting this flag after
		333	establishing a connection I<may> be a bit too late (data loss could
		334	already have occured on BSD systems), but at least it will protect you
		335	from most attacks.
		336
229	=item read_size => <bytes>	337	=item read_size => <bytes>
230		338
231	The default read block size (the amount of bytes this module will	339	The default read block size (the amount of bytes this module will
232	try to read during each loop iteration, which affects memory	340	try to read during each loop iteration, which affects memory
233	requirements). Default: C<8192>.	341	requirements). Default: C<8192>.
…		…
359		467
360	sub new {	468	sub new {
361	my $class = shift;	469	my $class = shift;
362	my $self = bless { @_ }, $class;	470	my $self = bless { @_ }, $class;
363		471
364	$self->{fh} or Carp::croak "mandatory argument fh is missing";	472	if ($self->{fh}) {
		473	$self->_start;
		474	return unless $self->{fh}; # could be gone by now
		475
		476	} elsif ($self->{connect}) {
		477	require AnyEvent::Socket;
		478
		479	$self->{peername} = $self->{connect}[0]
		480	unless exists $self->{peername};
		481
		482	$self->{_skip_drain_rbuf} = 1;
		483
		484	{
		485	Scalar::Util::weaken (my $self = $self);
		486
		487	$self->{_connect} =
		488	AnyEvent::Socket::tcp_connect (
		489	$self->{connect}[0],
		490	$self->{connect}[1],
		491	sub {
		492	my ($fh, $host, $port, $retry) = @_;
		493
		494	if ($fh) {
		495	$self->{fh} = $fh;
		496
		497	delete $self->{_skip_drain_rbuf};
		498	$self->_start;
		499
		500	$self->{on_connect}
		501	and $self->{on_connect}($self, $host, $port, sub {
		502	delete @$self{qw(fh _tw _rtw _wtw _ww _rw _eof _queue rbuf _wbuf tls _tls_rbuf _tls_wbuf)};
		503	$self->{_skip_drain_rbuf} = 1;
		504	&$retry;
		505	});
		506
		507	} else {
		508	if ($self->{on_connect_error}) {
		509	$self->{on_connect_error}($self, "$!");
		510	$self->destroy;
		511	} else {
		512	$self->_error ($!, 1);
		513	}
		514	}
		515	},
		516	sub {
		517	local $self->{fh} = $_[0];
		518
		519	$self->{on_prepare}
		520	? $self->{on_prepare}->($self)
		521	: ()
		522	}
		523	);
		524	}
		525
		526	} else {
		527	Carp::croak "AnyEvent::Handle: either an existing fh or the connect parameter must be specified";
		528	}
		529
		530	$self
		531	}
		532
		533	sub _start {
		534	my ($self) = @_;
365		535
366	AnyEvent::Util::fh_nonblocking $self->{fh}, 1;	536	AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
367		537
		538	$self->{_activity} =
		539	$self->{_ractivity} =
368	$self->{_activity} = AnyEvent->now;	540	$self->{_wactivity} = AE::now;
369	$self->_timeout;
370		541
		542	$self->timeout (delete $self->{timeout} ) if $self->{timeout};
		543	$self->rtimeout (delete $self->{rtimeout} ) if $self->{rtimeout};
		544	$self->wtimeout (delete $self->{wtimeout} ) if $self->{wtimeout};
		545
371	$self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay};	546	$self->no_delay (delete $self->{no_delay} ) if exists $self->{no_delay} && $self->{no_delay};
		547	$self->keepalive (delete $self->{keepalive}) if exists $self->{keepalive} && $self->{keepalive};
372		548
		549	$self->oobinline (exists $self->{oobinline} ? delete $self->{oobinline} : 1);
		550
373	$self->starttls (delete $self->{tls}, delete $self->{tls_ctx})	551	$self->starttls (delete $self->{tls}, delete $self->{tls_ctx})
374	if $self->{tls};	552	if $self->{tls};
375		553
376	$self->on_drain (delete $self->{on_drain}) if $self->{on_drain};	554	$self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
377		555
378	$self->start_read	556	$self->start_read
379	if $self->{on_read};	557	if $self->{on_read} \|\| @{ $self->{_queue} };
380		558
381	$self->{fh} && $self	559	$self->_drain_wbuf;
382	}	560	}
383
384	#sub _shutdown {
385	# my ($self) = @_;
386	#
387	# delete @$self{qw(_tw _rw _ww fh wbuf on_read _queue)};
388	# $self->{_eof} = 1; # tell starttls et. al to stop trying
389	#
390	# &_freetls;
391	#}
392		561
393	sub _error {	562	sub _error {
394	my ($self, $errno, $fatal, $message) = @_;	563	my ($self, $errno, $fatal, $message) = @_;
395		564
396	$! = $errno;	565	$! = $errno;
…		…
433	$_[0]{on_eof} = $_[1];	602	$_[0]{on_eof} = $_[1];
434	}	603	}
435		604
436	=item $handle->on_timeout ($cb)	605	=item $handle->on_timeout ($cb)
437		606
438	Replace the current C<on_timeout> callback, or disables the callback (but	607	=item $handle->on_rtimeout ($cb)
439	not the timeout) if C<$cb> = C<undef>. See the C<timeout> constructor
440	argument and method.
441		608
442	=cut	609	=item $handle->on_wtimeout ($cb)
443		610
444	sub on_timeout {	611	Replace the current C<on_timeout>, C<on_rtimeout> or C<on_wtimeout>
445	$_[0]{on_timeout} = $_[1];	612	callback, or disables the callback (but not the timeout) if C<$cb> =
446	}	613	C<undef>. See the C<timeout> constructor argument and method.
		614
		615	=cut
		616
		617	# see below
447		618
448	=item $handle->autocork ($boolean)	619	=item $handle->autocork ($boolean)
449		620
450	Enables or disables the current autocork behaviour (see C<autocork>	621	Enables or disables the current autocork behaviour (see C<autocork>
451	constructor argument). Changes will only take effect on the next write.	622	constructor argument). Changes will only take effect on the next write.
…		…
466	sub no_delay {	637	sub no_delay {
467	$_[0]{no_delay} = $_[1];	638	$_[0]{no_delay} = $_[1];
468		639
469	eval {	640	eval {
470	local $SIG{__DIE__};	641	local $SIG{__DIE__};
471	setsockopt $_[0]{fh}, &Socket::IPPROTO_TCP, &Socket::TCP_NODELAY, int $_[1];	642	setsockopt $_[0]{fh}, Socket::IPPROTO_TCP (), Socket::TCP_NODELAY (), int $_[1]
		643	if $_[0]{fh};
		644	};
		645	}
		646
		647	=item $handle->keepalive ($boolean)
		648
		649	Enables or disables the C<keepalive> setting (see constructor argument of
		650	the same name for details).
		651
		652	=cut
		653
		654	sub keepalive {
		655	$_[0]{keepalive} = $_[1];
		656
		657	eval {
		658	local $SIG{__DIE__};
		659	setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_KEEPALIVE (), int $_[1]
		660	if $_[0]{fh};
		661	};
		662	}
		663
		664	=item $handle->oobinline ($boolean)
		665
		666	Enables or disables the C<oobinline> setting (see constructor argument of
		667	the same name for details).
		668
		669	=cut
		670
		671	sub oobinline {
		672	$_[0]{oobinline} = $_[1];
		673
		674	eval {
		675	local $SIG{__DIE__};
		676	setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_OOBINLINE (), int $_[1]
		677	if $_[0]{fh};
		678	};
		679	}
		680
		681	=item $handle->keepalive ($boolean)
		682
		683	Enables or disables the C<keepalive> setting (see constructor argument of
		684	the same name for details).
		685
		686	=cut
		687
		688	sub keepalive {
		689	$_[0]{keepalive} = $_[1];
		690
		691	eval {
		692	local $SIG{__DIE__};
		693	setsockopt $_[0]{fh}, Socket::SOL_SOCKET (), Socket::SO_KEEPALIVE (), int $_[1]
		694	if $_[0]{fh};
472	};	695	};
473	}	696	}
474		697
475	=item $handle->on_starttls ($cb)	698	=item $handle->on_starttls ($cb)
476		699
…		…
490		713
491	sub on_starttls {	714	sub on_starttls {
492	$_[0]{on_stoptls} = $_[1];	715	$_[0]{on_stoptls} = $_[1];
493	}	716	}
494		717
		718	=item $handle->rbuf_max ($max_octets)
		719
		720	Configures the C<rbuf_max> setting (C<undef> disables it).
		721
		722	=cut
		723
		724	sub rbuf_max {
		725	$_[0]{rbuf_max} = $_[1];
		726	}
		727
495	#############################################################################	728	#############################################################################
496		729
497	=item $handle->timeout ($seconds)	730	=item $handle->timeout ($seconds)
498		731
		732	=item $handle->rtimeout ($seconds)
		733
		734	=item $handle->wtimeout ($seconds)
		735
499	Configures (or disables) the inactivity timeout.	736	Configures (or disables) the inactivity timeout.
500		737
501	=cut	738	=item $handle->timeout_reset
502		739
503	sub timeout {	740	=item $handle->rtimeout_reset
		741
		742	=item $handle->wtimeout_reset
		743
		744	Reset the activity timeout, as if data was received or sent.
		745
		746	These methods are cheap to call.
		747
		748	=cut
		749
		750	for my $dir ("", "r", "w") {
		751	my $timeout = "${dir}timeout";
		752	my $tw = "_${dir}tw";
		753	my $on_timeout = "on_${dir}timeout";
		754	my $activity = "_${dir}activity";
		755	my $cb;
		756
		757	*$on_timeout = sub {
		758	$_[0]{$on_timeout} = $_[1];
		759	};
		760
		761	*$timeout = sub {
504	my ($self, $timeout) = @_;	762	my ($self, $new_value) = @_;
505		763
506	$self->{timeout} = $timeout;	764	$self->{$timeout} = $new_value;
507	$self->_timeout;	765	delete $self->{$tw}; &$cb;
508	}	766	};
509		767
		768	*{"${dir}timeout_reset"} = sub {
		769	$_[0]{$activity} = AE::now;
		770	};
		771
		772	# main workhorse:
510	# reset the timeout watcher, as neccessary	773	# reset the timeout watcher, as neccessary
511	# also check for time-outs	774	# also check for time-outs
512	sub _timeout {	775	$cb = sub {
513	my ($self) = @_;	776	my ($self) = @_;
514		777
515	if ($self->{timeout}) {	778	if ($self->{$timeout} && $self->{fh}) {
516	my $NOW = AnyEvent->now;	779	my $NOW = AE::now;
517		780
518	# when would the timeout trigger?	781	# when would the timeout trigger?
519	my $after = $self->{_activity} + $self->{timeout} - $NOW;	782	my $after = $self->{$activity} + $self->{$timeout} - $NOW;
520		783
521	# now or in the past already?	784	# now or in the past already?
522	if ($after <= 0) {	785	if ($after <= 0) {
523	$self->{_activity} = $NOW;	786	$self->{$activity} = $NOW;
524		787
525	if ($self->{on_timeout}) {	788	if ($self->{$on_timeout}) {
526	$self->{on_timeout}($self);	789	$self->{$on_timeout}($self);
527	} else {	790	} else {
528	$self->_error (Errno::ETIMEDOUT);	791	$self->_error (Errno::ETIMEDOUT);
		792	}
		793
		794	# callback could have changed timeout value, optimise
		795	return unless $self->{$timeout};
		796
		797	# calculate new after
		798	$after = $self->{$timeout};
529	}	799	}
530		800
531	# callback could have changed timeout value, optimise	801	Scalar::Util::weaken $self;
532	return unless $self->{timeout};	802	return unless $self; # ->error could have destroyed $self
533		803
534	# calculate new after	804	$self->{$tw} \|\|= AE::timer $after, 0, sub {
535	$after = $self->{timeout};	805	delete $self->{$tw};
		806	$cb->($self);
		807	};
		808	} else {
		809	delete $self->{$tw};
536	}	810	}
537
538	Scalar::Util::weaken $self;
539	return unless $self; # ->error could have destroyed $self
540
541	$self->{_tw} \|\|= AnyEvent->timer (after => $after, cb => sub {
542	delete $self->{_tw};
543	$self->_timeout;
544	});
545	} else {
546	delete $self->{_tw};
547	}	811	}
548	}	812	}
549		813
550	#############################################################################	814	#############################################################################
551		815
…		…
599	my $len = syswrite $self->{fh}, $self->{wbuf};	863	my $len = syswrite $self->{fh}, $self->{wbuf};
600		864
601	if (defined $len) {	865	if (defined $len) {
602	substr $self->{wbuf}, 0, $len, "";	866	substr $self->{wbuf}, 0, $len, "";
603		867
604	$self->{_activity} = AnyEvent->now;	868	$self->{_activity} = $self->{_wactivity} = AE::now;
605		869
606	$self->{on_drain}($self)	870	$self->{on_drain}($self)
607	if $self->{low_water_mark} >= (length $self->{wbuf}) + (length $self->{_tls_wbuf})	871	if $self->{low_water_mark} >= (length $self->{wbuf}) + (length $self->{_tls_wbuf})
608	&& $self->{on_drain};	872	&& $self->{on_drain};
609		873
…		…
615		879
616	# try to write data immediately	880	# try to write data immediately
617	$cb->() unless $self->{autocork};	881	$cb->() unless $self->{autocork};
618		882
619	# if still data left in wbuf, we need to poll	883	# if still data left in wbuf, we need to poll
620	$self->{_ww} = AnyEvent->io (fh => $self->{fh}, poll => "w", cb => $cb)	884	$self->{_ww} = AE::io $self->{fh}, 1, $cb
621	if length $self->{wbuf};	885	if length $self->{wbuf};
622	};	886	};
623	}	887	}
624		888
625	our %WH;	889	our %WH;
626		890
		891	# deprecated
627	sub register_write_type($$) {	892	sub register_write_type($$) {
628	$WH{$_[0]} = $_[1];	893	$WH{$_[0]} = $_[1];
629	}	894	}
630		895
631	sub push_write {	896	sub push_write {
632	my $self = shift;	897	my $self = shift;
633		898
634	if (@_ > 1) {	899	if (@_ > 1) {
635	my $type = shift;	900	my $type = shift;
636		901
		902	@_ = ($WH{$type} \|\|= _load_func "$type\::anyevent_write_type"
637	@_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write")	903	or Carp::croak "unsupported/unloadable type '$type' passed to AnyEvent::Handle::push_write")
638	->($self, @_);	904	->($self, @_);
639	}	905	}
640		906
641	if ($self->{tls}) {	907	if ($self->{tls}) {
642	$self->{_tls_wbuf} .= $_[0];	908	$self->{_tls_wbuf} .= $_[0];
643		909	&_dotls ($self) if $self->{fh};
644	&_dotls ($self);
645	} else {	910	} else {
646	$self->{wbuf} .= $_[0];	911	$self->{wbuf} .= $_[0];
647	$self->_drain_wbuf;	912	$self->_drain_wbuf if $self->{fh};
648	}	913	}
649	}	914	}
650		915
651	=item $handle->push_write (type => @args)	916	=item $handle->push_write (type => @args)
652		917
653	Instead of formatting your data yourself, you can also let this module do	918	Instead of formatting your data yourself, you can also let this module
654	the job by specifying a type and type-specific arguments.	919	do the job by specifying a type and type-specific arguments. You
		920	can also specify the (fully qualified) name of a package, in which
		921	case AnyEvent tries to load the package and then expects to find the
		922	C<anyevent_read_type> function inside (see "custom write types", below).
655		923
656	Predefined types are (if you have ideas for additional types, feel free to	924	Predefined types are (if you have ideas for additional types, feel free to
657	drop by and tell us):	925	drop by and tell us):
658		926
659	=over 4	927	=over 4
…		…
716	Other languages could read single lines terminated by a newline and pass	984	Other languages could read single lines terminated by a newline and pass
717	this line into their JSON decoder of choice.	985	this line into their JSON decoder of choice.
718		986
719	=cut	987	=cut
720		988
		989	sub json_coder() {
		990	eval { require JSON::XS; JSON::XS->new->utf8 }
		991	\|\| do { require JSON; JSON->new->utf8 }
		992	}
		993
721	register_write_type json => sub {	994	register_write_type json => sub {
722	my ($self, $ref) = @_;	995	my ($self, $ref) = @_;
723		996
724	require JSON;	997	my $json = $self->{json} \|\|= json_coder;
725		998
726	$self->{json} ? $self->{json}->encode ($ref)	999	$json->encode ($ref)
727	: JSON::encode_json ($ref)
728	};	1000	};
729		1001
730	=item storable => $reference	1002	=item storable => $reference
731		1003
732	Freezes the given reference using L<Storable> and writes it to the	1004	Freezes the given reference using L<Storable> and writes it to the
…		…
767		1039
768	delete $self->{low_water_mark};	1040	delete $self->{low_water_mark};
769	$self->on_drain (sub { shutdown $_[0]{fh}, 1 });	1041	$self->on_drain (sub { shutdown $_[0]{fh}, 1 });
770	}	1042	}
771		1043
772	=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)	1044	=item custom write types - Package::anyevent_write_type $handle, @args
773		1045
774	This function (not method) lets you add your own types to C<push_write>.	1046	Instead of one of the predefined types, you can also specify the name of
		1047	a package. AnyEvent will try to load the package and then expects to find
		1048	a function named C<anyevent_write_type> inside. If it isn't found, it
		1049	progressively tries to load the parent package until it either finds the
		1050	function (good) or runs out of packages (bad).
		1051
775	Whenever the given C<type> is used, C<push_write> will invoke the code	1052	Whenever the given C<type> is used, C<push_write> will the function with
776	reference with the handle object and the remaining arguments.	1053	the handle object and the remaining arguments.
777		1054
778	The code reference is supposed to return a single octet string that will	1055	The function is supposed to return a single octet string that will be
779	be appended to the write buffer.	1056	appended to the write buffer, so you cna mentally treat this function as a
		1057	"arguments to on-the-wire-format" converter.
780		1058
781	Note that this is a function, and all types registered this way will be	1059	Example: implement a custom write type C<join> that joins the remaining
782	global, so try to use unique names.	1060	arguments using the first one.
		1061
		1062	$handle->push_write (My::Type => " ", 1,2,3);
		1063
		1064	# uses the following package, which can be defined in the "My::Type" or in
		1065	# the "My" modules to be auto-loaded, or just about anywhere when the
		1066	# My::Type::anyevent_write_type is defined before invoking it.
		1067
		1068	package My::Type;
		1069
		1070	sub anyevent_write_type {
		1071	my ($handle, $delim, @args) = @_;
		1072
		1073	join $delim, @args
		1074	}
783		1075
784	=cut	1076	=cut
785		1077
786	#############################################################################	1078	#############################################################################
787		1079
…		…
869	=cut	1161	=cut
870		1162
871	sub _drain_rbuf {	1163	sub _drain_rbuf {
872	my ($self) = @_;	1164	my ($self) = @_;
873		1165
		1166	# avoid recursion
		1167	return if $self->{_skip_drain_rbuf};
874	local $self->{_in_drain} = 1;	1168	local $self->{_skip_drain_rbuf} = 1;
875
876	if (
877	defined $self->{rbuf_max}
878	&& $self->{rbuf_max} < length $self->{rbuf}
879	) {
880	$self->_error (Errno::ENOSPC, 1), return;
881	}
882		1169
883	while () {	1170	while () {
884	# we need to use a separate tls read buffer, as we must not receive data while	1171	# we need to use a separate tls read buffer, as we must not receive data while
885	# we are draining the buffer, and this can only happen with TLS.	1172	# we are draining the buffer, and this can only happen with TLS.
886	$self->{rbuf} .= delete $self->{_tls_rbuf} if exists $self->{_tls_rbuf};	1173	$self->{rbuf} .= delete $self->{_tls_rbuf}
		1174	if exists $self->{_tls_rbuf};
887		1175
888	my $len = length $self->{rbuf};	1176	my $len = length $self->{rbuf};
889		1177
890	if (my $cb = shift @{ $self->{_queue} }) {	1178	if (my $cb = shift @{ $self->{_queue} }) {
891	unless ($cb->($self)) {	1179	unless ($cb->($self)) {
892	if ($self->{_eof}) {	1180	# no progress can be made
893	# no progress can be made (not enough data and no data forthcoming)	1181	# (not enough data and no data forthcoming)
894	$self->_error (Errno::EPIPE, 1), return;	1182	$self->_error (Errno::EPIPE, 1), return
895	}	1183	if $self->{_eof};
896		1184
897	unshift @{ $self->{_queue} }, $cb;	1185	unshift @{ $self->{_queue} }, $cb;
898	last;	1186	last;
899	}	1187	}
900	} elsif ($self->{on_read}) {	1188	} elsif ($self->{on_read}) {
…		…
920	last;	1208	last;
921	}	1209	}
922	}	1210	}
923		1211
924	if ($self->{_eof}) {	1212	if ($self->{_eof}) {
925	if ($self->{on_eof}) {	1213	$self->{on_eof}
926	$self->{on_eof}($self)	1214	? $self->{on_eof}($self)
927	} else {
928	$self->_error (0, 1, "Unexpected end-of-file");	1215	: $self->_error (0, 1, "Unexpected end-of-file");
929	}	1216
		1217	return;
		1218	}
		1219
		1220	if (
		1221	defined $self->{rbuf_max}
		1222	&& $self->{rbuf_max} < length $self->{rbuf}
		1223	) {
		1224	$self->_error (Errno::ENOSPC, 1), return;
930	}	1225	}
931		1226
932	# may need to restart read watcher	1227	# may need to restart read watcher
933	unless ($self->{_rw}) {	1228	unless ($self->{_rw}) {
934	$self->start_read	1229	$self->start_read
…		…
946		1241
947	sub on_read {	1242	sub on_read {
948	my ($self, $cb) = @_;	1243	my ($self, $cb) = @_;
949		1244
950	$self->{on_read} = $cb;	1245	$self->{on_read} = $cb;
951	$self->_drain_rbuf if $cb && !$self->{_in_drain};	1246	$self->_drain_rbuf if $cb;
952	}	1247	}
953		1248
954	=item $handle->rbuf	1249	=item $handle->rbuf
955		1250
956	Returns the read buffer (as a modifiable lvalue).	1251	Returns the read buffer (as a modifiable lvalue).
…		…
1003	my $cb = pop;	1298	my $cb = pop;
1004		1299
1005	if (@_) {	1300	if (@_) {
1006	my $type = shift;	1301	my $type = shift;
1007		1302
		1303	$cb = ($RH{$type} \|\|= _load_func "$type\::anyevent_read_type"
1008	$cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")	1304	or Carp::croak "unsupported/unloadable type '$type' passed to AnyEvent::Handle::push_read")
1009	->($self, $cb, @_);	1305	->($self, $cb, @_);
1010	}	1306	}
1011		1307
1012	push @{ $self->{_queue} }, $cb;	1308	push @{ $self->{_queue} }, $cb;
1013	$self->_drain_rbuf unless $self->{_in_drain};	1309	$self->_drain_rbuf;
1014	}	1310	}
1015		1311
1016	sub unshift_read {	1312	sub unshift_read {
1017	my $self = shift;	1313	my $self = shift;
1018	my $cb = pop;	1314	my $cb = pop;
…		…
1022		1318
1023	$cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read")	1319	$cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::unshift_read")
1024	->($self, $cb, @_);	1320	->($self, $cb, @_);
1025	}	1321	}
1026		1322
1027
1028	unshift @{ $self->{_queue} }, $cb;	1323	unshift @{ $self->{_queue} }, $cb;
1029	$self->_drain_rbuf unless $self->{_in_drain};	1324	$self->_drain_rbuf;
1030	}	1325	}
1031		1326
1032	=item $handle->push_read (type => @args, $cb)	1327	=item $handle->push_read (type => @args, $cb)
1033		1328
1034	=item $handle->unshift_read (type => @args, $cb)	1329	=item $handle->unshift_read (type => @args, $cb)
1035		1330
1036	Instead of providing a callback that parses the data itself you can chose	1331	Instead of providing a callback that parses the data itself you can chose
1037	between a number of predefined parsing formats, for chunks of data, lines	1332	between a number of predefined parsing formats, for chunks of data, lines
1038	etc.	1333	etc. You can also specify the (fully qualified) name of a package, in
		1334	which case AnyEvent tries to load the package and then expects to find the
		1335	C<anyevent_read_type> function inside (see "custom read types", below).
1039		1336
1040	Predefined types are (if you have ideas for additional types, feel free to	1337	Predefined types are (if you have ideas for additional types, feel free to
1041	drop by and tell us):	1338	drop by and tell us):
1042		1339
1043	=over 4	1340	=over 4
…		…
1283	=cut	1580	=cut
1284		1581
1285	register_read_type json => sub {	1582	register_read_type json => sub {
1286	my ($self, $cb) = @_;	1583	my ($self, $cb) = @_;
1287		1584
1288	my $json = $self->{json} \|\|=	1585	my $json = $self->{json} \|\|= json_coder;
1289	eval { require JSON::XS; JSON::XS->new->utf8 }
1290	\|\| do { require JSON; JSON->new->utf8 };
1291		1586
1292	my $data;	1587	my $data;
1293	my $rbuf = \$self->{rbuf};	1588	my $rbuf = \$self->{rbuf};
1294		1589
1295	sub {	1590	sub {
…		…
1364	}	1659	}
1365	};	1660	};
1366		1661
1367	=back	1662	=back
1368		1663
1369	=item AnyEvent::Handle::register_read_type type => $coderef->($handle, $cb, @args)	1664	=item custom read types - Package::anyevent_read_type $handle, $cb, @args
1370		1665
1371	This function (not method) lets you add your own types to C<push_read>.	1666	Instead of one of the predefined types, you can also specify the name
		1667	of a package. AnyEvent will try to load the package and then expects to
		1668	find a function named C<anyevent_read_type> inside. If it isn't found, it
		1669	progressively tries to load the parent package until it either finds the
		1670	function (good) or runs out of packages (bad).
1372		1671
1373	Whenever the given C<type> is used, C<push_read> will invoke the code	1672	Whenever this type is used, C<push_read> will invoke the function with the
1374	reference with the handle object, the callback and the remaining	1673	handle object, the original callback and the remaining arguments.
1375	arguments.
1376		1674
1377	The code reference is supposed to return a callback (usually a closure)	1675	The function is supposed to return a callback (usually a closure) that
1378	that works as a plain read callback (see C<< ->push_read ($cb) >>).	1676	works as a plain read callback (see C<< ->push_read ($cb) >>), so you can
		1677	mentally treat the function as a "configurable read type to read callback"
		1678	converter.
1379		1679
1380	It should invoke the passed callback when it is done reading (remember to	1680	It should invoke the original callback when it is done reading (remember
1381	pass C<$handle> as first argument as all other callbacks do that).	1681	to pass C<$handle> as first argument as all other callbacks do that,
		1682	although there is no strict requirement on this).
1382		1683
1383	Note that this is a function, and all types registered this way will be
1384	global, so try to use unique names.
1385
1386	For examples, see the source of this module (F<perldoc -m AnyEvent::Handle>,	1684	For examples, see the source of this module (F<perldoc -m
1387	search for C<register_read_type>)).	1685	AnyEvent::Handle>, search for C<register_read_type>)).
1388		1686
1389	=item $handle->stop_read	1687	=item $handle->stop_read
1390		1688
1391	=item $handle->start_read	1689	=item $handle->start_read
1392		1690
…		…
1415	my ($self) = @_;	1713	my ($self) = @_;
1416		1714
1417	unless ($self->{_rw} \|\| $self->{_eof}) {	1715	unless ($self->{_rw} \|\| $self->{_eof}) {
1418	Scalar::Util::weaken $self;	1716	Scalar::Util::weaken $self;
1419		1717
1420	$self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {	1718	$self->{_rw} = AE::io $self->{fh}, 0, sub {
1421	my $rbuf = \($self->{tls} ? my $buf : $self->{rbuf});	1719	my $rbuf = \($self->{tls} ? my $buf : $self->{rbuf});
1422	my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} \|\| 8192, length $$rbuf;	1720	my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} \|\| 8192, length $$rbuf;
1423		1721
1424	if ($len > 0) {	1722	if ($len > 0) {
1425	$self->{_activity} = AnyEvent->now;	1723	$self->{_activity} = $self->{_ractivity} = AE::now;
1426		1724
1427	if ($self->{tls}) {	1725	if ($self->{tls}) {
1428	Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf);	1726	Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf);
1429		1727
1430	&_dotls ($self);	1728	&_dotls ($self);
1431	} else {	1729	} else {
1432	$self->_drain_rbuf unless $self->{_in_drain};	1730	$self->_drain_rbuf;
1433	}	1731	}
1434		1732
1435	} elsif (defined $len) {	1733	} elsif (defined $len) {
1436	delete $self->{_rw};	1734	delete $self->{_rw};
1437	$self->{_eof} = 1;	1735	$self->{_eof} = 1;
1438	$self->_drain_rbuf unless $self->{_in_drain};	1736	$self->_drain_rbuf;
1439		1737
1440	} elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {	1738	} elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
1441	return $self->_error ($!, 1);	1739	return $self->_error ($!, 1);
1442	}	1740	}
1443	});	1741	};
1444	}	1742	}
1445	}	1743	}
1446		1744
1447	our $ERROR_SYSCALL;	1745	our $ERROR_SYSCALL;
1448	our $ERROR_WANT_READ;	1746	our $ERROR_WANT_READ;
…		…
1503	$self->{_eof} = 1;	1801	$self->{_eof} = 1;
1504	}	1802	}
1505	}	1803	}
1506		1804
1507	$self->{_tls_rbuf} .= $tmp;	1805	$self->{_tls_rbuf} .= $tmp;
1508	$self->_drain_rbuf unless $self->{_in_drain};	1806	$self->_drain_rbuf;
1509	$self->{tls} or return; # tls session might have gone away in callback	1807	$self->{tls} or return; # tls session might have gone away in callback
1510	}	1808	}
1511		1809
1512	$tmp = Net::SSLeay::get_error ($self->{tls}, -1);	1810	$tmp = Net::SSLeay::get_error ($self->{tls}, -1);
1513	return $self->_tls_error ($tmp)	1811	return $self->_tls_error ($tmp)
…		…
1545	The TLS connection object will end up in C<< $handle->{tls} >>, the TLS	1843	The TLS connection object will end up in C<< $handle->{tls} >>, the TLS
1546	context in C<< $handle->{tls_ctx} >> after this call and can be used or	1844	context in C<< $handle->{tls_ctx} >> after this call and can be used or
1547	changed to your liking. Note that the handshake might have already started	1845	changed to your liking. Note that the handshake might have already started
1548	when this function returns.	1846	when this function returns.
1549		1847
1550	If it an error to start a TLS handshake more than once per	1848	Due to bugs in OpenSSL, it might or might not be possible to do multiple
1551	AnyEvent::Handle object (this is due to bugs in OpenSSL).	1849	handshakes on the same stream. Best do not attempt to use the stream after
		1850	stopping TLS.
1552		1851
1553	=cut	1852	=cut
1554		1853
1555	our %TLS_CACHE; #TODO not yet documented, should we?	1854	our %TLS_CACHE; #TODO not yet documented, should we?
1556		1855
1557	sub starttls {	1856	sub starttls {
1558	my ($self, $ssl, $ctx) = @_;	1857	my ($self, $tls, $ctx) = @_;
		1858
		1859	Carp::croak "It is an error to call starttls on an AnyEvent::Handle object while TLS is already active, caught"
		1860	if $self->{tls};
		1861
		1862	$self->{tls} = $tls;
		1863	$self->{tls_ctx} = $ctx if @_ > 2;
		1864
		1865	return unless $self->{fh};
1559		1866
1560	require Net::SSLeay;	1867	require Net::SSLeay;
1561
1562	Carp::croak "it is an error to call starttls more than once on an AnyEvent::Handle object"
1563	if $self->{tls};
1564		1868
1565	$ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL ();	1869	$ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL ();
1566	$ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ ();	1870	$ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ ();
1567		1871
		1872	$tls = delete $self->{tls};
1568	$ctx \|\|= $self->{tls_ctx};	1873	$ctx = $self->{tls_ctx};
1569		1874
1570	local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session	1875	local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session
1571		1876
1572	if ("HASH" eq ref $ctx) {	1877	if ("HASH" eq ref $ctx) {
1573	require AnyEvent::TLS;	1878	require AnyEvent::TLS;
…		…
1579	$ctx = new AnyEvent::TLS %$ctx;	1884	$ctx = new AnyEvent::TLS %$ctx;
1580	}	1885	}
1581	}	1886	}
1582		1887
1583	$self->{tls_ctx} = $ctx \|\| TLS_CTX ();	1888	$self->{tls_ctx} = $ctx \|\| TLS_CTX ();
1584	$self->{tls} = $ssl = $self->{tls_ctx}->_get_session ($ssl, $self, $self->{peername});	1889	$self->{tls} = $tls = $self->{tls_ctx}->_get_session ($tls, $self, $self->{peername});
1585		1890
1586	# basically, this is deep magic (because SSL_read should have the same issues)	1891	# basically, this is deep magic (because SSL_read should have the same issues)
1587	# but the openssl maintainers basically said: "trust us, it just works".	1892	# but the openssl maintainers basically said: "trust us, it just works".
1588	# (unfortunately, we have to hardcode constants because the abysmally misdesigned	1893	# (unfortunately, we have to hardcode constants because the abysmally misdesigned
1589	# and mismaintained ssleay-module doesn't even offer them).	1894	# and mismaintained ssleay-module doesn't even offer them).
…		…
1596	# and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to	1901	# and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to
1597	# have identity issues in that area.	1902	# have identity issues in that area.
1598	# Net::SSLeay::CTX_set_mode ($ssl,	1903	# Net::SSLeay::CTX_set_mode ($ssl,
1599	# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } \|\| 1)	1904	# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } \|\| 1)
1600	# \| (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } \|\| 2));	1905	# \| (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } \|\| 2));
1601	Net::SSLeay::CTX_set_mode ($ssl, 1\|2);	1906	Net::SSLeay::CTX_set_mode ($tls, 1\|2);
1602		1907
1603	$self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());	1908	$self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1604	$self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());	1909	$self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1605		1910
		1911	Net::SSLeay::BIO_write ($self->{_rbio}, delete $self->{rbuf});
		1912
1606	Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio});	1913	Net::SSLeay::set_bio ($tls, $self->{_rbio}, $self->{_wbio});
1607		1914
1608	$self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) }	1915	$self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) }
1609	if $self->{on_starttls};	1916	if $self->{on_starttls};
1610		1917
1611	&_dotls; # need to trigger the initial handshake	1918	&_dotls; # need to trigger the initial handshake
…		…
1614		1921
1615	=item $handle->stoptls	1922	=item $handle->stoptls
1616		1923
1617	Shuts down the SSL connection - this makes a proper EOF handshake by	1924	Shuts down the SSL connection - this makes a proper EOF handshake by
1618	sending a close notify to the other side, but since OpenSSL doesn't	1925	sending a close notify to the other side, but since OpenSSL doesn't
1619	support non-blocking shut downs, it is not possible to re-use the stream	1926	support non-blocking shut downs, it is not guarenteed that you can re-use
1620	afterwards.	1927	the stream afterwards.
1621		1928
1622	=cut	1929	=cut
1623		1930
1624	sub stoptls {	1931	sub stoptls {
1625	my ($self) = @_;	1932	my ($self) = @_;
…		…
1638	sub _freetls {	1945	sub _freetls {
1639	my ($self) = @_;	1946	my ($self) = @_;
1640		1947
1641	return unless $self->{tls};	1948	return unless $self->{tls};
1642		1949
1643	$self->{tls_ctx}->_put_session (delete $self->{tls});	1950	$self->{tls_ctx}->_put_session (delete $self->{tls})
		1951	if $self->{tls} > 0;
1644		1952
1645	delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)};	1953	delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)};
1646	}	1954	}
1647		1955
1648	sub DESTROY {	1956	sub DESTROY {
…		…
1656	my $fh = delete $self->{fh};	1964	my $fh = delete $self->{fh};
1657	my $wbuf = delete $self->{wbuf};	1965	my $wbuf = delete $self->{wbuf};
1658		1966
1659	my @linger;	1967	my @linger;
1660		1968
1661	push @linger, AnyEvent->io (fh => $fh, poll => "w", cb => sub {	1969	push @linger, AE::io $fh, 1, sub {
1662	my $len = syswrite $fh, $wbuf, length $wbuf;	1970	my $len = syswrite $fh, $wbuf, length $wbuf;
1663		1971
1664	if ($len > 0) {	1972	if ($len > 0) {
1665	substr $wbuf, 0, $len, "";	1973	substr $wbuf, 0, $len, "";
1666	} else {	1974	} else {
1667	@linger = (); # end	1975	@linger = (); # end
1668	}	1976	}
1669	});	1977	};
1670	push @linger, AnyEvent->timer (after => $linger, cb => sub {	1978	push @linger, AE::timer $linger, 0, sub {
1671	@linger = ();	1979	@linger = ();
1672	});	1980	};
1673	}	1981	}
1674	}	1982	}
1675		1983
1676	=item $handle->destroy	1984	=item $handle->destroy
1677		1985
1678	Shuts down the handle object as much as possible - this call ensures that	1986	Shuts down the handle object as much as possible - this call ensures that
1679	no further callbacks will be invoked and as many resources as possible	1987	no further callbacks will be invoked and as many resources as possible
1680	will be freed. You must not call any methods on the object afterwards.	1988	will be freed. Any method you will call on the handle object after
		1989	destroying it in this way will be silently ignored (and it will return the
		1990	empty list).
1681		1991
1682	Normally, you can just "forget" any references to an AnyEvent::Handle	1992	Normally, you can just "forget" any references to an AnyEvent::Handle
1683	object and it will simply shut down. This works in fatal error and EOF	1993	object and it will simply shut down. This works in fatal error and EOF
1684	callbacks, as well as code outside. It does I<NOT> work in a read or write	1994	callbacks, as well as code outside. It does I<NOT> work in a read or write
1685	callback, so when you want to destroy the AnyEvent::Handle object from	1995	callback, so when you want to destroy the AnyEvent::Handle object from
…		…
1699	sub destroy {	2009	sub destroy {
1700	my ($self) = @_;	2010	my ($self) = @_;
1701		2011
1702	$self->DESTROY;	2012	$self->DESTROY;
1703	%$self = ();	2013	%$self = ();
		2014	bless $self, "AnyEvent::Handle::destroyed";
		2015	}
		2016
		2017	sub AnyEvent::Handle::destroyed::AUTOLOAD {
		2018	#nop
1704	}	2019	}
1705		2020
1706	=item AnyEvent::Handle::TLS_CTX	2021	=item AnyEvent::Handle::TLS_CTX
1707		2022
1708	This function creates and returns the AnyEvent::TLS object used by default	2023	This function creates and returns the AnyEvent::TLS object used by default

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents): Revision 1.158 by root, Fri Jul 24 08:40:35 2009 UTC vs. Revision 1.185 by root, Thu Sep 3 19:48:27 2009 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents):
Revision 1.158 by root, Fri Jul 24 08:40:35 2009 UTC vs.
Revision 1.185 by root, Thu Sep 3 19:48:27 2009 UTC