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.134 by root, Fri Jul 3 00:09:04 2009 UTC vs.
Revision 1.142 by root, Mon Jul 6 20:24:47 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.45; 19our $VERSION = 4.452;
20 20
21=head1 SYNOPSIS 21=head1 SYNOPSIS
22 22
23 use AnyEvent; 23 use AnyEvent;
24 use AnyEvent::Handle; 24 use AnyEvent::Handle;
133and no read request is in the queue (unlike read queue callbacks, this 133and no read request is in the queue (unlike read queue callbacks, this
134callback will only be called when at least one octet of data is in the 134callback will only be called when at least one octet of data is in the
135read buffer). 135read buffer).
136 136
137To access (and remove data from) the read buffer, use the C<< ->rbuf >> 137To access (and remove data from) the read buffer, use the C<< ->rbuf >>
138method or access the C<$handle->{rbuf}> member directly. Note that you 138method or access the C<< $handle->{rbuf} >> member directly. Note that you
139must not enlarge or modify the read buffer, you can only remove data at 139must not enlarge or modify the read buffer, you can only remove data at
140the beginning from it. 140the beginning from it.
141 141
142When an EOF condition is detected then AnyEvent::Handle will first try to 142When 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 143feed all the remaining data to the queued callbacks and C<on_read> before
249 249
250A string used to identify the remote site - usually the DNS hostname 250A string used to identify the remote site - usually the DNS hostname
251(I<not> IDN!) used to create the connection, rarely the IP address. 251(I<not> IDN!) used to create the connection, rarely the IP address.
252 252
253Apart from being useful in error messages, this string is also used in TLS 253Apart from being useful in error messages, this string is also used in TLS
254common name verification (see C<verify_cn> in L<AnyEvent::TLS>). 254peername verification (see C<verify_peername> in L<AnyEvent::TLS>).
255 255
256=item tls => "accept" | "connect" | Net::SSLeay::SSL object 256=item tls => "accept" | "connect" | Net::SSLeay::SSL object
257 257
258When this parameter is given, it enables TLS (SSL) mode, that means 258When this parameter is given, it enables TLS (SSL) mode, that means
259AnyEvent will start a TLS handshake as soon as the conenction has been 259AnyEvent will start a TLS handshake as soon as the conenction has been
296 296
297Instead of an object, you can also specify a hash reference with C<< key 297Instead of an object, you can also specify a hash reference with C<< key
298=> value >> pairs. Those will be passed to L<AnyEvent::TLS> to create a 298=> value >> pairs. Those will be passed to L<AnyEvent::TLS> to create a
299new TLS context object. 299new TLS context object.
300 300
301=item on_starttls => $cb->($handle, $success)
302
303This callback will be invoked when the TLS/SSL handshake has finished. If
304C<$success> is true, then the TLS handshake succeeded, otherwise it failed
305(C<on_stoptls> will not be called in this case).
306
307The session in C<< $handle->{tls} >> can still be examined in this
308callback, even when the handshake was not successful.
309
310=item on_stoptls => $cb->($handle)
311
312When a SSLv3/TLS shutdown/close notify/EOF is detected and this callback is
313set, then it will be invoked after freeing the TLS session. If it is not,
314then a TLS shutdown condition will be treated like a normal EOF condition
315on the handle.
316
317The session in C<< $handle->{tls} >> can still be examined in this
318callback.
319
320This callback will only be called on TLS shutdowns, not when the
321underlying handle signals EOF.
322
301=item json => JSON or JSON::XS object 323=item json => JSON or JSON::XS object
302 324
303This is the json coder object used by the C<json> read and write types. 325This is the json coder object used by the C<json> read and write types.
304 326
305If you don't supply it, then AnyEvent::Handle will create and use a 327If you don't supply it, then AnyEvent::Handle will create and use a
425 447
426 eval { 448 eval {
427 local $SIG{__DIE__}; 449 local $SIG{__DIE__};
428 setsockopt $_[0]{fh}, &Socket::IPPROTO_TCP, &Socket::TCP_NODELAY, int $_[1]; 450 setsockopt $_[0]{fh}, &Socket::IPPROTO_TCP, &Socket::TCP_NODELAY, int $_[1];
429 }; 451 };
452}
453
454=item $handle->on_starttls ($cb)
455
456Replace the current C<on_starttls> callback (see the C<on_starttls> constructor argument).
457
458=cut
459
460sub on_starttls {
461 $_[0]{on_starttls} = $_[1];
462}
463
464=item $handle->on_stoptls ($cb)
465
466Replace the current C<on_stoptls> callback (see the C<on_stoptls> constructor argument).
467
468=cut
469
470sub on_starttls {
471 $_[0]{on_stoptls} = $_[1];
430} 472}
431 473
432############################################################################# 474#############################################################################
433 475
434=item $handle->timeout ($seconds) 476=item $handle->timeout ($seconds)
683 725
684=item $handle->push_shutdown 726=item $handle->push_shutdown
685 727
686Sometimes you know you want to close the socket after writing your data 728Sometimes you know you want to close the socket after writing your data
687before it was actually written. One way to do that is to replace your 729before it was actually written. One way to do that is to replace your
688C<on_drain> handler by a callback that shuts down the socket. This method 730C<on_drain> handler by a callback that shuts down the socket (and set
689is a shorthand for just that, and replaces the C<on_drain> callback with: 731C<low_water_mark> to C<0>). This method is a shorthand for just that, and
732replaces the C<on_drain> callback with:
690 733
691 sub { shutdown $_[0]{fh}, 1 } # for push_shutdown 734 sub { shutdown $_[0]{fh}, 1 } # for push_shutdown
692 735
693This simply shuts down the write side and signals an EOF condition to the 736This simply shuts down the write side and signals an EOF condition to the
694the peer. 737the peer.
697afterwards. This is the cleanest way to close a connection. 740afterwards. This is the cleanest way to close a connection.
698 741
699=cut 742=cut
700 743
701sub push_shutdown { 744sub push_shutdown {
745 my ($self) = @_;
746
747 delete $self->{low_water_mark};
702 $_[0]->{on_drain} = sub { shutdown $_[0]{fh}, 1 }; 748 $self->on_drain (sub { shutdown $_[0]{fh}, 1 });
703} 749}
704 750
705=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args) 751=item AnyEvent::Handle::register_write_type type => $coderef->($handle, @args)
706 752
707This function (not method) lets you add your own types to C<push_write>. 753This function (not method) lets you add your own types to C<push_write>.
856 902
857 if ($self->{_eof}) { 903 if ($self->{_eof}) {
858 if ($self->{on_eof}) { 904 if ($self->{on_eof}) {
859 $self->{on_eof}($self) 905 $self->{on_eof}($self)
860 } else { 906 } else {
861 $self->_error (0, 1); 907 $self->_error (0, 1, "Unexpected end-of-file");
862 } 908 }
863 } 909 }
864 910
865 # may need to restart read watcher 911 # may need to restart read watcher
866 unless ($self->{_rw}) { 912 unless ($self->{_rw}) {
1216=cut 1262=cut
1217 1263
1218register_read_type json => sub { 1264register_read_type json => sub {
1219 my ($self, $cb) = @_; 1265 my ($self, $cb) = @_;
1220 1266
1221 require JSON; 1267 my $json = $self->{json} ||=
1268 eval { require JSON::XS; JSON::XS->new->utf8 }
1269 || do { require JSON; JSON->new->utf8 };
1222 1270
1223 my $data; 1271 my $data;
1224 my $rbuf = \$self->{rbuf}; 1272 my $rbuf = \$self->{rbuf};
1225
1226 my $json = $self->{json} ||= JSON->new->utf8;
1227 1273
1228 sub { 1274 sub {
1229 my $ref = eval { $json->incr_parse ($self->{rbuf}) }; 1275 my $ref = eval { $json->incr_parse ($self->{rbuf}) };
1230 1276
1231 if ($ref) { 1277 if ($ref) {
1377 } 1423 }
1378} 1424}
1379 1425
1380our $ERROR_SYSCALL; 1426our $ERROR_SYSCALL;
1381our $ERROR_WANT_READ; 1427our $ERROR_WANT_READ;
1382our $ERROR_ZERO_RETURN;
1383 1428
1384sub _tls_error { 1429sub _tls_error {
1385 my ($self, $err) = @_; 1430 my ($self, $err) = @_;
1386 warn "$err,$!\n";#d#
1387 1431
1388 return $self->_error ($!, 1) 1432 return $self->_error ($!, 1)
1389 if $err == Net::SSLeay::ERROR_SYSCALL (); 1433 if $err == Net::SSLeay::ERROR_SYSCALL ();
1390 1434
1435 my $err =Net::SSLeay::ERR_error_string (Net::SSLeay::ERR_get_error ());
1436
1437 # reduce error string to look less scary
1438 $err =~ s/^error:[0-9a-fA-F]{8}:[^:]+:([^:]+):/\L$1: /;
1439
1391 $self->_error (&Errno::EPROTO, 1, 1440 $self->_error (&Errno::EPROTO, 1, $err);
1392 Net::SSLeay::ERR_error_string (Net::SSLeay::ERR_get_error ()));
1393} 1441}
1394 1442
1395# poll the write BIO and send the data if applicable 1443# poll the write BIO and send the data if applicable
1396# also decode read data if possible 1444# also decode read data if possible
1397# this is basiclaly our TLS state machine 1445# this is basiclaly our TLS state machine
1408 } 1456 }
1409 1457
1410 $tmp = Net::SSLeay::get_error ($self->{tls}, $tmp); 1458 $tmp = Net::SSLeay::get_error ($self->{tls}, $tmp);
1411 return $self->_tls_error ($tmp) 1459 return $self->_tls_error ($tmp)
1412 if $tmp != $ERROR_WANT_READ 1460 if $tmp != $ERROR_WANT_READ
1413 && ($tmp != $ERROR_SYSCALL || $!) 1461 && ($tmp != $ERROR_SYSCALL || $!);
1414 && $tmp != $ERROR_ZERO_RETURN;
1415 } 1462 }
1416 1463
1417 while (defined ($tmp = Net::SSLeay::read ($self->{tls}))) { 1464 while (defined ($tmp = Net::SSLeay::read ($self->{tls}))) {
1418 unless (length $tmp) { 1465 unless (length $tmp) {
1419 # let's treat SSL-eof as we treat normal EOF
1420 delete $self->{_rw};
1421 $self->{_eof} = 1;
1422 &_freetls; 1466 &_freetls;
1467 if ($self->{on_stoptls}) {
1468 $self->{on_stoptls}($self);
1469 return;
1470 } else {
1471 # let's treat SSL-eof as we treat normal EOF
1472 delete $self->{_rw};
1473 $self->{_eof} = 1;
1474 }
1423 } 1475 }
1424 1476
1425 $self->{_tls_rbuf} .= $tmp; 1477 $self->{_tls_rbuf} .= $tmp;
1426 $self->_drain_rbuf unless $self->{_in_drain}; 1478 $self->_drain_rbuf unless $self->{_in_drain};
1427 $self->{tls} or return; # tls session might have gone away in callback 1479 $self->{tls} or return; # tls session might have gone away in callback
1428 } 1480 }
1429 1481
1430 $tmp = Net::SSLeay::get_error ($self->{tls}, -1); 1482 $tmp = Net::SSLeay::get_error ($self->{tls}, -1);
1431 return $self->_tls_error ($tmp) 1483 return $self->_tls_error ($tmp)
1432 if $tmp != $ERROR_WANT_READ 1484 if $tmp != $ERROR_WANT_READ
1433 && ($tmp != $ERROR_SYSCALL || $!) 1485 && ($tmp != $ERROR_SYSCALL || $!);
1434 && $tmp != $ERROR_ZERO_RETURN;
1435 1486
1436 while (length ($tmp = Net::SSLeay::BIO_read ($self->{_wbio}))) { 1487 while (length ($tmp = Net::SSLeay::BIO_read ($self->{_wbio}))) {
1437 $self->{wbuf} .= $tmp; 1488 $self->{wbuf} .= $tmp;
1438 $self->_drain_wbuf; 1489 $self->_drain_wbuf;
1439 } 1490 }
1491
1492 $self->{_on_starttls}
1493 and Net::SSLeay::state ($self->{tls}) == Net::SSLeay::ST_OK ()
1494 and (delete $self->{_on_starttls})->($self, 1);
1440} 1495}
1441 1496
1442=item $handle->starttls ($tls[, $tls_ctx]) 1497=item $handle->starttls ($tls[, $tls_ctx])
1443 1498
1444Instead of starting TLS negotiation immediately when the AnyEvent::Handle 1499Instead of starting TLS negotiation immediately when the AnyEvent::Handle
1461If it an error to start a TLS handshake more than once per 1516If it an error to start a TLS handshake more than once per
1462AnyEvent::Handle object (this is due to bugs in OpenSSL). 1517AnyEvent::Handle object (this is due to bugs in OpenSSL).
1463 1518
1464=cut 1519=cut
1465 1520
1521our %TLS_CACHE; #TODO not yet documented, should we?
1522
1466sub starttls { 1523sub starttls {
1467 my ($self, $ssl, $ctx) = @_; 1524 my ($self, $ssl, $ctx) = @_;
1468 1525
1469 require Net::SSLeay; 1526 require Net::SSLeay;
1470 1527
1471 Carp::croak "it is an error to call starttls more than once on an AnyEvent::Handle object" 1528 Carp::croak "it is an error to call starttls more than once on an AnyEvent::Handle object"
1472 if $self->{tls}; 1529 if $self->{tls};
1473 1530
1474 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL (); 1531 $ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL ();
1475 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ (); 1532 $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ ();
1476 $ERROR_ZERO_RETURN = Net::SSLeay::ERROR_ZERO_RETURN ();
1477 1533
1478 $ctx ||= $self->{tls_ctx}; 1534 $ctx ||= $self->{tls_ctx};
1479 1535
1480 if ("HASH" eq ref $ctx) { 1536 if ("HASH" eq ref $ctx) {
1481 require AnyEvent::TLS; 1537 require AnyEvent::TLS;
1482 1538
1483 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context 1539 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context
1540
1541 if ($ctx->{cache}) {
1542 my $key = $ctx+0;
1543 $ctx = $TLS_CACHE{$key} ||= new AnyEvent::TLS %$ctx;
1544 } else {
1484 $ctx = new AnyEvent::TLS %$ctx; 1545 $ctx = new AnyEvent::TLS %$ctx;
1546 }
1485 } 1547 }
1486 1548
1487 $self->{tls_ctx} = $ctx || TLS_CTX (); 1549 $self->{tls_ctx} = $ctx || TLS_CTX ();
1488 $self->{tls} = $ssl = $self->{tls_ctx}->_get_session ($ssl, $self, $self->{peername}); 1550 $self->{tls} = $ssl = $self->{tls_ctx}->_get_session ($ssl, $self, $self->{peername});
1489 1551
1507 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1569 $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1508 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); 1570 $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
1509 1571
1510 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio}); 1572 Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio});
1511 1573
1574 $self->{_on_starttls} = sub { $_[0]{on_starttls}(@_) }
1575 if exists $self->{on_starttls};
1576
1512 &_dotls; # need to trigger the initial handshake 1577 &_dotls; # need to trigger the initial handshake
1513 $self->start_read; # make sure we actually do read 1578 $self->start_read; # make sure we actually do read
1514} 1579}
1515 1580
1516=item $handle->stoptls 1581=item $handle->stoptls
1528 if ($self->{tls}) { 1593 if ($self->{tls}) {
1529 Net::SSLeay::shutdown ($self->{tls}); 1594 Net::SSLeay::shutdown ($self->{tls});
1530 1595
1531 &_dotls; 1596 &_dotls;
1532 1597
1533 # we don't give a shit. no, we do, but we can't. no... 1598# # we don't give a shit. no, we do, but we can't. no...#d#
1534 # we, we... have to use openssl :/ 1599# # we, we... have to use openssl :/#d#
1535 &_freetls; 1600# &_freetls;#d#
1536 } 1601 }
1537} 1602}
1538 1603
1539sub _freetls { 1604sub _freetls {
1540 my ($self) = @_; 1605 my ($self) = @_;
1541 1606
1542 return unless $self->{tls}; 1607 return unless $self->{tls};
1608
1609 $self->{_on_starttls}
1610 and (delete $self->{_on_starttls})->($self, undef);
1543 1611
1544 $self->{tls_ctx}->_put_session (delete $self->{tls}); 1612 $self->{tls_ctx}->_put_session (delete $self->{tls});
1545 1613
1546 delete @$self{qw(_rbio _wbio _tls_wbuf)}; 1614 delete @$self{qw(_rbio _wbio _tls_wbuf)};
1547} 1615}
1575} 1643}
1576 1644
1577=item $handle->destroy 1645=item $handle->destroy
1578 1646
1579Shuts down the handle object as much as possible - this call ensures that 1647Shuts down the handle object as much as possible - this call ensures that
1580no further callbacks will be invoked and resources will be freed as much 1648no further callbacks will be invoked and as many resources as possible
1581as possible. You must not call any methods on the object afterwards. 1649will be freed. You must not call any methods on the object afterwards.
1582 1650
1583Normally, you can just "forget" any references to an AnyEvent::Handle 1651Normally, you can just "forget" any references to an AnyEvent::Handle
1584object and it will simply shut down. This works in fatal error and EOF 1652object and it will simply shut down. This works in fatal error and EOF
1585callbacks, as well as code outside. It does I<NOT> work in a read or write 1653callbacks, as well as code outside. It does I<NOT> work in a read or write
1586callback, so when you want to destroy the AnyEvent::Handle object from 1654callback, so when you want to destroy the AnyEvent::Handle object from

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines