File Coverage

blib/lib/Mojo/IOLoop/Server.pm
Criterion Covered Total %
statement 72 82 87.8
branch 24 36 66.6
condition 19 26 73.0
subroutine 18 21 85.7
pod 7 7 100.0
total 140 172 81.4


line stmt bran cond sub pod time code
1             package Mojo::IOLoop::Server;
2 63     63   73468 use Mojo::Base 'Mojo::EventEmitter';
  63         202  
  63         436  
3              
4 63     63   437 use Carp qw(croak);
  63         156  
  63         3105  
5 63     63   2838 use IO::Socket::IP;
  63         79545  
  63         924  
6 63     63   38571 use IO::Socket::UNIX;
  63         168  
  63         617  
7 63     63   99387 use Mojo::File qw(path);
  63         156  
  63         3290  
8 63     63   2615 use Mojo::IOLoop;
  63         185  
  63         540  
9 63     63   813 use Mojo::IOLoop::TLS;
  63         147  
  63         421  
10 63     63   419 use Scalar::Util qw(weaken);
  63         179  
  63         3292  
11 63     63   456 use Socket qw(IPPROTO_TCP TCP_NODELAY);
  63         200  
  63         80858  
12              
13             has reactor => sub { Mojo::IOLoop->singleton->reactor }, weak => 1;
14              
15             sub DESTROY {
16 115     115   2774 my $self = shift;
17 115 100       4114 $ENV{MOJO_REUSE} =~ s/(?:^|\,)\Q$self->{reuse}\E// if $self->{reuse};
18 115 100 66     923 $self->stop if $self->{handle} && $self->reactor;
19             }
20              
21 0     0 1 0 sub generate_port { IO::Socket::IP->new(Listen => 5, LocalAddr => '127.0.0.1')->sockport }
22              
23 1     1 1 7 sub handle { shift->{handle} }
24              
25 4     4 1 32 sub is_accepting { !!shift->{active} }
26              
27             sub listen {
28 147 100   147 1 614 my ($self, $args) = (shift, ref $_[0] ? $_[0] : {@_});
29              
30             # Look for reusable file descriptor
31 147         339 my $path = $args->{path};
32 147   50     499 my $address = $args->{address} || '0.0.0.0';
33 147         308 my $port = $args->{port};
34 147   100     986 $ENV{MOJO_REUSE} ||= '';
35             my $fd = ($path && $ENV{MOJO_REUSE} =~ /(?:^|\,)unix:\Q$path\E:(\d+)/)
36 147 50 33     1097 || ($port && $ENV{MOJO_REUSE} =~ /(?:^|\,)\Q$address:$port\E:(\d+)/) ? $1 : undef;
37              
38             # Allow file descriptor inheritance
39 147         687 local $^F = 1023;
40              
41             # Reuse file descriptor
42 147         277 my $handle;
43 147 50       434 my $class = $path ? 'IO::Socket::UNIX' : 'IO::Socket::IP';
44 147 100 66     874 if (defined($fd //= $args->{fd})) {
45 1 50       14 $handle = $class->new_from_fd($fd, 'r') or croak "Can't open file descriptor $fd: $!";
46             }
47              
48             else {
49 146   50     1013 my %options = (Listen => $args->{backlog} // SOMAXCONN, Type => SOCK_STREAM);
50              
51             # UNIX domain socket
52 146         266 my $reuse;
53 146 50       365 if ($path) {
54 0 0       0 path($path)->remove if -S $path;
55 0         0 $options{Local} = $path;
56 0 0       0 $handle = $class->new(%options) or croak "Can't create listen socket: $!";
57 0         0 $reuse = $self->{reuse} = join ':', 'unix', $path, fileno $handle;
58             }
59              
60             # IP socket
61             else {
62 146         387 $options{LocalAddr} = $address;
63 146         509 $options{LocalAddr} =~ y/[]//d;
64 146 50       438 $options{LocalPort} = $port if $port;
65 146         333 $options{ReuseAddr} = 1;
66 146         375 $options{ReusePort} = $args->{reuse};
67 146 50       1438 $handle = $class->new(%options) or croak "Can't create listen socket: $@";
68 146         97225 $fd = fileno $handle;
69 146         660 $reuse = $self->{reuse} = join ':', $address, $handle->sockport, $fd;
70             }
71              
72 146 100       9146 $ENV{MOJO_REUSE} .= length $ENV{MOJO_REUSE} ? ",$reuse" : "$reuse";
73             }
74 147         920 $handle->blocking(0);
75 147         3027 @$self{qw(args handle)} = ($args, $handle);
76              
77 147 100 100     1325 croak 'IO::Socket::SSL 2.009+ required for TLS support' if !Mojo::IOLoop::TLS->can_tls && $args->{tls};
78             }
79              
80 146     146 1 662 sub port { shift->{handle}->sockport }
81              
82             sub start {
83 391     391 1 721 my $self = shift;
84 391         1348 weaken $self;
85 391 50   194   1467 ++$self->{active} and $self->reactor->io($self->{handle} => sub { $self->_accept })->watch($self->{handle}, 1, 0);
  194         851  
86             }
87              
88 448 100   448 1 1920 sub stop { delete($_[0]{active}) and $_[0]->reactor->remove($_[0]{handle}) }
89              
90             sub _accept {
91 194     194   452 my $self = shift;
92              
93             # Greedy accept
94 194         505 my $args = $self->{args};
95 194         376 my $accepted = 0;
96 194   100     1320 while ($self->{active} && !($args->{single_accept} && $accepted++)) {
      100        
97 383 100       1612 return unless my $handle = $self->{handle}->accept;
98 194         34936 $handle->blocking(0);
99              
100             # Disable Nagle's algorithm
101 194         4248 setsockopt $handle, IPPROTO_TCP, TCP_NODELAY, 1;
102              
103 194 50 50     1837 $self->emit(accept => $handle) and next unless $args->{tls};
104              
105             # Start TLS handshake
106 0           my $tls = Mojo::IOLoop::TLS->new($handle)->reactor($self->reactor);
107 0     0     $tls->on(upgrade => sub { $self->emit(accept => pop) });
  0            
108 0     0     $tls->on(error => sub { });
109 0           $tls->negotiate(%$args, server => 1);
110             }
111             }
112              
113             1;
114              
115             =encoding utf8
116              
117             =head1 NAME
118              
119             Mojo::IOLoop::Server - Non-blocking TCP and UNIX domain socket server
120              
121             =head1 SYNOPSIS
122              
123             use Mojo::IOLoop::Server;
124              
125             # Create listen socket
126             my $server = Mojo::IOLoop::Server->new;
127             $server->on(accept => sub ($server, $handle) {...});
128             $server->listen(port => 3000);
129              
130             # Start and stop accepting connections
131             $server->start;
132             $server->stop;
133              
134             # Start reactor if necessary
135             $server->reactor->start unless $server->reactor->is_running;
136              
137             =head1 DESCRIPTION
138              
139             L accepts TCP/IP and UNIX domain socket connections for L.
140              
141             =head1 EVENTS
142              
143             L inherits all events from L and can emit the following new ones.
144              
145             =head2 accept
146              
147             $server->on(accept => sub ($server, $handle) {...});
148              
149             Emitted for each accepted connection.
150              
151             =head1 ATTRIBUTES
152              
153             L implements the following attributes.
154              
155             =head2 reactor
156              
157             my $reactor = $server->reactor;
158             $server = $server->reactor(Mojo::Reactor::Poll->new);
159              
160             Low-level event reactor, defaults to the C attribute value of the global L singleton. Note that
161             this attribute is weakened.
162              
163             =head1 METHODS
164              
165             L inherits all methods from L and implements the following new ones.
166              
167             =head2 generate_port
168              
169             my $port = Mojo::IOLoop::Server->generate_port;
170              
171             Find a free TCP port, primarily used for tests.
172              
173             =head2 handle
174              
175             my $handle = $server->handle;
176              
177             Get handle for server, usually an L object.
178              
179             =head2 is_accepting
180              
181             my $bool = $server->is_accepting;
182              
183             Check if connections are currently being accepted.
184              
185             =head2 listen
186              
187             $server->listen(port => 3000);
188             $server->listen({port => 3000});
189              
190             Create a new listen socket. Note that TLS support depends on L (2.009+).
191              
192             These options are currently available:
193              
194             =over 2
195              
196             =item address
197              
198             address => '127.0.0.1'
199              
200             Local address to listen on, defaults to C<0.0.0.0>.
201              
202             =item backlog
203              
204             backlog => 128
205              
206             Maximum backlog size, defaults to C.
207              
208             =item fd
209              
210             fd => 3
211              
212             File descriptor with an already prepared listen socket.
213              
214             =item path
215              
216             path => '/tmp/myapp.sock'
217              
218             Path for UNIX domain socket to listen on.
219              
220             =item port
221              
222             port => 80
223              
224             Port to listen on, defaults to a random port.
225              
226             =item reuse
227              
228             reuse => 1
229              
230             Allow multiple servers to use the same port with the C socket option.
231              
232             =item single_accept
233              
234             single_accept => 1
235              
236             Only accept one connection at a time.
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.
249              
250             =item tls_cert
251              
252             tls_cert => '/etc/tls/server.crt'
253             tls_cert => {'mojolicious.org' => '/etc/tls/mojo.crt'}
254              
255             Path to the TLS cert file, defaults to a built-in test certificate.
256              
257             =item tls_key
258              
259             tls_key => '/etc/tls/server.key'
260             tls_key => {'mojolicious.org' => '/etc/tls/mojo.key'}
261              
262             Path to the TLS key file, defaults to a built-in test key.
263              
264             =item tls_options
265              
266             tls_options => {SSL_alpn_protocols => ['foo', 'bar'], SSL_verify_mode => 0x00}
267              
268             Additional options for L.
269              
270             =back
271              
272             =head2 port
273              
274             my $port = $server->port;
275              
276             Get port this server is listening on.
277              
278             =head2 start
279              
280             $server->start;
281              
282             Start or resume accepting connections.
283              
284             =head2 stop
285              
286             $server->stop;
287              
288             Stop accepting connections.
289              
290             =head1 SEE ALSO
291              
292             L, L, L.
293              
294             =cut