view release on metacpan or  search on metacpan

lib/IO/Async/SSL.pm  view on Meta::CPAN

   eval {
      $socket = IO::Socket::SSL->start_SSL( $socket, _SSL_args
         SSL_startHandshake => 0,

         # Required to make IO::Socket::SSL not ->close before we have a chance to remove it from the loop
         SSL_error_trap => sub { },

         %ssl_params,
      ) or die IO::Socket::SSL->errstr;
   } or do {
      chomp( my $e = $@ );
      return $f->fail( $e, "ssl" );
   };

   my $ready_method = $ssl_params{SSL_server} ? "accept_SSL" : "connect_SSL";

   my $ready = sub {
      my ( $self ) = @_;
      if( $socket->$ready_method ) {
         $loop->remove( $self );

         if( $stream ) {
            $stream->configure(
               handle => $socket,
               reader => \&sslread,
               writer => \&sslwrite,
            );
         }

         $f->done( $stream || $socket );
         return;
      }

      if( $! != EAGAIN and $! != EWOULDBLOCK ) {
         my $errstr = IO::Socket::SSL::errstr();
         $loop->remove( $self );
         $f->fail( $errstr, "ssl" );
         return;
      }

      $self->want_readready ( $SSL_ERROR == SSL_WANT_READ );
      $self->want_writeready( $SSL_ERROR == SSL_WANT_WRITE );
   };

   # We're going to steal the IO handle from $stream, so we'll have to
   # temporarily deconfigure it
   $stream->configure( handle => undef ) if $stream;

   $loop->add( my $handle = IO::Async::Handle->new(
      handle => $socket,
      on_read_ready  => $ready,
      on_write_ready => $ready,
   ) );

   $ready->( $handle );

   return $f if defined wantarray;

   # Caller is not going to keep hold of the Future, so we have to ensure it
   # stays alive somehow
   $f->on_ready( sub { undef $f } ); # intentional cycle
}

=head2 SSL_connect

   $stream = $loop->SSL_connect( %params )->get;

This method performs a non-blocking connection to a given address or set of
addresses, upgrades the socket to SSL, then yields a C<IO::Async::Stream>
object when the SSL handshake is complete.

It takes all the same arguments as C<IO::Async::Loop::connect()>. Any argument
whose name starts C<SSL_> will be passed on to the L<IO::Socket::SSL>
constructor rather than the Loop's C<connect> method. It is not required to
pass the C<socktype> option, as SSL implies this will be C<stream>.

This method can also upgrade an existing C<IO::Async::Stream> or subclass
instance given as the C<handle> argument, by setting the C<reader> and
C<writer> functions.

=head2 SSL_connect (void)

   $loop->SSL_connect( %params,
      on_connected => sub { ... },
      on_stream => sub { ... },
   );

When not returning a future, this method also supports the C<on_connected> and
C<on_stream> continuations.

In addition, the following arguments are then required:

=over 8

=item on_ssl_error => CODE

A continuation that is invoked if C<IO::Socket::SSL> detects an SSL-based
error once the actual stream socket is connected.

=back

If the C<on_connected> continuation is used, the socket handle it yields will
be a C<IO::Socket::SSL>, which must be wrapped in C<IO::Async::SSLStream> to
be used by C<IO::Async>. The C<on_stream> continuation will already yield such
an instance.

=cut

sub IO::Async::Loop::SSL_connect
{
   my $loop = shift;
   my %params = @_;

   my %ssl_params = map { $_ => delete $params{$_} } grep m/^SSL_/, keys %params;

   my $on_done;
   if( exists $params{on_connected} ) {
      my $on_connected = delete $params{on_connected};
      $on_done = sub {
         my ( $stream ) = @_;
         $on_connected->( $stream->read_handle );
      };
   }
   elsif( exists $params{on_stream} ) {
      my $on_stream = delete $params{on_stream};
      $on_done = $on_stream;
   }
   else {
      croak "Expected 'on_connected' or 'on_stream' or to return a Future" unless defined wantarray;
   }

   my $on_ssl_error = delete $params{on_ssl_error} or defined wantarray or
      croak "Expected 'on_ssl_error' or to return a Future";

   my $stream = delete $params{handle} || do {
      require IO::Async::Stream;
      IO::Async::Stream->new;
   };

   $stream->isa( "IO::Async::Stream" ) or
      croak "Can only SSL_connect a handle instance of IO::Async::Stream";

   # Don't ->connect with the handle yet, because we'll first have to use the
   # socket to perform SSL_upgrade on. We don't want to confuse the loop by
   # giving it the same fd twice.

   my $f = $loop->connect(
      socktype => 'stream', # SSL over DGRAM or RAW makes no sense
      %params,
   )->then( sub {
      my ( $socket ) = @_;

      $stream->configure( handle => $socket );

      $loop->SSL_upgrade(
         _SSL_args( %ssl_params ),
         handle => $stream,
      )
   });

   $f->on_done( $on_done ) if $on_done;
   $f->on_fail( sub {
      $on_ssl_error->( $_[0] ) if defined $_[1] and $_[1] eq "ssl";
   }) if $on_ssl_error;

   return $f if defined wantarray;

   # Caller is not going to keep hold of the Future, so we have to ensure it
   # stays alive somehow
   $f->on_ready( sub { undef $f } ); # intentional cycle
}

