File Coverage

blib/lib/Feersum/Runner.pm
Criterion Covered Total %
statement 222 578 38.4
branch 90 364 24.7
condition 21 157 13.3
subroutine 35 56 62.5
pod 4 4 100.0
total 372 1159 32.1


line stmt bran cond sub pod time code
1             package Feersum::Runner;
2 10     10   1830528 use warnings;
  10         46  
  10         712  
3 10     10   59 use strict;
  10         19  
  10         300  
4              
5 10     10   4360 use EV;
  10         17419  
  10         297  
6 10     10   4473 use Feersum;
  10         56  
  10         501  
7 10         1311 use Socket qw/SOMAXCONN SOL_SOCKET SO_REUSEADDR AF_INET SOCK_STREAM
8 10     10   52 inet_aton pack_sockaddr_in/;
  10         15  
9             BEGIN {
10             # IPv6 support (Socket 1.95+, Perl 5.14+)
11 10         241 eval { Socket->import(qw/AF_INET6 inet_pton pack_sockaddr_in6/); 1 }
  10         472  
12 10 50   10   23 or do {
13 0         0 *AF_INET6 = sub () { undef };
14 0         0 *inet_pton = sub { undef };
  0         0  
15 0         0 *pack_sockaddr_in6 = sub { undef };
  0         0  
16             };
17             }
18             BEGIN {
19             # SO_REUSEPORT may not be available on all systems
20 10         202 eval { Socket->import('SO_REUSEPORT'); 1 }
  10         227  
21 10 50   10   20 or *SO_REUSEPORT = sub () { undef };
22             }
23 10     10   4838 use POSIX ();
  10         57664  
  10         292  
24 10     10   51 use Scalar::Util qw/weaken/;
  10         16  
  10         416  
25 10     10   416 use Guard ();
  10         525  
  10         190  
26 10     10   33 use Carp qw/carp croak/;
  10         9  
  10         369  
27 10     10   1646 use File::Spec::Functions 'rel2abs';
  10         2682  
  10         438  
28              
29 10     10   41 use constant DEATH_TIMER => 5.0; # seconds
  10         14  
  10         647  
30 10     10   41 use constant DEATH_TIMER_INCR => 2.0; # seconds
  10         14  
  10         373  
31 10     10   37 use constant DEFAULT_HOST => 'localhost';
  10         14  
  10         319  
32 10     10   39 use constant DEFAULT_PORT => 5000;
  10         12  
  10         535  
33 10   50 10   40 use constant MAX_PRE_FORK => $ENV{FEERSUM_MAX_PRE_FORK} || 1000;
  10         45  
  10         63105  
