Skip to content

Commit

Permalink
Merge branch 'ioloop_tls'
Browse files Browse the repository at this point in the history
  • Loading branch information
@kraih
kraih committed Jan 14, 2017
2 parents 1a37eff + b863ad4 commit 47ed248
Show file tree
Hide file tree
Showing 18 changed files with 327 additions and 152 deletions.
2 changes: 1 addition & 1 deletion lib/Mojo/IOLoop.pm
View file
Expand Up @@ -304,7 +304,7 @@ For better scalability (epoll, kqueue) and to provide non-blocking name
resolution, SOCKS5 as well as TLS support, the optional modules L<EV> (4.0+),
L<Net::DNS::Native> (0.15+), L<IO::Socket::Socks> (0.64+) and
L<IO::Socket::SSL> (1.94+) will be used automatically if possible. Individual
features can also be disabled with the C<MOJO_NO_NDN>, C<MOJO_NO_SOCKS> and
features can also be disabled with the C<MOJO_NO_NNR>, C<MOJO_NO_SOCKS> and
C<MOJO_NO_TLS> environment variables.

See L<Mojolicious::Guides::Cookbook/"REAL-TIME WEB"> for more.
Expand Down
95 changes: 39 additions & 56 deletions lib/Mojo/IOLoop/Client.pm
View file
Expand Up @@ -2,33 +2,30 @@ package Mojo::IOLoop::Client;
use Mojo::Base 'Mojo::EventEmitter';

use Errno 'EINPROGRESS';
use Exporter 'import';
use IO::Socket::IP;
use Mojo::IOLoop;
use Mojo::IOLoop::TLS;
use Scalar::Util 'weaken';
use Socket qw(IPPROTO_TCP SOCK_STREAM TCP_NODELAY);

# Non-blocking name resolution requires Net::DNS::Native
use constant NDN => $ENV{MOJO_NO_NDN}
use constant HAS_NNR => $ENV{MOJO_NO_NNR}
? 0
: eval 'use Net::DNS::Native 0.15 (); 1';
my $NDN = NDN ? Net::DNS::Native->new(pool => 5, extra_thread => 1) : undef;

# TLS support requires IO::Socket::SSL
use constant TLS => $ENV{MOJO_NO_TLS}
? 0
: eval 'use IO::Socket::SSL 1.94 (); 1';
use constant TLS_READ => TLS ? IO::Socket::SSL::SSL_WANT_READ() : 0;
use constant TLS_WRITE => TLS ? IO::Socket::SSL::SSL_WANT_WRITE() : 0;
my $NDN = HAS_NNR ? Net::DNS::Native->new(pool => 5, extra_thread => 1) : undef;

# SOCKS support requires IO::Socket::Socks
use constant SOCKS => $ENV{MOJO_NO_SOCKS}
use constant HAS_SOCKS => $ENV{MOJO_NO_SOCKS}
? 0
: eval 'use IO::Socket::Socks 0.64 (); 1';
use constant SOCKS_READ => SOCKS ? IO::Socket::Socks::SOCKS_WANT_READ() : 0;
use constant SOCKS_WRITE => SOCKS ? IO::Socket::Socks::SOCKS_WANT_WRITE() : 0;
use constant READ => HAS_SOCKS ? IO::Socket::Socks::SOCKS_WANT_READ() : 0;
use constant WRITE => HAS_SOCKS ? IO::Socket::Socks::SOCKS_WANT_WRITE() : 0;

has reactor => sub { Mojo::IOLoop->singleton->reactor };

our @EXPORT_OK = qw(HAS_NNR HAS_SOCKS);

sub DESTROY { shift->_cleanup }