=head2 SSL_listen

   $loop->SSL_listen( %params )->get;

This method sets up a listening socket using the addresses given, and will
invoke the callback each time a new connection is accepted on the socket and
the SSL handshake has been completed. This can be either the C<on_accept> or
C<on_stream> continuation; C<on_socket> is not supported.

It takes all the same arguments as C<IO::Async::Loop::listen()>. Any argument
whose name starts C<SSL_> will be passed on to the L<IO::Socket::SSL>
constructor rather than the Loop's C<listen> method. It is not required to
pass the C<socktype> option, as SSL implies this will be C<stream>.

In addition, the following arguments are rquired:

=over 8

=item on_ssl_error => CODE

A continuation that is invoked if C<IO::Socket::SSL> detects an SSL-based
error once the actual stream socket is connected.

=back

The underlying L<IO::Socket::SSL> socket will also require the server key and
certificate for a server-mode socket. See its documentation for more details.

If the C<on_accept> continuation is used, the socket handle it yields will be
a C<IO::Socket::SSL>, which must be wrapped in C<IO::Async::SSLStream> to be
used by C<IO::Async>. The C<on_stream> continuation will already yield such an
instance.

=cut

sub IO::Async::Loop::SSL_listen
{
   my $loop = shift;
   my %params = @_;

   my %ssl_params = map { $_ => delete $params{$_} } grep m/^SSL_/, keys %params;
   my $on_ssl_error = delete $params{on_ssl_error} or defined wantarray
      or croak "Expected 'on_ssl_error'";

   my $f = $loop->listen(
      socktype => 'stream',
      %params,
   )->on_done( sub {
      my $listener = shift;

      my $cleartext_acceptor = $listener->acceptor;
      my $ssl_acceptor = sub {
         my $listener = shift;
         my ( $listen_sock, %params ) = @_;
         my $stream = $params{handle};
         !defined $stream or $stream->isa( "IO::Async::Stream" ) or
            croak "Can only accept SSL on IO::Async::Stream handles";

         $listener->$cleartext_acceptor( $listen_sock )->then( sub {
            my ( $socket ) = @_;

            return Future->done() unless $socket; # EAGAIN

            $stream->configure( handle => $socket ) if $stream;

            $loop->SSL_upgrade(
               _SSL_args( SSL_server => 1, %ssl_params ),
               handle   => ( $stream || $socket ),
            )->catch_with_f( ssl => sub {
               my ( $f, $failure ) = @_;
               if( $on_ssl_error ) {
                  $on_ssl_error->( $failure );
                  return Future->done;  # eat it
               }
               return $f;
            });
         });
      };

      $listener->configure( acceptor => $ssl_acceptor );
   });

   return $f if defined wantarray;

   # Caller is not going to keep hold of the Future, so we have to ensure it
   # stays alive somehow
   $f->on_ready( sub { undef $f } ); # intentional cycle
}

=head1 STREAM PROTOCOL METHODS

The following extra methods are added to L<IO::Async::Protocol::Stream>.

=cut

=head2 SSL_upgrade

   $protocol->SSL_upgrade( %params )->get;

A shortcut to calling C<< $loop->SSL_upgrade >>. This method will unconfigure
the C<transport> of the Protocol, upgrade its underlying filehandle to SSL,
then reconfigure it again with SSL reader and writer functions on it. It takes
the same arguments as C<< $loop->SSL_upgrade >>, except that the C<handle>
argument is not required as it's taken from the Protocol's C<transport>.

=cut

sub IO::Async::Protocol::Stream::SSL_upgrade
{
   my $protocol = shift;
   my %params = @_;

   my $on_upgraded = delete $params{on_upgraded} or croak "Expected 'on_upgraded'";

   my $loop = $protocol->get_loop or croak "Expected to be a member of a Loop";

   my $transport = $protocol->transport;

   $protocol->configure( transport => undef );

   $loop->SSL_upgrade(
      handle => $transport,
      on_upgraded => sub {
         my ( $transport ) = @_;

         $protocol->configure( transport => $transport );

         $on_upgraded->();
      },

      %params,
   );
}

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;