view release on metacpan or  search on metacpan

lib/AnyEvent/Handle.pm  view on Meta::CPAN

   my $tmp;

   while (length $self->{_tls_wbuf}) {
      if (($tmp = Net::SSLeay::write ($self->{tls}, $self->{_tls_wbuf})) <= 0) {
         $tmp = Net::SSLeay::get_error ($self->{tls}, $tmp);

         return $self->_tls_error ($tmp)
            if $tmp != $ERROR_WANT_READ
               && ($tmp != $ERROR_SYSCALL || $!);

         last;
      }

      substr $self->{_tls_wbuf}, 0, $tmp, "";
   }

   while (defined ($tmp = Net::SSLeay::read ($self->{tls}))) {
      unless (length $tmp) {
         $self->{_on_starttls}
            and (delete $self->{_on_starttls})->($self, undef, "EOF during handshake"); # ???
         &_freetls;

         if ($self->{on_stoptls}) {
            $self->{on_stoptls}($self);
            return;
         } else {
            # let's treat SSL-eof as we treat normal EOF
            delete $self->{_rw};
            $self->{_eof} = 1;
         }
      }

      $self->{_tls_rbuf} .= $tmp;
      $self->_drain_rbuf;
      $self->{tls} or return; # tls session might have gone away in callback
   }

   $tmp = Net::SSLeay::get_error ($self->{tls}, -1); # -1 is not neccessarily correct, but Net::SSLeay doesn't tell us
   return $self->_tls_error ($tmp)
      if $tmp != $ERROR_WANT_READ
         && ($tmp != $ERROR_SYSCALL || $!);

   while (length ($tmp = Net::SSLeay::BIO_read ($self->{_wbio}))) {
      $self->{wbuf} .= $tmp;
      $self->_drain_wbuf;
      $self->{tls} or return; # tls session might have gone away in callback
   }

   $self->{_on_starttls}
      and Net::SSLeay::state ($self->{tls}) == Net::SSLeay::ST_OK ()
      and (delete $self->{_on_starttls})->($self, 1, "TLS/SSL connection established");
}

=item $handle->starttls ($tls[, $tls_ctx])

Instead of starting TLS negotiation immediately when the AnyEvent::Handle
object is created, you can also do that at a later time by calling
C<starttls>. See the C<tls> constructor argument for general info.

Starting TLS is currently an asynchronous operation - when you push some
write data and then call C<< ->starttls >> then TLS negotiation will start
immediately, after which the queued write data is then sent. This might
change in future versions, so best make sure you have no outstanding write
data when calling this method.

The first argument is the same as the C<tls> constructor argument (either
C<"connect">, C<"accept"> or an existing Net::SSLeay object).

The second argument is the optional C<AnyEvent::TLS> object that is used
when AnyEvent::Handle has to create its own TLS connection object, or
a hash reference with C<< key => value >> pairs that will be used to
construct a new context.

The TLS connection object will end up in C<< $handle->{tls} >>, the TLS
context in C<< $handle->{tls_ctx} >> after this call and can be used or
changed to your liking. Note that the handshake might have already started
when this function returns.

Due to bugs in OpenSSL, it might or might not be possible to do multiple
handshakes on the same stream. It is best to not attempt to use the
stream after stopping TLS.

This method may invoke callbacks (and therefore the handle might be
destroyed after it returns).

=cut

our %TLS_CACHE; #TODO not yet documented, should we?

sub starttls {
   my ($self, $tls, $ctx) = @_;

   Carp::croak "It is an error to call starttls on an AnyEvent::Handle object while TLS is already active, caught"
      if $self->{tls};

   unless (defined $AnyEvent::TLS::VERSION) {
      eval {
         require Net::SSLeay;
         require AnyEvent::TLS;
         1
      } or return $self->_error (Errno::EPROTO, 1, "TLS support not available on this system");
   }

   $self->{tls}     = $tls;
   $self->{tls_ctx} = $ctx if @_ > 2;

   return unless $self->{fh};

   $ERROR_SYSCALL   = Net::SSLeay::ERROR_SYSCALL     ();
   $ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ   ();

   $tls = delete $self->{tls};
   $ctx = $self->{tls_ctx};

   local $Carp::CarpLevel = 1; # skip ourselves when creating a new context or session

   if ("HASH" eq ref $ctx) {
      if ($ctx->{cache}) {
         my $key = $ctx+0;
         $ctx = $TLS_CACHE{$key} ||= new AnyEvent::TLS %$ctx;