ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/Handle.pm
(Generate patch)

Comparing AnyEvent/lib/AnyEvent/Handle.pm (file contents):
Revision 1.76 by root, Sun Jul 27 03:28:36 2008 UTC vs.
Revision 1.159 by root, Fri Jul 24 12:35:58 2009 UTC

1package AnyEvent::Handle; 1package AnyEvent::Handle;
2 2
3no warnings;
4use strict;
5
6use AnyEvent ();
7use AnyEvent::Util qw(WSAEWOULDBLOCK);
8use Scalar::Util (); 3use Scalar::Util ();
9use Carp (); 4use Carp ();
10use Fcntl ();
11use Errno qw(EAGAIN EINTR); 5use Errno qw(EAGAIN EINTR);
12 6
7use AnyEvent (); BEGIN { AnyEvent::common_sense }
8use AnyEvent::Util qw(WSAEWOULDBLOCK);
9
13=head1 NAME 10=head1 NAME
14 11
15AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent 12AnyEvent::Handle - non-blocking I/O on file handles via AnyEvent
16 13
17=cut 14=cut
18 15
19our $VERSION = 4.22; 16our $VERSION = 4.86;
20 17
21=head1 SYNOPSIS 18=head1 SYNOPSIS
22 19
23 use AnyEvent; 20 use AnyEvent;
24 use AnyEvent::Handle; 21 use AnyEvent::Handle;
25 22
26 my $cv = AnyEvent->condvar; 23 my $cv = AnyEvent->condvar;
27 24
28 my $handle = 25 my $hdl; $hdl = new AnyEvent::Handle
29 AnyEvent::Handle->new (
30 fh => \*STDIN, 26 fh => \*STDIN,
31 on_eof => sub { 27 on_error => sub {
32 $cv->broadcast; 28 my ($hdl, $fatal, $msg) = @_;
33 }, 29 warn "got error $msg\n";
30 $hdl->destroy;
31 $cv->send;
34 ); 32 );
35 33
36 # send some request line 34 # send some request line
37 $handle->push_write ("getinfo\015\012"); 35 $hdl->push_write ("getinfo\015\012");
38 36
39 # read the response line 37 # read the response line
40 $handle->push_read (line => sub { 38 $hdl->push_read (line => sub {
41 my ($handle, $line) = @_; 39 my ($hdl, $line) = @_;
42 warn "read line <$line>\n"; 40 warn "got line <$line>\n";
43 $cv->send; 41 $cv->send;
44 }); 42 });
45 43
46 $cv->recv; 44 $cv->recv;
47 45
48=head1 DESCRIPTION 46=head1 DESCRIPTION
49 47
50This module is a helper module to make it easier to do event-based I/O on 48This module is a helper module to make it easier to do event-based I/O on
51filehandles. For utility functions for doing non-blocking connects and accepts 49filehandles.
52on sockets see L<AnyEvent::Util>. 50
51The L<AnyEvent::Intro> tutorial contains some well-documented
52AnyEvent::Handle examples.
53 53
54In the following, when the documentation refers to of "bytes" then this 54In the following, when the documentation refers to of "bytes" then this
55means characters. As sysread and syswrite are used for all I/O, their 55means characters. As sysread and syswrite are used for all I/O, their
56treatment of characters applies to this module as well. 56treatment of characters applies to this module as well.
57 57
58At the very minimum, you should specify C<fh> or C<connect>, and the
59C<on_error> callback.
60
58All callbacks will be invoked with the handle object as their first 61All callbacks will be invoked with the handle object as their first
59argument. 62argument.
60 63
61=head1 METHODS 64=head1 METHODS
62 65
63=over 4 66=over 4
64 67
65=item B<new (%args)> 68=item $handle = B<new> AnyEvent::TLS fh => $filehandle, key => value...
66 69
67The constructor supports these arguments (all as key => value pairs). 70The constructor supports these arguments (all as C<< key => value >> pairs).
68 71
69=over 4 72=over 4
70 73
71=item fh => $filehandle [MANDATORY] 74=item fh => $filehandle [C<fh> or C<connect> MANDATORY]
72 75
73The filehandle this L<AnyEvent::Handle> object will operate on. 76The filehandle this L<AnyEvent::Handle> object will operate on.
74
75NOTE: The filehandle will be set to non-blocking (using 77NOTE: The filehandle will be set to non-blocking mode (using
76AnyEvent::Util::fh_nonblocking). 78C<AnyEvent::Util::fh_nonblocking>) by the constructor and needs to stay in
79that mode.
77 80
81=item connect => [$host, $service] [C<fh> or C<connect> MANDATORY]
82
83Try to connect to the specified host and service (port), using
84C<AnyEvent::Socket::tcp_connect>. The C<$host> additionally becomes the
85default C<peername>.
86
87You have to specify either this parameter, or C<fh>, above.
88
89When this parameter is specified, then the C<on_prepare>,
90C<on_connect_error> and C<on_connect> callbacks will be called under the
91appropriate circumstances:
92
93=over 4
94
78=item on_eof => $cb->($handle) 95=item on_prepare => $cb->($handle)
79 96
80Set the callback to be called when an end-of-file condition is detected, 97This (rarely used) callback is called before a new connection is
81i.e. in the case of a socket, when the other side has closed the 98attempted, but after the file handle has been created. It could be used to
82connection cleanly. 99prepare the file handle with parameters required for the actual connect
100(as opposed to settings that can be changed when the connection is already
101established).
83 102
84While not mandatory, it is highly recommended to set an eof callback, 103=item on_connect => $cb->($handle, $host, $port, $retry->())
85otherwise you might end up with a closed socket while you are still
86waiting for data.
87 104
105This callback is called when a connection has been successfully established.
106
107The actual numeric host and port (the socket peername) are passed as
108parameters, together with a retry callback.
109
110When, for some reason, the handle is not acceptable, then calling
111C<$retry> will continue with the next conenction target (in case of
112multi-homed hosts or SRV records there can be multiple connection
113endpoints). When it is called then the read and write queues, eof status,
114tls status and similar properties of the handle are being reset.
115
116In most cases, ignoring the C<$retry> parameter is the way to go.
117
118=item on_connect_error => $cb->($handle, $message)
119
120This callback is called when the conenction could not be
121established. C<$!> will contain the relevant error code, and C<$message> a
122message describing it (usually the same as C<"$!">).
123
124If this callback isn't specified, then C<on_error> will be called with a
125fatal error instead.
126
127=back
128
88=item on_error => $cb->($handle, $fatal) 129=item on_error => $cb->($handle, $fatal, $message)
89 130
90This is the error callback, which is called when, well, some error 131This is the error callback, which is called when, well, some error
91occured, such as not being able to resolve the hostname, failure to 132occured, such as not being able to resolve the hostname, failure to
92connect or a read error. 133connect or a read error.
93 134
94Some errors are fatal (which is indicated by C<$fatal> being true). On 135Some errors are fatal (which is indicated by C<$fatal> being true). On
95fatal errors the handle object will be shut down and will not be 136fatal errors the handle object will be destroyed (by a call to C<< ->
137destroy >>) after invoking the error callback (which means you are free to
138examine the handle object). Examples of fatal errors are an EOF condition
139with active (but unsatisifable) read watchers (C<EPIPE>) or I/O errors. In
140cases where the other side can close the connection at their will it is
141often easiest to not report C<EPIPE> errors in this callback.
142
143AnyEvent::Handle tries to find an appropriate error code for you to check
144against, but in some cases (TLS errors), this does not work well. It is
145recommended to always output the C<$message> argument in human-readable
146error messages (it's usually the same as C<"$!">).
147
96usable. Non-fatal errors can be retried by simply returning, but it is 148Non-fatal errors can be retried by simply returning, but it is recommended
97recommended to simply ignore this parameter and instead abondon the handle 149to simply ignore this parameter and instead abondon the handle object
98object when this callback is invoked. 150when this callback is invoked. Examples of non-fatal errors are timeouts
151C<ETIMEDOUT>) or badly-formatted data (C<EBADMSG>).
99 152
100On callback entrance, the value of C<$!> contains the operating system 153On callback entrance, the value of C<$!> contains the operating system
101error (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT> or C<EBADMSG>). 154error code (or C<ENOSPC>, C<EPIPE>, C<ETIMEDOUT>, C<EBADMSG> or
155C<EPROTO>).
102 156
103While not mandatory, it is I<highly> recommended to set this callback, as 157While not mandatory, it is I<highly> recommended to set this callback, as
104you will not be notified of errors otherwise. The default simply calls 158you will not be notified of errors otherwise. The default simply calls
105C<croak>. 159C<croak>.
106 160
110and no read request is in the queue (unlike read queue callbacks, this 164and no read request is in the queue (unlike read queue callbacks, this
111callback will only be called when at least one octet of data is in the 165callback will only be called when at least one octet of data is in the
112read buffer). 166read buffer).
113 167
114To access (and remove data from) the read buffer, use the C<< ->rbuf >> 168To access (and remove data from) the read buffer, use the C<< ->rbuf >>
115method or access the C<$handle->{rbuf}> member directly. 169method or access the C<< $handle->{rbuf} >> member directly. Note that you
170must not enlarge or modify the read buffer, you can only remove data at
171the beginning from it.
116 172
117When an EOF condition is detected then AnyEvent::Handle will first try to 173When an EOF condition is detected then AnyEvent::Handle will first try to
118feed all the remaining data to the queued callbacks and C<on_read> before 174feed all the remaining data to the queued callbacks and C<on_read> before
119calling the C<on_eof> callback. If no progress can be made, then a fatal 175calling the C<on_eof> callback. If no progress can be made, then a fatal
120error will be raised (with C<$!> set to C<EPIPE>). 176error will be raised (with C<$!> set to C<EPIPE>).
177
178Note that, unlike requests in the read queue, an C<on_read> callback
179doesn't mean you I<require> some data: if there is an EOF and there
180are outstanding read requests then an error will be flagged. With an
181C<on_read> callback, the C<on_eof> callback will be invoked.
182
183=item on_eof => $cb->($handle)
184
185Set the callback to be called when an end-of-file condition is detected,
186i.e. in the case of a socket, when the other side has closed the
187connection cleanly, and there are no outstanding read requests in the
188queue (if there are read requests, then an EOF counts as an unexpected
189connection close and will be flagged as an error).
190
191For sockets, this just means that the other side has stopped sending data,
192you can still try to write data, and, in fact, one can return from the EOF
193callback and continue writing data, as only the read part has been shut
194down.
195
196If an EOF condition has been detected but no C<on_eof> callback has been
197set, then a fatal error will be raised with C<$!> set to <0>.
121 198
122=item on_drain => $cb->($handle) 199=item on_drain => $cb->($handle)
123 200
124This sets the callback that is called when the write buffer becomes empty 201This sets the callback that is called when the write buffer becomes empty
125(or when the callback is set and the buffer is empty already). 202(or when the callback is set and the buffer is empty already).
135=item timeout => $fractional_seconds 212=item timeout => $fractional_seconds
136 213
137If non-zero, then this enables an "inactivity" timeout: whenever this many 214If non-zero, then this enables an "inactivity" timeout: whenever this many
138seconds pass without a successful read or write on the underlying file 215seconds pass without a successful read or write on the underlying file
139handle, the C<on_timeout> callback will be invoked (and if that one is 216handle, the C<on_timeout> callback will be invoked (and if that one is
140missing, an C<ETIMEDOUT> error will be raised). 217missing, a non-fatal C<ETIMEDOUT> error will be raised).
141 218
142Note that timeout processing is also active when you currently do not have 219Note that timeout processing is also active when you currently do not have
143any outstanding read or write requests: If you plan to keep the connection 220any outstanding read or write requests: If you plan to keep the connection
144idle then you should disable the timout temporarily or ignore the timeout 221idle then you should disable the timout temporarily or ignore the timeout
145in the C<on_timeout> callback. 222in the C<on_timeout> callback, in which case AnyEvent::Handle will simply
223restart the timeout.
146 224
147Zero (the default) disables this timeout. 225Zero (the default) disables this timeout.
148 226
149=item on_timeout => $cb->($handle) 227=item on_timeout => $cb->($handle)
150 228
154 232
155=item rbuf_max => <bytes> 233=item rbuf_max => <bytes>
156 234
157If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>) 235If defined, then a fatal error will be raised (with C<$!> set to C<ENOSPC>)
158when the read buffer ever (strictly) exceeds this size. This is useful to 236when the read buffer ever (strictly) exceeds this size. This is useful to
159avoid denial-of-service attacks. 237avoid some forms of denial-of-service attacks.
160 238
161For example, a server accepting connections from untrusted sources should 239For example, a server accepting connections from untrusted sources should
162be configured to accept only so-and-so much data that it cannot act on 240be configured to accept only so-and-so much data that it cannot act on
163(for example, when expecting a line, an attacker could send an unlimited 241(for example, when expecting a line, an attacker could send an unlimited
164amount of data without a callback ever being called as long as the line 242amount of data without a callback ever being called as long as the line
165isn't finished). 243isn't finished).
166 244
167=item autocork => <boolean> 245=item autocork => <boolean>
168 246
169When disabled (the default), then C<push_write> will try to immediately 247When disabled (the default), then C<push_write> will try to immediately
170write the data to the handle if possible. This avoids having to register 248write the data to the handle, if possible. This avoids having to register
171a write watcher and wait for the next event loop iteration, but can be 249a write watcher and wait for the next event loop iteration, but can
172inefficient if you write multiple small chunks (this disadvantage is 250be inefficient if you write multiple small chunks (on the wire, this
173usually avoided by your kernel's nagle algorithm, see C<low_delay>). 251disadvantage is usually avoided by your kernel's nagle algorithm, see
252C<no_delay>, but this option can save costly syscalls).
174 253
175When enabled, then writes will always be queued till the next event loop 254When enabled, then writes will always be queued till the next event loop
176iteration. This is efficient when you do many small writes per iteration, 255iteration. This is efficient when you do many small writes per iteration,
177but less efficient when you do a single write only. 256but less efficient when you do a single write only per iteration (or when
257the write buffer often is full). It also increases write latency.
178 258
179=item no_delay => <boolean> 259=item no_delay => <boolean>
180 260
181When doing small writes on sockets, your operating system kernel might 261When doing small writes on sockets, your operating system kernel might
182wait a bit for more data before actually sending it out. This is called 262wait a bit for more data before actually sending it out. This is called
183the Nagle algorithm, and usually it is beneficial. 263the Nagle algorithm, and usually it is beneficial.
184 264
185In some situations you want as low a delay as possible, which cna be 265In some situations you want as low a delay as possible, which can be
186accomplishd by setting this option to true. 266accomplishd by setting this option to a true value.
187 267
188The default is your opertaing system's default behaviour, this option 268The default is your opertaing system's default behaviour (most likely
189explicitly enables or disables it, if possible. 269enabled), this option explicitly enables or disables it, if possible.
190 270
191=item read_size => <bytes> 271=item read_size => <bytes>
192 272
193The default read block size (the amount of bytes this module will try to read 273The default read block size (the amount of bytes this module will
194during each (loop iteration). Default: C<8192>. 274try to read during each loop iteration, which affects memory
275requirements). Default: C<8192>.
195 276
196=item low_water_mark => <bytes> 277=item low_water_mark => <bytes>
197 278
198Sets the amount of bytes (default: C<0>) that make up an "empty" write 279Sets the amount of bytes (default: C<0>) that make up an "empty" write
199buffer: If the write reaches this size or gets even samller it is 280buffer: If the write reaches this size or gets even samller it is
200considered empty. 281considered empty.
201 282
283Sometimes it can be beneficial (for performance reasons) to add data to
284the write buffer before it is fully drained, but this is a rare case, as
285the operating system kernel usually buffers data as well, so the default
286is good in almost all cases.
287
202=item linger => <seconds> 288=item linger => <seconds>
203 289
204If non-zero (default: C<3600>), then the destructor of the 290If non-zero (default: C<3600>), then the destructor of the
205AnyEvent::Handle object will check wether there is still outstanding write 291AnyEvent::Handle object will check whether there is still outstanding
206data and will install a watcher that will write out this data. No errors 292write data and will install a watcher that will write this data to the
207will be reported (this mostly matches how the operating system treats 293socket. No errors will be reported (this mostly matches how the operating
208outstanding data at socket close time). 294system treats outstanding data at socket close time).
209 295
210This will not work for partial TLS data that could not yet been 296This will not work for partial TLS data that could not be encoded
211encoded. This data will be lost. 297yet. This data will be lost. Calling the C<stoptls> method in time might
298help.
299
300=item peername => $string
301
302A string used to identify the remote site - usually the DNS hostname
303(I<not> IDN!) used to create the connection, rarely the IP address.
304
305Apart from being useful in error messages, this string is also used in TLS
306peername verification (see C<verify_peername> in L<AnyEvent::TLS>). This
307verification will be skipped when C<peername> is not specified or
308C<undef>.
212 309
213=item tls => "accept" | "connect" | Net::SSLeay::SSL object 310=item tls => "accept" | "connect" | Net::SSLeay::SSL object
214 311
215When this parameter is given, it enables TLS (SSL) mode, that means it 312When this parameter is given, it enables TLS (SSL) mode, that means
216will start making tls handshake and will transparently encrypt/decrypt 313AnyEvent will start a TLS handshake as soon as the conenction has been
217data. 314established and will transparently encrypt/decrypt data afterwards.
315
316All TLS protocol errors will be signalled as C<EPROTO>, with an
317appropriate error message.
218 318
219TLS mode requires Net::SSLeay to be installed (it will be loaded 319TLS mode requires Net::SSLeay to be installed (it will be loaded
220automatically when you try to create a TLS handle). 320automatically when you try to create a TLS handle): this module doesn't
321have a dependency on that module, so if your module requires it, you have
322to add the dependency yourself.
221 323
222For the TLS server side, use C<accept>, and for the TLS client side of a 324Unlike TCP, TLS has a server and client side: for the TLS server side, use
223connection, use C<connect> mode. 325C<accept>, and for the TLS client side of a connection, use C<connect>
326mode.
224 327
225You can also provide your own TLS connection object, but you have 328You can also provide your own TLS connection object, but you have
226to make sure that you call either C<Net::SSLeay::set_connect_state> 329to make sure that you call either C<Net::SSLeay::set_connect_state>
227or C<Net::SSLeay::set_accept_state> on it before you pass it to 330or C<Net::SSLeay::set_accept_state> on it before you pass it to
228AnyEvent::Handle. 331AnyEvent::Handle. Also, this module will take ownership of this connection
332object.
229 333
334At some future point, AnyEvent::Handle might switch to another TLS
335implementation, then the option to use your own session object will go
336away.
337
338B<IMPORTANT:> since Net::SSLeay "objects" are really only integers,
339passing in the wrong integer will lead to certain crash. This most often
340happens when one uses a stylish C<< tls => 1 >> and is surprised about the
341segmentation fault.
342
230See the C<starttls> method if you need to start TLS negotiation later. 343See the C<< ->starttls >> method for when need to start TLS negotiation later.
231 344
232=item tls_ctx => $ssl_ctx 345=item tls_ctx => $anyevent_tls
233 346
234Use the given Net::SSLeay::CTX object to create the new TLS connection 347Use the given C<AnyEvent::TLS> object to create the new TLS connection
235(unless a connection object was specified directly). If this parameter is 348(unless a connection object was specified directly). If this parameter is
236missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>. 349missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.
237 350
351Instead of an object, you can also specify a hash reference with C<< key
352=> value >> pairs. Those will be passed to L<AnyEvent::TLS> to create a
353new TLS context object.
354
355=item on_starttls => $cb->($handle, $success[, $error_message])
356
357This callback will be invoked when the TLS/SSL handshake has finished. If
358C<$success> is true, then the TLS handshake succeeded, otherwise it failed
359(C<on_stoptls> will not be called in this case).
360
361The session in C<< $handle->{tls} >> can still be examined in this
362callback, even when the handshake was not successful.
363
364TLS handshake failures will not cause C<on_error> to be invoked when this
365callback is in effect, instead, the error message will be passed to C<on_starttls>.
366
367Without this callback, handshake failures lead to C<on_error> being
368called, as normal.
369
370Note that you cannot call C<starttls> right again in this callback. If you
371need to do that, start an zero-second timer instead whose callback can
372then call C<< ->starttls >> again.
373
374=item on_stoptls => $cb->($handle)
375
376When a SSLv3/TLS shutdown/close notify/EOF is detected and this callback is
377set, then it will be invoked after freeing the TLS session. If it is not,
378then a TLS shutdown condition will be treated like a normal EOF condition
379on the handle.
380
381The session in C<< $handle->{tls} >> can still be examined in this
382callback.
383
384This callback will only be called on TLS shutdowns, not when the
385underlying handle signals EOF.
386
238=item json => JSON or JSON::XS object 387=item json => JSON or JSON::XS object
239 388
240This is the json coder object used by the C<json> read and write types. 389This is the json coder object used by the C<json> read and write types.
241 390
242If you don't supply it, then AnyEvent::Handle will create and use a 391If you don't supply it, then AnyEvent::Handle will create and use a
243suitable one, which will write and expect UTF-8 encoded JSON texts. 392suitable one (on demand), which will write and expect UTF-8 encoded JSON
393texts.
244 394
245Note that you are responsible to depend on the JSON module if you want to 395Note that you are responsible to depend on the JSON module if you want to
246use this functionality, as AnyEvent does not have a dependency itself. 396use this functionality, as AnyEvent does not have a dependency itself.
247 397
248=item filter_r => $cb
249
250=item filter_w => $cb
251
252These exist, but are undocumented at this time.
253
254=back 398=back
255 399
256=cut 400=cut
257 401
258sub new { 402sub new {
259 my $class = shift; 403 my $class = shift;
260
261 my $self = bless { @_ }, $class; 404 my $self = bless { @_ }, $class;
262 405
263 $self->{fh} or Carp::croak "mandatory argument fh is missing"; 406 if ($self->{fh}) {
407 $self->_start;
408 return unless $self->{fh}; # could be gone by now
409
410 } elsif ($self->{connect}) {
411 require AnyEvent::Socket;
412
413 $self->{peername} = $self->{connect}[0]
414 unless exists $self->{peername};
415
416 $self->{_skip_drain_rbuf} = 1;
417
418 {
419 Scalar::Util::weaken (my $self = $self);
420
421 $self->{_connect} =
422 AnyEvent::Socket::tcp_connect (
423 $self->{connect}[0],
424 $self->{connect}[1],
425 sub {
426 my ($fh, $host, $port, $retry) = @_;
427
428 if ($fh) {
429 $self->{fh} = $fh;
430
431 delete $self->{_skip_drain_rbuf};
432 $self->_start;
433
434 $self->{on_connect}
435 and $self->{on_connect}($self, $host, $port, sub {
436 delete @$self{qw(fh _tw _ww _rw _eof _queue rbuf _wbuf tls _tls_rbuf _tls_wbuf)};
437 $self->{_skip_drain_rbuf} = 1;
438 &$retry;
439 });
440
441 } else {
442 if ($self->{on_connect_error}) {
443 $self->{on_connect_error}($self, "$!");
444 $self->destroy;
445 } else {
446 $self->fatal ($!, 1);
447 }
448 }
449 },
450 sub {
451 local $self->{fh} = $_[0];
452
453 $self->{on_prepare}->($self)
454 if $self->{on_prepare};
455 }
456 );
457 }
458
459 } else {
460 Carp::croak "AnyEvent::Handle: either an existing fh or the connect parameter must be specified";
461 }
462
463 $self
464}
465
466sub _start {
467 my ($self) = @_;
264 468
265 AnyEvent::Util::fh_nonblocking $self->{fh}, 1; 469 AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
266
267 if ($self->{tls}) {
268 require Net::SSLeay;
269 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx});
270 }
271 470
272 $self->{_activity} = AnyEvent->now; 471 $self->{_activity} = AnyEvent->now;
273 $self->_timeout; 472 $self->_timeout;
274 473
275 $self->on_drain (delete $self->{on_drain}) if exists $self->{on_drain};
276 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay}; 474 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay};
277 475
476 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx})
477 if $self->{tls};
478
479 $self->on_drain (delete $self->{on_drain}) if $self->{on_drain};
480
278 $self->start_read 481 $self->start_read
279 if $self->{on_read}; 482 if $self->{on_read} || @{ $self->{_queue} };
280
281 $self
282} 483}
283 484
284sub _shutdown { 485#sub _shutdown {
285 my ($self) = @_; 486# my ($self) = @_;
286 487#
287 delete $self->{_tw}; 488# delete @$self{qw(_tw _rw _ww fh wbuf on_read _queue)};
288 delete $self->{_rw}; 489# $self->{_eof} = 1; # tell starttls et. al to stop trying
289 delete $self->{_ww}; 490#
290 delete $self->{fh}; 491# &_freetls;
291 492#}
292 $self->stoptls;
293}
294 493
295sub _error { 494sub _error {
296 my ($self, $errno, $fatal) = @_; 495 my ($self, $errno, $fatal, $message) = @_;
297
298 $self->_shutdown
299 if $fatal;
300 496
301 $! = $errno; 497 $! = $errno;
498 $message ||= "$!";
302 499
303 if ($self->{on_error}) { 500 if ($self->{on_error}) {
304 $self->{on_error}($self, $fatal); 501 $self->{on_error}($self, $fatal, $message);
305 } else { 502 $self->destroy if $fatal;
503 } elsif ($self->{fh}) {
504 $self->destroy;
306 Carp::croak "AnyEvent::Handle uncaught error: $!"; 505 Carp::croak "AnyEvent::Handle uncaught error: $message";
307 } 506 }
308} 507}
309 508
310=item $fh = $handle->fh 509=item $fh = $handle->fh
311 510
312This method returns the file handle of the L<AnyEvent::Handle> object. 511This method returns the file handle used to create the L<AnyEvent::Handle> object.
313 512
314=cut 513=cut
315 514
316sub fh { $_[0]{fh} } 515sub fh { $_[0]{fh} }
317 516
335 $_[0]{on_eof} = $_[1]; 534 $_[0]{on_eof} = $_[1];
336} 535}
337 536
338=item $handle->on_timeout ($cb) 537=item $handle->on_timeout ($cb)
339 538
340Replace the current C<on_timeout> callback, or disables the callback 539Replace the current C<on_timeout> callback, or disables the callback (but
341(but not the timeout) if C<$cb> = C<undef>. See C<timeout> constructor 540not the timeout) if C<$cb> = C<undef>. See the C<timeout> constructor
342argument. 541argument and method.
343 542
344=cut 543=cut
345 544
346sub on_timeout { 545sub on_timeout {
347 $_[0]{on_timeout} = $_[1]; 546 $_[0]{on_timeout} = $_[1];
348} 547}
349 548
350=item $handle->autocork ($boolean) 549=item $handle->autocork ($boolean)
351 550
352Enables or disables the current autocork behaviour (see C<autocork> 551Enables or disables the current autocork behaviour (see C<autocork>
353constructor argument). 552constructor argument). Changes will only take effect on the next write.
354 553
355=cut 554=cut
555
556sub autocork {
557 $_[0]{autocork} = $_[1];
558}
356 559
357=item $handle->no_delay ($boolean) 560=item $handle->no_delay ($boolean)
358 561
359Enables or disables the C<no_delay> setting (see constructor argument of 562Enables or disables the C<no_delay> setting (see constructor argument of
360the same name for details). 563the same name for details).
364sub no_delay { 567sub no_delay {
365 $_[0]{no_delay} = $_[1]; 568 $_[0]{no_delay} = $_[1];
366 569
367 eval { 570 eval {
368 local $SIG{__DIE__}; 571 local $SIG{__DIE__};
369 setsockopt $_[0]{fh}, &Socket::IPPROTO_TCP, &Socket::TCP_NODELAY, int $_[1]; 572 setsockopt $_[0]{fh}, &Socket::IPPROTO_TCP, &Socket::TCP_NODELAY, int $_[1]
573 if $_[0]{fh};
370 }; 574 };
575}
576
577=item $handle->on_starttls ($cb)
578
579Replace the current C<on_starttls> callback (see the C<on_starttls> constructor argument).
580
581=cut
582
583sub on_starttls {
584 $_[0]{on_starttls} = $_[1];
585}
586
587=item $handle->on_stoptls ($cb)
588
589Replace the current C<on_stoptls> callback (see the C<on_stoptls> constructor argument).
590
591=cut
592
593sub on_starttls {
594 $_[0]{on_stoptls} = $_[1];
371} 595}
372 596
373############################################################################# 597#############################################################################
374 598
375=item $handle->timeout ($seconds) 599=item $handle->timeout ($seconds)
388# reset the timeout watcher, as neccessary 612# reset the timeout watcher, as neccessary
389# also check for time-outs 613# also check for time-outs
390sub _timeout { 614sub _timeout {
391 my ($self) = @_; 615 my ($self) = @_;
392 616
393 if ($self->{timeout}) { 617 if ($self->{timeout} && $self->{fh}) {
394 my $NOW = AnyEvent->now; 618 my $NOW = AnyEvent->now;
395 619
396 # when would the timeout trigger? 620 # when would the timeout trigger?
397 my $after = $self->{_activity} + $self->{timeout} - $NOW; 621 my $after = $self->{_activity} + $self->{timeout} - $NOW;
398 622
401 $self->{_activity} = $NOW; 625 $self->{_activity} = $NOW;
402 626
403 if ($self->{on_timeout}) { 627 if ($self->{on_timeout}) {
404 $self->{on_timeout}($self); 628 $self->{on_timeout}($self);
405 } else { 629 } else {
406 $self->_error (&Errno::ETIMEDOUT); 630 $self->_error (Errno::ETIMEDOUT);
407 } 631 }
408 632
409 # callback could have changed timeout value, optimise 633 # callback could have changed timeout value, optimise
410 return unless $self->{timeout}; 634 return unless $self->{timeout};
411 635
453 my ($self, $cb) = @_; 677 my ($self, $cb) = @_;
454 678
455 $self->{on_drain} = $cb; 679 $self->{on_drain} = $cb;
456 680
457 $cb->($self) 681 $cb->($self)
458 if $cb && $self->{low_water_mark} >= length $self->{wbuf}; 682 if $cb && $self->{low_water_mark} >= (length $self->{wbuf}) + (length $self->{_tls_wbuf});
459} 683}
460 684
461=item $handle->push_write ($data) 685=item $handle->push_write ($data)
462 686
463Queues the given scalar to be written. You can push as much data as you 687Queues the given scalar to be written. You can push as much data as you
474 Scalar::Util::weaken $self; 698 Scalar::Util::weaken $self;
475 699
476 my $cb = sub { 700 my $cb = sub {
477 my $len = syswrite $self->{fh}, $self->{wbuf}; 701 my $len = syswrite $self->{fh}, $self->{wbuf};
478 702
479 if ($len >= 0) { 703 if (defined $len) {
480 substr $self->{wbuf}, 0, $len, ""; 704 substr $self->{wbuf}, 0, $len, "";
481 705
482 $self->{_activity} = AnyEvent->now; 706 $self->{_activity} = AnyEvent->now;
483 707
484 $self->{on_drain}($self) 708 $self->{on_drain}($self)
485 if $self->{low_water_mark} >= length $self->{wbuf} 709 if $self->{low_water_mark} >= (length $self->{wbuf}) + (length $self->{_tls_wbuf})
486 && $self->{on_drain}; 710 && $self->{on_drain};
487 711
488 delete $self->{_ww} unless length $self->{wbuf}; 712 delete $self->{_ww} unless length $self->{wbuf};
489 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 713 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
490 $self->_error ($!, 1); 714 $self->_error ($!, 1);
514 738
515 @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write") 739 @_ = ($WH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_write")
516 ->($self, @_); 740 ->($self, @_);
517 } 741 }
518 742
519 if ($self->{filter_w}) { 743 if ($self->{tls}) {
520 $self->{filter_w}($self, \$_[0]); 744 $self->{_tls_wbuf} .= $_[0];
745
746 &_dotls ($self);
521 } else { 747 } else {
522 $self->{wbuf} .= $_[0]; 748 $self->{wbuf} .= $_[0];
523 $self->_drain_wbuf; 749 $self->_drain_wbuf if $self->{fh};
524 } 750 }
525} 751}
526 752
527=item $handle->push_write (type => @args) 753=item $handle->push_write (type => @args)
528 754
542=cut 768=cut
543 769
544register_write_type netstring => sub { 770register_write_type netstring => sub {
545 my ($self, $string) = @_; 771 my ($self, $string) = @_;
546 772
547 sprintf "%d:%s,", (length $string), $string 773 (length $string) . ":$string,"
548}; 774};
549 775
550=item packstring => $format, $data 776=item packstring => $format, $data
551 777
552An octet string prefixed with an encoded length. The encoding C<$format> 778An octet string prefixed with an encoded length. The encoding C<$format>
617 843
618 pack "w/a*", Storable::nfreeze ($ref) 844 pack "w/a*", Storable::nfreeze ($ref)
619}; 845};
620 846
621=back 847=back
848
849=item $handle->push_shutdown
850
851Sometimes you know you want to close the socket after writing your data
852before it was actually written. One way to do that is to replace your
853C<on_drain> handler by a callback that shuts down the socket (and set
854C<low_water_mark> to C<0>). This method is a shorthand for just that, and
855replaces the C<on_drain> callback with:
856
857 sub { shutdown $_[0]{fh}, 1 } # for push_shutdown
858
859This simply shuts down the write side and signals an EOF condition to the
860the peer.
861
862You can rely on the normal read queue and C<on_eof> handling
863afterwards. This is the cleanest way to close a connection.
864
865=cut
866
867sub push_shutdown {
868 my ($self) = @_;
869
870 delete $self->{low_water_mark};
871 $self->on_drain (sub { shutdown $_[0]{fh}, 1 });
872}
622 873
623=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) 874=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
624 875
625This function (not method) lets you add your own types to C<push_write>. 876This function (not method) lets you add your own types to C<push_write>.
626Whenever the given C<type> is used, C<push_write> will invoke the code 877Whenever the given C<type> is used, C<push_write> will invoke the code
720=cut 971=cut
721 972
722sub _drain_rbuf { 973sub _drain_rbuf {
723 my ($self) = @_; 974 my ($self) = @_;
724 975
976 # avoid recursion
977 return if exists $self->{_skip_drain_rbuf};
725 local $self->{_in_drain} = 1; 978 local $self->{_skip_drain_rbuf} = 1;
726 979
727 if ( 980 if (
728 defined $self->{rbuf_max} 981 defined $self->{rbuf_max}
729 && $self->{rbuf_max} < length $self->{rbuf} 982 && $self->{rbuf_max} < length $self->{rbuf}
730 ) { 983 ) {
731 return $self->_error (&Errno::ENOSPC, 1); 984 $self->_error (Errno::ENOSPC, 1), return;
732 } 985 }
733 986
734 while () { 987 while () {
735 no strict 'refs'; 988 # we need to use a separate tls read buffer, as we must not receive data while
989 # we are draining the buffer, and this can only happen with TLS.
990 $self->{rbuf} .= delete $self->{_tls_rbuf} if exists $self->{_tls_rbuf};
736 991
737 my $len = length $self->{rbuf}; 992 my $len = length $self->{rbuf};
738 993
739 if (my $cb = shift @{ $self->{_queue} }) { 994 if (my $cb = shift @{ $self->{_queue} }) {
740 unless ($cb->($self)) { 995 unless ($cb->($self)) {
741 if ($self->{_eof}) { 996 if ($self->{_eof}) {
742 # no progress can be made (not enough data and no data forthcoming) 997 # no progress can be made (not enough data and no data forthcoming)
743 $self->_error (&Errno::EPIPE, 1), last; 998 $self->_error (Errno::EPIPE, 1), return;
744 } 999 }
745 1000
746 unshift @{ $self->{_queue} }, $cb; 1001 unshift @{ $self->{_queue} }, $cb;
747 last; 1002 last;
748 } 1003 }
756 && !@{ $self->{_queue} } # and the queue is still empty 1011 && !@{ $self->{_queue} } # and the queue is still empty
757 && $self->{on_read} # but we still have on_read 1012 && $self->{on_read} # but we still have on_read
758 ) { 1013 ) {
759 # no further data will arrive 1014 # no further data will arrive
760 # so no progress can be made 1015 # so no progress can be made
761 $self->_error (&Errno::EPIPE, 1), last 1016 $self->_error (Errno::EPIPE, 1), return
762 if $self->{_eof}; 1017 if $self->{_eof};
763 1018
764 last; # more data might arrive 1019 last; # more data might arrive
765 } 1020 }
766 } else { 1021 } else {
767 # read side becomes idle 1022 # read side becomes idle
768 delete $self->{_rw}; 1023 delete $self->{_rw} unless $self->{tls};
769 last; 1024 last;
770 } 1025 }
771 } 1026 }
772 1027
1028 if ($self->{_eof}) {
1029 if ($self->{on_eof}) {
773 $self->{on_eof}($self) 1030 $self->{on_eof}($self)
774 if $self->{_eof} && $self->{on_eof}; 1031 } else {
1032 $self->_error (0, 1, "Unexpected end-of-file");
1033 }
1034 }
775 1035
776 # may need to restart read watcher 1036 # may need to restart read watcher
777 unless ($self->{_rw}) { 1037 unless ($self->{_rw}) {
778 $self->start_read 1038 $self->start_read
779 if $self->{on_read} || @{ $self->{_queue} }; 1039 if $self->{on_read} || @{ $self->{_queue} };
790 1050
791sub on_read { 1051sub on_read {
792 my ($self, $cb) = @_; 1052 my ($self, $cb) = @_;
793 1053
794 $self->{on_read} = $cb; 1054 $self->{on_read} = $cb;
795 $self->_drain_rbuf if $cb && !$self->{_in_drain}; 1055 $self->_drain_rbuf if $cb;
796} 1056}
797 1057
798=item $handle->rbuf 1058=item $handle->rbuf
799 1059
800Returns the read buffer (as a modifiable lvalue). 1060Returns the read buffer (as a modifiable lvalue).
801 1061
802You can access the read buffer directly as the C<< ->{rbuf} >> member, if 1062You can access the read buffer directly as the C<< ->{rbuf} >>
803you want. 1063member, if you want. However, the only operation allowed on the
1064read buffer (apart from looking at it) is removing data from its
1065beginning. Otherwise modifying or appending to it is not allowed and will
1066lead to hard-to-track-down bugs.
804 1067
805NOTE: The read buffer should only be used or modified if the C<on_read>, 1068NOTE: The read buffer should only be used or modified if the C<on_read>,
806C<push_read> or C<unshift_read> methods are used. The other read methods 1069C<push_read> or C<unshift_read> methods are used. The other read methods
807automatically manage the read buffer. 1070automatically manage the read buffer.
808 1071
849 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read") 1112 $cb = ($RH{$type} or Carp::croak "unsupported type passed to AnyEvent::Handle::push_read")
850 ->($self, $cb, @_); 1113 ->($self, $cb, @_);
851 } 1114 }
852 1115
853 push @{ $self->{_queue} }, $cb; 1116 push @{ $self->{_queue} }, $cb;
854 $self->_drain_rbuf unless $self->{_in_drain}; 1117 $self->_drain_rbuf;
855} 1118}
856 1119
857sub unshift_read { 1120sub unshift_read {
858 my $self = shift; 1121 my $self = shift;
859 my $cb = pop; 1122 my $cb = pop;
865 ->($self, $cb, @_); 1128 ->($self, $cb, @_);
866 } 1129 }
867 1130
868 1131
869 unshift @{ $self->{_queue} }, $cb; 1132 unshift @{ $self->{_queue} }, $cb;
870 $self->_drain_rbuf unless $self->{_in_drain}; 1133 $self->_drain_rbuf;
871} 1134}
872 1135
873=item $handle->push_read (type => @args, $cb) 1136=item $handle->push_read (type => @args, $cb)
874 1137
875=item $handle->unshift_read (type => @args, $cb) 1138=item $handle->unshift_read (type => @args, $cb)
904 $len <= length $_[0]{rbuf} or return; 1167 $len <= length $_[0]{rbuf} or return;
905 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, ""); 1168 $cb->($_[0], substr $_[0]{rbuf}, 0, $len, "");
906 1 1169 1
907 } 1170 }
908}; 1171};
909
910# compatibility with older API
911sub push_read_chunk {
912 $_[0]->push_read (chunk => $_[1], $_[2]);
913}
914
915sub unshift_read_chunk {
916 $_[0]->unshift_read (chunk => $_[1], $_[2]);
917}
918 1172
919=item line => [$eol, ]$cb->($handle, $line, $eol) 1173=item line => [$eol, ]$cb->($handle, $line, $eol)
920 1174
921The callback will be called only once a full line (including the end of 1175The callback will be called only once a full line (including the end of
922line marker, C<$eol>) has been read. This line (excluding the end of line 1176line marker, C<$eol>) has been read. This line (excluding the end of line
958 $cb->($_[0], $1, $2); 1212 $cb->($_[0], $1, $2);
959 1 1213 1
960 } 1214 }
961 } 1215 }
962}; 1216};
963
964# compatibility with older API
965sub push_read_line {
966 my $self = shift;
967 $self->push_read (line => @_);
968}
969
970sub unshift_read_line {
971 my $self = shift;
972 $self->unshift_read (line => @_);
973}
974 1217
975=item regex => $accept[, $reject[, $skip], $cb->($handle, $data) 1218=item regex => $accept[, $reject[, $skip], $cb->($handle, $data)
976 1219
977Makes a regex match against the regex object C<$accept> and returns 1220Makes a regex match against the regex object C<$accept> and returns
978everything up to and including the match. 1221everything up to and including the match.
1028 return 1; 1271 return 1;
1029 } 1272 }
1030 1273
1031 # reject 1274 # reject
1032 if ($reject && $$rbuf =~ $reject) { 1275 if ($reject && $$rbuf =~ $reject) {
1033 $self->_error (&Errno::EBADMSG); 1276 $self->_error (Errno::EBADMSG);
1034 } 1277 }
1035 1278
1036 # skip 1279 # skip
1037 if ($skip && $$rbuf =~ $skip) { 1280 if ($skip && $$rbuf =~ $skip) {
1038 $data .= substr $$rbuf, 0, $+[0], ""; 1281 $data .= substr $$rbuf, 0, $+[0], "";
1054 my ($self, $cb) = @_; 1297 my ($self, $cb) = @_;
1055 1298
1056 sub { 1299 sub {
1057 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) { 1300 unless ($_[0]{rbuf} =~ s/^(0|[1-9][0-9]*)://) {
1058 if ($_[0]{rbuf} =~ /[^0-9]/) { 1301 if ($_[0]{rbuf} =~ /[^0-9]/) {
1059 $self->_error (&Errno::EBADMSG); 1302 $self->_error (Errno::EBADMSG);
1060 } 1303 }
1061 return; 1304 return;
1062 } 1305 }
1063 1306
1064 my $len = $1; 1307 my $len = $1;
1067 my $string = $_[1]; 1310 my $string = $_[1];
1068 $_[0]->unshift_read (chunk => 1, sub { 1311 $_[0]->unshift_read (chunk => 1, sub {
1069 if ($_[1] eq ",") { 1312 if ($_[1] eq ",") {
1070 $cb->($_[0], $string); 1313 $cb->($_[0], $string);
1071 } else { 1314 } else {
1072 $self->_error (&Errno::EBADMSG); 1315 $self->_error (Errno::EBADMSG);
1073 } 1316 }
1074 }); 1317 });
1075 }); 1318 });
1076 1319
1077 1 1320 1
1083An octet string prefixed with an encoded length. The encoding C<$format> 1326An octet string prefixed with an encoded length. The encoding C<$format>
1084uses the same format as a Perl C<pack> format, but must specify a single 1327uses the same format as a Perl C<pack> format, but must specify a single
1085integer only (only one of C<cCsSlLqQiInNvVjJw> is allowed, plus an 1328integer only (only one of C<cCsSlLqQiInNvVjJw> is allowed, plus an
1086optional C<!>, C<< < >> or C<< > >> modifier). 1329optional C<!>, C<< < >> or C<< > >> modifier).
1087 1330
1088DNS over TCP uses a prefix of C<n>, EPP uses a prefix of C<N>. 1331For example, DNS over TCP uses a prefix of C<n> (2 octet network order),
1332EPP uses a prefix of C<N> (4 octtes).
1089 1333
1090Example: read a block of data prefixed by its length in BER-encoded 1334Example: read a block of data prefixed by its length in BER-encoded
1091format (very efficient). 1335format (very efficient).
1092 1336
1093 $handle->push_read (packstring => "w", sub { 1337 $handle->push_read (packstring => "w", sub {
1102 sub { 1346 sub {
1103 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method 1347 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method
1104 defined (my $len = eval { unpack $format, $_[0]{rbuf} }) 1348 defined (my $len = eval { unpack $format, $_[0]{rbuf} })
1105 or return; 1349 or return;
1106 1350
1351 $format = length pack $format, $len;
1352
1353 # bypass unshift if we already have the remaining chunk
1354 if ($format + $len <= length $_[0]{rbuf}) {
1355 my $data = substr $_[0]{rbuf}, $format, $len;
1356 substr $_[0]{rbuf}, 0, $format + $len, "";
1357 $cb->($_[0], $data);
1358 } else {
1107 # remove prefix 1359 # remove prefix
1108 substr $_[0]{rbuf}, 0, (length pack $format, $len), ""; 1360 substr $_[0]{rbuf}, 0, $format, "";
1109 1361
1110 # read rest 1362 # read remaining chunk
1111 $_[0]->unshift_read (chunk => $len, $cb); 1363 $_[0]->unshift_read (chunk => $len, $cb);
1364 }
1112 1365
1113 1 1366 1
1114 } 1367 }
1115}; 1368};
1116 1369
1117=item json => $cb->($handle, $hash_or_arrayref) 1370=item json => $cb->($handle, $hash_or_arrayref)
1118 1371
1119Reads a JSON object or array, decodes it and passes it to the callback. 1372Reads a JSON object or array, decodes it and passes it to the
1373callback. When a parse error occurs, an C<EBADMSG> error will be raised.
1120 1374
1121If a C<json> object was passed to the constructor, then that will be used 1375If a C<json> object was passed to the constructor, then that will be used
1122for the final decode, otherwise it will create a JSON coder expecting UTF-8. 1376for the final decode, otherwise it will create a JSON coder expecting UTF-8.
1123 1377
1124This read type uses the incremental parser available with JSON version 1378This read type uses the incremental parser available with JSON version
1133=cut 1387=cut
1134 1388
1135register_read_type json => sub { 1389register_read_type json => sub {
1136 my ($self, $cb) = @_; 1390 my ($self, $cb) = @_;
1137 1391
1138 require JSON; 1392 my $json = $self->{json} ||=
1393 eval { require JSON::XS; JSON::XS->new->utf8 }
1394 || do { require JSON; JSON->new->utf8 };
1139 1395
1140 my $data; 1396 my $data;
1141 my $rbuf = \$self->{rbuf}; 1397 my $rbuf = \$self->{rbuf};
1142 1398
1143 my $json = $self->{json} ||= JSON->new->utf8;
1144
1145 sub { 1399 sub {
1146 my $ref = $json->incr_parse ($self->{rbuf}); 1400 my $ref = eval { $json->incr_parse ($self->{rbuf}) };
1147 1401
1148 if ($ref) { 1402 if ($ref) {
1149 $self->{rbuf} = $json->incr_text; 1403 $self->{rbuf} = $json->incr_text;
1150 $json->incr_text = ""; 1404 $json->incr_text = "";
1151 $cb->($self, $ref); 1405 $cb->($self, $ref);
1152 1406
1153 1 1407 1
1408 } elsif ($@) {
1409 # error case
1410 $json->incr_skip;
1411
1412 $self->{rbuf} = $json->incr_text;
1413 $json->incr_text = "";
1414
1415 $self->_error (Errno::EBADMSG);
1416
1417 ()
1154 } else { 1418 } else {
1155 $self->{rbuf} = ""; 1419 $self->{rbuf} = "";
1420
1156 () 1421 ()
1157 } 1422 }
1158 } 1423 }
1159}; 1424};
1160 1425
1176 sub { 1441 sub {
1177 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method 1442 # when we can use 5.10 we can use ".", but for 5.8 we use the re-pack method
1178 defined (my $len = eval { unpack "w", $_[0]{rbuf} }) 1443 defined (my $len = eval { unpack "w", $_[0]{rbuf} })
1179 or return; 1444 or return;
1180 1445
1446 my $format = length pack "w", $len;
1447
1448 # bypass unshift if we already have the remaining chunk
1449 if ($format + $len <= length $_[0]{rbuf}) {
1450 my $data = substr $_[0]{rbuf}, $format, $len;
1451 substr $_[0]{rbuf}, 0, $format + $len, "";
1452 $cb->($_[0], Storable::thaw ($data));
1453 } else {
1181 # remove prefix 1454 # remove prefix
1182 substr $_[0]{rbuf}, 0, (length pack "w", $len), ""; 1455 substr $_[0]{rbuf}, 0, $format, "";
1183 1456
1184 # read rest 1457 # read remaining chunk
1185 $_[0]->unshift_read (chunk => $len, sub { 1458 $_[0]->unshift_read (chunk => $len, sub {
1186 if (my $ref = eval { Storable::thaw ($_[1]) }) { 1459 if (my $ref = eval { Storable::thaw ($_[1]) }) {
1187 $cb->($_[0], $ref); 1460 $cb->($_[0], $ref);
1188 } else { 1461 } else {
1189 $self->_error (&Errno::EBADMSG); 1462 $self->_error (Errno::EBADMSG);
1463 }
1190 } 1464 });
1191 }); 1465 }
1466
1467 1
1192 } 1468 }
1193}; 1469};
1194 1470
1195=back 1471=back
1196 1472
1226Note that AnyEvent::Handle will automatically C<start_read> for you when 1502Note that AnyEvent::Handle will automatically C<start_read> for you when
1227you change the C<on_read> callback or push/unshift a read callback, and it 1503you change the C<on_read> callback or push/unshift a read callback, and it
1228will automatically C<stop_read> for you when neither C<on_read> is set nor 1504will automatically C<stop_read> for you when neither C<on_read> is set nor
1229there are any read requests in the queue. 1505there are any read requests in the queue.
1230 1506
1507These methods will have no effect when in TLS mode (as TLS doesn't support
1508half-duplex connections).
1509
1231=cut 1510=cut
1232 1511
1233sub stop_read { 1512sub stop_read {
1234 my ($self) = @_; 1513 my ($self) = @_;
1235 1514
1236 delete $self->{_rw}; 1515 delete $self->{_rw} unless $self->{tls};
1237} 1516}
1238 1517
1239sub start_read { 1518sub start_read {
1240 my ($self) = @_; 1519 my ($self) = @_;
1241 1520
1242 unless ($self->{_rw} || $self->{_eof}) { 1521 unless ($self->{_rw} || $self->{_eof}) {
1243 Scalar::Util::weaken $self; 1522 Scalar::Util::weaken $self;
1244 1523
1245 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub { 1524 $self->{_rw} = AnyEvent->io (fh => $self->{fh}, poll => "r", cb => sub {
1246 my $rbuf = $self->{filter_r} ? \my $buf : \$self->{rbuf}; 1525 my $rbuf = \($self->{tls} ? my $buf : $self->{rbuf});
1247 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf; 1526 my $len = sysread $self->{fh}, $$rbuf, $self->{read_size} || 8192, length $$rbuf;
1248 1527
1249 if ($len > 0) { 1528 if ($len > 0) {
1250 $self->{_activity} = AnyEvent->now; 1529 $self->{_activity} = AnyEvent->now;
1251 1530
1252 $self->{filter_r} 1531 if ($self->{tls}) {
1253 ? $self->{filter_r}($self, $rbuf) 1532 Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf);
1254 : $self->{_in_drain} || $self->_drain_rbuf; 1533
1534 &_dotls ($self);
1535 } else {
1536 $self->_drain_rbuf;
1537 }
1255 1538
1256 } elsif (defined $len) { 1539 } elsif (defined $len) {
1257 delete $self->{_rw}; 1540 delete $self->{_rw};
1258 $self->{_eof} = 1; 1541 $self->{_eof} = 1;
1259 $self->_drain_rbuf unless $self->{_in_drain}; 1542 $self->_drain_rbuf;
1260 1543
1261 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { 1544 } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) {
1262 return $self->_error ($!, 1); 1545 return $self->_error ($!, 1);
1263 } 1546 }
1264 }); 1547 });
1265 } 1548 }
1266} 1549}
1267 1550
1551our $ERROR_SYSCALL;
1552our $ERROR_WANT_READ;
1553
1554sub _tls_error {
1555 my ($self, $err) = @_;
1556
1557 return $self->_error ($!, 1)
1558 if $err == Net::SSLeay::ERROR_SYSCALL ();
1559
1560 my $err =Net::SSLeay::ERR_error_string (Net::SSLeay::ERR_get_error ());
1561
1562 # reduce error string to look less scary
1563 $err =~ s/^error:[0-9a-fA-F]{8}:[^:]+:([^:]+):/\L$1: /;
1564
1565 if ($self->{_on_starttls}) {
1566 (delete $self->{_on_starttls})->($self, undef, $err);
1567 &_freetls;
1568 } else {
1569 &_freetls;
1570 $self->_error (Errno::EPROTO, 1, $err);
1571 }
1572}
1573
1574# poll the write BIO and send the data if applicable
1575# also decode read data if possible
1576# this is basiclaly our TLS state machine
1577# more efficient implementations are possible with openssl,
1578# but not with the buggy and incomplete Net::SSLeay.
1268sub _dotls { 1579sub _dotls {
1269 my ($self) = @_; 1580 my ($self) = @_;
1270 1581
1271 my $buf; 1582 my $tmp;
1272 1583
1273 if (length $self->{_tls_wbuf}) { 1584 if (length $self->{_tls_wbuf}) {
1274 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) { 1585 while (($tmp = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) {
1275 substr $self->{_tls_wbuf}, 0, $len, ""; 1586 substr $self->{_tls_wbuf}, 0, $tmp, "";
1276 } 1587 }
1277 }
1278 1588
1589 $tmp = Net::SSLeay::get_error ($self->{tls}, $tmp);
1590 return $self->_tls_error ($tmp)
1591 if $tmp != $ERROR_WANT_READ
1592 && ($tmp != $ERROR_SYSCALL || $!);
1593 }
1594
1595 while (defined ($tmp = Net::SSLeay::read ($self->{tls}))) {
1596 unless (length $tmp) {
1597 $self->{_on_starttls}
1598 and (delete $self->{_on_starttls})->($self, undef, "EOF during handshake"); # ???
1599 &_freetls;
1600
1601 if ($self->{on_stoptls}) {
1602 $self->{on_stoptls}($self);
1603 return;
1604 } else {
1605 # let's treat SSL-eof as we treat normal EOF
1606 delete $self->{_rw};
1607 $self->{_eof} = 1;
1608 }
1609 }
1610
1611 $self->{_tls_rbuf} .= $tmp;
1612 $self->_drain_rbuf;
1613 $self->{tls} or return; # tls session might have gone away in callback
1614 }
1615
1616 $tmp = Net::SSLeay::get_error ($self->{tls}, -1);
1617 return $self->_tls_error ($tmp)
1618 if $tmp != $ERROR_WANT_READ
1619 && ($tmp != $ERROR_SYSCALL || $!);
1620
1279 if (length ($buf = Net::SSLeay::BIO_read ($self->{_wbio}))) { 1621 while (length ($tmp = Net::SSLeay::BIO_read ($self->{_wbio}))) {
1280 $self->{wbuf} .= $buf; 1622 $self->{wbuf} .= $tmp;
1281 $self->_drain_wbuf; 1623 $self->_drain_wbuf;
1282 } 1624 }
1283 1625
1284 while (defined ($buf = Net::SSLeay::read ($self->{tls}))) { 1626 $self->{_on_starttls}
1285 if (length $buf) { 1627 and Net::SSLeay::state ($self->{tls}) == Net::SSLeay::ST_OK ()
1286 $self->{rbuf} .= $buf; 1628 and (delete $self->{_on_starttls})->($self, 1, "TLS/SSL connection established");
1287 $self->_drain_rbuf unless $self->{_in_drain};
1288 } else {
1289 # let's treat SSL-eof as we treat normal EOF
1290 $self->{_eof} = 1;
1291 $self->_shutdown;
1292 return;
1293 }
1294 }
1295
1296 my $err = Net::SSLeay::get_error ($self->{tls}, -1);
1297
1298 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
1299 if ($err == Net::SSLeay::ERROR_SYSCALL ()) {
1300 return $self->_error ($!, 1);
1301 } elsif ($err == Net::SSLeay::ERROR_SSL ()) {
1302 return $self->_error (&Errno::EIO, 1);
1303 }
1304
1305 # all others are fine for our purposes
1306 }
1307} 1629}
1308 1630
1309=item $handle->starttls ($tls[, $tls_ctx]) 1631=item $handle->starttls ($tls[, $tls_ctx])
1310 1632
1311Instead of starting TLS negotiation immediately when the AnyEvent::Handle 1633Instead of starting TLS negotiation immediately when the AnyEvent::Handle
1312object is created, you can also do that at a later time by calling 1634object is created, you can also do that at a later time by calling
1313C<starttls>. 1635C<starttls>.
1314 1636
1637Starting TLS is currently an asynchronous operation - when you push some
1638write data and then call C<< ->starttls >> then TLS negotiation will start
1639immediately, after which the queued write data is then sent.
1640
1315The first argument is the same as the C<tls> constructor argument (either 1641The first argument is the same as the C<tls> constructor argument (either
1316C<"connect">, C<"accept"> or an existing Net::SSLeay object). 1642C<"connect">, C<"accept"> or an existing Net::SSLeay object).
1317 1643
1318The second argument is the optional C<Net::SSLeay::CTX> object that is 1644The second argument is the optional C<AnyEvent::TLS> object that is used
1319used when AnyEvent::Handle has to create its own TLS connection object. 1645when AnyEvent::Handle has to create its own TLS connection object, or
1646a hash reference with C<< key => value >> pairs that will be used to
1647construct a new context.
1320 1648
1321The TLS connection object will end up in C<< $handle->{tls} >> after this 1649The TLS connection object will end up in C<< $handle->{tls} >>, the TLS
1322call and can be used or changed to your liking. Note that the handshake 1650context in C<< $handle->{tls_ctx} >> after this call and can be used or
1323might have already started when this function returns. 1651changed to your liking. Note that the handshake might have already started
1652when this function returns.
1324 1653
1654If it an error to start a TLS handshake more than once per
1655AnyEvent::Handle object (this is due to bugs in OpenSSL).
1656
1325=cut 1657=cut
1658
1659our %TLS_CACHE; #TODO not yet documented, should we?
1326 1660
1327sub starttls { 1661sub starttls {
1328 my ($self, $ssl, $ctx) = @_; 1662 my ($self, $ssl, $ctx) = @_;
1329 1663
1330 $self->stoptls; 1664 require Net::SSLeay;
1331 1665
1332 if ($ssl eq "accept") { 1666 Carp::croak "it is an error to call starttls more than once on an AnyEvent::Handle object"
1333 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); 1667 if $self->{tls};
1334 Net::SSLeay::set_accept_state ($ssl); 1668
1335 } elsif ($ssl eq "connect") { 1669 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL ();
1336 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); 1670 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ ();
1337 Net::SSLeay::set_connect_state ($ssl); 1671
1672 $ctx ||= $self->{tls_ctx};
1673
1674 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session
1675
1676 if ("HASH" eq ref $ctx) {
1677 require AnyEvent::TLS;
1678
1679 if ($ctx->{cache}) {
1680 my $key = $ctx+0;
1681 $ctx = $TLS_CACHE{$key} ||= new AnyEvent::TLS %$ctx;
1682 } else {
1683 $ctx = new AnyEvent::TLS %$ctx;
1684 }
1685 }
1338 } 1686
1339 1687 $self->{tls_ctx} = $ctx || TLS_CTX ();
1340 $self->{tls} = $ssl; 1688 $self->{tls} = $ssl = $self->{tls_ctx}->_get_session ($ssl, $self, $self->{peername});
1341 1689
1342 # basically, this is deep magic (because SSL_read should have the same issues) 1690 # basically, this is deep magic (because SSL_read should have the same issues)
1343 # but the openssl maintainers basically said: "trust us, it just works". 1691 # but the openssl maintainers basically said: "trust us, it just works".
1344 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 1692 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
1345 # and mismaintained ssleay-module doesn't even offer them). 1693 # and mismaintained ssleay-module doesn't even offer them).
1346 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html 1694 # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html
1695 #
1696 # in short: this is a mess.
1697 #
1698 # note that we do not try to keep the length constant between writes as we are required to do.
1699 # we assume that most (but not all) of this insanity only applies to non-blocking cases,
1700 # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to
1701 # have identity issues in that area.
1347 Net::SSLeay::CTX_set_mode ($self->{tls}, 1702# Net::SSLeay::CTX_set_mode ($ssl,
1348 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 1703# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
1349 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 1704# | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
1705 Net::SSLeay::CTX_set_mode ($ssl, 1|2);
1350 1706
1351 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1707 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1352 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1708 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1353 1709
1354 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio}); 1710 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio});
1355 1711
1356 $self->{filter_w} = sub { 1712 $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) }
1357 $_[0]{_tls_wbuf} .= ${$_[1]}; 1713 if $self->{on_starttls};
1358 &_dotls; 1714
1359 }; 1715 &_dotls; # need to trigger the initial handshake
1360 $self->{filter_r} = sub { 1716 $self->start_read; # make sure we actually do read
1361 Net::SSLeay::BIO_write ($_[0]{_rbio}, ${$_[1]});
1362 &_dotls;
1363 };
1364} 1717}
1365 1718
1366=item $handle->stoptls 1719=item $handle->stoptls
1367 1720
1368Destroys the SSL connection, if any. Partial read or write data will be 1721Shuts down the SSL connection - this makes a proper EOF handshake by
1369lost. 1722sending a close notify to the other side, but since OpenSSL doesn't
1723support non-blocking shut downs, it is not possible to re-use the stream
1724afterwards.
1370 1725
1371=cut 1726=cut
1372 1727
1373sub stoptls { 1728sub stoptls {
1374 my ($self) = @_; 1729 my ($self) = @_;
1375 1730
1376 Net::SSLeay::free (delete $self->{tls}) if $self->{tls}; 1731 if ($self->{tls}) {
1732 Net::SSLeay::shutdown ($self->{tls});
1377 1733
1378 delete $self->{_rbio}; 1734 &_dotls;
1379 delete $self->{_wbio}; 1735
1380 delete $self->{_tls_wbuf}; 1736# # we don't give a shit. no, we do, but we can't. no...#d#
1381 delete $self->{filter_r}; 1737# # we, we... have to use openssl :/#d#
1382 delete $self->{filter_w}; 1738# &_freetls;#d#
1739 }
1740}
1741
1742sub _freetls {
1743 my ($self) = @_;
1744
1745 return unless $self->{tls};
1746
1747 $self->{tls_ctx}->_put_session (delete $self->{tls});
1748
1749 delete @$self{qw(_rbio _wbio _tls_wbuf _on_starttls)};
1383} 1750}
1384 1751
1385sub DESTROY { 1752sub DESTROY {
1386 my $self = shift; 1753 my ($self) = @_;
1387 1754
1388 $self->stoptls; 1755 &_freetls;
1389 1756
1390 my $linger = exists $self->{linger} ? $self->{linger} : 3600; 1757 my $linger = exists $self->{linger} ? $self->{linger} : 3600;
1391 1758
1392 if ($linger && length $self->{wbuf}) { 1759 if ($linger && length $self->{wbuf} && $self->{fh}) {
1393 my $fh = delete $self->{fh}; 1760 my $fh = delete $self->{fh};
1394 my $wbuf = delete $self->{wbuf}; 1761 my $wbuf = delete $self->{wbuf};
1395 1762
1396 my @linger; 1763 my @linger;
1397 1764
1408 @linger = (); 1775 @linger = ();
1409 }); 1776 });
1410 } 1777 }
1411} 1778}
1412 1779
1780=item $handle->destroy
1781
1782Shuts down the handle object as much as possible - this call ensures that
1783no further callbacks will be invoked and as many resources as possible
1784will be freed. You must not call any methods on the object afterwards.
1785
1786Normally, you can just "forget" any references to an AnyEvent::Handle
1787object and it will simply shut down. This works in fatal error and EOF
1788callbacks, as well as code outside. It does I<NOT> work in a read or write
1789callback, so when you want to destroy the AnyEvent::Handle object from
1790within such an callback. You I<MUST> call C<< ->destroy >> explicitly in
1791that case.
1792
1793Destroying the handle object in this way has the advantage that callbacks
1794will be removed as well, so if those are the only reference holders (as
1795is common), then one doesn't need to do anything special to break any
1796reference cycles.
1797
1798The handle might still linger in the background and write out remaining
1799data, as specified by the C<linger> option, however.
1800
1801=cut
1802
1803sub destroy {
1804 my ($self) = @_;
1805
1806 $self->DESTROY;
1807 %$self = ();
1808}
1809
1413=item AnyEvent::Handle::TLS_CTX 1810=item AnyEvent::Handle::TLS_CTX
1414 1811
1415This function creates and returns the Net::SSLeay::CTX object used by 1812This function creates and returns the AnyEvent::TLS object used by default
1416default for TLS mode. 1813for TLS mode.
1417 1814
1418The context is created like this: 1815The context is created by calling L<AnyEvent::TLS> without any arguments.
1419
1420 Net::SSLeay::load_error_strings;
1421 Net::SSLeay::SSLeay_add_ssl_algorithms;
1422 Net::SSLeay::randomize;
1423
1424 my $CTX = Net::SSLeay::CTX_new;
1425
1426 Net::SSLeay::CTX_set_options $CTX, Net::SSLeay::OP_ALL
1427 1816
1428=cut 1817=cut
1429 1818
1430our $TLS_CTX; 1819our $TLS_CTX;
1431 1820
1432sub TLS_CTX() { 1821sub TLS_CTX() {
1433 $TLS_CTX || do { 1822 $TLS_CTX ||= do {
1434 require Net::SSLeay; 1823 require AnyEvent::TLS;
1435 1824
1436 Net::SSLeay::load_error_strings (); 1825 new AnyEvent::TLS
1437 Net::SSLeay::SSLeay_add_ssl_algorithms ();
1438 Net::SSLeay::randomize ();
1439
1440 $TLS_CTX = Net::SSLeay::CTX_new ();
1441
1442 Net::SSLeay::CTX_set_options ($TLS_CTX, Net::SSLeay::OP_ALL ());
1443
1444 $TLS_CTX
1445 } 1826 }
1446} 1827}
1447 1828
1448=back 1829=back
1830
1831
1832=head1 NONFREQUENTLY ASKED QUESTIONS
1833
1834=over 4
1835
1836=item I C<undef> the AnyEvent::Handle reference inside my callback and
1837still get further invocations!
1838
1839That's because AnyEvent::Handle keeps a reference to itself when handling
1840read or write callbacks.
1841
1842It is only safe to "forget" the reference inside EOF or error callbacks,
1843from within all other callbacks, you need to explicitly call the C<<
1844->destroy >> method.
1845
1846=item I get different callback invocations in TLS mode/Why can't I pause
1847reading?
1848
1849Unlike, say, TCP, TLS connections do not consist of two independent
1850communication channels, one for each direction. Or put differently. The
1851read and write directions are not independent of each other: you cannot
1852write data unless you are also prepared to read, and vice versa.
1853
1854This can mean than, in TLS mode, you might get C<on_error> or C<on_eof>
1855callback invocations when you are not expecting any read data - the reason
1856is that AnyEvent::Handle always reads in TLS mode.
1857
1858During the connection, you have to make sure that you always have a
1859non-empty read-queue, or an C<on_read> watcher. At the end of the
1860connection (or when you no longer want to use it) you can call the
1861C<destroy> method.
1862
1863=item How do I read data until the other side closes the connection?
1864
1865If you just want to read your data into a perl scalar, the easiest way
1866to achieve this is by setting an C<on_read> callback that does nothing,
1867clearing the C<on_eof> callback and in the C<on_error> callback, the data
1868will be in C<$_[0]{rbuf}>:
1869
1870 $handle->on_read (sub { });
1871 $handle->on_eof (undef);
1872 $handle->on_error (sub {
1873 my $data = delete $_[0]{rbuf};
1874 });
1875
1876The reason to use C<on_error> is that TCP connections, due to latencies
1877and packets loss, might get closed quite violently with an error, when in
1878fact, all data has been received.
1879
1880It is usually better to use acknowledgements when transferring data,
1881to make sure the other side hasn't just died and you got the data
1882intact. This is also one reason why so many internet protocols have an
1883explicit QUIT command.
1884
1885=item I don't want to destroy the handle too early - how do I wait until
1886all data has been written?
1887
1888After writing your last bits of data, set the C<on_drain> callback
1889and destroy the handle in there - with the default setting of
1890C<low_water_mark> this will be called precisely when all data has been
1891written to the socket:
1892
1893 $handle->push_write (...);
1894 $handle->on_drain (sub {
1895 warn "all data submitted to the kernel\n";
1896 undef $handle;
1897 });
1898
1899If you just want to queue some data and then signal EOF to the other side,
1900consider using C<< ->push_shutdown >> instead.
1901
1902=item I want to contact a TLS/SSL server, I don't care about security.
1903
1904If your TLS server is a pure TLS server (e.g. HTTPS) that only speaks TLS,
1905simply connect to it and then create the AnyEvent::Handle with the C<tls>
1906parameter:
1907
1908 tcp_connect $host, $port, sub {
1909 my ($fh) = @_;
1910
1911 my $handle = new AnyEvent::Handle
1912 fh => $fh,
1913 tls => "connect",
1914 on_error => sub { ... };
1915
1916 $handle->push_write (...);
1917 };
1918
1919=item I want to contact a TLS/SSL server, I do care about security.
1920
1921Then you should additionally enable certificate verification, including
1922peername verification, if the protocol you use supports it (see
1923L<AnyEvent::TLS>, C<verify_peername>).
1924
1925E.g. for HTTPS:
1926
1927 tcp_connect $host, $port, sub {
1928 my ($fh) = @_;
1929
1930 my $handle = new AnyEvent::Handle
1931 fh => $fh,
1932 peername => $host,
1933 tls => "connect",
1934 tls_ctx => { verify => 1, verify_peername => "https" },
1935 ...
1936
1937Note that you must specify the hostname you connected to (or whatever
1938"peername" the protocol needs) as the C<peername> argument, otherwise no
1939peername verification will be done.
1940
1941The above will use the system-dependent default set of trusted CA
1942certificates. If you want to check against a specific CA, add the
1943C<ca_file> (or C<ca_cert>) arguments to C<tls_ctx>:
1944
1945 tls_ctx => {
1946 verify => 1,
1947 verify_peername => "https",
1948 ca_file => "my-ca-cert.pem",
1949 },
1950
1951=item I want to create a TLS/SSL server, how do I do that?
1952
1953Well, you first need to get a server certificate and key. You have
1954three options: a) ask a CA (buy one, use cacert.org etc.) b) create a
1955self-signed certificate (cheap. check the search engine of your choice,
1956there are many tutorials on the net) or c) make your own CA (tinyca2 is a
1957nice program for that purpose).
1958
1959Then create a file with your private key (in PEM format, see
1960L<AnyEvent::TLS>), followed by the certificate (also in PEM format). The
1961file should then look like this:
1962
1963 -----BEGIN RSA PRIVATE KEY-----
1964 ...header data
1965 ... lots of base64'y-stuff
1966 -----END RSA PRIVATE KEY-----
1967
1968 -----BEGIN CERTIFICATE-----
1969 ... lots of base64'y-stuff
1970 -----END CERTIFICATE-----
1971
1972The important bits are the "PRIVATE KEY" and "CERTIFICATE" parts. Then
1973specify this file as C<cert_file>:
1974
1975 tcp_server undef, $port, sub {
1976 my ($fh) = @_;
1977
1978 my $handle = new AnyEvent::Handle
1979 fh => $fh,
1980 tls => "accept",
1981 tls_ctx => { cert_file => "my-server-keycert.pem" },
1982 ...
1983
1984When you have intermediate CA certificates that your clients might not
1985know about, just append them to the C<cert_file>.
1986
1987=back
1988
1449 1989
1450=head1 SUBCLASSING AnyEvent::Handle 1990=head1 SUBCLASSING AnyEvent::Handle
1451 1991
1452In many cases, you might want to subclass AnyEvent::Handle. 1992In many cases, you might want to subclass AnyEvent::Handle.
1453 1993

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines