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.137 by root, Sat Jul 4 23:58:52 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;
… …
1216=cut 1216=cut
1217 1217
1218register_read_type json => sub { 1218register_read_type json => sub {
1219 my ($self, $cb) = @_; 1219 my ($self, $cb) = @_;
1220 1220
1221 require JSON; 1221 my $json = $self->{json} ||=
1222 eval { require JSON::XS; JSON::XS->new->utf8 }
1223 || do { require JSON; JSON->new->utf8 };
1222 1224
1223 my $data; 1225 my $data;
1224 my $rbuf = \$self->{rbuf}; 1226 my $rbuf = \$self->{rbuf};
1225
1226 my $json = $self->{json} ||= JSON->new->utf8;
1227 1227
1228 sub { 1228 sub {
1229 my $ref = eval { $json->incr_parse ($self->{rbuf}) }; 1229 my $ref = eval { $json->incr_parse ($self->{rbuf}) };
1230 1230
1231 if ($ref) { 1231 if ($ref) {
… …
1381our $ERROR_WANT_READ; 1381our $ERROR_WANT_READ;
1382our $ERROR_ZERO_RETURN; 1382our $ERROR_ZERO_RETURN;
1383 1383
1384sub _tls_error { 1384sub _tls_error {
1385 my ($self, $err) = @_; 1385 my ($self, $err) = @_;
1386 warn "$err,$!\n";#d#
1387 1386
1388 return $self->_error ($!, 1) 1387 return $self->_error ($!, 1)
1389 if $err == Net::SSLeay::ERROR_SYSCALL (); 1388 if $err == Net::SSLeay::ERROR_SYSCALL ();
1390 1389
1390 my $err =Net::SSLeay::ERR_error_string (Net::SSLeay::ERR_get_error ());
1391
1392 # reduce error string to look less scary
1393 $err =~ s/^error:[0-9a-fA-F]{8}:[^:]+:([^:]+):/\L$1: /;
1394
1391 $self->_error (&Errno::EPROTO, 1, 1395 $self->_error (&Errno::EPROTO, 1, $err);
1392 Net::SSLeay::ERR_error_string (Net::SSLeay::ERR_get_error ()));
1393} 1396}
1394 1397
1395# poll the write BIO and send the data if applicable 1398# poll the write BIO and send the data if applicable
1396# also decode read data if possible 1399# also decode read data if possible
1397# this is basiclaly our TLS state machine 1400# this is basiclaly our TLS state machine
… …
1461If it an error to start a TLS handshake more than once per 1464If it an error to start a TLS handshake more than once per
1462AnyEvent::Handle object (this is due to bugs in OpenSSL). 1465AnyEvent::Handle object (this is due to bugs in OpenSSL).
1463 1466
1464=cut 1467=cut
1465 1468
1469our %TLS_CACHE; #TODO not yet documented, should we?
1470
1466sub starttls { 1471sub starttls {
1467 my ($self, $ssl, $ctx) = @_; 1472 my ($self, $ssl, $ctx) = @_;
1468 1473
1469 require Net::SSLeay; 1474 require Net::SSLeay;
1470 1475
… …
1479 1484
1480 if ("HASH" eq ref $ctx) { 1485 if ("HASH" eq ref $ctx) {
1481 require AnyEvent::TLS; 1486 require AnyEvent::TLS;
1482 1487
1483 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context 1488 local $Carp::CarpLevel = 1; # skip ourselves when creating a new context
1489
1490 if ($ctx->{cache}) {
1491 my $key = $ctx+0;
1492 $ctx = $TLS_CACHE{$key} ||= new AnyEvent::TLS %$ctx;
1493 } else {
1484 $ctx = new AnyEvent::TLS %$ctx; 1494 $ctx = new AnyEvent::TLS %$ctx;
1495 }
1485 } 1496 }
1486 1497
1487 $self->{tls_ctx} = $ctx || TLS_CTX (); 1498 $self->{tls_ctx} = $ctx || TLS_CTX ();
1488 $self->{tls} = $ssl = $self->{tls_ctx}->_get_session ($ssl, $self, $self->{peername}); 1499 $self->{tls} = $ssl = $self->{tls_ctx}->_get_session ($ssl, $self, $self->{peername});
1489 1500

Diff Legend

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