| … | |
… | |
| 550 | ->($self, @_); |
550 | ->($self, @_); |
| 551 | } |
551 | } |
| 552 | |
552 | |
| 553 | if ($self->{tls}) { |
553 | if ($self->{tls}) { |
| 554 | $self->{_tls_wbuf} .= $_[0]; |
554 | $self->{_tls_wbuf} .= $_[0]; |
|
|
555 | |
| 555 | &_dotls ($self); |
556 | &_dotls ($self); |
| 556 | } else { |
557 | } else { |
| 557 | $self->{wbuf} .= $_[0]; |
558 | $self->{wbuf} .= $_[0]; |
| 558 | $self->_drain_wbuf; |
559 | $self->_drain_wbuf; |
| 559 | } |
560 | } |
| … | |
… | |
| 1291 | if ($len > 0) { |
1292 | if ($len > 0) { |
| 1292 | $self->{_activity} = AnyEvent->now; |
1293 | $self->{_activity} = AnyEvent->now; |
| 1293 | |
1294 | |
| 1294 | if ($self->{tls}) { |
1295 | if ($self->{tls}) { |
| 1295 | Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf); |
1296 | Net::SSLeay::BIO_write ($self->{_rbio}, $$rbuf); |
|
|
1297 | |
| 1296 | &_dotls ($self); |
1298 | &_dotls ($self); |
| 1297 | } else { |
1299 | } else { |
| 1298 | $self->_drain_rbuf unless $self->{_in_drain}; |
1300 | $self->_drain_rbuf unless $self->{_in_drain}; |
| 1299 | } |
1301 | } |
| 1300 | |
1302 | |
| … | |
… | |
| 1308 | } |
1310 | } |
| 1309 | }); |
1311 | }); |
| 1310 | } |
1312 | } |
| 1311 | } |
1313 | } |
| 1312 | |
1314 | |
|
|
1315 | # poll the write BIO and send the data if applicable |
| 1313 | sub _dotls { |
1316 | sub _dotls { |
| 1314 | my ($self) = @_; |
1317 | my ($self) = @_; |
| 1315 | |
1318 | |
| 1316 | my $buf; |
1319 | my $tmp; |
| 1317 | |
1320 | |
| 1318 | if (length $self->{_tls_wbuf}) { |
1321 | if (length $self->{_tls_wbuf}) { |
| 1319 | while ((my $len = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) { |
1322 | while (($tmp = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) > 0) { |
| 1320 | substr $self->{_tls_wbuf}, 0, $len, ""; |
1323 | substr $self->{_tls_wbuf}, 0, $tmp, ""; |
| 1321 | } |
1324 | } |
| 1322 | } |
1325 | } |
| 1323 | |
1326 | |
| 1324 | while (defined ($buf = Net::SSLeay::read ($self->{tls}))) { |
1327 | while (defined ($tmp = Net::SSLeay::read ($self->{tls}))) { |
| 1325 | unless (length $buf) { |
1328 | unless (length $tmp) { |
| 1326 | # let's treat SSL-eof as we treat normal EOF |
1329 | # let's treat SSL-eof as we treat normal EOF |
| 1327 | delete $self->{_rw}; |
1330 | delete $self->{_rw}; |
| 1328 | $self->{_eof} = 1; |
1331 | $self->{_eof} = 1; |
| 1329 | &_freetls; |
1332 | &_freetls; |
| 1330 | } |
1333 | } |
| 1331 | |
1334 | |
| 1332 | $self->{rbuf} .= $buf; |
1335 | $self->{rbuf} .= $tmp; |
| 1333 | $self->_drain_rbuf unless $self->{_in_drain}; |
1336 | $self->_drain_rbuf unless $self->{_in_drain}; |
| 1334 | $self->{tls} or return; # tls session might have gone away in callback |
1337 | $self->{tls} or return; # tls session might have gone away in callback |
| 1335 | } |
1338 | } |
| 1336 | |
1339 | |
| 1337 | my $err = Net::SSLeay::get_error ($self->{tls}, -1); |
1340 | $tmp = Net::SSLeay::get_error ($self->{tls}, -1); |
| 1338 | |
1341 | |
| 1339 | if ($err!= Net::SSLeay::ERROR_WANT_READ ()) { |
1342 | if ($tmp != Net::SSLeay::ERROR_WANT_READ ()) { |
| 1340 | if ($err == Net::SSLeay::ERROR_SYSCALL ()) { |
1343 | if ($tmp == Net::SSLeay::ERROR_SYSCALL ()) { |
| 1341 | return $self->_error ($!, 1); |
1344 | return $self->_error ($!, 1); |
| 1342 | } elsif ($err == Net::SSLeay::ERROR_SSL ()) { |
1345 | } elsif ($tmp == Net::SSLeay::ERROR_SSL ()) { |
| 1343 | return $self->_error (&Errno::EIO, 1); |
1346 | return $self->_error (&Errno::EIO, 1); |
| 1344 | } |
1347 | } |
| 1345 | |
1348 | |
| 1346 | # all others are fine for our purposes |
1349 | # all other errors are fine for our purposes |
| 1347 | } |
1350 | } |
| 1348 | |
1351 | |
| 1349 | while (length ($buf = Net::SSLeay::BIO_read ($self->{_wbio}))) { |
1352 | while (length ($tmp = Net::SSLeay::BIO_read ($self->{_wbio}))) { |
| 1350 | $self->{wbuf} .= $buf; |
1353 | $self->{wbuf} .= $tmp; |
| 1351 | $self->_drain_wbuf; |
1354 | $self->_drain_wbuf; |
| 1352 | } |
1355 | } |
| 1353 | } |
1356 | } |
| 1354 | |
1357 | |
| 1355 | =item $handle->starttls ($tls[, $tls_ctx]) |
1358 | =item $handle->starttls ($tls[, $tls_ctx]) |