34              
35             our $INSTANCE;
36             sub new { ## no critic (RequireArgUnpacking)
37 22     22 1 22038 my $c = shift;
38 22 100       445 if ($INSTANCE) {
39             croak "Only one Feersum::Runner instance can be active at a time"
40 2 50       8 if $INSTANCE->{running};
41             # Clean up old instance state before creating new one
42 2         7 $INSTANCE->_cleanup();
43 2         5 undef $INSTANCE;
44             }
45 22         727 $INSTANCE = bless {quiet=>1, @_, running=>0}, $c;
46 22         190 return $INSTANCE;
47             }
48              
49             sub _cleanup {
50 23     23   45 my $self = shift;
51 23 100       86 return if $self->{_cleaned_up};
52 21         69 $self->{_cleaned_up} = 1;
53 21 100       92 if (my $f = $self->{endjinn}) {
54 6     0   102 $f->request_handler(sub{});
55 6         79 $f->unlisten();
56             }
57 21         84 $self->{_quit} = undef;
58 21         138 $self->{running} = 0;
59 21 50       115 if (my $file = $self->{pid_file}) {
60 0 0       0 unlink $file if -f $file;
61             }
62 21         186 return;
63             }
64              
65             sub DESTROY {
66 18     18   10939 local $@;
67 18         40 $_[0]->_cleanup();
68             }
69              
70             sub _create_socket {
71 14     14   34 my ($self, $listen, $use_reuseport) = @_;
72 14   50     154 my $backlog = $self->{backlog} || SOMAXCONN;
73              
74 14         44 my $sock;
75 14 50       188 if ($listen =~ m#^[/\.]+\w#) {
76 0         0 require IO::Socket::UNIX;
77 0 0       0 if (-S $listen) {
78 0 0       0 unlink $listen or carp "unlink stale socket '$listen': $!";
79             }
80 0         0 my $saved = umask(0);
81 0         0 $sock = eval {
82 0         0 IO::Socket::UNIX->new(
83             Local => rel2abs($listen),
84             Listen => $backlog,
85             );
86             };
87 0         0 my $err = $@;
88 0         0 umask($saved); # Restore umask even if socket creation failed
89 0 0       0 die $err if $err;
90 0 0       0 croak "couldn't bind to socket" unless $sock;
91 0 0       0 $sock->blocking(0) || do { close($sock); croak "couldn't unblock socket: $!"; };
  0         0  
  0         0  
92             }
93             else {
94 14         248 require IO::Socket::INET;
95             # SO_REUSEPORT must be set BEFORE bind for multiple sockets per port
96 14 50 33     97 if ($use_reuseport && defined SO_REUSEPORT) {
97             # Parse listen address - handle IPv6 bracketed notation [host]:port
98 0         0 my ($host, $port, $is_ipv6);
99 0 0       0 if ($listen =~ /^\[([^\]]+)\]:(\d*)$/) {
    0          
    0          
100             # IPv6 with port: [::1]:8080
101 0   0     0 ($host, $port, $is_ipv6) = ($1, $2 || 0, 1);
102             } elsif ($listen =~ /^\[([^\]]+)\]$/) {
103             # IPv6 without port: [::1]
104 0         0 ($host, $port, $is_ipv6) = ($1, 0, 1);
105             } elsif ($listen =~ /:.*:/) {
106             # Bare IPv6 - reject ambiguous cases that look like host:port
107 0 0       0 if ($listen =~ /:(\d{1,5})$/) {
108 0         0 my $maybe_port = $1;
109             # 5 digits = definitely a port; >=1024 = likely a port
110 0 0 0     0 if ($maybe_port <= 65535 && (length($maybe_port) == 5 || $maybe_port >= 1024)) {
      0        
111 0         0 croak "ambiguous IPv6 address '$listen': use bracket notation [host]:port " .
112             "(e.g., [::1]:$maybe_port or [2001:db8::1]:$maybe_port)";
113             }
114             }
115 0         0 ($host, $port, $is_ipv6) = ($listen, 0, 1);
116             } else {
117             # IPv4: host:port
118 0         0 ($host, $port) = split /:/, $listen, 2;
119 0   0     0 $host ||= '0.0.0.0';
120 0   0     0 $port ||= 0;
121 0         0 $is_ipv6 = 0;
122             }
123              
124             # Validate port range (0-65535)
125 0 0 0     0 if ($port !~ /^\d+$/ || $port > 65535) {
126 0         0 croak "invalid port '$port': must be 0-65535";
127             }
128              
129 0         0 my ($domain, $sockaddr);
130 0 0       0 if ($is_ipv6) {
131 0 0       0 defined AF_INET6()
132             or croak "IPv6 not supported on this system";
133 0 0       0 my $addr = inet_pton(AF_INET6(), $host)
134             or croak "couldn't resolve IPv6 address '$host'";
135 0         0 $domain = AF_INET6();
136 0         0 $sockaddr = pack_sockaddr_in6($port, $addr);
137             } else {
138 0 0       0 my $addr = inet_aton($host)
139             or croak "couldn't resolve address '$host'";
140 0         0 $domain = AF_INET();
141 0         0 $sockaddr = pack_sockaddr_in($port, $addr);
142             }
143              
144             # Create socket with correct address family
145 0 0       0 socket($sock, $domain, SOCK_STREAM(), 0)
146             or croak "couldn't create socket: $!";
147             setsockopt($sock, SOL_SOCKET, SO_REUSEADDR, pack("i", 1))
148 0 0       0 or do { close($sock); croak "setsockopt SO_REUSEADDR failed: $!"; };
  0         0  
  0         0  
149             setsockopt($sock, SOL_SOCKET, SO_REUSEPORT, pack("i", 1))
150 0 0       0 or do { close($sock); croak "setsockopt SO_REUSEPORT failed: $!"; };
  0         0  
  0         0  
151             bind($sock, $sockaddr)
152 0 0       0 or do { close($sock); croak "couldn't bind to socket: $!"; };
  0         0  
  0         0  
153             listen($sock, $backlog)
154 0 0       0 or do { close($sock); croak "couldn't listen: $!"; };
  0         0  
  0         0  
155              
156             # Wrap in IO::Handle for ->blocking() method
157 0         0 require IO::Handle;
158 0         0 bless $sock, 'IO::Handle';
159             $sock->blocking(0)
160 0 0       0 || do { close($sock); croak "couldn't unblock socket: $!"; };
  0         0  
  0         0  
161             }
162             else {
163             # Validate port in listen address for better error messages
164 14 50       102 if ($listen =~ /:(\d+)$/) {
    0          
165 14         165 my $port = $1;
166 14 50       50 croak "invalid port '$port': must be 0-65535" if $port > 65535;
167             } elsif ($listen =~ /:(\S+)$/) {
168 0         0 my $port = $1;
169 0 0       0 croak "invalid port '$port': must be numeric" unless $port =~ /^\d+$/;
170             }
171 14         313 $sock = IO::Socket::INET->new(
172             LocalAddr => $listen,
173             ReuseAddr => 1,
174             Proto => 'tcp',
175             Listen => $backlog,
176             Blocking => 0,
177             );
178 14 50       11171 croak "couldn't bind to socket: $!" unless $sock;
179             }
180             }
181 14         80 return $sock;
182             }
183              
184             sub _extract_options {
185 3     3   55 my $self = shift;
186 3 50       138 if (my $opts = $self->{options}) {
187 0         0 $self->{$_} = delete $opts->{$_} for grep defined($opts->{$_}),
188             qw/pre_fork preload_app keepalive backlog hot_restart graceful_timeout startup_timeout
189             after_fork pid_file daemonize user group max_requests_per_worker access_log
190             read_timeout header_timeout write_timeout max_connection_reqs reuseport epoll_exclusive
191             read_priority write_priority accept_priority max_accept_per_loop max_connections
192             max_read_buf max_body_len max_uri_len wbuf_low_water max_h2_concurrent_streams
193             reverse_proxy proxy_protocol psgix_io h2 tls tls_cert_file tls_key_file sni/;
194 0         0 for my $unknown (keys %$opts) {
195 0         0 carp "Unknown option '$unknown' ignored";
196             }
197             }
198             }
199              
200             # Option name -> Feersum setter method. Used by both _prepare (cold start,
201             # consumes from $self) and _apply_settings (hot_restart child, preserves
202             # $self). Adding a new "set this value if defined" setting in one place but
203             # not the other would silently break hot_restart workers, so both paths
204             # iterate the same list.
205             my @SIMPLE_SETTINGS = (
206             [keepalive => 'set_keepalive'],
207             [reverse_proxy => 'set_reverse_proxy'],
208             [proxy_protocol => 'set_proxy_protocol'],
209             [psgix_io => 'set_psgix_io'],
210             [read_timeout => 'read_timeout'],
211             [header_timeout => 'header_timeout'],
212             [write_timeout => 'write_timeout'],
213             [max_connection_reqs => 'max_connection_reqs'],
214             [read_priority => 'read_priority'],
215             [write_priority => 'write_priority'],
216             [accept_priority => 'accept_priority'],
217             [max_accept_per_loop => 'max_accept_per_loop'],
218             [max_connections => 'max_connections'],
219             [max_read_buf => 'max_read_buf'],
220             [max_body_len => 'max_body_len'],
221             [max_uri_len => 'max_uri_len'],
222             [wbuf_low_water => 'wbuf_low_water'],
223             );
224              
225             # Walk @SIMPLE_SETTINGS plus the can()-gated extras. $consume=1 deletes from
226             # $self after applying (cold-start path); $consume=0 leaves $self intact
227             # (hot_restart child re-applying preserved config from master).
228             sub _apply_simple_settings {
229 10     10   20 my ($self, $f, $consume) = @_;
230 10         57 for my $pair (@SIMPLE_SETTINGS) {
231 170         309 my ($opt, $meth) = @$pair;
232 170 50       272 my $val = $consume ? delete $self->{$opt} : $self->{$opt};
233 170 100       351 $f->$meth($val) if defined $val;
234             }
235 10 50       153 if ($f->can('max_h2_concurrent_streams')) {
236             my $v = $consume ? delete $self->{max_h2_concurrent_streams}
237 10 50       26 : $self->{max_h2_concurrent_streams};
238 10 50       24 $f->max_h2_concurrent_streams($v) if defined $v;
239             }
240             }
241              
242             # Install the periodic watcher that triggers graceful shutdown once the
243             # worker has served max_requests_per_worker requests. Returns the watcher
244             # SV; caller must keep the reference alive (a my-scoped lexical works).
245             # Used by both the non-prefork hot_restart generation and pre_fork workers.
246             sub _install_max_requests_watcher {
247 0     0   0 my ($self, $f) = @_;
248 0 0       0 my $max = $self->{max_requests_per_worker} or return;
249 0         0 my $w; $w = EV::timer(1, 1, sub {
250 0 0   0   0 if ($f->total_requests >= $max) {
251 0         0 $f->graceful_shutdown(sub { POSIX::_exit(0) });
  0         0  
252 0         0 undef $w;
253             }
254 0         0 });
255 0         0 return $w;
256             }
257              
258             sub _apply_tls_to_listeners {
259 0     0   0 my ($self, $f, $n_listeners, $tls, $sni) = @_;
260 0         0 for my $i (0 .. $n_listeners - 1) {
261 0         0 $f->set_tls(listener => $i, %$tls);
262             }
263 0 0       0 if ($sni) {
264 0 0       0 croak "sni must be an array reference" unless ref $sni eq 'ARRAY';
265 0         0 for my $entry (@$sni) {
266 0         0 for my $i (0 .. $n_listeners - 1) {
267 0         0 $f->set_tls(listener => $i, %$entry);
268             }
269             }
270             }
271             }
272              
273             sub _normalize_listen {
274 13     13   87 my $self = shift;
275 13 50 33     176 if (defined $self->{listen} && !ref $self->{listen}) {
276 0         0 $self->{listen} = [ $self->{listen} ];
277             }
278             $self->{listen} ||=
279 13   0     58 [ ($self->{host}||DEFAULT_HOST).':'.($self->{port}||DEFAULT_PORT) ];
      0        
      50        
280             croak "listen must be an array reference"
281 13 50       55 if ref $self->{listen} ne 'ARRAY';
282             croak "listen array cannot be empty"
283 13 50       34 if @{$self->{listen}} == 0;
  13         103  
284 13         55 $self->{_listen_addrs} = [ @{$self->{listen}} ];
  13         94  
285             }
286              
287             # Fold the flat tls_cert_file/tls_key_file shorthand and the top-level h2 flag
288             # into $self->{tls} (a hashref), in place, and validate. Shared by the
289             # cold-start _prepare path and the hot_restart master so that generation
290             # children - which apply TLS via _apply_settings, not _prepare - get identical
291             # TLS/H2 configuration. Does NOT consume $self->{tls} (hot_restart re-reads it
292             # for each generation).
293             sub _normalize_tls_config {
294 13     13   29 my $self = shift;
295 13 100       38 if (!$self->{tls}) {
296 10 100       35 if (my $cert = delete $self->{tls_cert_file}) {
    100          
297             my $key = delete $self->{tls_key_file}
298 2 100       141 or croak "tls_cert_file requires tls_key_file";
299 1         3 $self->{tls} = { cert_file => $cert, key_file => $key };
300             } elsif (delete $self->{tls_key_file}) {
301 1         96 croak "tls_key_file requires tls_cert_file";
302             }
303             } else {
304             # tls hash takes precedence; discard flat options
305 3         5 delete $self->{tls_cert_file};
306 3         5 delete $self->{tls_key_file};
307             }
308 11 100       29 if (my $tls = $self->{tls}) {
    100          
309 4 50       12 croak "tls must be a hash reference" unless ref $tls eq 'HASH';
310 4 50       9 croak "tls requires cert_file" unless $tls->{cert_file};
311 4 50       6 croak "tls requires key_file" unless $tls->{key_file};
312             # H2 is off by default; only enable if h2 => 1 was passed
313 4 100       10 $tls->{h2} = 1 if delete $self->{h2};
314             } elsif (delete $self->{h2}) {
315 1         86 croak "h2 requires TLS (provide tls_cert_file and tls_key_file, or a tls hash)";
316             }
317 10         15 return;
318             }
319              
320             sub _prepare {
321 13     13   40 my $self = shift;
322              
323 13         147 $self->_normalize_listen();
324              
325             # Validate pre_fork early (before socket creation) to fail fast
326 13 100       30 if ($self->{pre_fork}) {
327 3         6 my $n = $self->{pre_fork};
328 3 50 33     350 if ($n !~ /^\d+$/ || $n < 1) {
329 0         0 croak "pre_fork must be a positive integer";
330             }
331 3 50       39 if ($n > MAX_PRE_FORK) {
332 0         0 croak "pre_fork=$n exceeds maximum of " . MAX_PRE_FORK;
333             }
334             }
335              
336             # Enable reuseport automatically in prefork mode if SO_REUSEPORT available
337 13   0     50 my $use_reuseport = $self->{reuseport} && $self->{pre_fork} && defined SO_REUSEPORT;
338 13         56 $self->{_use_reuseport} = $use_reuseport;
339              
340 13         277 my $f = Feersum->endjinn;
341              
342             # EPOLLEXCLUSIVE must be set BEFORE use_socket() so the separate accept epoll
343             # is created with EPOLLEXCLUSIVE flag (Linux 4.5+)
344 13 50 66     182 if ($self->{epoll_exclusive} && $self->{pre_fork} && $^O eq 'linux') {
      33        
345 2         152 $f->set_epoll_exclusive(1);
346             }
347              
348 13         21 my @socks;
349 13         16 for my $listen (@{$self->{_listen_addrs}}) {
  13         45  
350 14         68 my $sock = $self->_create_socket($listen, $use_reuseport);
351 14         50 push @socks, $sock;
352 14         66 $f->use_socket($sock);
353             }
354 13         29 $self->{sock} = $socks[0]; # backward compat: primary socket
355 13         36 $self->{_socks} = \@socks; # all sockets
356              
357             # Validate priorities (-2..+2 per libev) before applying
358 13         22 for my $prio_name (qw/read_priority write_priority accept_priority/) {
359 36         67 my $val = $self->{$prio_name};
360 36 100       61 next unless defined $val;
361 5 50       24 croak "$prio_name must be an integer" unless $val =~ /^-?\d+$/;
362 5 100 100     374 croak "$prio_name must be between -2 and 2" if $val < -2 || $val > 2;
363             }
364 10 50       88 if (defined(my $val = $self->{max_accept_per_loop})) {
365 0 0 0     0 croak "max_accept_per_loop must be a positive integer"
366             unless $val =~ /^\d+$/ && $val > 0;
367             }
368 10 50       38 if (defined(my $val = $self->{max_connections})) {
369 0 0       0 croak "max_connections must be a non-negative integer"
370             unless $val =~ /^\d+$/;
371             }
372 10         34 $self->_apply_simple_settings($f, 1); # consume from $self
373              
374             # Fold flat tls_cert_file/tls_key_file shorthand + h2 into $self->{tls}
375             # (also used by the hot_restart master via _normalize_tls_config).
376 10         29 $self->_normalize_tls_config;
377              
378             # TLS configuration: apply to all listeners
379 8 100       21 if (my $tls = delete $self->{tls}) {
380 2 50 33     302 -f $tls->{cert_file} && -r _
381             or croak "tls cert_file '$tls->{cert_file}': not found or not readable";
382 0 0 0     0 -f $tls->{key_file} && -r _
383             or croak "tls key_file '$tls->{key_file}': not found or not readable";
384              
385 0 0       0 if ($f->has_tls()) {
386 0         0 $self->_apply_tls_to_listeners($f, scalar(@socks), $tls, $self->{sni});
387 0         0 $self->{_tls_config} = $tls; # for reuseport workers
388 0 0       0 $self->{quiet} or warn "Feersum [$$]: TLS enabled on "
389             . scalar(@socks) . " listener(s)\n";
390             } else {
391 0         0 croak "tls option requires Feersum compiled with TLS support (need picotls submodule + OpenSSL; see Alien::OpenSSL)";
392             }
393             }
394              
395 6         42 $self->{endjinn} = $f;
396 6         23 return;
397             }
398              
399             # for overriding:
400             sub assign_request_handler {
401 3     3 1 34 my ($self, $app) = @_;
402 3 50       14 if (my $log_cb = $self->{access_log}) {
403 0         0 my $orig = $app;
404             $app = sub {
405 0     0   0 my $r = shift;
406 0         0 my $t0 = EV::now();
407 0         0 my $method = $r->method;
408 0         0 my $uri = $r->uri;
409             $r->response_guard(Guard::guard(sub {
410 0         0 $log_cb->($method, $uri, EV::now() - $t0);
411 0         0 }));
412 0         0 $orig->($r);
413 0         0 };
414             }
415 3         31 return $self->{endjinn}->request_handler($app);
416             }
417              
418             sub run {
419 3     3 1 207 my $self = shift;
420 3         112 weaken $self;
421              
422 3         203 $self->{running} = 1;
423 3   33     575 my $app = shift || $self->{app};
424 3 50       158 $self->{quiet} or warn "Feersum [$$]: starting...\n";
425              
426 3         193 $self->_extract_options();
427              
428             # Hot restart mode: entry process creates sockets, then manages
429             # generation children that each load a fresh app with clean modules.
430 3 50       95 if ($self->{hot_restart}) {
431 0 0       0 croak "hot_restart requires app_file" unless $self->{app_file};
432 0         0 $self->_daemonize_and_write_pid();
433 0         0 $self->_run_hot_restart_master(); # creates sockets, then drops privs
434 0         0 return;
435             }
436              
437 3         147 $self->_prepare(); # bind() on listen sockets
438 3         107 $self->_daemonize_and_write_pid();
439 3         26 $self->_drop_privs(); # after bind, before app load
440              
441             # preload_app => 0: fork workers first, each loads the app independently.
442             # Default (preload_app unset or true): load app once, fork inherits via COW.
443 3 50 33     51 if ($self->{pre_fork} && defined $self->{preload_app} && !$self->{preload_app}) {
      33        
444             $self->{_app_loader} = sub {
445 0   0 0   0 my $a = $app || $self->{app};
446 0 0 0     0 if (!$a && $self->{app_file}) {
447 0         0 local ($@, $!);
448 0         0 $a = do(rel2abs($self->{app_file}));
449 0 0 0     0 warn "couldn't load $self->{app_file}: " . ($@ || $!) if $@ || !$a;
      0        
450             }
451 0 0       0 croak "app not defined or failed to compile" unless $a;
452 0         0 $self->assign_request_handler($a);
453 0         0 };
454             # Set a no-op handler on parent so it doesn't crash if it briefly
455             # re-accepts during non-reuseport worker respawn
456             $self->{endjinn}->request_handler(sub {
457 0     0   0 $_[0]->send_response(503, ['Content-Type'=>'text/plain'], \"Service Unavailable\n");
458 0         0 });
459 0 0   0   0 $self->{_quit} = EV::signal 'QUIT', sub { $self && $self->quit };
  0         0  
460 0         0 $self->_start_pre_fork;
461             } else {
462 3   33     61 $app ||= delete $self->{app};
463 3 50 33     76 if (!$app && $self->{app_file}) {
464 3         138 local ($@, $!);
465 3         81 $app = do(rel2abs($self->{app_file}));
466 3 50       14 warn "couldn't parse $self->{app_file}: $@" if $@;
467 3 50 33     27 warn "couldn't do $self->{app_file}: $!" if ($! && !defined $app);
468 3 50       32 warn "couldn't run $self->{app_file}: didn't return anything"
469             unless $app;
470             }
471 3 50       7 croak "app not defined or failed to compile" unless $app;
472              
473 3         14 $self->assign_request_handler($app);
474              
475 3 50   6   271 $self->{_quit} = EV::signal 'QUIT', sub { $self && $self->quit };
  6         359  
476              
477 3 50       40 $self->_start_pre_fork if $self->{pre_fork};
478             }
479 3         29353389 EV::run;
480 3 50       14 $self->{quiet} or warn "Feersum [$$]: done\n";
481 3         54 $self->_cleanup();
482 3         202 return;
483             }
484              
485             # Hot restart master: creates sockets once, then manages generations.
486             # Each generation is a forked child that runs _apply_settings + app load + serve.
487             # SIGHUP -> fork new gen -> if ready -> SIGQUIT old gen.
488             sub _run_hot_restart_master {
489 0     0   0 my ($self) = @_;
490 0         0 my $quiet = $self->{quiet};
491              
492 0 0       0 $quiet or warn "Feersum [$$]: hot restart master starting\n";
493              
494 0         0 $self->_normalize_listen();
495             # Fold flat TLS keys + h2 into $self->{tls} once, here in the master, so
496             # every generation child's _apply_settings sees the complete TLS/H2 config
497             # (these children never run _prepare, which is where folding otherwise
498             # happens). Without this, hot_restart silently drops flat tls_cert_file/
499             # tls_key_file and the h2 flag.
500 0         0 $self->_normalize_tls_config();
501              
502             # Create listen sockets in the master (shared across generations via fork).
503             # Use SO_REUSEPORT if configured - reuseport workers need all sockets
504             # on the same addr:port to have the flag set.
505 0   0     0 $self->{_listen_addrs} ||= [ @{$self->{listen}} ];
  0         0  
506 0   0     0 my $use_reuseport = $self->{reuseport} && $self->{pre_fork} && defined SO_REUSEPORT;
507 0         0 my @socks;
508 0         0 for my $listen (@{$self->{_listen_addrs}}) {
  0         0  
509 0         0 my $sock = $self->_create_socket($listen, $use_reuseport);
510 0         0 push @socks, $sock;
511             }
512 0         0 $self->{_master_socks} = \@socks;
513              
514             # Drop privileges after sockets are bound (privileged ports are now open)
515 0         0 $self->_drop_privs();
516              
517 0         0 my $gen = 0;
518 0         0 my $current_pid;
519             my $pending_pid; # generation being started (not yet $current_pid)
520 0         0 my $shutting_down = 0;
521 0   0     0 my $startup_timeout = $self->{startup_timeout} // 10;
522              
523             # Fork a generation child. The child inherits listen sockets via fork,
524             # registers them with use_socket, then calls _apply_settings (which
525             # applies TLS and other settings without consuming from $self), loads the
526             # app file fresh, then serves.
527             my $fork_generation = sub {
528 0     0   0 $gen++;
529 0         0 my $pid = fork;
530 0 0       0 croak "fork generation: $!" unless defined $pid;
531              
532 0 0       0 if ($pid == 0) {
533             # === Generation child ===
534 0         0 EV::default_loop()->loop_fork;
535 0 0       0 $quiet or warn "Feersum [$$]: gen $gen loading app\n";
536              
537             # Sockets were created in the master and inherited via fork -
538             # register them with this generation's Feersum instance.
539 0         0 my $f = Feersum->endjinn;
540             # EPOLLEXCLUSIVE must be set BEFORE use_socket() so each accept
541             # watcher is created with it (mirrors _prepare); otherwise
542             # non-reuseport hot_restart workers inherit plain accept watchers
543             # and lose the thundering-herd mitigation.
544 0 0 0     0 if ($self->{epoll_exclusive} && $self->{pre_fork} && $^O eq 'linux'
      0        
      0        
545             && $f->can('set_epoll_exclusive')) {
546 0         0 $f->set_epoll_exclusive(1);
547             }
548 0         0 for my $sock (@socks) {
549 0         0 $f->use_socket($sock);
550             }
551 0         0 $self->{_socks} = \@socks;
552 0         0 $self->{sock} = $socks[0];
553              
554             # Apply server settings (preserved in $self for later generations)
555 0         0 $self->_apply_settings($f);
556              
557             # Load app fresh (fork gave us clean copy-on-write memory)
558 0         0 my $app_file = rel2abs($self->{app_file});
559 0         0 local ($@, $!);
560 0         0 my $app = do $app_file;
561 0 0 0     0 if ($@ || !$app || ref $app ne 'CODE') {
      0        
562 0   0     0 warn "Feersum [$$]: gen $gen: failed to load $app_file: "
563             . ($@ || $! || "not a coderef") . "\n";
564 0         0 POSIX::_exit(1);
565             }
566              
567 0         0 $self->{endjinn} = $f;
568 0         0 $self->assign_request_handler($app);
569              
570 0         0 my ($quit_w, $death_w);
571             $quit_w = EV::signal 'QUIT', sub {
572 0 0       0 if ($self->{pre_fork}) {
573 0         0 kill POSIX::SIGQUIT, -$$;
574             }
575 0         0 $f->graceful_shutdown(sub { POSIX::_exit(0) });
  0         0  
576             my $gt = $self->{graceful_timeout}
577             // $ENV{FEERSUM_GRACEFUL_TIMEOUT}
578 0   0     0 // DEATH_TIMER;
      0        
579             $death_w = EV::timer($gt + DEATH_TIMER_INCR, 0, sub {
580 0         0 POSIX::_exit(1);
581 0         0 });
582 0         0 };
583              
584 0 0       0 if ($self->{pre_fork}) {
585 0         0 $f->set_multiprocess(1);
586             # Set reuseport flag for _fork_another workers
587             $self->{_use_reuseport} = $self->{reuseport}
588 0   0     0 && $self->{pre_fork} && defined SO_REUSEPORT;
589             # (epoll_exclusive already set before use_socket above)
590 0 0       0 POSIX::setsid() or warn "Feersum [$$]: setsid failed: $!\n";
591 0         0 $self->{_kids} = [];
592 0         0 $self->{_n_kids} = 0;
593 0         0 $self->_fork_another($_) for (1 .. $self->{pre_fork});
594 0         0 $f->unlisten(); # parent of workers doesn't accept
595             }
596              
597 0         0 my $mrw;
598 0 0       0 if (!$self->{pre_fork}) {
599 0 0       0 $self->{after_fork}->() if $self->{after_fork};
600 0         0 $mrw = $self->_install_max_requests_watcher($f);
601             }
602              
603             # Signal master: ready to serve (after workers are forked)
604 0         0 kill 'USR2', getppid();
605              
606             $quiet or warn "Feersum [$$]: gen $gen ready"
607 0 0       0 . ($self->{pre_fork} ? " ($self->{pre_fork} workers)" : "") . "\n";
    0          
608 0         0 EV::run;
609 0         0 POSIX::_exit(0);
610             }
611              
612 0         0 return $pid;
613 0         0 };
614              
615             # Fork first generation
616 0         0 $pending_pid = $fork_generation->();
617 0 0       0 unless (_wait_for_ready($pending_pid, $quiet, $gen, \$shutting_down, $startup_timeout)) {
618 0 0       0 kill 'KILL', $pending_pid if kill(0, $pending_pid);
619 0         0 waitpid($pending_pid, 0);
620 0         0 croak "first generation failed to start";
621             }
622 0         0 $current_pid = $pending_pid;
623 0         0 $pending_pid = undef;
624              
625 0 0       0 $quiet or warn "Feersum [$$]: master ready (gen $gen, pid $current_pid)\n";
626              
627             my $hup = EV::signal 'HUP', sub {
628 0 0 0 0   0 return if $shutting_down || $pending_pid; # debounce rapid HUPs
629 0 0       0 $quiet or warn "Feersum [$$]: HUP - spawning gen " . ($gen + 1) . "\n";
630              
631 0         0 my $old_pid = $current_pid;
632 0         0 $pending_pid = $fork_generation->();
633              
634 0 0       0 if (_wait_for_ready($pending_pid, $quiet, $gen, \$shutting_down, $startup_timeout)) {
635 0 0       0 $quiet or warn "Feersum [$$]: gen $gen ready (pid $pending_pid), retiring old (pid $old_pid)\n";
636 0         0 $current_pid = $pending_pid;
637 0         0 $pending_pid = undef;
638 0 0       0 kill 'QUIT', $old_pid if $old_pid;
639             } else {
640 0         0 warn "Feersum [$$]: gen $gen failed, keeping old (pid $old_pid)\n";
641 0 0       0 kill 'KILL', $pending_pid if kill(0, $pending_pid);
642 0         0 waitpid($pending_pid, 0);
643 0         0 $pending_pid = undef;
644             }
645 0         0 };
646              
647             my $quit = EV::signal 'QUIT', sub {
648 0 0   0   0 return if $shutting_down;
649 0         0 $shutting_down = 1;
650 0 0       0 $quiet or warn "Feersum [$$]: master shutting down\n";
651 0 0       0 kill 'QUIT', $current_pid if $current_pid;
652             # Also kill $pending_pid in case QUIT raced with a HUP reload:
653             # the pending gen may be about to be promoted to $current_pid.
654 0 0       0 kill 'QUIT', $pending_pid if $pending_pid;
655 0         0 };
656              
657             my $int = EV::signal 'INT', sub {
658 0 0   0   0 return if $shutting_down;
659 0         0 $shutting_down = 1;
660 0 0       0 $quiet or warn "Feersum [$$]: master interrupted\n";
661 0 0       0 kill 'QUIT', $current_pid if $current_pid;
662 0 0       0 kill 'QUIT', $pending_pid if $pending_pid;
663 0         0 };
664              
665             # Reap children; restart if active generation dies unexpectedly
666             my $reap = EV::child 0, 0, sub {
667 0     0   0 my $kid = $_[0]->rpid;
668 0         0 my $status = $_[0]->rstatus >> 8;
669 0 0       0 $quiet or warn "Feersum [$$]: child $kid exited ($status)\n";
670             # Ignore pending generation deaths - handled by _wait_for_ready
671 0 0 0     0 return if $pending_pid && $kid == $pending_pid;
672 0 0 0     0 if ($current_pid && $kid == $current_pid) {
673 0         0 $current_pid = undef;
674 0 0       0 EV::break if $shutting_down;
675 0 0 0     0 unless ($shutting_down || $pending_pid) {
676 0         0 warn "Feersum [$$]: active generation died, restarting\n";
677 0         0 $pending_pid = $fork_generation->();
678 0 0       0 if (_wait_for_ready($pending_pid, $quiet, $gen, \$shutting_down, $startup_timeout)) {
679 0         0 $current_pid = $pending_pid;
680             } else {
681             # Replacement also failed - kill it and shut down
682 0         0 warn "Feersum [$$]: replacement generation also failed, giving up\n";
683 0 0       0 kill 'KILL', $pending_pid if kill(0, $pending_pid);
684 0         0 waitpid($pending_pid, 0);
685 0         0 EV::break;
686             }
687 0         0 $pending_pid = undef;
688             }
689             }
690 0         0 };
691              
692 0         0 EV::run;
693             # Cleanup
694 0         0 for my $sock (@socks) { close($sock) }
  0         0  
695 0         0 waitpid(-1, POSIX::WNOHANG()) for 1..100;
696 0 0       0 $quiet or warn "Feersum [$$]: master done\n";
697             }
698              
699             # Wait for a generation child to signal readiness (USR2) or fail.
700             # Uses RUN_ONCE loop to avoid EV::break propagating to the outer EV::run.
701             sub _wait_for_ready {
702 0     0   0 my ($pid, $quiet, $gen, $shutdown_ref, $timeout) = @_;
703 0   0     0 $timeout //= 10;
704 0         0 my $ready = 0;
705 0         0 my $done = 0;
706 0     0   0 my $usr2 = EV::signal 'USR2', sub { $ready = 1; $done = 1 };
  0         0  
  0         0  
707             my $fail = EV::child $pid, 0, sub {
708 0     0   0 warn "Feersum [$$]: gen $gen (pid $pid) died during startup\n";
709 0         0 $done = 1;
710 0         0 };
711             my $to = EV::timer($timeout, 0, sub {
712 0     0   0 warn "Feersum [$$]: gen $gen startup timeout\n";
713 0         0 $done = 1;
714 0         0 });
715 0   0     0 EV::run(EV::RUN_ONCE) until $done || ($shutdown_ref && $$shutdown_ref);
      0        
716 0         0 return $ready;
717             }
718              
719             # Apply server settings to a Feersum instance (without consuming from $self).
720             # Used by hot_restart generations to re-apply settings from the master's config.
721             sub _apply_settings {
722 0     0   0 my ($self, $f) = @_;
723 0         0 $self->_apply_simple_settings($f, 0); # preserve $self for re-use
724             # Gate on pre_fork like _prepare: EPOLLEXCLUSIVE is only meaningful with
725             # multiple accepting workers (the generation child already set it before
726             # use_socket; this keeps the two settings paths consistent).
727             $f->set_epoll_exclusive($self->{epoll_exclusive} && $self->{pre_fork} ? 1 : 0)
728 0 0 0     0 if defined $self->{epoll_exclusive} && $f->can('set_epoll_exclusive');
    0 0        
729              
730             # TLS
731 0 0       0 if (my $tls = $self->{tls}) {
732 0 0       0 if ($f->has_tls()) {
733 0 0       0 my $n = scalar @{$self->{_master_socks} || $self->{_socks}};
  0         0  
734 0         0 $self->_apply_tls_to_listeners($f, $n, $tls, $self->{sni});
735 0         0 $self->{_tls_config} = $tls; # for reuseport workers
736             } else {
737             # Match _prepare's loud failure: never silently serve plaintext on
738             # a TLS-configured listener just because this build lacks TLS.
739 0         0 warn "Feersum [$$]: tls configured but TLS not compiled in"
740             . " - aborting generation\n";
741 0         0 POSIX::_exit(1);
742             }
743             }
744             }
745              
746             sub _fork_another {
747 20     20   54 my ($self, $slot) = @_;
748              
749 20         30839 my $pid = fork;
750 20 50       762 croak "failed to fork: $!" unless defined $pid;
751 20 50       203 unless ($pid) {
752 0         0 EV::default_loop()->loop_fork;
753 0 0       0 $self->{quiet} or warn "Feersum [$$]: starting\n";
754 0         0 delete $self->{_kids};
755 0         0 delete $self->{pre_fork};
756 0         0 $self->{_n_kids} = 0;
757              
758             # With SO_REUSEPORT, each child creates its own sockets
759             # This eliminates accept() contention for better scaling
760 0 0       0 if ($self->{_use_reuseport}) {
761 0         0 $self->{endjinn}->unlisten();
762 0 0       0 for my $old_sock (@{$self->{_socks} || []}) {
  0         0  
763             close($old_sock)
764 0 0       0 or do { warn "close parent socket in child: $!"; POSIX::_exit(1); };
  0         0  
  0         0  
765             }
766 0         0 my @new_socks;
767             eval {
768 0         0 for my $listen (@{$self->{_listen_addrs}}) {
  0         0  
769 0         0 my $sock = $self->_create_socket($listen, 1);
770 0         0 push @new_socks, $sock;
771 0         0 $self->{endjinn}->use_socket($sock);
772             }
773 0         0 1;
774 0 0       0 } or do {
775 0         0 warn "Feersum [$$]: child socket creation failed: $@";
776 0         0 POSIX::_exit(1);
777             };
778 0         0 $self->{sock} = $new_socks[0];
779 0         0 $self->{_socks} = \@new_socks;
780              
781             # Re-apply TLS config + SNI on new listeners
782 0 0       0 if (my $tls = $self->{_tls_config}) {
783             $self->_apply_tls_to_listeners(
784 0         0 $self->{endjinn}, scalar(@new_socks), $tls, $self->{sni});
785             }
786             }
787              
788             # Per-worker app loading (preload_app => 0)
789 0 0       0 if (my $loader = $self->{_app_loader}) {
790 0         0 eval { $loader->() };
  0         0  
791 0 0       0 if ($@) {
792 0         0 warn "Feersum [$$]: worker app load failed: $@";
793 0         0 POSIX::_exit(1);
794             }
795             }
796              
797 0 0       0 if (my $cb = $self->{after_fork}) { $cb->() }
  0         0  
798              
799 0         0 my $max_reqs_w = $self->_install_max_requests_watcher($self->{endjinn});
800              
801 0         0 eval { EV::run; }; ## no critic (RequireCheckingReturnValueOfEval)
  0         0  
802 0 0       0 carp $@ if $@;
803 0 0       0 POSIX::_exit($@ ? 1 : 0); # _exit avoids running parent's END blocks
804             }
805              
806 20         710 weaken $self; # prevent circular ref with watcher callback
807 20         103 $self->{_n_kids}++;
808             $self->{_kids}[$slot] = EV::child $pid, 0, sub {
809 20     20   103 my $w = shift;
810 20 50       150 return unless $self; # guard against destruction during shutdown
811 20 50       163 $self->{quiet} or warn "Feersum [$$]: child $pid exited ".
812             "with rstatus ".$w->rstatus."\n";
813 20         72 $self->{_n_kids}--;
814 20 50       48 if ($self->{_shutdown}) {
815 20 100       50 unless ($self->{_n_kids}) {
816 3         97 $self->{_death} = undef;
817 3         26 EV::break(EV::BREAK_ALL());
818             }
819 20         2273 return;
820             }
821             # Without SO_REUSEPORT, parent needs to accept during respawn
822 0 0       0 unless ($self->{_use_reuseport}) {
823 0         0 my $feersum = $self->{endjinn};
824 0 0       0 my @socks = @{$self->{_socks} || [$self->{sock}]};
  0         0  
825 0         0 my $all_valid = 1;
826 0         0 for my $sock (@socks) {
827 0 0       0 unless (defined fileno $sock) {
828 0         0 $all_valid = 0;
829 0         0 last;
830             }
831             }
832 0 0       0 if ($all_valid) {
833 0         0 for my $sock (@socks) {
834 0         0 $feersum->accept_on_fd(fileno $sock);
835             }
836 0         0 $self->_fork_another($slot);
837 0         0 $feersum->unlisten;
838             } else {
839 0         0 carp "fileno returned undef during respawn, cannot respawn worker";
840             }
841             }
842             else {
843             # With SO_REUSEPORT, just spawn new child (it creates its own socket)
844 0         0 $self->_fork_another($slot);
845             }
846 20         3308 };
847 20         1244 return;
848             }
849              
850             sub _start_pre_fork {
851 3     3   6 my $self = shift;
852              
853             # pre_fork value already validated in _prepare()
854 3         18 $self->{endjinn}->set_multiprocess(1);
855              
856 3 50       512 POSIX::setsid() or croak "setsid() failed: $!";
857              
858 3         46 $self->{_kids} = [];
859 3         43 $self->{_n_kids} = 0;
860 3         50 $self->_fork_another($_) for (1 .. $self->{pre_fork});
861              
862             # Parent stops accepting - children handle connections
863 3         575 $self->{endjinn}->unlisten();
864              
865             # With SO_REUSEPORT, parent can close its sockets entirely
866             # Children have their own sockets
867 3 50       80 if ($self->{_use_reuseport}) {
868 0 0       0 for my $sock (@{$self->{_socks} || []}) {
  0         0  
869 0 0       0 close($sock)
870             or warn "close parent socket after fork: $!";
871             }
872 0         0 $self->{sock} = undef;
873 0         0 $self->{_socks} = [];
874             }
875 3         47 return;
876             }
877              
878             sub _daemonize_and_write_pid {
879 3     3   11 my $self = shift;
880              
881 3 50       20 if ($self->{daemonize}) {
    50          
882 0         0 my $pid = fork;
883 0 0       0 croak "daemonize fork: $!" unless defined $pid;
884 0 0       0 if ($pid) {
885 0 0       0 if (my $file = $self->{pid_file}) {
886 0 0       0 open my $fh, '>', $file or croak "Cannot write pid_file '$file': $!";
887 0         0 print $fh "$pid\n";
888 0         0 close $fh;
889             }
890 0         0 POSIX::_exit(0);
891             }
892 0         0 POSIX::setsid();
893 0 0       0 open STDIN, '<', '/dev/null' or croak "redirect stdin: $!";
894 0 0       0 open STDOUT, '>', '/dev/null' or croak "redirect stdout: $!";
895             open STDERR, '>', '/dev/null' or croak "redirect stderr: $!"
896 0 0 0     0 unless $ENV{FEERSUM_DEBUG};
897             } elsif (my $file = $self->{pid_file}) {
898 0 0       0 open my $fh, '>', $file or croak "Cannot write pid_file '$file': $!";
899 0         0 print $fh "$$\n";
900 0         0 close $fh;
901             }
902             }
903              
904             sub _drop_privs {
905 5     5   16 my $self = shift;
906 5 100       30 if (my $group = $self->{group}) {
907 1         166 my $gid = getgrnam($group);
908 1 50       96 croak "Unknown group '$group'" unless defined $gid;
909             # Setting $) clears supplemental groups AND sets effective GID (via
910             # setgroups + setgid). Without this, supplemental groups like wheel,
911             # sudo, docker, shadow inherited from root are retained after setuid.
912 0         0 $) = "$gid $gid";
913 0 0       0 croak "setgroups/setegid($gid): $!" if $!;
914 0 0       0 POSIX::setgid($gid) or croak "setgid($gid): $!";
915             # Verify drop took effect AND supplemental groups were cleared
916             # (some LSMs/seccomp policies silently no-op setgroups).
917 0         0 my @rg = split ' ', $(;
918 0 0 0     0 croak "setgid($gid) verification failed: real GID list is @rg"
919             unless @rg == 1 && $rg[0] == $gid;
920             }
921 4 100       17 if (my $user = $self->{user}) {
922 1         313 my $uid = getpwnam($user);
923 1 50       281 croak "Unknown user '$user'" unless defined $uid;
924 0 0       0 POSIX::setuid($uid) or croak "setuid($uid): $!";
925             # Verify the privilege drop actually happened.
926 0 0 0     0 croak "setuid($uid) verification failed: \$<=$<, \$>=$>"
927             unless $< == $uid && $> == $uid;
928             }
929             }
930              
931             sub quit {
932 6     6 1 53 my $self = shift;
933 6 100       10845 return if $self->{_shutdown};
934              
935 3         22 $self->{_shutdown} = 1;
936 3 50       62 $self->{quiet} or warn "Feersum [$$]: shutting down...\n";
937             my $death = $self->{graceful_timeout}
938             // $ENV{FEERSUM_GRACEFUL_TIMEOUT}
939 3   33     144 // DEATH_TIMER;
      50        
940              
941 3 50       53 if ($self->{_n_kids}) {
942             # in parent, broadcast SIGQUIT to the process group (including self,
943             # but protected by _shutdown flag above)
944 3         456 kill POSIX::SIGQUIT, -$$;
945 3         39 $death += DEATH_TIMER_INCR;
946             }
947             else {
948             # in child or solo process
949 0     0   0 $self->{endjinn}->graceful_shutdown(sub { POSIX::_exit(0) });
  0         0  
950             }
951              
952 3     0   440 $self->{_death} = EV::timer $death, 0, sub { POSIX::_exit(1) };
  0         0  
953 3         109 return;
954             }
955              
956             1;
957             __END__