| … | |
… | |
| 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 | |
| … | |
… | |
| 1324 | while (defined ($buf = Net::SSLeay::read ($self->{tls}))) { |
1324 | while (defined ($buf = Net::SSLeay::read ($self->{tls}))) { |
| 1325 | unless (length $buf) { |
1325 | unless (length $buf) { |
| 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 | delete $self->{_rw}; |
| 1328 | $self->{_eof} = 1; |
1328 | $self->{_eof} = 1; |
|
|
1329 | &_freetls; |
| 1329 | } |
1330 | } |
| 1330 | |
1331 | |
| 1331 | $self->{rbuf} .= $buf; |
1332 | $self->{rbuf} .= $buf; |
| 1332 | $self->_drain_rbuf unless $self->{_in_drain}; |
1333 | $self->_drain_rbuf unless $self->{_in_drain}; |
| 1333 | |
|
|
| 1334 | $self->{tls} or return; # tls could have gone away |
1334 | $self->{tls} or return; # tls session might have gone away in callback |
| 1335 | } |
1335 | } |
| 1336 | |
1336 | |
| 1337 | my $err = Net::SSLeay::get_error ($self->{tls}, -1); |
1337 | my $err = Net::SSLeay::get_error ($self->{tls}, -1); |
| 1338 | |
1338 | |
| 1339 | if ($err!= Net::SSLeay::ERROR_WANT_READ ()) { |
1339 | if ($err!= Net::SSLeay::ERROR_WANT_READ ()) { |
| … | |
… | |
| 1366 | |
1366 | |
| 1367 | The TLS connection object will end up in C<< $handle->{tls} >> after this |
1367 | The TLS connection object will end up in C<< $handle->{tls} >> after this |
| 1368 | call and can be used or changed to your liking. Note that the handshake |
1368 | call and can be used or changed to your liking. Note that the handshake |
| 1369 | might have already started when this function returns. |
1369 | might have already started when this function returns. |
| 1370 | |
1370 | |
|
|
1371 | If it an error to start a TLS handshake more than once per |
|
|
1372 | AnyEvent::Handle object (this is due to bugs in OpenSSL). |
|
|
1373 | |
| 1371 | =cut |
1374 | =cut |
| 1372 | |
1375 | |
| 1373 | sub starttls { |
1376 | sub starttls { |
| 1374 | my ($self, $ssl, $ctx) = @_; |
1377 | my ($self, $ssl, $ctx) = @_; |
| 1375 | |
1378 | |
| 1376 | $self->stoptls; |
1379 | Carp::croak "it is an error to call starttls more than once on an Anyevent::Handle object" |
| 1377 | |
1380 | if $self->{tls}; |
|
|
1381 | |
| 1378 | if ($ssl eq "accept") { |
1382 | if ($ssl eq "accept") { |
| 1379 | $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); |
1383 | $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); |
| 1380 | Net::SSLeay::set_accept_state ($ssl); |
1384 | Net::SSLeay::set_accept_state ($ssl); |
| 1381 | } elsif ($ssl eq "connect") { |
1385 | } elsif ($ssl eq "connect") { |
| 1382 | $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); |
1386 | $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); |
| … | |
… | |
| 1417 | &_dotls; # need to trigger the initial negotiation exchange |
1421 | &_dotls; # need to trigger the initial negotiation exchange |
| 1418 | } |
1422 | } |
| 1419 | |
1423 | |
| 1420 | =item $handle->stoptls |
1424 | =item $handle->stoptls |
| 1421 | |
1425 | |
| 1422 | Destroys the SSL connection, if any. Partial read or write data will be |
1426 | Shuts down the SSL connection - this makes a proper EOF handshake by |
| 1423 | lost. |
1427 | sending a close notify to the other side, but since OpenSSL doesn't |
|
|
1428 | support non-blocking shut downs, it is not possible to re-use the stream |
|
|
1429 | afterwards. |
| 1424 | |
1430 | |
| 1425 | =cut |
1431 | =cut |
| 1426 | |
1432 | |
| 1427 | sub stoptls { |
1433 | sub stoptls { |
| 1428 | my ($self) = @_; |
1434 | my ($self) = @_; |
| 1429 | |
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 | |
|
|
1447 | sub _freetls { |
|
|
1448 | my ($self) = @_; |
|
|
1449 | |
|
|
1450 | return unless $self->{tls}; |
|
|
1451 | |
| 1430 | Net::SSLeay::free (delete $self->{tls}) if $self->{tls}; |
1452 | Net::SSLeay::free (delete $self->{tls}); |
| 1431 | |
1453 | |
| 1432 | delete $self->{_rbio}; |
1454 | delete @$self{qw(_rbio filter_w _wbio filter_r)}; |
| 1433 | delete $self->{_wbio}; |
|
|
| 1434 | delete $self->{_tls_wbuf}; |
|
|
| 1435 | delete $self->{filter_r}; |
|
|
| 1436 | delete $self->{filter_w}; |
|
|
| 1437 | } |
1455 | } |
| 1438 | |
1456 | |
| 1439 | sub DESTROY { |
1457 | sub DESTROY { |
| 1440 | my $self = shift; |
1458 | my $self = shift; |
| 1441 | |
1459 | |
| 1442 | $self->stoptls; |
1460 | &_freetls; |
| 1443 | |
1461 | |
| 1444 | my $linger = exists $self->{linger} ? $self->{linger} : 3600; |
1462 | my $linger = exists $self->{linger} ? $self->{linger} : 3600; |
| 1445 | |
1463 | |
| 1446 | if ($linger && length $self->{wbuf}) { |
1464 | if ($linger && length $self->{wbuf}) { |
| 1447 | my $fh = delete $self->{fh}; |
1465 | my $fh = delete $self->{fh}; |