sub connect {
Expand All @@ -44,7 +41,7 @@ sub connect {
$_ && s/[[\]]//g for @$args{qw(address socks_address)};
my $address = $args->{socks_address} || ($args->{address} ||= '127.0.0.1');
return $reactor->next_tick(sub { $self && $self->_connect($args) })
if !NDN || $args->{handle};
if !HAS_NNR || $args->{handle};

# Non-blocking name resolution
my $handle = $self->{dns} = $NDN->getaddrinfo($address, _port($args),
Expand Down Expand Up @@ -86,7 +83,7 @@ sub _connect {
}
$handle->blocking(0);

$self->_wait($handle, $args);
$self->_wait('_ready', $handle, $args);
}

sub _port { $_[0]{socks_port} || $_[0]{port} || ($_[0]{tls} ? 443 : 80) }
Expand All @@ -99,7 +96,7 @@ sub _ready {
unless ($handle->connect) {
return $self->emit(error => $!) unless $! == EINPROGRESS;
$self->reactor->remove($handle);
return $self->_wait($handle, $args);
return $self->_wait('_ready', $handle, $args);
}

return $self->emit(error => $! || 'Not connected') unless $handle->connected;
Expand All @@ -119,22 +116,9 @@ sub _socks {

# Switch between reading and writing
my $err = $IO::Socket::Socks::SOCKS_ERROR;
if ($err == SOCKS_READ) { $self->reactor->watch($handle, 1, 0) }
elsif ($err == SOCKS_WRITE) { $self->reactor->watch($handle, 1, 1) }
else { $self->emit(error => $err) }
}

sub _tls {
my $self = shift;

# Connected
my $handle = $self->{handle};
return $self->_cleanup->emit(connect => $handle) if $handle->connect_SSL;

# Switch between reading and writing
my $err = $IO::Socket::SSL::SSL_ERROR;
if ($err == TLS_READ) { $self->reactor->watch($handle, 1, 0) }
elsif ($err == TLS_WRITE) { $self->reactor->watch($handle, 1, 1) }
if ($err == READ) { $self->reactor->watch($handle, 1, 0) }
elsif ($err == WRITE) { $self->reactor->watch($handle, 1, 1) }
else { $self->emit(error => $err) }
}

sub _try_socks {
Expand All @@ -144,7 +128,7 @@ sub _try_socks {
return $self->_try_tls($args) unless $args->{socks_address};
return $self->emit(
error => 'IO::Socket::Socks 0.64+ required for SOCKS support')
unless SOCKS;
unless HAS_SOCKS;

my %options = (ConnectAddr => $args->{address}, ConnectPort => $args->{port});
@options{qw(AuthType Username Password)}
Expand All @@ -154,43 +138,29 @@ sub _try_socks {
$reactor->remove($handle);
return $self->emit(error => 'SOCKS upgrade failed')
unless IO::Socket::Socks->start_SOCKS($handle, %options);
weaken $self;
$reactor->io($handle => sub { $self->_socks($args) })->watch($handle, 0, 1);

$self->_wait('_socks', $handle, $args);
}

sub _try_tls {
my ($self, $args) = @_;

my $handle = $self->{handle};
return $self->_cleanup->emit(connect => $handle) unless $args->{tls};
return $self->emit(error => 'IO::Socket::SSL 1.94+ required for TLS support')
unless TLS;

# Upgrade
weaken $self;
my %options = (
SSL_ca_file => $args->{tls_ca}
&& -T $args->{tls_ca} ? $args->{tls_ca} : undef,
SSL_cert_file => $args->{tls_cert},
SSL_error_trap => sub { $self->emit(error => $_[1]) },
SSL_hostname => IO::Socket::SSL->can_client_sni ? $args->{address} : '',
SSL_key_file => $args->{tls_key},
SSL_startHandshake => 0,
SSL_verify_mode => $args->{tls_ca} ? 0x01 : 0x00,
SSL_verifycn_name => $args->{address},
SSL_verifycn_scheme => $args->{tls_ca} ? 'http' : undef
);
my $reactor = $self->reactor;
$reactor->remove($handle);
return $self->emit(error => 'TLS upgrade failed')
unless IO::Socket::SSL->start_SSL($handle, %options);
$reactor->io($handle => sub { $self->_tls })->watch($handle, 0, 1);

# Start TLS handshake
my $tls = Mojo::IOLoop::TLS->new($handle)->reactor($self->reactor);
$tls->on(upgrade => sub { $self->_cleanup->emit(connect => pop) });
$tls->on(error => sub { $self->emit(error => pop) });
$tls->negotiate(%$args);
}

sub _wait {
my ($self, $handle, $args) = @_;
my ($self, $next, $handle, $args) = @_;
weaken $self;
$self->reactor->io($handle => sub { $self->_ready($args) })
$self->reactor->io($handle => sub { $self->$next($args) })
->watch($handle, 0, 1);
}

Expand Down Expand Up @@ -359,6 +329,19 @@ Path to the TLS key file.

=back

=head1 CONSTANTS

L<Mojo::IOLoop::Client> implements the following constants, which can be
imported individually.

=head2 HAS_NNR

Non-blocking name resolution is supported with L<Net::DNS::Native>.

=head2 HAS_SOCKS

SOCKS5 is supported with L<IO::Socket::SOCKS>.

=head1 SEE ALSO

L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicious.org>.
Expand Down
75 changes: 13 additions & 62 deletions lib/Mojo/IOLoop/Server.pm
View file
Expand Up @@ -3,31 +3,17 @@ use Mojo::Base 'Mojo::EventEmitter';

use Carp 'croak';
use IO::Socket::IP;
use Mojo::File 'path';
use Mojo::IOLoop;
use Mojo::IOLoop::TLS 'HAS_TLS';
use Scalar::Util 'weaken';
use Socket qw(IPPROTO_TCP TCP_NODELAY);

# TLS support requires IO::Socket::SSL
use constant TLS => $ENV{MOJO_NO_TLS}
? 0
: eval 'use IO::Socket::SSL 1.94 (); 1';
use constant TLS_READ => TLS ? IO::Socket::SSL::SSL_WANT_READ() : 0;
use constant TLS_WRITE => TLS ? IO::Socket::SSL::SSL_WANT_WRITE() : 0;

# To regenerate the certificate run this command (18.04.2012)
# openssl req -new -x509 -keyout server.key -out server.crt -nodes -days 7300
my $CERT = path(__FILE__)->dirname->child('resources', 'server.crt')->to_string;
my $KEY = path(__FILE__)->dirname->child('resources', 'server.key')->to_string;

has reactor => sub { Mojo::IOLoop->singleton->reactor };

sub DESTROY {
my $self = shift;
$ENV{MOJO_REUSE} =~ s/(?:^|\,)\Q$self->{reuse}\E// if $self->{reuse};
return unless my $reactor = $self->reactor;
$self->stop if $self->{handle};
$reactor->remove($_) for values %{$self->{handles}};
$self->stop if $self->{handle} && $self->reactor;
}

sub generate_port {
Expand Down Expand Up @@ -76,28 +62,10 @@ sub listen {
$ENV{MOJO_REUSE} .= length $ENV{MOJO_REUSE} ? ",$reuse" : "$reuse";
}
$handle->blocking(0);
@$self{qw(handle single_accept)} = ($handle, $args->{single_accept});
@$self{qw(args handle)} = ($args, $handle);

return unless $args->{tls};
croak 'IO::Socket::SSL 1.94+ required for TLS support' unless TLS;

weaken $self;
my $tls = $self->{tls} = {
SSL_cert_file => $args->{tls_cert} || $CERT,
SSL_error_trap => sub {
return unless my $handle = delete $self->{handles}{shift()};
$self->reactor->remove($handle);
close $handle;
},
SSL_honor_cipher_order => 1,
SSL_key_file => $args->{tls_key} || $KEY,
SSL_startHandshake => 0,
SSL_verify_mode => $args->{tls_verify} // ($args->{tls_ca} ? 0x03 : 0x00)
};
$tls->{SSL_ca_file} = $args->{tls_ca}
if $args->{tls_ca} && -T $args->{tls_ca};
$tls->{SSL_cipher_list} = $args->{tls_ciphers} if $args->{tls_ciphers};
$tls->{SSL_version} = $args->{tls_version} if $args->{tls_version};
croak 'IO::Socket::SSL 1.94+ required for TLS support'
if !HAS_TLS && $args->{tls};
}

sub port { shift->{handle}->sockport }
Expand All @@ -115,40 +83,23 @@ sub _accept {
my $self = shift;

# Greedy accept
my $args = $self->{args};
my $accepted = 0;
while ($self->{active} && !($self->{single_accept} && $accepted++)) {
while ($self->{active} && !($args->{single_accept} && $accepted++)) {
return unless my $handle = $self->{handle}->accept;
$handle->blocking(0);

# Disable Nagle's algorithm
setsockopt $handle, IPPROTO_TCP, TCP_NODELAY, 1;

# Start TLS handshake
$self->emit(accept => $handle) and next unless my $tls = $self->{tls};
$self->_handshake($self->{handles}{$handle} = $handle)
if $handle = IO::Socket::SSL->start_SSL($handle, %$tls, SSL_server => 1);
}
}
$self->emit(accept => $handle) and next unless $args->{tls};

sub _handshake {
my ($self, $handle) = @_;
weaken $self;
$self->reactor->io($handle => sub { $self->_tls($handle) });
}

sub _tls {
my ($self, $handle) = @_;

# Accepted
if ($handle->accept_SSL) {
$self->reactor->remove($handle);
return $self->emit(accept => delete $self->{handles}{$handle});
# Start TLS handshake
my $tls = Mojo::IOLoop::TLS->new($handle)->reactor($self->reactor);
$tls->on(upgrade => sub { $self->emit(accept => pop) });
$tls->on(error => sub { });
$tls->negotiate(%$args, server => 1);
}

# Switch between reading and writing
my $err = $IO::Socket::SSL::SSL_ERROR;
if ($err == TLS_READ) { $self->reactor->watch($handle, 1, 0) }
elsif ($err == TLS_WRITE) { $self->reactor->watch($handle, 1, 1) }
}

1;
Expand Down

0 comments on commit 47ed248

Please sign in to comment.