File Coverage

blib/lib/Mojo/IOLoop/Client.pm

Criterion	Covered	Total	%
statement	96	130	73.8
branch	24	52	46.1
condition	13	25	52.0
subroutine	26	30	86.6
pod	3	3	100.0
total	162	240	67.5

package Mojo::IOLoop::Client;
use Mojo::Base 'Mojo::EventEmitter';

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

# Non-blocking name resolution requires Net::DNS::Native
use constant NNR => $ENV{MOJO_NO_NNR} ? 0 : !!eval { require Net::DNS::Native; Net::DNS::Native->VERSION('0.15'); 1 };
my $NDN;

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

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

sub DESTROY { shift->_cleanup }

sub can_nnr   {NNR}
sub can_socks {SOCKS}

sub connect {
  my ($self, $args) = (shift, ref $_[0] ? $_[0] : {@_});

  # Timeout
  weaken $self;
  my $reactor = $self->reactor;
  $self->{timer} = $reactor->timer($args->{timeout} || 10, sub { $self->emit(error => 'Connect timeout') });

  # Blocking name resolution
  $_ && 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 !NNR || $args->{handle} || $args->{path};

  # Non-blocking name resolution
  $NDN //= Net::DNS::Native->new(pool => 5, extra_thread => 1);
  my $handle = $self->{dns}
    = $NDN->getaddrinfo($address, _port($args), {protocol => IPPROTO_TCP, socktype => SOCK_STREAM});
  $reactor->io(
    $handle => sub {
      my $reactor = shift;

      $reactor->remove($self->{dns});
      my ($err, @res) = $NDN->get_result(delete $self->{dns});
      return $self->emit(error => "Can't resolve: $err") if $err;

      $args->{addr_info} = \@res;
      $self->_connect($args);
    }
  )->watch($handle, 1, 0);
}

sub _cleanup {
  my $self = shift;
  $NDN->timedout($self->{dns}) if $NDN && $self->{dns};
  return $self unless my $reactor = $self->reactor;
  $self->{$_} && $reactor->remove(delete $self->{$_}) for qw(dns timer handle);
  return $self;
}

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

  my $path   = $args->{path};
  my $handle = $self->{handle} = $args->{handle};

  unless ($handle) {
    my $class   = $path ? 'IO::Socket::UNIX' : 'IO::Socket::IP';
    my %options = (Blocking => 0);

    # UNIX domain socket
    if ($path) { $options{Peer} = $path }

    # IP socket
    else {
      if (my $info = $args->{addr_info}) { $options{PeerAddrInfo} = $info }
      else {
        $options{PeerAddr} = $args->{socks_address} || $args->{address};
        $options{PeerPort} = _port($args);
      }
      @options{keys %{$args->{socket_options}}} = values %{$args->{socket_options}} if $args->{socket_options};
    }

    return $self->emit(error => "Can't connect: $@") unless $self->{handle} = $handle = $class->new(%options);
  }
  $handle->blocking(0);

  $path ? $self->_try_socks($args) : $self->_wait('_ready', $handle, $args);
}

sub _port { $_[0]{socks_port} || $_[0]{port} || ($_[0]{tls} ? 443 : 80) }

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

  # Socket changes in between attempts and needs to be re-added for epoll/kqueue
  my $handle = $self->{handle};
  unless ($handle->connect) {
    return $self->emit(error => $!) unless $! == EINPROGRESS;
    $self->reactor->remove($handle);
    return $self->_wait('_ready', $handle, $args);
  }

  return $self->emit(error => $! || 'Not connected') unless $handle->connected;

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

  $self->_try_socks($args);
}

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

  # Connected
  my $handle = $self->{handle};
  return $self->_try_tls($args) if $handle->ready;

  # Switch between reading and writing
  my $err = $IO::Socket::Socks::SOCKS_ERROR;
  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 {
  my ($self, $args) = @_;

  my $handle = $self->{handle};
  return $self->_try_tls($args)                                                     unless $args->{socks_address};
  return $self->emit(error => 'IO::Socket::Socks 0.64+ required for SOCKS support') unless SOCKS;

  my %options = (ConnectAddr => $args->{address}, ConnectPort => $args->{port});
  @options{qw(AuthType Username Password)} = ('userpass', @$args{qw(socks_user socks_pass)}) if $args->{socks_user};
  my $reactor = $self->reactor;
  $reactor->remove($handle);
  return $self->emit(error => 'SOCKS upgrade failed') unless IO::Socket::Socks->start_SOCKS($handle, %options);

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

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

  my $handle = $self->{handle};
  return $self->_cleanup->emit(connect => $handle) unless $args->{tls};
  my $reactor = $self->reactor;
  $reactor->remove($handle);

  # Start TLS handshake
  weaken $self;
  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, $next, $handle, $args) = @_;
  weaken $self;
  $self->reactor->io($handle => sub { $self->$next($args) })->watch($handle, 0, 1);
}

