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.58 by root, Wed Jun 4 22:51:15 2008 UTC vs.
Revision 1.151 by root, Thu Jul 16 04:20:23 2009 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines