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.133 by root, Thu Jul 2 23:22:35 2009 UTC vs.
Revision 1.140 by root, Mon Jul 6 00:45:00 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
… …
245yet. This data will be lost. Calling the C<stoptls> method in time might 245yet. This data will be lost. Calling the C<stoptls> method in time might
246help. 246help.
247 247
248=item peername => $string 248=item peername => $string
249 249
250A string used to identify the remote site - usually the DNS hostname used 250A string used to identify the remote site - usually the DNS hostname
251to create the connection. 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
… …
856 856
857 if ($self->{_eof}) { 857 if ($self->{_eof}) {
858 if ($self->{on_eof}) { 858 if ($self->{on_eof}) {
859 $self->{on_eof}($self) 859 $self->{on_eof}($self)
860 } else { 860 } else {
861 $self->_error (0, 1); 861 $self->_error (0, 1, "Unexpected end-of-file");
862 } 862 }
863 } 863 }
864 864
865 # may need to restart read watcher 865 # may need to restart read watcher
866 unless ($self->{_rw}) { 866 unless ($self->{_rw}) {
… …
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