add files
|
1 |
package Mojo::IOLoop::Client; |
2 |
use Mojo::Base 'Mojo::EventEmitter'; |
|
3 | ||
4 |
use Errno 'EINPROGRESS'; |
|
5 |
use IO::Socket::INET; |
|
6 |
use Scalar::Util 'weaken'; |
|
7 |
use Socket qw(IPPROTO_TCP SO_ERROR TCP_NODELAY); |
|
8 | ||
9 |
# IPv6 support requires IO::Socket::IP |
|
10 |
use constant IPV6 => $ENV{MOJO_NO_IPV6} |
|
11 |
? 0 |
|
12 |
: eval 'use IO::Socket::IP 0.16 (); 1'; |
|
13 | ||
14 |
# TLS support requires IO::Socket::SSL |
|
15 |
use constant TLS => $ENV{MOJO_NO_TLS} ? 0 |
|
16 |
: eval(IPV6 ? 'use IO::Socket::SSL 1.75 (); 1' |
|
17 |
: 'use IO::Socket::SSL 1.75 "inet4"; 1'); |
|
18 |
use constant TLS_READ => TLS ? IO::Socket::SSL::SSL_WANT_READ() : 0; |
|
19 |
use constant TLS_WRITE => TLS ? IO::Socket::SSL::SSL_WANT_WRITE() : 0; |
|
20 | ||
21 |
has reactor => sub { |
|
22 |
require Mojo::IOLoop; |
|
23 |
Mojo::IOLoop->singleton->reactor; |
|
24 |
}; |
|
25 | ||
26 |
sub DESTROY { shift->_cleanup } |
|
27 | ||
28 |
sub connect { |
|
29 |
my $self = shift; |
|
30 |
my $args = ref $_[0] ? $_[0] : {@_}; |
|
31 |
weaken $self; |
|
32 |
$self->{delay} = $self->reactor->timer(0 => sub { $self->_connect($args) }); |
|
33 |
} |
|
34 | ||
35 |
sub _cleanup { |
|
36 |
my $self = shift; |
|
37 |
return $self unless my $reactor = $self->reactor; |
|
38 |
$self->{$_} && $reactor->remove(delete $self->{$_}) |
|
39 |
for qw(delay timer handle); |
|
40 |
return $self; |
|
41 |
} |
|
42 | ||
43 |
sub _connect { |
|
44 |
my ($self, $args) = @_; |
|
45 | ||
46 |
my $handle; |
|
47 |
my $reactor = $self->reactor; |
|
48 |
my $address = $args->{address} ||= 'localhost'; |
|
49 |
unless ($handle = $self->{handle} = $args->{handle}) { |
|
50 |
my %options = ( |
|
51 |
Blocking => 0, |
|
52 |
PeerAddr => $address eq 'localhost' ? '127.0.0.1' : $address, |
|
53 |
PeerPort => $args->{port} || ($args->{tls} ? 443 : 80) |
|
54 |
); |
|
55 |
$options{LocalAddr} = $args->{local_address} if $args->{local_address}; |
|
56 |
$options{PeerAddr} =~ s/[\[\]]//g if $options{PeerAddr}; |
|
57 |
my $class = IPV6 ? 'IO::Socket::IP' : 'IO::Socket::INET'; |
|
58 |
return $self->emit(error => "Couldn't connect: $@") |
|
59 |
unless $self->{handle} = $handle = $class->new(%options); |
|
60 | ||
61 |
# Timeout |
|
62 |
$self->{timer} = $reactor->timer($args->{timeout} || 10, |
|
63 |
sub { $self->emit(error => 'Connect timeout') }); |
|
64 |
} |
|
65 |
$handle->blocking(0); |
|
66 | ||
67 |
# Wait for handle to become writable |
|
68 |
weaken $self; |
|
69 |
$reactor->io($handle => sub { $self->_try($args) })->watch($handle, 0, 1); |
|
70 |
} |
|
71 | ||
72 |
sub _tls { |
|
73 |
my $self = shift; |
|
74 | ||
75 |
# Connected |
|
76 |
my $handle = $self->{handle}; |
|
77 |
return $self->_cleanup->emit_safe(connect => $handle) |
|
78 |
if $handle->connect_SSL; |
|
79 | ||
80 |
# Switch between reading and writing |
|
81 |
my $err = $IO::Socket::SSL::SSL_ERROR; |
|
82 |
if ($err == TLS_READ) { $self->reactor->watch($handle, 1, 0) } |
|
83 |
elsif ($err == TLS_WRITE) { $self->reactor->watch($handle, 1, 1) } |
|
84 |
} |
|
85 | ||
86 |
sub _try { |
|
87 |
my ($self, $args) = @_; |
|
88 | ||
89 |
# Retry or handle exceptions |
|
90 |
my $handle = $self->{handle}; |
|
91 |
return $! == EINPROGRESS ? undef : $self->emit(error => $!) |
|
92 |
if IPV6 && !$handle->connect; |
|
93 |
return $self->emit(error => $! = $handle->sockopt(SO_ERROR)) |
|
94 |
if !IPV6 && !$handle->connected; |
|
95 | ||
96 |
# Disable Nagle's algorithm |
|
97 |
setsockopt $handle, IPPROTO_TCP, TCP_NODELAY, 1; |
|
98 | ||
99 |
return $self->_cleanup->emit_safe(connect => $handle) |
|
100 |
if !$args->{tls} || $handle->isa('IO::Socket::SSL'); |
|
101 |
return $self->emit(error => 'IO::Socket::SSL 1.75 required for TLS support') |
|
102 |
unless TLS; |
|
103 | ||
104 |
# Upgrade |
|
105 |
weaken $self; |
|
106 |
my %options = ( |
|
107 |
SSL_ca_file => $args->{tls_ca} |
|
108 |
&& -T $args->{tls_ca} ? $args->{tls_ca} : undef, |
|
109 |
SSL_cert_file => $args->{tls_cert}, |
|
110 |
SSL_error_trap => sub { $self->_cleanup->emit(error => $_[1]) }, |
|
111 |
SSL_hostname => $args->{address}, |
|
112 |
SSL_key_file => $args->{tls_key}, |
|
113 |
SSL_startHandshake => 0, |
|
114 |
SSL_verify_mode => $args->{tls_ca} ? 0x01 : 0x00, |
|
115 |
SSL_verifycn_name => $args->{address}, |
|
116 |
SSL_verifycn_scheme => $args->{tls_ca} ? 'http' : undef |
|
117 |
); |
|
118 |
my $reactor = $self->reactor; |
|
119 |
$reactor->remove($handle); |
|
120 |
return $self->emit(error => 'TLS upgrade failed') |
|
121 |
unless $handle = IO::Socket::SSL->start_SSL($handle, %options); |
|
122 |
$reactor->io($handle => sub { $self->_tls })->watch($handle, 0, 1); |
|
123 |
} |
|
124 | ||
125 |
1; |
|
126 | ||
127 |
=encoding utf8 |
|
128 | ||
129 |
=head1 NAME |
|
130 | ||
131 |
Mojo::IOLoop::Client - Non-blocking TCP client |
|
132 | ||
133 |
=head1 SYNOPSIS |
|
134 | ||
135 |
use Mojo::IOLoop::Client; |
|
136 | ||
137 |
# Create socket connection |
|
138 |
my $client = Mojo::IOLoop::Client->new; |
|
139 |
$client->on(connect => sub { |
|
140 |
my ($client, $handle) = @_; |
|
141 |
... |
|
142 |
}); |
|
143 |
$client->on(error => sub { |
|
144 |
my ($client, $err) = @_; |
|
145 |
... |
|
146 |
}); |
|
147 |
$client->connect(address => 'example.com', port => 80); |
|
148 | ||
149 |
# Start reactor if necessary |
|
150 |
$client->reactor->start unless $client->reactor->is_running; |
|
151 | ||
152 |
=head1 DESCRIPTION |
|
153 | ||
154 |
L<Mojo::IOLoop::Client> opens TCP connections for L<Mojo::IOLoop>. |
|
155 | ||
156 |
=head1 EVENTS |
|
157 | ||
158 |
L<Mojo::IOLoop::Client> inherits all events from L<Mojo::EventEmitter> and can |
|
159 |
emit the following new ones. |
|
160 | ||
161 |
=head2 connect |
|
162 | ||
163 |
$client->on(connect => sub { |
|
164 |
my ($client, $handle) = @_; |
|
165 |
... |
|
166 |
}); |
|
167 | ||
168 |
Emitted safely once the connection is established. |
|
169 | ||
170 |
=head2 error |
|
171 | ||
172 |
$client->on(error => sub { |
|
173 |
my ($client, $err) = @_; |
|
174 |
... |
|
175 |
}); |
|
176 | ||
177 |
Emitted if an error occurs on the connection, fatal if unhandled. |
|
178 | ||
179 |
=head1 ATTRIBUTES |
|
180 | ||
181 |
L<Mojo::IOLoop::Client> implements the following attributes. |
|
182 | ||
183 |
=head2 reactor |
|
184 | ||
185 |
my $reactor = $client->reactor; |
|
186 |
$client = $client->reactor(Mojo::Reactor::Poll->new); |
|
187 | ||
188 |
Low level event reactor, defaults to the C<reactor> attribute value of the |
|
189 |
global L<Mojo::IOLoop> singleton. |
|
190 | ||
191 |
=head1 METHODS |
|
192 | ||
193 |
L<Mojo::IOLoop::Client> inherits all methods from L<Mojo::EventEmitter> and |
|
194 |
implements the following new ones. |
|
195 | ||
196 |
=head2 connect |
|
197 | ||
198 |
$client->connect(address => '127.0.0.1', port => 3000); |
|
199 | ||
200 |
Open a socket connection to a remote host. Note that TLS support depends on |
|
201 |
L<IO::Socket::SSL> (1.75+) and IPv6 support on L<IO::Socket::IP> (0.16+). |
|
202 | ||
203 |
These options are currently available: |
|
204 | ||
205 |
=over 2 |
|
206 | ||
207 |
=item address |
|
208 | ||
209 |
address => 'mojolicio.us' |
|
210 | ||
211 |
Address or host name of the peer to connect to, defaults to C<localhost>. |
|
212 | ||
213 |
=item handle |
|
214 | ||
215 |
handle => $handle |
|
216 | ||
217 |
Use an already prepared handle. |
|
218 | ||
219 |
=item local_address |
|
220 | ||
221 |
local_address => '127.0.0.1' |
|
222 | ||
223 |
Local address to bind to. |
|
224 | ||
225 |
=item port |
|
226 | ||
227 |
port => 80 |
|
228 | ||
229 |
Port to connect to, defaults to C<80> or C<443> with C<tls> option. |
|
230 | ||
231 |
=item timeout |
|
232 | ||
233 |
timeout => 15 |
|
234 | ||
235 |
Maximum amount of time in seconds establishing connection may take before |
|
236 |
getting canceled, defaults to C<10>. |
|
237 | ||
238 |
=item tls |
|
239 | ||
240 |
tls => 1 |
|
241 | ||
242 |
Enable TLS. |
|
243 | ||
244 |
=item tls_ca |
|
245 | ||
246 |
tls_ca => '/etc/tls/ca.crt' |
|
247 | ||
248 |
Path to TLS certificate authority file. Also activates hostname verification. |
|
249 | ||
250 |
=item tls_cert |
|
251 | ||
252 |
tls_cert => '/etc/tls/client.crt' |
|
253 | ||
254 |
Path to the TLS certificate file. |
|
255 | ||
256 |
=item tls_key |
|
257 | ||
258 |
tls_key => '/etc/tls/client.key' |
|
259 | ||
260 |
Path to the TLS key file. |
|
261 | ||
262 |
=back |
|
263 | ||
264 |
=head1 SEE ALSO |
|
265 | ||
266 |
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>. |
|
267 | ||
268 |
=cut |