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.89 by root, Sat Sep 6 10:54:32 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;
… …
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
64=head1 METHODS 72=head1 METHODS
65 73
66=over 4 74=over 4
67 75
68=item B<new (%args)> 76=item B<new (%args)>
… …
318 delete $self->{_tw}; 326 delete $self->{_tw};
319 delete $self->{_rw}; 327 delete $self->{_rw};
320 delete $self->{_ww}; 328 delete $self->{_ww};
321 delete $self->{fh}; 329 delete $self->{fh};
322 330
323 $self->stoptls; 331 &_freetls;
324 332
325 delete $self->{on_read}; 333 delete $self->{on_read};
326 delete $self->{_queue}; 334 delete $self->{_queue};
327} 335}
328 336
… …
1311 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) {
1312 substr $self->{_tls_wbuf}, 0, $len, ""; 1320 substr $self->{_tls_wbuf}, 0, $len, "";
1313 } 1321 }
1314 } 1322 }
1315 1323
1316 if (length ($buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
1317 $self->{wbuf} .= $buf;
1318 $self->_drain_wbuf;
1319 }
1320
1321 while (defined ($buf = Net::SSLeay::read ($self->{tls}))) { 1324 while (defined ($buf = Net::SSLeay::read ($self->{tls}))) {
1322 if (length $buf) { 1325 unless (length $buf) {
1323 $self->{rbuf} .= $buf;
1324 $self->_drain_rbuf unless $self->{_in_drain};
1325 } else {
1326 # 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};
1327 $self->{_eof} = 1; 1328 $self->{_eof} = 1;
1328 $self->_shutdown; 1329 &_freetls;
1329 return;
1330 } 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
1331 } 1335 }
1332 1336
1333 my $err = Net::SSLeay::get_error ($self->{tls}, -1); 1337 my $err = Net::SSLeay::get_error ($self->{tls}, -1);
1334 1338
1335 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) { 1339 if ($err!= Net::SSLeay::ERROR_WANT_READ ()) {
… …
1339 return $self->_error (&Errno::EIO, 1); 1343 return $self->_error (&Errno::EIO, 1);
1340 } 1344 }
1341 1345
1342 # all others are fine for our purposes 1346 # all others are fine for our purposes
1343 } 1347 }
1348
1349 if (length ($buf = Net::SSLeay::BIO_read ($self->{_wbio}))) {
1350 $self->{wbuf} .= $buf;
1351 $self->_drain_wbuf;
1352 }
1344} 1353}
1345 1354
1346=item $handle->starttls ($tls[, $tls_ctx]) 1355=item $handle->starttls ($tls[, $tls_ctx])
1347 1356
1348Instead of starting TLS negotiation immediately when the AnyEvent::Handle 1357Instead of starting TLS negotiation immediately when the AnyEvent::Handle
… …
1357 1366
1358The 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
1359call 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
1360might have already started when this function returns. 1369might have already started when this function returns.
1361 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
1362=cut 1374=cut
1363 1375
1364sub starttls { 1376sub starttls {
1365 my ($self, $ssl, $ctx) = @_; 1377 my ($self, $ssl, $ctx) = @_;
1366 1378
1367 $self->stoptls; 1379 Carp::croak "it is an error to call starttls more than once on an Anyevent::Handle object"
1368 1380 if $self->{tls};
1381
1369 if ($ssl eq "accept") { 1382 if ($ssl eq "accept") {
1370 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); 1383 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
1371 Net::SSLeay::set_accept_state ($ssl); 1384 Net::SSLeay::set_accept_state ($ssl);
1372 } elsif ($ssl eq "connect") { 1385 } elsif ($ssl eq "connect") {
1373 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); 1386 $ssl = Net::SSLeay::new ($ctx || TLS_CTX ());
… …
1402 }; 1415 };
1403 $self->{filter_r} = sub { 1416 $self->{filter_r} = sub {
1404 Net::SSLeay::BIO_write ($_[0]{_rbio}, ${$_[1]}); 1417 Net::SSLeay::BIO_write ($_[0]{_rbio}, ${$_[1]});
1405 &_dotls; 1418 &_dotls;
1406 }; 1419 };
1420
1421 &_dotls; # need to trigger the initial negotiation exchange
1407} 1422}
1408 1423
1409=item $handle->stoptls 1424=item $handle->stoptls
1410 1425
1411Destroys the SSL connection, if any. Partial read or write data will be 1426Shuts down the SSL connection - this makes a proper EOF handshake by
1412lost. 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.
1413 1430
1414=cut 1431=cut
1415 1432
1416sub stoptls { 1433sub stoptls {
1417 my ($self) = @_; 1434 my ($self) = @_;
1418 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
1419 Net::SSLeay::free (delete $self->{tls}) if $self->{tls}; 1452 Net::SSLeay::free (delete $self->{tls});
1420 1453
1421 delete $self->{_rbio}; 1454 delete @$self{qw(_rbio filter_w _wbio filter_r)};
1422 delete $self->{_wbio};
1423 delete $self->{_tls_wbuf};
1424 delete $self->{filter_r};
1425 delete $self->{filter_w};
1426} 1455}
1427 1456
1428sub DESTROY { 1457sub DESTROY {
1429 my $self = shift; 1458 my $self = shift;
1430 1459
1431 $self->stoptls; 1460 &_freetls;
1432 1461
1433 my $linger = exists $self->{linger} ? $self->{linger} : 3600; 1462 my $linger = exists $self->{linger} ? $self->{linger} : 3600;
1434 1463
1435 if ($linger && length $self->{wbuf}) { 1464 if ($linger && length $self->{wbuf}) {
1436 my $fh = delete $self->{fh}; 1465 my $fh = delete $self->{fh};

Diff Legend

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