sub starttls { my ($self, $ssl, $ctx) = @_; $self->stoptls; if ($ssl eq "accept") { $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); Net::SSLeay::set_accept_state ($ssl); } elsif ($ssl eq "connect") { $ssl = Net::SSLeay::new ($ctx || TLS_CTX ()); Net::SSLeay::set_connect_state ($ssl); } $self->{tls} = $ssl; # basically, this is deep magic (because SSL_read should have the same issues) # but the openssl maintainers basically said: "trust us, it just works". # (unfortunately, we have to hardcode constants because the abysmally misdesigned # and mismaintained ssleay-module doesn't even offer them). # http://www.mail-archive.com/openssl-dev@openssl.org/msg22420.html Net::SSLeay::CTX_set_mode ($self->{tls}, (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ENABLE_PARTIAL_WRITE () } || 1) | (eval { local $SIG{__DIE__}; Net::SSLeay::MODE_ACCEPT_MOVING_WRITE_BUFFER () } || 2)); $self->{_rbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); $self->{_wbio} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ()); Net::SSLeay::set_bio ($ssl, $self->{_rbio}, $self->{_wbio}); $self->{filter_w} = sub { $_[0]{_tls_wbuf} .= ${$_[1]}; &_dotls; }; $self->{filter_r} = sub { Net::SSLeay::BIO_write ($_[0]{_rbio}, ${$_[1]}); &_dotls; }; }