1package Mojo::Server::Daemon;
2use Mojo::Base 'Mojo::Server';
3
4use Carp qw(croak);
5use Mojo::IOLoop;
6use Mojo::Transaction::WebSocket;
7use Mojo::URL;
8use Mojo::Util qw(term_escape);
9use Mojo::WebSocket qw(server_handshake);
10use Scalar::Util qw(weaken);
11
12use constant DEBUG => $ENV{MOJO_SERVER_DEBUG} || 0;
13
14has acceptors => sub { [] };
15has [qw(backlog max_clients silent)];
16has inactivity_timeout => sub { $ENV{MOJO_INACTIVITY_TIMEOUT} // 30 };
17has ioloop             => sub { Mojo::IOLoop->singleton };
18has keep_alive_timeout => sub { $ENV{MOJO_KEEP_ALIVE_TIMEOUT} // 5 };
19has listen             => sub { [split /,/, $ENV{MOJO_LISTEN} || 'http://*:3000'] };
20has max_requests       => 100;
21
22sub DESTROY {
23  my $self = shift;
24  return if ${^GLOBAL_PHASE} eq 'DESTRUCT';
25  my $loop = $self->ioloop;
26  $loop->remove($_) for keys %{$self->{connections} // {}}, @{$self->acceptors};
27}
28
29sub ports { [map { $_[0]->ioloop->acceptor($_)->port } @{$_[0]->acceptors}] }
30
31sub run {
32  my $self = shift;
33
34  # Make sure the event loop can be stopped in regular intervals
35  my $loop = $self->ioloop;
36  my $int  = $loop->recurring(1 => sub { });
37  local $SIG{INT} = local $SIG{TERM} = sub { $loop->stop };
38  $self->start->ioloop->start;
39  $loop->remove($int);
40}
41
42sub start {
43  my $self = shift;
44
45  my $loop = $self->ioloop;
46  if (my $max = $self->max_clients) { $loop->max_connections($max) }
47
48  # Resume accepting connections
49  if (my $servers = $self->{servers}) {
50    push @{$self->acceptors}, $loop->acceptor(delete $servers->{$_}) for keys %$servers;
51  }
52
53  # Start listening
54  elsif (!@{$self->acceptors}) {
55    $self->app->server($self);
56    $self->_listen($_) for @{$self->listen};
57  }
58
59  return $self;
60}
61
62sub stop {
63  my $self = shift;
64
65  # Suspend accepting connections but keep listen sockets open
66  my $loop = $self->ioloop;
67  while (my $id = shift @{$self->acceptors}) {
68    my $server = $self->{servers}{$id} = $loop->acceptor($id);
69    $loop->remove($id);
70    $server->stop;
71  }
72
73  return $self;
74}
75
76sub _build_tx {
77  my ($self, $id, $c) = @_;
78
79  my $tx = $self->build_tx->connection($id);
80  $tx->res->headers->server('Mojolicious (Perl)');
81  my $handle = $self->ioloop->stream($id)->timeout($self->inactivity_timeout)->handle;
82  unless ($handle->isa('IO::Socket::UNIX')) {
83    $tx->local_address($handle->sockhost)->local_port($handle->sockport);
84    $tx->remote_address($handle->peerhost)->remote_port($handle->peerport);
85  }
86  $tx->req->url->base->scheme('https') if $c->{tls};
87
88  weaken $self;
89  $tx->on(
90    request => sub {
91      my $tx = shift;
92
93      my $req = $tx->req;
94      if (my $error = $req->error) { $self->_trace($id, $error->{message}) }
95
96      # WebSocket
97      if ($req->is_handshake) {
98        my $ws = $self->{connections}{$id}{next} = Mojo::Transaction::WebSocket->new(handshake => $tx);
99        $self->emit(request => server_handshake $ws);
100      }
101
102      # HTTP
103      else { $self->emit(request => $tx) }
104
105      # Last keep-alive request or corrupted connection
106      my $c = $self->{connections}{$id};
107      $tx->res->headers->connection('close') if ($c->{requests} || 1) >= $self->max_requests || $req->error;
108
109      $tx->on(resume => sub { $self->_write($id) });
110      $self->_write($id);
111    }
112  );
113
114  # Kept alive if we have more than one request on the connection
115  return ++$c->{requests} > 1 ? $tx->kept_alive(1) : $tx;
116}
117
118sub _close {
119  my ($self, $id) = @_;
120  if (my $tx = $self->{connections}{$id}{tx}) { $tx->closed }
121  delete $self->{connections}{$id};
122}
123
124sub _trace { $_[0]->app->log->trace($_[2]) if $_[0]{connections}{$_[1]}{tx} }
125
126sub _finish {
127  my ($self, $id) = @_;
128
129  # Always remove connection for WebSockets
130  my $c = $self->{connections}{$id};
131  return unless my $tx = $c->{tx};
132  return $self->_remove($id) if $tx->is_websocket;
133
134  # Finish transaction
135  delete($c->{tx})->closed;
136
137  # Upgrade connection to WebSocket
138  if (my $ws = delete $c->{next}) {
139
140    # Successful upgrade
141    if ($ws->handshake->res->code == 101) {
142      $c->{tx} = $ws->established(1);
143      weaken $self;
144      $ws->on(resume => sub { $self->_write($id) });
145      $self->_write($id);
146    }
147
148    # Failed upgrade
149    else { $ws->closed }
150  }
151
152  # Close connection if necessary
153  return $self->_remove($id) if $tx->error || !$tx->keep_alive;
154
155  # Build new transaction for leftovers
156  if (length(my $leftovers = $tx->req->content->leftovers)) {
157    $tx = $c->{tx} = $self->_build_tx($id, $c);
158    $tx->server_read($leftovers);
159  }
160
161  # Keep-alive connection
162  $self->ioloop->stream($id)->timeout($self->keep_alive_timeout) unless $c->{tx};
163}
164
165sub _listen {
166  my ($self, $listen) = @_;
167
168  my $url   = Mojo::URL->new($listen);
169  my $proto = $url->protocol;
170  croak qq{Invalid listen location "$listen"} unless $proto eq 'http' || $proto eq 'https' || $proto eq 'http+unix';
171
172  my $query   = $url->query;
173  my $options = {backlog => $self->backlog};
174  $options->{$_} = $query->param($_) for qw(fd single_accept reuse);
175  if ($proto eq 'http+unix') { $options->{path} = $url->host }
176  else {
177    if ((my $host = $url->host) ne '*') { $options->{address} = $host }
178    if (my $port = $url->port) { $options->{port} = $port }
179  }
180
181  $options->{tls_ca} = $query->param('ca');
182  /^(.*)_(cert|key)$/ and $options->{"tls_$2"}{$1} = $query->param($_) for @{$query->names};
183  if (my $cert = $query->param('cert')) { $options->{tls_cert}{''} = $cert }
184  if (my $key  = $query->param('key'))  { $options->{tls_key}{''}  = $key }
185  my ($ciphers, $verify, $version) = ($query->param('ciphers'), $query->param('verify'), $query->param('version'));
186  $options->{tls_options}{SSL_cipher_list} = $ciphers    if defined $ciphers;
187  $options->{tls_options}{SSL_verify_mode} = hex $verify if defined $verify;
188  $options->{tls_options}{SSL_version}     = $version    if defined $version;
189  my $tls = $options->{tls} = $proto eq 'https';
190
191  weaken $self;
192  push @{$self->acceptors}, $self->ioloop->server(
193    $options => sub {
194      my ($loop, $stream, $id) = @_;
195
196      $self->{connections}{$id} = {tls => $tls};
197      warn "-- Accept $id (@{[$stream->handle->peerhost]})\n" if DEBUG;
198      $stream->timeout($self->inactivity_timeout);
199
200      $stream->on(close   => sub { $self && $self->_close($id) });
201      $stream->on(error   => sub { $self && $self->app->log->error(pop) && $self->_close($id) });
202      $stream->on(read    => sub { $self->_read($id => pop) });
203      $stream->on(timeout => sub { $self->_trace($id, 'Inactivity timeout') });
204    }
205  );
206
207  return if $self->silent;
208  $self->app->log->info(qq{Listening at "$url"});
209  $query->pairs([]);
210  $url->host('127.0.0.1')        if $url->host eq '*';
211  $url->port($self->ports->[-1]) if !$options->{path} && !$url->port;
212  say 'Web application available at ', $options->{path} // $url;
213}
214
215sub _read {
216  my ($self, $id, $chunk) = @_;
217
218  # Make sure we have a transaction
219  my $c  = $self->{connections}{$id};
220  my $tx = $c->{tx} ||= $self->_build_tx($id, $c);
221  warn term_escape "-- Server <<< Client (@{[_url($tx)]})\n$chunk\n" if DEBUG;
222  $tx->server_read($chunk);
223}
224
225sub _remove {
226  my ($self, $id) = @_;
227  $self->ioloop->remove($id);
228  $self->_close($id);
229}
230
231sub _url { shift->req->url->to_abs }
232
233sub _write {
234  my ($self, $id) = @_;
235
236  # Protect from resume event recursion
237  my $c = $self->{connections}{$id};
238  return if !(my $tx = $c->{tx}) || $c->{writing};
239  local $c->{writing} = 1;
240  my $chunk = $tx->server_write;
241  warn term_escape "-- Server >>> Client (@{[_url($tx)]})\n$chunk\n" if DEBUG;
242  my $next = $tx->is_finished ? '_finish' : length $chunk ? '_write' : undef;
243  return $self->ioloop->stream($id)->write($chunk) unless $next;
244  weaken $self;
245  $self->ioloop->stream($id)->write($chunk => sub { $self->$next($id) });
246}
247
2481;
249
250=encoding utf8
251
252=head1 NAME
253
254Mojo::Server::Daemon - Non-blocking I/O HTTP and WebSocket server
255
256=head1 SYNOPSIS
257
258  use Mojo::Server::Daemon;
259
260  my $daemon = Mojo::Server::Daemon->new(listen => ['http://*:8080']);
261  $daemon->unsubscribe('request')->on(request => sub ($daemon, $tx) {
262
263    # Request
264    my $method = $tx->req->method;
265    my $path   = $tx->req->url->path;
266
267    # Response
268    $tx->res->code(200);
269    $tx->res->headers->content_type('text/plain');
270    $tx->res->body("$method request for $path!");
271
272    # Resume transaction
273    $tx->resume;
274  });
275  $daemon->run;
276
277=head1 DESCRIPTION
278
279L<Mojo::Server::Daemon> is a full featured, highly portable non-blocking I/O HTTP and WebSocket server, with IPv6, TLS,
280SNI, Comet (long polling), keep-alive and multiple event loop support.
281
282For better scalability (epoll, kqueue) and to provide non-blocking name resolution, SOCKS5 as well as TLS support, the
283optional modules L<EV> (4.32+), L<Net::DNS::Native> (0.15+), L<IO::Socket::Socks> (0.64+) and L<IO::Socket::SSL>
284(2.009+) will be used automatically if possible. Individual features can also be disabled with the C<MOJO_NO_NNR>,
285C<MOJO_NO_SOCKS> and C<MOJO_NO_TLS> environment variables.
286
287See L<Mojolicious::Guides::Cookbook/"DEPLOYMENT"> for more.
288
289=head1 SIGNALS
290
291The L<Mojo::Server::Daemon> process can be controlled at runtime with the following signals.
292
293=head2 INT, TERM
294
295Shut down server immediately.
296
297=head1 EVENTS
298
299L<Mojo::Server::Daemon> inherits all events from L<Mojo::Server>.
300
301=head1 ATTRIBUTES
302
303L<Mojo::Server::Daemon> inherits all attributes from L<Mojo::Server> and implements the following new ones.
304
305=head2 acceptors
306
307  my $acceptors = $daemon->acceptors;
308  $daemon       = $daemon->acceptors(['6be0c140ef00a389c5d039536b56d139']);
309
310Active acceptor ids.
311
312  # Check port
313  mu $port = $daemon->ioloop->acceptor($daemon->acceptors->[0])->port;
314
315=head2 backlog
316
317  my $backlog = $daemon->backlog;
318  $daemon     = $daemon->backlog(128);
319
320Listen backlog size, defaults to C<SOMAXCONN>.
321
322=head2 inactivity_timeout
323
324  my $timeout = $daemon->inactivity_timeout;
325  $daemon     = $daemon->inactivity_timeout(5);
326
327Maximum amount of time in seconds a connection with an active request can be inactive before getting closed, defaults
328to the value of the C<MOJO_INACTIVITY_TIMEOUT> environment variable or C<30>. Setting the value to C<0> will allow
329connections to be inactive indefinitely.
330
331=head2 ioloop
332
333  my $loop = $daemon->ioloop;
334  $daemon  = $daemon->ioloop(Mojo::IOLoop->new);
335
336Event loop object to use for I/O operations, defaults to the global L<Mojo::IOLoop> singleton.
337
338=head2 keep_alive_timeout
339
340  my $timeout = $daemon->keep_alive_timeout;
341  $daemon     = $daemon->keep_alive_timeout(10);
342
343Maximum amount of time in seconds a connection without an active request can be inactive before getting closed,
344defaults to the value of the C<MOJO_KEEP_ALIVE_TIMEOUT> environment variable or C<5>. Setting the value to C<0> will
345allow connections to be inactive indefinitely.
346
347=head2 listen
348
349  my $listen = $daemon->listen;
350  $daemon    = $daemon->listen(['https://127.0.0.1:8080']);
351
352Array reference with one or more locations to listen on, defaults to the value of the C<MOJO_LISTEN> environment
353variable or C<http://*:3000> (shortcut for C<http://0.0.0.0:3000>).
354
355  # Listen on all IPv4 interfaces
356  $daemon->listen(['http://*:3000']);
357
358  # Listen on all IPv4 and IPv6 interfaces
359  $daemon->listen(['http://[::]:3000']);
360
361  # Listen on IPv6 interface
362  $daemon->listen(['http://[::1]:4000']);
363
364  # Listen on IPv4 and IPv6 interfaces
365  $daemon->listen(['http://127.0.0.1:3000', 'http://[::1]:3000']);
366
367  # Listen on UNIX domain socket "/tmp/myapp.sock" (percent encoded slash)
368  $daemon->listen(['http+unix://%2Ftmp%2Fmyapp.sock']);
369
370  # File descriptor, as used by systemd
371  $daemon->listen(['http://127.0.0.1?fd=3']);
372
373  # Allow multiple servers to use the same port (SO_REUSEPORT)
374  $daemon->listen(['http://*:8080?reuse=1']);
375
376  # Listen on two ports with HTTP and HTTPS at the same time
377  $daemon->listen(['http://*:3000', 'https://*:4000']);
378
379  # Use a custom certificate and key
380  $daemon->listen(['https://*:3000?cert=/x/server.crt&key=/y/server.key']);
381
382  # Domain specific certificates and keys (SNI)
383  $daemon->listen(
384    ['https://*:3000?example.com_cert=/x/my.crt&example.com_key=/y/my.key']);
385
386  # Or even a custom certificate authority
387  $daemon->listen(
388    ['https://*:3000?cert=/x/server.crt&key=/y/server.key&ca=/z/ca.crt']);
389
390These parameters are currently available:
391
392=over 2
393
394=item ca
395
396  ca=/etc/tls/ca.crt
397
398Path to TLS certificate authority file used to verify the peer certificate.
399
400=item cert
401
402  cert=/etc/tls/server.crt
403  mojolicious.org_cert=/etc/tls/mojo.crt
404
405Path to the TLS cert file, defaults to a built-in test certificate.
406
407=item ciphers
408
409  ciphers=AES128-GCM-SHA256:RC4:HIGH:!MD5:!aNULL:!EDH
410
411TLS cipher specification string. For more information about the format see
412L<https://www.openssl.org/docs/manmaster/man1/ciphers.html#CIPHER-STRINGS>.
413
414=item fd
415
416  fd=3
417
418File descriptor with an already prepared listen socket.
419
420=item key
421
422  key=/etc/tls/server.key
423  mojolicious.org_key=/etc/tls/mojo.key
424
425Path to the TLS key file, defaults to a built-in test key.
426
427=item reuse
428
429  reuse=1
430
431Allow multiple servers to use the same port with the C<SO_REUSEPORT> socket option.
432
433=item single_accept
434
435  single_accept=1
436
437Only accept one connection at a time.
438
439=item verify
440
441  verify=0x00
442
443TLS verification mode.
444
445=item version
446
447  version=TLSv1_2
448
449TLS protocol version.
450
451=back
452
453=head2 max_clients
454
455  my $max = $daemon->max_clients;
456  $daemon = $daemon->max_clients(100);
457
458Maximum number of accepted connections this server is allowed to handle concurrently, before stopping to accept new
459incoming connections, passed along to L<Mojo::IOLoop/"max_connections">.
460
461=head2 max_requests
462
463  my $max = $daemon->max_requests;
464  $daemon = $daemon->max_requests(250);
465
466Maximum number of keep-alive requests per connection, defaults to C<100>.
467
468=head2 silent
469
470  my $bool = $daemon->silent;
471  $daemon  = $daemon->silent($bool);
472
473Disable console messages.
474
475=head1 METHODS
476
477L<Mojo::Server::Daemon> inherits all methods from L<Mojo::Server> and implements the following new ones.
478
479=head2 ports
480
481  my $ports = $daemon->ports;
482
483Get all ports this server is currently listening on.
484
485  # All ports
486  say for @{$daemon->ports};
487
488=head2 run
489
490  $daemon->run;
491
492Run server and wait for L</"SIGNALS">.
493
494=head2 start
495
496  $daemon = $daemon->start;
497
498Start or resume accepting connections through L</"ioloop">.
499
500  # Listen on random port
501  my $port = $daemon->listen(['http://127.0.0.1'])->start->ports->[0];
502
503  # Run multiple web servers concurrently
504  my $daemon1 = Mojo::Server::Daemon->new(listen => ['http://*:3000'])->start;
505  my $daemon2 = Mojo::Server::Daemon->new(listen => ['http://*:4000'])->start;
506  Mojo::IOLoop->start unless Mojo::IOLoop->is_running;
507
508=head2 stop
509
510  $daemon = $daemon->stop;
511
512Stop accepting connections through L</"ioloop">.
513
514=head1 DEBUGGING
515
516You can set the C<MOJO_SERVER_DEBUG> environment variable to get some advanced diagnostics information printed to
517C<STDERR>.
518
519  MOJO_SERVER_DEBUG=1
520
521=head1 SEE ALSO
522
523L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
524
525=cut
526