1;

=encoding utf8

=head1 NAME

Mojo::IOLoop::Client - Non-blocking TCP/IP and UNIX domain socket client

=head1 SYNOPSIS

  use Mojo::IOLoop::Client;

  # Create socket connection
  my $client = Mojo::IOLoop::Client->new;
  $client->on(connect => sub ($client, $handle) {...});
  $client->on(error => sub ($client, $err) {...});
  $client->connect(address => 'example.com', port => 80);

  # Start reactor if necessary
  $client->reactor->start unless $client->reactor->is_running;

=head1 DESCRIPTION

L opens TCP/IP and UNIX domain socket connections for L.

=head1 EVENTS

L inherits all events from L and can emit the following new ones.

=head2 connect

  $client->on(connect => sub ($client, $handle) {...});

Emitted once the connection is established.

=head2 error

  $client->on(error => sub ($client, $err) {...});

Emitted if an error occurs on the connection, fatal if unhandled.

=head1 ATTRIBUTES

L implements the following attributes.

=head2 reactor

  my $reactor = $client->reactor;
  $client     = $client->reactor(Mojo::Reactor::Poll->new);

Low-level event reactor, defaults to the C attribute value of the global L singleton. Note that
this attribute is weakened.

=head1 METHODS

L inherits all methods from L and implements the following new ones.

=head2 can_nnr

  my $bool = Mojo::IOLoop::Client->can_nnr;

True if L 0.15+ is installed and non-blocking name resolution support enabled.

=head2 can_socks

  my $bool = Mojo::IOLoop::Client->can_socks;

True if L 0.64+ is installed and SOCKS5 support enabled.

=head2 connect

  $client->connect(address => '127.0.0.1', port => 3000);
  $client->connect({address => '127.0.0.1', port => 3000});

Open a socket connection to a remote host. Note that non-blocking name resolution depends on L
(0.15+), SOCKS5 support on L (0.64), and TLS support on L (2.009+).

These options are currently available:

=over 2

=item address

  address => 'mojolicious.org'

Address or host name of the peer to connect to, defaults to C<127.0.0.1>.

=item handle

  handle => $handle

Use an already prepared L object.

=item path

  path => '/tmp/myapp.sock'

Path of UNIX domain socket to connect to.

=item port

  port => 80

Port to connect to, defaults to C<80> or C<443> with C option.

=item socket_options

  socket_options => {LocalAddr => '127.0.0.1'}

Additional options for L when opening new connections.

=item socks_address

  socks_address => '127.0.0.1'

Address or host name of SOCKS5 proxy server to use for connection.

=item socks_pass

  socks_pass => 'secr3t'

Password to use for SOCKS5 authentication.

=item socks_port

  socks_port => 9050

Port of SOCKS5 proxy server to use for connection.

=item socks_user

  socks_user => 'sri'

Username to use for SOCKS5 authentication.

=item timeout

  timeout => 15

Maximum amount of time in seconds establishing connection may take before getting canceled, defaults to C<10>.

=item tls

  tls => 1

Enable TLS.

=item tls_ca

  tls_ca => '/etc/tls/ca.crt'

Path to TLS certificate authority file.

=item tls_cert

  tls_cert => '/etc/tls/client.crt'

Path to the TLS certificate file.

=item tls_key

  tls_key => '/etc/tls/client.key'

Path to the TLS key file.

=item tls_options

  tls_options => {SSL_alpn_protocols => ['foo', 'bar'], SSL_verify_mode => 0x00}

Additional options for L.

=back

=head1 SEE ALSO

L, L, L.

=cut