1 | package Mojo::IOLoop::Client;
|
---|
2 | use Mojo::Base 'Mojo::EventEmitter';
|
---|
3 |
|
---|
4 | use Errno 'EINPROGRESS';
|
---|
5 | use IO::Socket::IP;
|
---|
6 | use IO::Socket::UNIX;
|
---|
7 | use Mojo::IOLoop;
|
---|
8 | use Mojo::IOLoop::TLS;
|
---|
9 | use Scalar::Util 'weaken';
|
---|
10 | use Socket qw(IPPROTO_TCP SOCK_STREAM TCP_NODELAY);
|
---|
11 |
|
---|
12 | # Non-blocking name resolution requires Net::DNS::Native
|
---|
13 | use constant NNR => $ENV{MOJO_NO_NNR}
|
---|
14 | ? 0
|
---|
15 | : eval { require Net::DNS::Native; Net::DNS::Native->VERSION('0.15'); 1 };
|
---|
16 | my $NDN;
|
---|
17 |
|
---|
18 | # SOCKS support requires IO::Socket::Socks
|
---|
19 | use constant SOCKS => $ENV{MOJO_NO_SOCKS}
|
---|
20 | ? 0
|
---|
21 | : eval { require IO::Socket::Socks; IO::Socket::Socks->VERSION('0.64'); 1 };
|
---|
22 | use constant READ => SOCKS ? IO::Socket::Socks::SOCKS_WANT_READ() : 0;
|
---|
23 | use constant WRITE => SOCKS ? IO::Socket::Socks::SOCKS_WANT_WRITE() : 0;
|
---|
24 |
|
---|
25 | has reactor => sub { Mojo::IOLoop->singleton->reactor };
|
---|
26 |
|
---|
27 | sub DESTROY { shift->_cleanup }
|
---|
28 |
|
---|
29 | sub can_nnr {NNR}
|
---|
30 | sub can_socks {SOCKS}
|
---|
31 |
|
---|
32 | sub connect {
|
---|
33 | my ($self, $args) = (shift, ref $_[0] ? $_[0] : {@_});
|
---|
34 |
|
---|
35 | # Timeout
|
---|
36 | weaken $self;
|
---|
37 | my $reactor = $self->reactor;
|
---|
38 | $self->{timer} = $reactor->timer($args->{timeout} || 10,
|
---|
39 | sub { $self->emit(error => 'Connect timeout') });
|
---|
40 |
|
---|
41 | # Blocking name resolution
|
---|
42 | $_ && s/[[\]]//g for @$args{qw(address socks_address)};
|
---|
43 | my $address = $args->{socks_address} || ($args->{address} ||= '127.0.0.1');
|
---|
44 | return $reactor->next_tick(sub { $self && $self->_connect($args) })
|
---|
45 | if !NNR || $args->{handle} || $args->{path};
|
---|
46 |
|
---|
47 | # Non-blocking name resolution
|
---|
48 | $NDN //= Net::DNS::Native->new(pool => 5, extra_thread => 1);
|
---|
49 | my $handle = $self->{dns} = $NDN->getaddrinfo($address, _port($args),
|
---|
50 | {protocol => IPPROTO_TCP, socktype => SOCK_STREAM});
|
---|
51 | $reactor->io(
|
---|
52 | $handle => sub {
|
---|
53 | my $reactor = shift;
|
---|
54 |
|
---|
55 | $reactor->remove($self->{dns});
|
---|
56 | my ($err, @res) = $NDN->get_result(delete $self->{dns});
|
---|
57 | return $self->emit(error => "Can't resolve: $err") if $err;
|
---|
58 |
|
---|
59 | $args->{addr_info} = \@res;
|
---|
60 | $self->_connect($args);
|
---|
61 | }
|
---|
62 | )->watch($handle, 1, 0);
|
---|
63 | }
|
---|
64 |
|
---|
65 | sub _cleanup {
|
---|
66 | my $self = shift;
|
---|
67 | $NDN->timedout($self->{dns}) if $NDN && $self->{dns};
|
---|
68 | return unless my $reactor = $self->reactor;
|
---|
69 | $self->{$_} && $reactor->remove(delete $self->{$_}) for qw(dns timer handle);
|
---|
70 | return $self;
|
---|
71 | }
|
---|
72 |
|
---|
73 | sub _connect {
|
---|
74 | my ($self, $args) = @_;
|
---|
75 |
|
---|
76 | my $path = $args->{path};
|
---|
77 | my $handle = $self->{handle} = $args->{handle};
|
---|
78 |
|
---|
79 | unless ($handle) {
|
---|
80 | my $class = $path ? 'IO::Socket::UNIX' : 'IO::Socket::IP';
|
---|
81 | my %options = (Blocking => 0);
|
---|
82 |
|
---|
83 | # UNIX domain socket
|
---|
84 | if ($path) { $options{Peer} = $path }
|
---|
85 |
|
---|
86 | # IP socket
|
---|
87 | else {
|
---|
88 | if (my $info = $args->{addr_info}) { $options{PeerAddrInfo} = $info }
|
---|
89 | else {
|
---|
90 | $options{PeerAddr} = $args->{socks_address} || $args->{address};
|
---|
91 | $options{PeerPort} = _port($args);
|
---|
92 | }
|
---|
93 | $options{LocalAddr} = $args->{local_address} if $args->{local_address};
|
---|
94 | }
|
---|
95 |
|
---|
96 | return $self->emit(error => "Can't connect: $@")
|
---|
97 | unless $self->{handle} = $handle = $class->new(%options);
|
---|
98 | }
|
---|
99 | $handle->blocking(0);
|
---|
100 |
|
---|
101 | $path ? $self->_try_socks($args) : $self->_wait('_ready', $handle, $args);
|
---|
102 | }
|
---|
103 |
|
---|
104 | sub _port { $_[0]{socks_port} || $_[0]{port} || ($_[0]{tls} ? 443 : 80) }
|
---|
105 |
|
---|
106 | sub _ready {
|
---|
107 | my ($self, $args) = @_;
|
---|
108 |
|
---|
109 | # Socket changes in between attempts and needs to be re-added for epoll/kqueue
|
---|
110 | my $handle = $self->{handle};
|
---|
111 | unless ($handle->connect) {
|
---|
112 | return $self->emit(error => $!) unless $! == EINPROGRESS;
|
---|
113 | $self->reactor->remove($handle);
|
---|
114 | return $self->_wait('_ready', $handle, $args);
|
---|
115 | }
|
---|
116 |
|
---|
117 | return $self->emit(error => $! || 'Not connected') unless $handle->connected;
|
---|
118 |
|
---|
119 | # Disable Nagle's algorithm
|
---|
120 | setsockopt $handle, IPPROTO_TCP, TCP_NODELAY, 1;
|
---|
121 |
|
---|
122 | $self->_try_socks($args);
|
---|
123 | }
|
---|
124 |
|
---|
125 | sub _socks {
|
---|
126 | my ($self, $args) = @_;
|
---|
127 |
|
---|
128 | # Connected
|
---|
129 | my $handle = $self->{handle};
|
---|
130 | return $self->_try_tls($args) if $handle->ready;
|
---|
131 |
|
---|
132 | # Switch between reading and writing
|
---|
133 | my $err = $IO::Socket::Socks::SOCKS_ERROR;
|
---|
134 | if ($err == READ) { $self->reactor->watch($handle, 1, 0) }
|
---|
135 | elsif ($err == WRITE) { $self->reactor->watch($handle, 1, 1) }
|
---|
136 | else { $self->emit(error => $err) }
|
---|
137 | }
|
---|
138 |
|
---|
139 | sub _try_socks {
|
---|
140 | my ($self, $args) = @_;
|
---|
141 |
|
---|
142 | my $handle = $self->{handle};
|
---|
143 | return $self->_try_tls($args) unless $args->{socks_address};
|
---|
144 | return $self->emit(
|
---|
145 | error => 'IO::Socket::Socks 0.64+ required for SOCKS support')
|
---|
146 | unless SOCKS;
|
---|
147 |
|
---|
148 | my %options = (ConnectAddr => $args->{address}, ConnectPort => $args->{port});
|
---|
149 | @options{qw(AuthType Username Password)}
|
---|
150 | = ('userpass', @$args{qw(socks_user socks_pass)})
|
---|
151 | if $args->{socks_user};
|
---|
152 | my $reactor = $self->reactor;
|
---|
153 | $reactor->remove($handle);
|
---|
154 | return $self->emit(error => 'SOCKS upgrade failed')
|
---|
155 | unless IO::Socket::Socks->start_SOCKS($handle, %options);
|
---|
156 |
|
---|
157 | $self->_wait('_socks', $handle, $args);
|
---|
158 | }
|
---|
159 |
|
---|
160 | sub _try_tls {
|
---|
161 | my ($self, $args) = @_;
|
---|
162 |
|
---|
163 | my $handle = $self->{handle};
|
---|
164 | return $self->_cleanup->emit(connect => $handle) unless $args->{tls};
|
---|
165 | my $reactor = $self->reactor;
|
---|
166 | $reactor->remove($handle);
|
---|
167 |
|
---|
168 | # Start TLS handshake
|
---|
169 | weaken $self;
|
---|
170 | my $tls = Mojo::IOLoop::TLS->new($handle)->reactor($self->reactor);
|
---|
171 | $tls->on(upgrade => sub { $self->_cleanup->emit(connect => pop) });
|
---|
172 | $tls->on(error => sub { $self->emit(error => pop) });
|
---|
173 | $tls->negotiate(%$args);
|
---|
174 | }
|
---|
175 |
|
---|
176 | sub _wait {
|
---|
177 | my ($self, $next, $handle, $args) = @_;
|
---|
178 | weaken $self;
|
---|
179 | $self->reactor->io($handle => sub { $self->$next($args) })
|
---|
180 | ->watch($handle, 0, 1);
|
---|
181 | }
|
---|
182 |
|
---|
183 | 1;
|
---|
184 |
|
---|
185 | =encoding utf8
|
---|
186 |
|
---|
187 | =head1 NAME
|
---|
188 |
|
---|
189 | Mojo::IOLoop::Client - Non-blocking TCP/IP and UNIX domain socket client
|
---|
190 |
|
---|
191 | =head1 SYNOPSIS
|
---|
192 |
|
---|
193 | use Mojo::IOLoop::Client;
|
---|
194 |
|
---|
195 | # Create socket connection
|
---|
196 | my $client = Mojo::IOLoop::Client->new;
|
---|
197 | $client->on(connect => sub {
|
---|
198 | my ($client, $handle) = @_;
|
---|
199 | ...
|
---|
200 | });
|
---|
201 | $client->on(error => sub {
|
---|
202 | my ($client, $err) = @_;
|
---|
203 | ...
|
---|
204 | });
|
---|
205 | $client->connect(address => 'example.com', port => 80);
|
---|
206 |
|
---|
207 | # Start reactor if necessary
|
---|
208 | $client->reactor->start unless $client->reactor->is_running;
|
---|
209 |
|
---|
210 | =head1 DESCRIPTION
|
---|
211 |
|
---|
212 | L<Mojo::IOLoop::Client> opens TCP/IP and UNIX domain socket connections for
|
---|
213 | L<Mojo::IOLoop>.
|
---|
214 |
|
---|
215 | =head1 EVENTS
|
---|
216 |
|
---|
217 | L<Mojo::IOLoop::Client> inherits all events from L<Mojo::EventEmitter> and can
|
---|
218 | emit the following new ones.
|
---|
219 |
|
---|
220 | =head2 connect
|
---|
221 |
|
---|
222 | $client->on(connect => sub {
|
---|
223 | my ($client, $handle) = @_;
|
---|
224 | ...
|
---|
225 | });
|
---|
226 |
|
---|
227 | Emitted once the connection is established.
|
---|
228 |
|
---|
229 | =head2 error
|
---|
230 |
|
---|
231 | $client->on(error => sub {
|
---|
232 | my ($client, $err) = @_;
|
---|
233 | ...
|
---|
234 | });
|
---|
235 |
|
---|
236 | Emitted if an error occurs on the connection, fatal if unhandled.
|
---|
237 |
|
---|
238 | =head1 ATTRIBUTES
|
---|
239 |
|
---|
240 | L<Mojo::IOLoop::Client> implements the following attributes.
|
---|
241 |
|
---|
242 | =head2 reactor
|
---|
243 |
|
---|
244 | my $reactor = $client->reactor;
|
---|
245 | $client = $client->reactor(Mojo::Reactor::Poll->new);
|
---|
246 |
|
---|
247 | Low-level event reactor, defaults to the C<reactor> attribute value of the
|
---|
248 | global L<Mojo::IOLoop> singleton.
|
---|
249 |
|
---|
250 | =head1 METHODS
|
---|
251 |
|
---|
252 | L<Mojo::IOLoop::Client> inherits all methods from L<Mojo::EventEmitter> and
|
---|
253 | implements the following new ones.
|
---|
254 |
|
---|
255 | =head2 can_nnr
|
---|
256 |
|
---|
257 | my $bool = Mojo::IOLoop::Client->can_nnr;
|
---|
258 |
|
---|
259 | True if L<Net::DNS::Native> 0.15+ is installed and non-blocking name resolution
|
---|
260 | support enabled.
|
---|
261 |
|
---|
262 | =head2 can_socks
|
---|
263 |
|
---|
264 | my $bool = Mojo::IOLoop::Client->can_socks;
|
---|
265 |
|
---|
266 | True if L<IO::Socket::SOCKS> 0.64+ is installed and SOCKS5 support enabled.
|
---|
267 |
|
---|
268 | =head2 connect
|
---|
269 |
|
---|
270 | $client->connect(address => '127.0.0.1', port => 3000);
|
---|
271 | $client->connect({address => '127.0.0.1', port => 3000});
|
---|
272 |
|
---|
273 | Open a socket connection to a remote host. Note that non-blocking name
|
---|
274 | resolution depends on L<Net::DNS::Native> (0.15+), SOCKS5 support on
|
---|
275 | L<IO::Socket::Socks> (0.64), and TLS support on L<IO::Socket::SSL> (2.009+).
|
---|
276 |
|
---|
277 | These options are currently available:
|
---|
278 |
|
---|
279 | =over 2
|
---|
280 |
|
---|
281 | =item address
|
---|
282 |
|
---|
283 | address => 'mojolicious.org'
|
---|
284 |
|
---|
285 | Address or host name of the peer to connect to, defaults to C<127.0.0.1>.
|
---|
286 |
|
---|
287 | =item handle
|
---|
288 |
|
---|
289 | handle => $handle
|
---|
290 |
|
---|
291 | Use an already prepared L<IO::Socket::IP> object.
|
---|
292 |
|
---|
293 | =item local_address
|
---|
294 |
|
---|
295 | local_address => '127.0.0.1'
|
---|
296 |
|
---|
297 | Local address to bind to.
|
---|
298 |
|
---|
299 | =item path
|
---|
300 |
|
---|
301 | path => '/tmp/myapp.sock'
|
---|
302 |
|
---|
303 | Path of UNIX domain socket to connect to.
|
---|
304 |
|
---|
305 | =item port
|
---|
306 |
|
---|
307 | port => 80
|
---|
308 |
|
---|
309 | Port to connect to, defaults to C<80> or C<443> with C<tls> option.
|
---|
310 |
|
---|
311 | =item socks_address
|
---|
312 |
|
---|
313 | socks_address => '127.0.0.1'
|
---|
314 |
|
---|
315 | Address or host name of SOCKS5 proxy server to use for connection.
|
---|
316 |
|
---|
317 | =item socks_pass
|
---|
318 |
|
---|
319 | socks_pass => 'secr3t'
|
---|
320 |
|
---|
321 | Password to use for SOCKS5 authentication.
|
---|
322 |
|
---|
323 | =item socks_port
|
---|
324 |
|
---|
325 | socks_port => 9050
|
---|
326 |
|
---|
327 | Port of SOCKS5 proxy server to use for connection.
|
---|
328 |
|
---|
329 | =item socks_user
|
---|
330 |
|
---|
331 | socks_user => 'sri'
|
---|
332 |
|
---|
333 | Username to use for SOCKS5 authentication.
|
---|
334 |
|
---|
335 | =item timeout
|
---|
336 |
|
---|
337 | timeout => 15
|
---|
338 |
|
---|
339 | Maximum amount of time in seconds establishing connection may take before
|
---|
340 | getting canceled, defaults to C<10>.
|
---|
341 |
|
---|
342 | =item tls
|
---|
343 |
|
---|
344 | tls => 1
|
---|
345 |
|
---|
346 | Enable TLS.
|
---|
347 |
|
---|
348 | =item tls_ca
|
---|
349 |
|
---|
350 | tls_ca => '/etc/tls/ca.crt'
|
---|
351 |
|
---|
352 | Path to TLS certificate authority file.
|
---|
353 |
|
---|
354 | =item tls_cert
|
---|
355 |
|
---|
356 | tls_cert => '/etc/tls/client.crt'
|
---|
357 |
|
---|
358 | Path to the TLS certificate file.
|
---|
359 |
|
---|
360 | =item tls_key
|
---|
361 |
|
---|
362 | tls_key => '/etc/tls/client.key'
|
---|
363 |
|
---|
364 | Path to the TLS key file.
|
---|
365 |
|
---|
366 | =item tls_protocols
|
---|
367 |
|
---|
368 | tls_protocols => ['foo', 'bar']
|
---|
369 |
|
---|
370 | ALPN protocols to negotiate.
|
---|
371 |
|
---|
372 | =item tls_verify
|
---|
373 |
|
---|
374 | tls_verify => 0x00
|
---|
375 |
|
---|
376 | TLS verification mode.
|
---|
377 |
|
---|
378 | =back
|
---|
379 |
|
---|
380 | =head1 SEE ALSO
|
---|
381 |
|
---|
382 | L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
|
---|
383 |
|
---|
384 | =cut
|
---|