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.94 by root, Wed Oct 1 15:50:33 2008 UTC vs.
Revision 1.131 by root, Tue Jun 30 22:42:33 2009 UTC

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.3; 19our $VERSION = 4.45;
20 20
21=head1 SYNOPSIS 21=head1 SYNOPSIS
22 22
23 use AnyEvent; 23 use AnyEvent;
24 use AnyEvent::Handle; 24 use AnyEvent::Handle;
27 27
28 my $handle = 28 my $handle =
29 AnyEvent::Handle->new ( 29 AnyEvent::Handle->new (
30 fh => \*STDIN, 30 fh => \*STDIN,
31 on_eof => sub { 31 on_eof => sub {
32 $cv->broadcast; 32 $cv->send;
33 }, 33 },
34 ); 34 );
35 35
36 # send some request line 36 # send some request line
37 $handle->push_write ("getinfo\015\012"); 37 $handle->push_write ("getinfo\015\012");
59treatment of characters applies to this module as well. 59treatment of characters applies to this module as well.
60 60
61All callbacks will be invoked with the handle object as their first 61All callbacks will be invoked with the handle object as their first
62argument. 62argument.
63 63
64=head2 SIGPIPE is not handled by this module
65
66SIGPIPE is not handled by this module, so one of the practical
67requirements of using it is to ignore SIGPIPE (C<$SIG{PIPE} =
68'IGNORE'>). At least, this is highly recommend in a networked program: If
69you use AnyEvent::Handle in a filter program (like sort), exiting on
70SIGPIPE is probably the right thing to do.
71
72=head1 METHODS 64=head1 METHODS
73 65
74=over 4 66=over 4
75 67
76=item B<new (%args)> 68=item $handle = B<new> AnyEvent::TLS fh => $filehandle, key => value...
77 69
78The constructor supports these arguments (all as key => value pairs). 70The constructor supports these arguments (all as C<< key => value >> pairs).
79 71
80=over 4 72=over 4
81 73
82=item fh => $filehandle [MANDATORY] 74=item fh => $filehandle [MANDATORY]
83 75
92Set the callback to be called when an end-of-file condition is detected, 84Set the callback to be called when an end-of-file condition is detected,
93i.e. in the case of a socket, when the other side has closed the 85i.e. in the case of a socket, when the other side has closed the
94connection cleanly. 86connection cleanly.
95 87
96For sockets, this just means that the other side has stopped sending data, 88For sockets, this just means that the other side has stopped sending data,
97you can still try to write data, and, in fact, one can return from the eof 89you can still try to write data, and, in fact, one can return from the EOF
98callback and continue writing data, as only the read part has been shut 90callback and continue writing data, as only the read part has been shut
99down. 91down.
100 92
101While not mandatory, it is I<highly> recommended to set an eof callback, 93While not mandatory, it is I<highly> recommended to set an EOF callback,
102otherwise you might end up with a closed socket while you are still 94otherwise you might end up with a closed socket while you are still
103waiting for data. 95waiting for data.
104 96
105If an EOF condition has been detected but no C<on_eof> callback has been 97If an EOF condition has been detected but no C<on_eof> callback has been
106set, then a fatal error will be raised with C<$!> set to <0>. 98set, then a fatal error will be raised with C<$!> set to <0>.
135and no read request is in the queue (unlike read queue callbacks, this 127and no read request is in the queue (unlike read queue callbacks, this
136callback will only be called when at least one octet of data is in the 128callback will only be called when at least one octet of data is in the
137read buffer). 129read buffer).
138 130
139To access (and remove data from) the read buffer, use the C<< ->rbuf >> 131To access (and remove data from) the read buffer, use the C<< ->rbuf >>
140method or access the C<$handle->{rbuf}> member directly. 132method or access the C<$handle->{rbuf}> member directly. Note that you
133must not enlarge or modify the read buffer, you can only remove data at
134the beginning from it.
141 135
142When an EOF condition is detected then AnyEvent::Handle will first try to 136When an EOF condition is detected then AnyEvent::Handle will first try to
143feed all the remaining data to the queued callbacks and C<on_read> before 137feed all the remaining data to the queued callbacks and C<on_read> before
144calling the C<on_eof> callback. If no progress can be made, then a fatal 138calling the C<on_eof> callback. If no progress can be made, then a fatal
145error will be raised (with C<$!> set to C<EPIPE>). 139error will be raised (with C<$!> set to C<EPIPE>).
243 237
244This will not work for partial TLS data that could not be encoded 238This will not work for partial TLS data that could not be encoded
245yet. This data will be lost. Calling the C<stoptls> method in time might 239yet. This data will be lost. Calling the C<stoptls> method in time might
246help. 240help.
247 241
242=item common_name => $string
243
244The common name used by some verification methods (most notably SSL/TLS)
245associated with this connection. Usually this is the remote hostname used
246to connect, but can be almost anything.
247
248=item tls => "accept" | "connect" | Net::SSLeay::SSL object 248=item tls => "accept" | "connect" | Net::SSLeay::SSL object
249 249
250When this parameter is given, it enables TLS (SSL) mode, that means 250When this parameter is given, it enables TLS (SSL) mode, that means
251AnyEvent will start a TLS handshake as soon as the conenction has been 251AnyEvent will start a TLS handshake as soon as the conenction has been
252established and will transparently encrypt/decrypt data afterwards. 252established and will transparently encrypt/decrypt data afterwards.
261mode. 261mode.
262 262
263You can also provide your own TLS connection object, but you have 263You can also provide your own TLS connection object, but you have
264to make sure that you call either C<Net::SSLeay::set_connect_state> 264to make sure that you call either C<Net::SSLeay::set_connect_state>
265or C<Net::SSLeay::set_accept_state> on it before you pass it to 265or C<Net::SSLeay::set_accept_state> on it before you pass it to
266AnyEvent::Handle. 266AnyEvent::Handle. Also, this module will take ownership of this connection
267object.
268
269At some future point, AnyEvent::Handle might switch to another TLS
270implementation, then the option to use your own session object will go
271away.
272
273B<IMPORTANT:> since Net::SSLeay "objects" are really only integers,
274passing in the wrong integer will lead to certain crash. This most often
275happens when one uses a stylish C<< tls => 1 >> and is surprised about the
276segmentation fault.
267 277
268See the C<< ->starttls >> method for when need to start TLS negotiation later. 278See the C<< ->starttls >> method for when need to start TLS negotiation later.
269 279
270=item tls_ctx => $ssl_ctx 280=item tls_ctx => $anyevent_tls
271 281
272Use the given C<Net::SSLeay::CTX> object to create the new TLS connection 282Use the given C<AnyEvent::TLS> object to create the new TLS connection
273(unless a connection object was specified directly). If this parameter is 283(unless a connection object was specified directly). If this parameter is
274missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>. 284missing, then AnyEvent::Handle will use C<AnyEvent::Handle::TLS_CTX>.
285
286Instead of an object, you can also specify a hash reference with C<< key
287=> value >> pairs. Those will be passed to L<AnyEvent::TLS> to create a
288new TLS context object.
275 289
276=item json => JSON or JSON::XS object 290=item json => JSON or JSON::XS object
277 291
278This is the json coder object used by the C<json> read and write types. 292This is the json coder object used by the C<json> read and write types.
279 293
288 302
289=cut 303=cut
290 304
291sub new { 305sub new {
292 my $class = shift; 306 my $class = shift;
293
294 my $self = bless { @_ }, $class; 307 my $self = bless { @_ }, $class;
295 308
296 $self->{fh} or Carp::croak "mandatory argument fh is missing"; 309 $self->{fh} or Carp::croak "mandatory argument fh is missing";
297 310
298 AnyEvent::Util::fh_nonblocking $self->{fh}, 1; 311 AnyEvent::Util::fh_nonblocking $self->{fh}, 1;
312
313 $self->{_activity} = AnyEvent->now;
314 $self->_timeout;
315
316 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay};
299 317
300 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx}) 318 $self->starttls (delete $self->{tls}, delete $self->{tls_ctx})
301 if $self->{tls}; 319 if $self->{tls};
302 320
303 $self->{_activity} = AnyEvent->now;
304 $self->_timeout;
305
306 $self->on_drain (delete $self->{on_drain}) if exists $self->{on_drain}; 321 $self->on_drain (delete $self->{on_drain}) if exists $self->{on_drain};
307 $self->no_delay (delete $self->{no_delay}) if exists $self->{no_delay};
308 322
309 $self->start_read 323 $self->start_read
310 if $self->{on_read}; 324 if $self->{on_read};
311 325
312 $self 326 $self->{fh} && $self
313} 327}
314 328
315sub _shutdown { 329sub _shutdown {
316 my ($self) = @_; 330 my ($self) = @_;
317 331
318 delete $self->{_tw}; 332 delete @$self{qw(_tw _rw _ww fh rbuf wbuf on_read _queue)};
319 delete $self->{_rw}; 333 $self->{_eof} = 1; # tell starttls et. al to stop trying
320 delete $self->{_ww};
321 delete $self->{fh};
322 334
323 &_freetls; 335 &_freetls;
324
325 delete $self->{on_read};
326 delete $self->{_queue};
327} 336}
328 337
329sub _error { 338sub _error {
330 my ($self, $errno, $fatal) = @_; 339 my ($self, $errno, $fatal) = @_;
331 340
334 343
335 $! = $errno; 344 $! = $errno;
336 345
337 if ($self->{on_error}) { 346 if ($self->{on_error}) {
338 $self->{on_error}($self, $fatal); 347 $self->{on_error}($self, $fatal);
339 } else { 348 } elsif ($self->{fh}) {
340 Carp::croak "AnyEvent::Handle uncaught error: $!"; 349 Carp::croak "AnyEvent::Handle uncaught error: $!";
341 } 350 }
342} 351}
343 352
344=item $fh = $handle->fh 353=item $fh = $handle->fh
382} 391}
383 392
384=item $handle->autocork ($boolean) 393=item $handle->autocork ($boolean)
385 394
386Enables or disables the current autocork behaviour (see C<autocork> 395Enables or disables the current autocork behaviour (see C<autocork>
387constructor argument). 396constructor argument). Changes will only take effect on the next write.
388 397
389=cut 398=cut
399
400sub autocork {
401 $_[0]{autocork} = $_[1];
402}
390 403
391=item $handle->no_delay ($boolean) 404=item $handle->no_delay ($boolean)
392 405
393Enables or disables the C<no_delay> setting (see constructor argument of 406Enables or disables the C<no_delay> setting (see constructor argument of
394the same name for details). 407the same name for details).
550 ->($self, @_); 563 ->($self, @_);
551 } 564 }
552 565
553 if ($self->{tls}) { 566 if ($self->{tls}) {
554 $self->{_tls_wbuf} .= $_[0]; 567 $self->{_tls_wbuf} .= $_[0];
568
555 &_dotls ($self); 569 &_dotls ($self);
556 } else { 570 } else {
557 $self->{wbuf} .= $_[0]; 571 $self->{wbuf} .= $_[0];
558 $self->_drain_wbuf; 572 $self->_drain_wbuf;
559 } 573 }
577=cut 591=cut
578 592
579register_write_type netstring => sub { 593register_write_type netstring => sub {
580 my ($self, $string) = @_; 594 my ($self, $string) = @_;
581 595
582 sprintf "%d:%s,", (length $string), $string 596 (length $string) . ":$string,"
583}; 597};
584 598
585=item packstring => $format, $data 599=item packstring => $format, $data
586 600
587An octet string prefixed with an encoded length. The encoding C<$format> 601An octet string prefixed with an encoded length. The encoding C<$format>
765 ) { 779 ) {
766 $self->_error (&Errno::ENOSPC, 1), return; 780 $self->_error (&Errno::ENOSPC, 1), return;
767 } 781 }
768 782
769 while () { 783 while () {
784 # we need to use a separate tls read buffer, as we must not receive data while
785 # we are draining the buffer, and this can only happen with TLS.
786 $self->{rbuf} .= delete $self->{_tls_rbuf} if exists $self->{_tls_rbuf};
787
770 my $len = length $self->{rbuf}; 788 my $len = length $self->{rbuf};
771 789
772 if (my $cb = shift @{ $self->{_queue} }) { 790 if (my $cb = shift @{ $self->{_queue} }) {
773 unless ($cb->($self)) { 791 unless ($cb->($self)) {
774 if ($self->{_eof}) { 792 if ($self->{_eof}) {
835 853
836=item $handle->rbuf 854=item $handle->rbuf
837 855
838Returns the read buffer (as a modifiable lvalue). 856Returns the read buffer (as a modifiable lvalue).
839 857
840You can access the read buffer directly as the C<< ->{rbuf} >> member, if 858You can access the read buffer directly as the C<< ->{rbuf} >>
841you want. 859member, if you want. However, the only operation allowed on the
860read buffer (apart from looking at it) is removing data from its
861beginning. Otherwise modifying or appending to it is not allowed and will
862lead to hard-to-track-down bugs.
842 863
843NOTE: The read buffer should only be used or modified if the C<on_read>, 864NOTE: The read buffer should only be used or modified if the C<on_read>,
844C<push_read> or C<unshift_read> methods are used. The other read methods 865C<push_read> or C<unshift_read> methods are used. The other read methods
845automatically manage the read buffer. 866automatically manage the read buffer.
846 867
1101An octet string prefixed with an encoded length. The encoding C<$format> 1122An octet string prefixed with an encoded length. The encoding C<$format>
1102uses the same format as a Perl C<pack> format, but must specify a single 1123uses the same format as a Perl C<pack> format, but must specify a single
1103integer only (only one of C<cCsSlLqQiInNvVjJw> is allowed, plus an 1124integer only (only one of C<cCsSlLqQiInNvVjJw> is allowed, plus an
1104optional C<!>, C<< < >> or C<< > >> modifier). 1125optional C<!>, C<< < >> or C<< > >> modifier).
1105 1126
1106DNS over TCP uses a prefix of C<n>, EPP uses a prefix of C<N>. 1127For example, DNS over TCP uses a prefix of C<n> (2 octet network order),
1128EPP uses a prefix of C<N> (4 octtes).
1107 1129
1108Example: read a block of data prefixed by its length in BER-encoded 1130Example: read a block of data prefixed by its length in BER-encoded
1109format (very efficient). 1131format (very efficient).
1110 1132
1111 $handle->push_read (packstring => "w", sub { 1133 $handle->push_read (packstring => "w", sub {
1141 } 1163 }
1142}; 1164};
1143 1165
1144=item json => $cb->($handle, $hash_or_arrayref) 1166=item json => $cb->($handle, $hash_or_arrayref)
1145 1167
1146Reads a JSON object or array, decodes it and passes it to the callback. 1168Reads a JSON object or array, decodes it and passes it to the
1169callback. When a parse error occurs, an C<EBADMSG> error will be raised.
1147 1170
1148If a C<json> object was passed to the constructor, then that will be used 1171If a C<json> object was passed to the constructor, then that will be used
1149for the final decode, otherwise it will create a JSON coder expecting UTF-8. 1172for the final decode, otherwise it will create a JSON coder expecting UTF-8.
1150 1173
1151This read type uses the incremental parser available with JSON version 1174This read type uses the incremental parser available with JSON version
1168 my $rbuf = \$self->{rbuf}; 1191 my $rbuf = \$self->{rbuf};
1169 1192
1170 my $json = $self->{json} ||= JSON->new->utf8; 1193 my $json = $self->{json} ||= JSON->new->utf8;
1171 1194
1172 sub { 1195 sub {
1173 my $ref = $json->incr_parse ($self->{rbuf}); 1196 my $ref = eval { $json->incr_parse ($self->{rbuf}) };
1174 1197
1175 if ($ref) { 1198 if ($ref) {
1176 $self->{rbuf} = $json->incr_text; 1199 $self->{rbuf} = $json->incr_text;
1177 $json->incr_text = ""; 1200 $json->incr_text = "";
1178 $cb->($self, $ref); 1201 $cb->($self, $ref);
1179 1202
1180 1 1203 1
1204 } elsif ($@) {
1205 # error case
1206 $json->incr_skip;
1207
1208 $self->{rbuf} = $json->incr_text;
1209 $json->incr_text = "";
1210
1211 $self->_error (&Errno::EBADMSG);
1212
1213 ()
1181 } else { 1214 } else {
1182 $self->{rbuf} = ""; 1215 $self->{rbuf} = "";
1216
1183 () 1217 ()
1184 } 1218 }
1185 } 1219 }
1186}; 1220};
1187 1221
1290 if ($len > 0) { 1324 if ($len > 0) {
1291 $self->{_activity} = AnyEvent->now; 1325 $self->{_activity} = AnyEvent->now;
1292 1326
1293 if ($self->{tls}) { 1327 if ($self->{tls}) {
1294 Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf); 1328 Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf);
1329
1295 &_dotls ($self); 1330 &_dotls ($self);
1296 } else { 1331 } else {
1297 $self->_drain_rbuf unless $self->{_in_drain}; 1332 $self->_drain_rbuf unless $self->{_in_drain};
1298 } 1333 }
1299 1334
1307 } 1342 }
1308 }); 1343 });
1309 } 1344 }
1310} 1345}
1311 1346
1347# poll the write BIO and send the data if applicable
1312sub _dotls { 1348sub _dotls {
1313 my ($self) = @_; 1349 my ($self) = @_;
1314 1350
1315 my $buf; 1351 my $tmp;
1316 1352
1317 if (length $self->{_tls_wbuf}) { 1353 if (length $self->{_tls_wbuf}) {
1318 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) { 1354 while (($tmp = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) {
1319 substr $self->{_tls_wbuf}, 0, $len, ""; 1355 substr $self->{_tls_wbuf}, 0, $tmp, "";
1320 } 1356 }
1321 } 1357 }
1322 1358
1323 while (defined ($buf = Net::SSLeay::read ($self->{tls}))) { 1359 while (defined ($tmp = Net::SSLeay::read ($self->{tls}))) {
1324 unless (length $buf) { 1360 unless (length $tmp) {
1325 # let's treat SSL-eof as we treat normal EOF 1361 # let's treat SSL-eof as we treat normal EOF
1326 delete $self->{_rw}; 1362 delete $self->{_rw};
1327 $self->{_eof} = 1; 1363 $self->{_eof} = 1;
1328 &_freetls; 1364 &_freetls;
1329 } 1365 }
1330 1366
1331 $self->{rbuf} .= $buf; 1367 $self->{_tls_rbuf} .= $tmp;
1332 $self->_drain_rbuf unless $self->{_in_drain}; 1368 $self->_drain_rbuf unless $self->{_in_drain};
1333 $self->{tls} or return; # tls session might have gone away in callback 1369 $self->{tls} or return; # tls session might have gone away in callback
1334 } 1370 }
1335 1371
1336 my $err = Net::SSLeay::get_error ($self->{tls}, -1); 1372 $tmp = Net::SSLeay::get_error ($self->{tls}, -1);
1337 1373
1338 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) { 1374 if ($tmp != Net::SSLeay::ERROR_WANT_READ ()) {
1339 if ($err == Net::SSLeay::ERROR_SYSCALL ()) { 1375 if ($tmp == Net::SSLeay::ERROR_SYSCALL ()) {
1340 return $self->_error ($!, 1); 1376 return $self->_error ($!, 1);
1341 } elsif ($err == Net::SSLeay::ERROR_SSL ()) { 1377 } elsif ($tmp == Net::SSLeay::ERROR_SSL ()) {
1342 return $self->_error (&Errno::EIO, 1); 1378 return $self->_error (&Errno::EIO, 1);
1343 } 1379 }
1344 1380
1345 # all others are fine for our purposes 1381 # all other errors are fine for our purposes
1346 } 1382 }
1347 1383
1348 if (length ($buf = Net::SSLeay::BIO_read ($self->{_wbio}))) { 1384 while (length ($tmp = Net::SSLeay::BIO_read ($self->{_wbio}))) {
1349 $self->{wbuf} .= $buf; 1385 $self->{wbuf} .= $tmp;
1350 $self->_drain_wbuf; 1386 $self->_drain_wbuf;
1351 } 1387 }
1352} 1388}
1353 1389
1354=item $handle->starttls ($tls[, $tls_ctx]) 1390=item $handle->starttls ($tls[, $tls_ctx])
1358C<starttls>. 1394C<starttls>.
1359 1395
1360The first argument is the same as the C<tls> constructor argument (either 1396The first argument is the same as the C<tls> constructor argument (either
1361C<"connect">, C<"accept"> or an existing Net::SSLeay object). 1397C<"connect">, C<"accept"> or an existing Net::SSLeay object).
1362 1398
1363The second argument is the optional C<Net::SSLeay::CTX> object that is 1399The second argument is the optional C<AnyEvent::TLS> object that is used
1364used when AnyEvent::Handle has to create its own TLS connection object. 1400when AnyEvent::Handle has to create its own TLS connection object, or
1401a hash reference with C<< key => value >> pairs that will be used to
1402construct a new context.
1365 1403
1366The TLS connection object will end up in C<< $handle->{tls} >> after this 1404The TLS connection object will end up in C<< $handle->{tls} >>, the TLS
1367call and can be used or changed to your liking. Note that the handshake 1405context in C<< $handle->{tls_ctx} >> after this call and can be used or
1368might have already started when this function returns. 1406changed to your liking. Note that the handshake might have already started
1407when this function returns.
1369 1408
1370If it an error to start a TLS handshake more than once per 1409If it an error to start a TLS handshake more than once per
1371AnyEvent::Handle object (this is due to bugs in OpenSSL). 1410AnyEvent::Handle object (this is due to bugs in OpenSSL).
1372 1411
1373=cut 1412=cut
1375sub starttls { 1414sub starttls {
1376 my ($self, $ssl, $ctx) = @_; 1415 my ($self, $ssl, $ctx) = @_;
1377 1416
1378 require Net::SSLeay; 1417 require Net::SSLeay;
1379 1418
1380 Carp::croak "it is an error to call starttls more than once on an Anyevent::Handle object" 1419 Carp::croak "it is an error to call starttls more than once on an AnyEvent::Handle object"
1381 if $self->{tls}; 1420 if $self->{tls};
1421
1422 $ctx ||= $self->{tls_ctx};
1423
1424 if ("HASH" eq ref $ctx) {
1425 require AnyEvent::TLS;
1426
1427 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context
1428 $ctx = new AnyEvent::TLS %$ctx;
1429 }
1382 1430
1383 if ($ssl eq "accept") { 1431 $self->{tls_ctx} = $ctx || TLS_CTX ();
1384 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); 1432 $self->{tls} = $ssl = $self->{tls_ctx}->_get_session ($ssl, $self);
1385 Net::SSLeay::set_accept_state ($ssl);
1386 } elsif ($ssl eq "connect") {
1387 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
1388 Net::SSLeay::set_connect_state ($ssl);
1389 }
1390
1391 $self->{tls} = $ssl;
1392 1433
1393 # basically, this is deep magic (because SSL_read should have the same issues) 1434 # basically, this is deep magic (because SSL_read should have the same issues)
1394 # but the openssl maintainers basically said: "trust us, it just works". 1435 # but the openssl maintainers basically said: "trust us, it just works".
1395 # (unfortunately, we have to hardcode constants because the abysmally misdesigned 1436 # (unfortunately, we have to hardcode constants because the abysmally misdesigned
1396 # and mismaintained ssleay-module doesn't even offer them). 1437 # and mismaintained ssleay-module doesn't even offer them).
1400 # 1441 #
1401 # note that we do not try to keep the length constant between writes as we are required to do. 1442 # note that we do not try to keep the length constant between writes as we are required to do.
1402 # we assume that most (but not all) of this insanity only applies to non-blocking cases, 1443 # we assume that most (but not all) of this insanity only applies to non-blocking cases,
1403 # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to 1444 # and we drive openssl fully in blocking mode here. Or maybe we don't - openssl seems to
1404 # have identity issues in that area. 1445 # have identity issues in that area.
1405 Net::SSLeay::CTX_set_mode ($self->{tls}, 1446# Net::SSLeay::CTX_set_mode ($ssl,
1406 (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) 1447# (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1)
1407 | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); 1448# | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2));
1449 Net::SSLeay::CTX_set_mode ($ssl, 1|2);
1408 1450
1409 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1451 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1410 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1452 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1411 1453
1412 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio}); 1454 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio});
1441sub _freetls { 1483sub _freetls {
1442 my ($self) = @_; 1484 my ($self) = @_;
1443 1485
1444 return unless $self->{tls}; 1486 return unless $self->{tls};
1445 1487
1446 Net::SSLeay::free (delete $self->{tls}); 1488 $self->{tls_ctx}->_put_session (delete $self->{tls});
1447 1489
1448 delete @$self{qw(_rbio _wbio _tls_wbuf)}; 1490 delete @$self{qw(_rbio _wbio _tls_wbuf)};
1449} 1491}
1450 1492
1451sub DESTROY { 1493sub DESTROY {
1452 my $self = shift; 1494 my ($self) = @_;
1453 1495
1454 &_freetls; 1496 &_freetls;
1455 1497
1456 my $linger = exists $self->{linger} ? $self->{linger} : 3600; 1498 my $linger = exists $self->{linger} ? $self->{linger} : 3600;
1457 1499
1474 @linger = (); 1516 @linger = ();
1475 }); 1517 });
1476 } 1518 }
1477} 1519}
1478 1520
1521=item $handle->destroy
1522
1523Shuts down the handle object as much as possible - this call ensures that
1524no further callbacks will be invoked and resources will be freed as much
1525as possible. You must not call any methods on the object afterwards.
1526
1527Normally, you can just "forget" any references to an AnyEvent::Handle
1528object and it will simply shut down. This works in fatal error and EOF
1529callbacks, as well as code outside. It does I<NOT> work in a read or write
1530callback, so when you want to destroy the AnyEvent::Handle object from
1531within such an callback. You I<MUST> call C<< ->destroy >> explicitly in
1532that case.
1533
1534The handle might still linger in the background and write out remaining
1535data, as specified by the C<linger> option, however.
1536
1537=cut
1538
1539sub destroy {
1540 my ($self) = @_;
1541
1542 $self->DESTROY;
1543 %$self = ();
1544}
1545
1479=item AnyEvent::Handle::TLS_CTX 1546=item AnyEvent::Handle::TLS_CTX
1480 1547
1481This function creates and returns the Net::SSLeay::CTX object used by 1548This function creates and returns the AnyEvent::TLS object used by default
1482default for TLS mode. 1549for TLS mode.
1483 1550
1484The context is created like this: 1551The context is created by calling L<AnyEvent::TLS> without any arguments.
1485
1486 Net::SSLeay::load_error_strings;
1487 Net::SSLeay::SSLeay_add_ssl_algorithms;
1488 Net::SSLeay::randomize;
1489
1490 my $CTX = Net::SSLeay::CTX_new;
1491
1492 Net::SSLeay::CTX_set_options $CTX, Net::SSLeay::OP_ALL
1493 1552
1494=cut 1553=cut
1495 1554
1496our $TLS_CTX; 1555our $TLS_CTX;
1497 1556
1498sub TLS_CTX() { 1557sub TLS_CTX() {
1499 $TLS_CTX || do { 1558 $TLS_CTX ||= do {
1500 require Net::SSLeay; 1559 require AnyEvent::TLS;
1501 1560
1502 Net::SSLeay::load_error_strings (); 1561 new AnyEvent::TLS
1503 Net::SSLeay::SSLeay_add_ssl_algorithms ();
1504 Net::SSLeay::randomize ();
1505
1506 $TLS_CTX = Net::SSLeay::CTX_new ();
1507
1508 Net::SSLeay::CTX_set_options ($TLS_CTX, Net::SSLeay::OP_ALL ());
1509
1510 $TLS_CTX
1511 } 1562 }
1512} 1563}
1513 1564
1514=back 1565=back
1566
1567
1568=head1 NONFREQUENTLY ASKED QUESTIONS
1569
1570=over 4
1571
1572=item I C<undef> the AnyEvent::Handle reference inside my callback and
1573still get further invocations!
1574
1575That's because AnyEvent::Handle keeps a reference to itself when handling
1576read or write callbacks.
1577
1578It is only safe to "forget" the reference inside EOF or error callbacks,
1579from within all other callbacks, you need to explicitly call the C<<
1580->destroy >> method.
1581
1582=item I get different callback invocations in TLS mode/Why can't I pause
1583reading?
1584
1585Unlike, say, TCP, TLS connections do not consist of two independent
1586communication channels, one for each direction. Or put differently. The
1587read and write directions are not independent of each other: you cannot
1588write data unless you are also prepared to read, and vice versa.
1589
1590This can mean than, in TLS mode, you might get C<on_error> or C<on_eof>
1591callback invocations when you are not expecting any read data - the reason
1592is that AnyEvent::Handle always reads in TLS mode.
1593
1594During the connection, you have to make sure that you always have a
1595non-empty read-queue, or an C<on_read> watcher. At the end of the
1596connection (or when you no longer want to use it) you can call the
1597C<destroy> method.
1598
1599=item How do I read data until the other side closes the connection?
1600
1601If you just want to read your data into a perl scalar, the easiest way
1602to achieve this is by setting an C<on_read> callback that does nothing,
1603clearing the C<on_eof> callback and in the C<on_error> callback, the data
1604will be in C<$_[0]{rbuf}>:
1605
1606 $handle->on_read (sub { });
1607 $handle->on_eof (undef);
1608 $handle->on_error (sub {
1609 my $data = delete $_[0]{rbuf};
1610 undef $handle;
1611 });
1612
1613The reason to use C<on_error> is that TCP connections, due to latencies
1614and packets loss, might get closed quite violently with an error, when in
1615fact, all data has been received.
1616
1617It is usually better to use acknowledgements when transferring data,
1618to make sure the other side hasn't just died and you got the data
1619intact. This is also one reason why so many internet protocols have an
1620explicit QUIT command.
1621
1622=item I don't want to destroy the handle too early - how do I wait until
1623all data has been written?
1624
1625After writing your last bits of data, set the C<on_drain> callback
1626and destroy the handle in there - with the default setting of
1627C<low_water_mark> this will be called precisely when all data has been
1628written to the socket:
1629
1630 $handle->push_write (...);
1631 $handle->on_drain (sub {
1632 warn "all data submitted to the kernel\n";
1633 undef $handle;
1634 });
1635
1636=back
1637
1515 1638
1516=head1 SUBCLASSING AnyEvent::Handle 1639=head1 SUBCLASSING AnyEvent::Handle
1517 1640
1518In many cases, you might want to subclass AnyEvent::Handle. 1641In many cases, you might want to subclass AnyEvent::Handle.
1519 1642

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines