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.90 by root, Mon Sep 29 02:08:57 2008 UTC vs.
Revision 1.92 by root, Wed Oct 1 08:52:06 2008 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.234; 19our $VERSION = 4.3;
20 20
21=head1 SYNOPSIS 21=head1 SYNOPSIS
22 22
23 use AnyEvent; 23 use AnyEvent;
24 use AnyEvent::Handle; 24 use AnyEvent::Handle;
… …
326 delete $self->{_tw}; 326 delete $self->{_tw};
327 delete $self->{_rw}; 327 delete $self->{_rw};
328 delete $self->{_ww}; 328 delete $self->{_ww};
329 delete $self->{fh}; 329 delete $self->{fh};
330 330
331 $self->stoptls; 331 &_freetls;
332 332
333 delete $self->{on_read}; 333 delete $self->{on_read};
334 delete $self->{_queue}; 334 delete $self->{_queue};
335} 335}
336 336
… …
1319 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) { 1319 while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) {
1320 substr $self->{_tls_wbuf}, 0, $len, ""; 1320 substr $self->{_tls_wbuf}, 0, $len, "";
1321 } 1321 }
1322 } 1322 }
1323 1323
1324 if (length ($buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
1325 $self->{wbuf} .= $buf;
1326 $self->_drain_wbuf;
1327 }
1328
1329 while (defined ($buf = Net::SSLeay::read ($self->{tls}))) { 1324 while (defined ($buf = Net::SSLeay::read ($self->{tls}))) {
1330 if (length $buf) { 1325 unless (length $buf) {
1331 $self->{rbuf} .= $buf;
1332 $self->_drain_rbuf unless $self->{_in_drain};
1333 } else {
1334 # let's treat SSL-eof as we treat normal EOF 1326 # let's treat SSL-eof as we treat normal EOF
1327 delete $self->{_rw};
1335 $self->{_eof} = 1; 1328 $self->{_eof} = 1;
1336 $self->_shutdown; 1329 &_freetls;
1337 return;
1338 } 1330 }
1331
1332 $self->{rbuf} .= $buf;
1333 $self->_drain_rbuf unless $self->{_in_drain};
1334 $self->{tls} or return; # tls session might have gone away in callback
1339 } 1335 }
1340 1336
1341 my $err = Net::SSLeay::get_error ($self->{tls}, -1); 1337 my $err = Net::SSLeay::get_error ($self->{tls}, -1);
1342 1338
1343 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) { 1339 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
… …
1347 return $self->_error (&Errno::EIO, 1); 1343 return $self->_error (&Errno::EIO, 1);
1348 } 1344 }
1349 1345
1350 # all others are fine for our purposes 1346 # all others are fine for our purposes
1351 } 1347 }
1348
1349 if (length ($buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
1350 $self->{wbuf} .= $buf;
1351 $self->_drain_wbuf;
1352 }
1352} 1353}
1353 1354
1354=item $handle->starttls ($tls[, $tls_ctx]) 1355=item $handle->starttls ($tls[, $tls_ctx])
1355 1356
1356Instead of starting TLS negotiation immediately when the AnyEvent::Handle 1357Instead of starting TLS negotiation immediately when the AnyEvent::Handle
… …
1365 1366
1366The TLS connection object will end up in C<< $handle->{tls} >> after this 1367The TLS connection object will end up in C<< $handle->{tls} >> after this
1367call and can be used or changed to your liking. Note that the handshake 1368call and can be used or changed to your liking. Note that the handshake
1368might have already started when this function returns. 1369might have already started when this function returns.
1369 1370
1371If it an error to start a TLS handshake more than once per
1372AnyEvent::Handle object (this is due to bugs in OpenSSL).
1373
1370=cut 1374=cut
1371 1375
1372sub starttls { 1376sub starttls {
1373 my ($self, $ssl, $ctx) = @_; 1377 my ($self, $ssl, $ctx) = @_;
1374 1378
1375 $self->stoptls; 1379 Carp::croak "it is an error to call starttls more than once on an Anyevent::Handle object"
1376 1380 if $self->{tls};
1381
1377 if ($ssl eq "accept") { 1382 if ($ssl eq "accept") {
1378 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); 1383 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
1379 Net::SSLeay::set_accept_state ($ssl); 1384 Net::SSLeay::set_accept_state ($ssl);
1380 } elsif ($ssl eq "connect") { 1385 } elsif ($ssl eq "connect") {
1381 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); 1386 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
… …
1410 }; 1415 };
1411 $self->{filter_r} = sub { 1416 $self->{filter_r} = sub {
1412 Net::SSLeay::BIO_write ($_[0]{_rbio}, ${$_[1]}); 1417 Net::SSLeay::BIO_write ($_[0]{_rbio}, ${$_[1]});
1413 &_dotls; 1418 &_dotls;
1414 }; 1419 };
1420
1421 &_dotls; # need to trigger the initial negotiation exchange
1415} 1422}
1416 1423
1417=item $handle->stoptls 1424=item $handle->stoptls
1418 1425
1419Destroys the SSL connection, if any. Partial read or write data will be 1426Shuts down the SSL connection - this makes a proper EOF handshake by
1420lost. 1427sending a close notify to the other side, but since OpenSSL doesn't
1428support non-blocking shut downs, it is not possible to re-use the stream
1429afterwards.
1421 1430
1422=cut 1431=cut
1423 1432
1424sub stoptls { 1433sub stoptls {
1425 my ($self) = @_; 1434 my ($self) = @_;
1426 1435
1436 if ($self->{tls}) {
1437 Net::SSLeay::shutdown $self->{tls};
1438
1439 &_dotls;
1440
1441 # we don't give a shit. no, we do, but we can't. no...
1442 # we, we... have to use openssl :/
1443 &_freetls;
1444 }
1445}
1446
1447sub _freetls {
1448 my ($self) = @_;
1449
1450 return unless $self->{tls};
1451
1427 Net::SSLeay::free (delete $self->{tls}) if $self->{tls}; 1452 Net::SSLeay::free (delete $self->{tls});
1428 1453
1429 delete $self->{_rbio}; 1454 delete @$self{qw(_rbio filter_w _wbio filter_r)};
1430 delete $self->{_wbio};
1431 delete $self->{_tls_wbuf};
1432 delete $self->{filter_r};
1433 delete $self->{filter_w};
1434} 1455}
1435 1456
1436sub DESTROY { 1457sub DESTROY {
1437 my $self = shift; 1458 my $self = shift;
1438 1459
1439 $self->stoptls; 1460 &_freetls;
1440 1461
1441 my $linger = exists $self->{linger} ? $self->{linger} : 3600; 1462 my $linger = exists $self->{linger} ? $self->{linger} : 3600;
1442 1463
1443 if ($linger && length $self->{wbuf}) { 1464 if ($linger && length $self->{wbuf}) {
1444 my $fh = delete $self->{fh}; 1465 my $fh = delete $self->{fh};

Diff Legend

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