File Coverage

blib/lib/Feersum/Runner.pm
Criterion Covered Total %
statement 226 585 38.6
branch 94 372 25.2
condition 24 166 14.4
subroutine 35 56 62.5
pod 4 4 100.0
total 383 1183 32.3


line stmt bran cond sub pod time code
1             package Feersum::Runner;
2 10     10   1881898 use warnings;
  10         33  
  10         602  
3 10     10   43 use strict;
  10         15  
  10         182  
4              
5 10     10   4042 use EV;
  10         15194  
  10         245  
6 10     10   3821 use Feersum;
  10         20  
  10         559  
7 10         1329 use Socket qw/SOMAXCONN SOL_SOCKET SO_REUSEADDR AF_INET SOCK_STREAM
8 10     10   48 inet_aton pack_sockaddr_in/;
  10         56  
9             BEGIN {
10             # IPv6 support (Socket 1.95+, Perl 5.14+)
11 10         255 eval { Socket->import(qw/AF_INET6 inet_pton pack_sockaddr_in6/); 1 }
  10         561  
12 10 50   10   27 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         233 eval { Socket->import('SO_REUSEPORT'); 1 }
  10         193  
21 10 50   10   21 or *SO_REUSEPORT = sub () { undef };
22             }
23 10     10   4647 use POSIX ();
  10         62438  
  10         302  
24 10     10   53 use Scalar::Util qw/weaken/;
  10         10  
  10         409  
25 10     10   375 use Guard ();
  10         503  
  10         163  
26 10     10   28 use Carp qw/carp croak/;
  10         10  
  10         354  
27 10     10   1668 use File::Spec::Functions 'rel2abs';
  10         2398  
  10         449  
28              
29 10     10   38 use constant DEATH_TIMER => 5.0; # seconds
  10         12  
  10         563  
30 10     10   32 use constant DEATH_TIMER_INCR => 2.0; # seconds
  10         15  
  10         301  
31 10     10   30 use constant DEFAULT_HOST => 'localhost';
  10         14  
  10         391  
32 10     10   38 use constant DEFAULT_PORT => 5000;
  10         11  
  10         412  
33 10   50 10   35 use constant MAX_PRE_FORK => $ENV{FEERSUM_MAX_PRE_FORK} || 1000;
  10         140  
  10         65700  
34              
35             our $INSTANCE;
36             sub new { ## no critic (RequireArgUnpacking)
37 22     22 1 19893 my $c = shift;
38 22 100       354 if ($INSTANCE) {
39             croak "Only one Feersum::Runner instance can be active at a time"
40 2 50       7 if $INSTANCE->{running};
41             # Clean up old instance state before creating new one
42 2         6 $INSTANCE->_cleanup();
43 2         3 undef $INSTANCE;
44             }
45 22         598 $INSTANCE = bless {quiet=>1, @_, running=>0}, $c;
46 22         157 return $INSTANCE;
47             }
48              
49             sub _cleanup {
50 23     23   33 my $self = shift;
51 23 100       144 return if $self->{_cleaned_up};
52 21         73 $self->{_cleaned_up} = 1;
53 21 100       92 if (my $f = $self->{endjinn}) {
54 6     0   120 $f->request_handler(sub{});
55 6         151 $f->unlisten();
56             }
57 21         107 $self->{_quit} = undef;
58 21         117 $self->{running} = 0;
59 21 50       133 if (my $file = $self->{pid_file}) {
60 0 0       0 unlink $file if -f $file;
61             }
62 21         280 return;
63             }
64              
65             sub DESTROY {
66 18     18   11409 local $@;
67 18         38 $_[0]->_cleanup();
68             }
69              
70             sub _create_socket {
71 13     13   54 my ($self, $listen, $use_reuseport) = @_;
72 13   50     95 my $backlog = $self->{backlog} || SOMAXCONN;
73              
74 13         17 my $sock;
75 13 50       128 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 13         191 require IO::Socket::INET;
95             # SO_REUSEPORT must be set BEFORE bind for multiple sockets per port
96 13 50 33     57 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 13 50       98 if ($listen =~ /:(\d+)$/) {
    0          
165 13         150 my $port = $1;
166 13 50       83 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 13         297 $sock = IO::Socket::INET->new(
172             LocalAddr => $listen,
173             ReuseAddr => 1,
174             Proto => 'tcp',
175             Listen => $backlog,
176             Blocking => 0,
177             );
178 13 50       9499 croak "couldn't bind to socket: $!" unless $sock;
179             }
180             }
181 13         29 return $sock;
182             }
183              
184             sub _extract_options {
185 3     3   61 my $self = shift;
186 3 50       85 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   17 my ($self, $f, $consume) = @_;
230 10         47 for my $pair (@SIMPLE_SETTINGS) {
231 170         284 my ($opt, $meth) = @$pair;
232 170 50       209 my $val = $consume ? delete $self->{$opt} : $self->{$opt};
233 170 100       291 $f->$meth($val) if defined $val;
234             }
235 10 50       121 if ($f->can('max_h2_concurrent_streams')) {
236             my $v = $consume ? delete $self->{max_h2_concurrent_streams}
237 10 50       23 : $self->{max_h2_concurrent_streams};
238 10 50       27 $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   35 my $self = shift;
275 13 50 33     206 if (defined $self->{listen} && !ref $self->{listen}) {
276 0         0 $self->{listen} = [ $self->{listen} ];
277             }
278             $self->{listen} ||=
279 13   0     87 [ ($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       22 if @{$self->{listen}} == 0;
  13         55  
284 13         33 $self->{_listen_addrs} = [ @{$self->{listen}} ];
  13         79  
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   48 my $self = shift;
295 13 100       34 if (!$self->{tls}) {
296 10 100       26 if (my $cert = delete $self->{tls_cert_file}) {
    100          
297             my $key = delete $self->{tls_key_file}
298 2 100       97 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         123 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         3 delete $self->{tls_key_file};
307             }
308 11 100       27 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       7 croak "tls requires cert_file" unless $tls->{cert_file};
311 4 50       23 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       7 $tls->{h2} = 1 if delete $self->{h2};
314             } elsif (delete $self->{h2}) {
315 1         82 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   49 my $self = shift;
322              
323 13         82 $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         22 my $n = $self->{pre_fork};
328 3 50 33     250 if ($n !~ /^\d+$/ || $n < 1) {
329 0         0 croak "pre_fork must be a positive integer";
330             }
331 3 50       20 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     115 my $use_reuseport = $self->{reuseport} && $self->{pre_fork} && defined SO_REUSEPORT;
338 13         51 $self->{_use_reuseport} = $use_reuseport;
339              
340 13         200 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     141 if ($self->{epoll_exclusive} && $self->{pre_fork} && $^O eq 'linux') {
      33        
345 2         117 $f->set_epoll_exclusive(1);
346             }
347              
348             # accept_priority must also be set BEFORE use_socket(): each accept watcher
349             # captures srvr->accept_priority when created (setup_accept_watcher), so a
350             # later assignment only affects listeners added afterwards.
351 13 100 66     86 if (defined $self->{accept_priority} && $f->can('accept_priority')) {
352 1         2 my $val = $self->{accept_priority};
353 1 50       6 croak "accept_priority must be an integer" unless $val =~ /^-?\d+$/;
354 1 50 33     85 croak "accept_priority must be between -2 and 2" if $val < -2 || $val > 2;
355 0         0 $f->accept_priority($val);
356             }
357              
358 12         16 my @socks;
359 12         13 for my $listen (@{$self->{_listen_addrs}}) {
  12         62  
360 13         50 my $sock = $self->_create_socket($listen, $use_reuseport);
361 13         24 push @socks, $sock;
362 13         60 $f->use_socket($sock);
363             }
364 12         36 $self->{sock} = $socks[0]; # backward compat: primary socket
365 12         30 $self->{_socks} = \@socks; # all sockets
366              
367             # Validate priorities (-2..+2 per libev) before applying
368 12         20 for my $prio_name (qw/read_priority write_priority accept_priority/) {
369 33         50 my $val = $self->{$prio_name};
370 33 100       56 next unless defined $val;
371 4 50       29 croak "$prio_name must be an integer" unless $val =~ /^-?\d+$/;
372 4 100 100     290 croak "$prio_name must be between -2 and 2" if $val < -2 || $val > 2;
373             }
374 10 50       44 if (defined(my $val = $self->{max_accept_per_loop})) {
375 0 0 0     0 croak "max_accept_per_loop must be a positive integer"
376             unless $val =~ /^\d+$/ && $val > 0;
377             }
378 10 50       24 if (defined(my $val = $self->{max_connections})) {
379 0 0       0 croak "max_connections must be a non-negative integer"
380             unless $val =~ /^\d+$/;
381             }
382 10         35 $self->_apply_simple_settings($f, 1); # consume from $self
383              
384             # Fold flat tls_cert_file/tls_key_file shorthand + h2 into $self->{tls}
385             # (also used by the hot_restart master via _normalize_tls_config).
386 10         34 $self->_normalize_tls_config;
387              
388             # TLS configuration: apply to all listeners
389 8 100       19 if (my $tls = delete $self->{tls}) {
390 2 50 33     258 -f $tls->{cert_file} && -r _
391             or croak "tls cert_file '$tls->{cert_file}': not found or not readable";
392 0 0 0     0 -f $tls->{key_file} && -r _
393             or croak "tls key_file '$tls->{key_file}': not found or not readable";
394              
395 0 0       0 if ($f->has_tls()) {
396 0         0 $self->_apply_tls_to_listeners($f, scalar(@socks), $tls, $self->{sni});
397 0         0 $self->{_tls_config} = $tls; # for reuseport workers
398 0 0       0 $self->{quiet} or warn "Feersum [$$]: TLS enabled on "
399             . scalar(@socks) . " listener(s)\n";
400             } else {
401 0         0 croak "tls option requires Feersum compiled with TLS support (need picotls submodule + OpenSSL; see Alien::OpenSSL)";
402             }
403             }
404              
405 6         33 $self->{endjinn} = $f;
406 6         14 return;
407             }
408              
409             # for overriding:
410             sub assign_request_handler {
411 3     3 1 9 my ($self, $app) = @_;
412 3 50       9 if (my $log_cb = $self->{access_log}) {
413 0         0 my $orig = $app;
414             $app = sub {
415 0     0   0 my $r = shift;
416 0         0 my $t0 = EV::now();
417 0         0 my $method = $r->method;
418 0         0 my $uri = $r->uri;
419             $r->response_guard(Guard::guard(sub {
420 0         0 $log_cb->($method, $uri, EV::now() - $t0);
421 0         0 }));
422 0         0 $orig->($r);
423 0         0 };
424             }
425 3         35 return $self->{endjinn}->request_handler($app);
426             }
427              
428             sub run {
429 3     3 1 244 my $self = shift;
430 3         103 weaken $self;
431              
432 3         184 $self->{running} = 1;
433 3   33     332 my $app = shift || $self->{app};
434 3 50       195 $self->{quiet} or warn "Feersum [$$]: starting...\n";
435              
436 3         162 $self->_extract_options();
437              
438             # Hot restart mode: entry process creates sockets, then manages
439             # generation children that each load a fresh app with clean modules.
440 3 50       102 if ($self->{hot_restart}) {
441 0 0       0 croak "hot_restart requires app_file" unless $self->{app_file};
442 0         0 $self->_daemonize_and_write_pid();
443 0         0 $self->_run_hot_restart_master(); # creates sockets, then drops privs
444 0         0 return;
445             }
446              
447 3         144 $self->_prepare(); # bind() on listen sockets
448 3         66 $self->_daemonize_and_write_pid();
449 3         18 $self->_drop_privs(); # after bind, before app load
450              
451             # preload_app => 0: fork workers first, each loads the app independently.
452             # Default (preload_app unset or true): load app once, fork inherits via COW.
453 3 50 33     22 if ($self->{pre_fork} && defined $self->{preload_app} && !$self->{preload_app}) {
      33        
454             $self->{_app_loader} = sub {
455 0   0 0   0 my $a = $app || $self->{app};
456 0 0 0     0 if (!$a && $self->{app_file}) {
457 0         0 local ($@, $!);
458 0         0 $a = do(rel2abs($self->{app_file}));
459 0 0 0     0 warn "couldn't load $self->{app_file}: " . ($@ || $!) if $@ || !$a;
      0        
460             }
461 0 0       0 croak "app not defined or failed to compile" unless $a;
462 0         0 $self->assign_request_handler($a);
463 0         0 };
464             # Set a no-op handler on parent so it doesn't crash if it briefly
465             # re-accepts during non-reuseport worker respawn
466             $self->{endjinn}->request_handler(sub {
467 0     0   0 $_[0]->send_response(503, ['Content-Type'=>'text/plain'], \"Service Unavailable\n");
468 0         0 });
469 0 0   0   0 $self->{_quit} = EV::signal 'QUIT', sub { $self && $self->quit };
  0         0  
470 0         0 $self->_start_pre_fork;
471             } else {
472 3   33     57 $app ||= delete $self->{app};
473 3 50 33     49 if (!$app && $self->{app_file}) {
474 3         107 local ($@, $!);
475 3         81 $app = do(rel2abs($self->{app_file}));
476 3 50       16 warn "couldn't parse $self->{app_file}: $@" if $@;
477 3 50 33     21 warn "couldn't do $self->{app_file}: $!" if ($! && !defined $app);
478 3 50       13 warn "couldn't run $self->{app_file}: didn't return anything"
479             unless $app;
480             }
481 3 50       9 croak "app not defined or failed to compile" unless $app;
482              
483 3         11 $self->assign_request_handler($app);
484              
485 3 50   6   176 $self->{_quit} = EV::signal 'QUIT', sub { $self && $self->quit };
  6         211  
486              
487 3 50       41 $self->_start_pre_fork if $self->{pre_fork};
488             }
489 3         29540987 EV::run;
490 3 50       25 $self->{quiet} or warn "Feersum [$$]: done\n";
491 3         55 $self->_cleanup();
492 3         142 return;
493             }
494              
495             # Hot restart master: creates sockets once, then manages generations.
496             # Each generation is a forked child that runs _apply_settings + app load + serve.
497             # SIGHUP -> fork new gen -> if ready -> SIGQUIT old gen.
498             sub _run_hot_restart_master {
499 0     0   0 my ($self) = @_;
500 0         0 my $quiet = $self->{quiet};
501              
502 0 0       0 $quiet or warn "Feersum [$$]: hot restart master starting\n";
503              
504 0         0 $self->_normalize_listen();
505             # Fold flat TLS keys + h2 into $self->{tls} once, here in the master, so
506             # every generation child's _apply_settings sees the complete TLS/H2 config
507             # (these children never run _prepare, which is where folding otherwise
508             # happens). Without this, hot_restart silently drops flat tls_cert_file/
509             # tls_key_file and the h2 flag.
510 0         0 $self->_normalize_tls_config();
511              
512             # Create listen sockets in the master (shared across generations via fork).
513             # Use SO_REUSEPORT if configured - reuseport workers need all sockets
514             # on the same addr:port to have the flag set.
515 0   0     0 $self->{_listen_addrs} ||= [ @{$self->{listen}} ];
  0         0  
516 0   0     0 my $use_reuseport = $self->{reuseport} && $self->{pre_fork} && defined SO_REUSEPORT;
517 0         0 my @socks;
518 0         0 for my $listen (@{$self->{_listen_addrs}}) {
  0         0  
519 0         0 my $sock = $self->_create_socket($listen, $use_reuseport);
520 0         0 push @socks, $sock;
521             }
522 0         0 $self->{_master_socks} = \@socks;
523              
524             # Drop privileges after sockets are bound (privileged ports are now open)
525 0         0 $self->_drop_privs();
526              
527 0         0 my $gen = 0;
528 0         0 my $current_pid;
529             my $pending_pid; # generation being started (not yet $current_pid)
530 0         0 my $shutting_down = 0;
531 0   0     0 my $startup_timeout = $self->{startup_timeout} // 10;
532              
533             # Fork a generation child. The child inherits listen sockets via fork,
534             # registers them with use_socket, then calls _apply_settings (which
535             # applies TLS and other settings without consuming from $self), loads the
536             # app file fresh, then serves.
537             my $fork_generation = sub {
538 0     0   0 $gen++;
539 0         0 my $pid = fork;
540 0 0       0 croak "fork generation: $!" unless defined $pid;
541              
542 0 0       0 if ($pid == 0) {
543             # === Generation child ===
544 0         0 EV::default_loop()->loop_fork;
545 0 0       0 $quiet or warn "Feersum [$$]: gen $gen loading app\n";
546              
547             # Sockets were created in the master and inherited via fork -
548             # register them with this generation's Feersum instance.
549 0         0 my $f = Feersum->endjinn;
550             # EPOLLEXCLUSIVE must be set BEFORE use_socket() so each accept
551             # watcher is created with it (mirrors _prepare); otherwise
552             # non-reuseport hot_restart workers inherit plain accept watchers
553             # and lose the thundering-herd mitigation.
554 0 0 0     0 if ($self->{epoll_exclusive} && $self->{pre_fork} && $^O eq 'linux'
      0        
      0        
555             && $f->can('set_epoll_exclusive')) {
556 0         0 $f->set_epoll_exclusive(1);
557             }
558             # accept_priority also before use_socket (see _prepare); the XS
559             # setter clamps to libev's valid range.
560 0 0 0     0 if (defined $self->{accept_priority} && $f->can('accept_priority')) {
561 0         0 $f->accept_priority($self->{accept_priority});
562             }
563 0         0 for my $sock (@socks) {
564 0         0 $f->use_socket($sock);
565             }
566 0         0 $self->{_socks} = \@socks;
567 0         0 $self->{sock} = $socks[0];
568              
569             # Apply server settings (preserved in $self for later generations)
570 0         0 $self->_apply_settings($f);
571              
572             # Load app fresh (fork gave us clean copy-on-write memory)
573 0         0 my $app_file = rel2abs($self->{app_file});
574 0         0 local ($@, $!);
575 0         0 my $app = do $app_file;
576 0 0 0     0 if ($@ || !$app || ref $app ne 'CODE') {
      0        
577 0   0     0 warn "Feersum [$$]: gen $gen: failed to load $app_file: "
578             . ($@ || $! || "not a coderef") . "\n";
579 0         0 POSIX::_exit(1);
580             }
581              
582 0         0 $self->{endjinn} = $f;
583 0         0 $self->assign_request_handler($app);
584              
585 0         0 my ($quit_w, $death_w);
586             $quit_w = EV::signal 'QUIT', sub {
587 0 0       0 if ($self->{pre_fork}) {
588 0         0 kill POSIX::SIGQUIT, -$$;
589             }
590 0         0 $f->graceful_shutdown(sub { POSIX::_exit(0) });
  0         0  
591             my $gt = $self->{graceful_timeout}
592             // $ENV{FEERSUM_GRACEFUL_TIMEOUT}
593 0   0     0 // DEATH_TIMER;
      0        
594             $death_w = EV::timer($gt + DEATH_TIMER_INCR, 0, sub {
595 0         0 POSIX::_exit(1);
596 0         0 });
597 0         0 };
598              
599 0 0       0 if ($self->{pre_fork}) {
600 0         0 $f->set_multiprocess(1);
601             # Set reuseport flag for _fork_another workers
602             $self->{_use_reuseport} = $self->{reuseport}
603 0   0     0 && $self->{pre_fork} && defined SO_REUSEPORT;
604             # (epoll_exclusive already set before use_socket above)
605 0 0       0 POSIX::setsid() or warn "Feersum [$$]: setsid failed: $!\n";
606 0         0 $self->{_kids} = [];
607 0         0 $self->{_n_kids} = 0;
608 0         0 $self->_fork_another($_) for (1 .. $self->{pre_fork});
609 0         0 $f->unlisten(); # parent of workers doesn't accept
610             }
611              
612 0         0 my $mrw;
613 0 0       0 if (!$self->{pre_fork}) {
614 0 0       0 $self->{after_fork}->() if $self->{after_fork};
615 0         0 $mrw = $self->_install_max_requests_watcher($f);
616             }
617              
618             # Signal master: ready to serve (after workers are forked)
619 0         0 kill 'USR2', getppid();
620              
621             $quiet or warn "Feersum [$$]: gen $gen ready"
622 0 0       0 . ($self->{pre_fork} ? " ($self->{pre_fork} workers)" : "") . "\n";
    0          
623 0         0 EV::run;
624 0         0 POSIX::_exit(0);
625             }
626              
627 0         0 return $pid;
628 0         0 };
629              
630             # Fork first generation
631 0         0 $pending_pid = $fork_generation->();
632 0 0       0 unless (_wait_for_ready($pending_pid, $quiet, $gen, \$shutting_down, $startup_timeout)) {
633 0 0       0 kill 'KILL', $pending_pid if kill(0, $pending_pid);
634 0         0 waitpid($pending_pid, 0);
635 0         0 croak "first generation failed to start";
636             }
637 0         0 $current_pid = $pending_pid;
638 0         0 $pending_pid = undef;
639              
640 0 0       0 $quiet or warn "Feersum [$$]: master ready (gen $gen, pid $current_pid)\n";
641              
642             my $hup = EV::signal 'HUP', sub {
643 0 0 0 0   0 return if $shutting_down || $pending_pid; # debounce rapid HUPs
644 0 0       0 $quiet or warn "Feersum [$$]: HUP - spawning gen " . ($gen + 1) . "\n";
645              
646 0         0 my $old_pid = $current_pid;
647 0         0 $pending_pid = $fork_generation->();
648              
649 0 0       0 if (_wait_for_ready($pending_pid, $quiet, $gen, \$shutting_down, $startup_timeout)) {
650 0 0       0 $quiet or warn "Feersum [$$]: gen $gen ready (pid $pending_pid), retiring old (pid $old_pid)\n";
651 0         0 $current_pid = $pending_pid;
652 0         0 $pending_pid = undef;
653 0 0       0 kill 'QUIT', $old_pid if $old_pid;
654             } else {
655 0         0 warn "Feersum [$$]: gen $gen failed, keeping old (pid $old_pid)\n";
656 0 0       0 kill 'KILL', $pending_pid if kill(0, $pending_pid);
657 0         0 waitpid($pending_pid, 0);
658 0         0 $pending_pid = undef;
659             }
660 0         0 };
661              
662             my $quit = EV::signal 'QUIT', sub {
663 0 0   0   0 return if $shutting_down;
664 0         0 $shutting_down = 1;
665 0 0       0 $quiet or warn "Feersum [$$]: master shutting down\n";
666 0 0       0 kill 'QUIT', $current_pid if $current_pid;
667             # Also kill $pending_pid in case QUIT raced with a HUP reload:
668             # the pending gen may be about to be promoted to $current_pid.
669 0 0       0 kill 'QUIT', $pending_pid if $pending_pid;
670 0         0 };
671              
672             my $int = EV::signal 'INT', sub {
673 0 0   0   0 return if $shutting_down;
674 0         0 $shutting_down = 1;
675 0 0       0 $quiet or warn "Feersum [$$]: master interrupted\n";
676 0 0       0 kill 'QUIT', $current_pid if $current_pid;
677 0 0       0 kill 'QUIT', $pending_pid if $pending_pid;
678 0         0 };
679              
680             # Reap children; restart if active generation dies unexpectedly
681             my $reap = EV::child 0, 0, sub {
682 0     0   0 my $kid = $_[0]->rpid;
683 0         0 my $status = $_[0]->rstatus >> 8;
684 0 0       0 $quiet or warn "Feersum [$$]: child $kid exited ($status)\n";
685             # Ignore pending generation deaths - handled by _wait_for_ready
686 0 0 0     0 return if $pending_pid && $kid == $pending_pid;
687 0 0 0     0 if ($current_pid && $kid == $current_pid) {
688 0         0 $current_pid = undef;
689 0 0       0 EV::break if $shutting_down;
690 0 0 0     0 unless ($shutting_down || $pending_pid) {
691 0         0 warn "Feersum [$$]: active generation died, restarting\n";
692 0         0 $pending_pid = $fork_generation->();
693 0 0       0 if (_wait_for_ready($pending_pid, $quiet, $gen, \$shutting_down, $startup_timeout)) {
694 0         0 $current_pid = $pending_pid;
695             } else {
696             # Replacement also failed - kill it and shut down
697 0         0 warn "Feersum [$$]: replacement generation also failed, giving up\n";
698 0 0       0 kill 'KILL', $pending_pid if kill(0, $pending_pid);
699 0         0 waitpid($pending_pid, 0);
700 0         0 EV::break;
701             }
702 0         0 $pending_pid = undef;
703             }
704             }
705 0         0 };
706              
707 0         0 EV::run;
708             # Cleanup
709 0         0 for my $sock (@socks) { close($sock) }
  0         0  
710 0         0 waitpid(-1, POSIX::WNOHANG()) for 1..100;
711 0 0       0 $quiet or warn "Feersum [$$]: master done\n";
712             }
713              
714             # Wait for a generation child to signal readiness (USR2) or fail.
715             # Uses RUN_ONCE loop to avoid EV::break propagating to the outer EV::run.
716             sub _wait_for_ready {
717 0     0   0 my ($pid, $quiet, $gen, $shutdown_ref, $timeout) = @_;
718 0   0     0 $timeout //= 10;
719 0         0 my $ready = 0;
720 0         0 my $done = 0;
721 0     0   0 my $usr2 = EV::signal 'USR2', sub { $ready = 1; $done = 1 };
  0         0  
  0         0  
722             my $fail = EV::child $pid, 0, sub {
723 0     0   0 warn "Feersum [$$]: gen $gen (pid $pid) died during startup\n";
724 0         0 $done = 1;
725 0         0 };
726             my $to = EV::timer($timeout, 0, sub {
727 0     0   0 warn "Feersum [$$]: gen $gen startup timeout\n";
728 0         0 $done = 1;
729 0         0 });
730 0   0     0 EV::run(EV::RUN_ONCE) until $done || ($shutdown_ref && $$shutdown_ref);
      0        
731 0         0 return $ready;
732             }
733              
734             # Apply server settings to a Feersum instance (without consuming from $self).
735             # Used by hot_restart generations to re-apply settings from the master's config.
736             sub _apply_settings {
737 0     0   0 my ($self, $f) = @_;
738 0         0 $self->_apply_simple_settings($f, 0); # preserve $self for re-use
739             # Gate on pre_fork like _prepare: EPOLLEXCLUSIVE is only meaningful with
740             # multiple accepting workers (the generation child already set it before
741             # use_socket; this keeps the two settings paths consistent).
742             $f->set_epoll_exclusive($self->{epoll_exclusive} && $self->{pre_fork} ? 1 : 0)
743 0 0 0     0 if defined $self->{epoll_exclusive} && $f->can('set_epoll_exclusive');
    0 0        
744              
745             # TLS
746 0 0       0 if (my $tls = $self->{tls}) {
747 0 0       0 if ($f->has_tls()) {
748 0 0       0 my $n = scalar @{$self->{_master_socks} || $self->{_socks}};
  0         0  
749 0         0 $self->_apply_tls_to_listeners($f, $n, $tls, $self->{sni});
750 0         0 $self->{_tls_config} = $tls; # for reuseport workers
751             } else {
752             # Match _prepare's loud failure: never silently serve plaintext on
753             # a TLS-configured listener just because this build lacks TLS.
754 0         0 warn "Feersum [$$]: tls configured but TLS not compiled in"
755             . " - aborting generation\n";
756 0         0 POSIX::_exit(1);
757             }
758             }
759             }
760              
761             sub _fork_another {
762 20     20   44 my ($self, $slot) = @_;
763              
764 20         21313 my $pid = fork;
765 20 50       753 croak "failed to fork: $!" unless defined $pid;
766 20 50       137 unless ($pid) {
767 0         0 EV::default_loop()->loop_fork;
768 0 0       0 $self->{quiet} or warn "Feersum [$$]: starting\n";
769 0         0 delete $self->{_kids};
770 0         0 delete $self->{pre_fork};
771 0         0 $self->{_n_kids} = 0;
772              
773             # With SO_REUSEPORT, each child creates its own sockets
774             # This eliminates accept() contention for better scaling
775 0 0       0 if ($self->{_use_reuseport}) {
776 0         0 $self->{endjinn}->unlisten();
777 0 0       0 for my $old_sock (@{$self->{_socks} || []}) {
  0         0  
778             close($old_sock)
779 0 0       0 or do { warn "close parent socket in child: $!"; POSIX::_exit(1); };
  0         0  
  0         0  
780             }
781 0         0 my @new_socks;
782             eval {
783 0         0 for my $listen (@{$self->{_listen_addrs}}) {
  0         0  
784 0         0 my $sock = $self->_create_socket($listen, 1);
785 0         0 push @new_socks, $sock;
786 0         0 $self->{endjinn}->use_socket($sock);
787             }
788 0         0 1;
789 0 0       0 } or do {
790 0         0 warn "Feersum [$$]: child socket creation failed: $@";
791 0         0 POSIX::_exit(1);
792             };
793 0         0 $self->{sock} = $new_socks[0];
794 0         0 $self->{_socks} = \@new_socks;
795              
796             # Re-apply TLS config + SNI on new listeners
797 0 0       0 if (my $tls = $self->{_tls_config}) {
798             $self->_apply_tls_to_listeners(
799 0         0 $self->{endjinn}, scalar(@new_socks), $tls, $self->{sni});
800             }
801             }
802              
803             # Per-worker app loading (preload_app => 0)
804 0 0       0 if (my $loader = $self->{_app_loader}) {
805 0         0 eval { $loader->() };
  0         0  
806 0 0       0 if ($@) {
807 0         0 warn "Feersum [$$]: worker app load failed: $@";
808 0         0 POSIX::_exit(1);
809             }
810             }
811              
812 0 0       0 if (my $cb = $self->{after_fork}) { $cb->() }
  0         0  
813              
814 0         0 my $max_reqs_w = $self->_install_max_requests_watcher($self->{endjinn});
815              
816 0         0 eval { EV::run; }; ## no critic (RequireCheckingReturnValueOfEval)
  0         0  
817 0 0       0 carp $@ if $@;
818 0 0       0 POSIX::_exit($@ ? 1 : 0); # _exit avoids running parent's END blocks
819             }
820              
821 20         528 weaken $self; # prevent circular ref with watcher callback
822 20         163 $self->{_n_kids}++;
823             $self->{_kids}[$slot] = EV::child $pid, 0, sub {
824 20     20   145 my $w = shift;
825 20 50       110 return unless $self; # guard against destruction during shutdown
826 20 50       93 $self->{quiet} or warn "Feersum [$$]: child $pid exited ".
827             "with rstatus ".$w->rstatus."\n";
828 20         55 $self->{_n_kids}--;
829 20 50       63 if ($self->{_shutdown}) {
830 20 100       49 unless ($self->{_n_kids}) {
831 3         87 $self->{_death} = undef;
832 3         68 EV::break(EV::BREAK_ALL());
833             }
834 20         9757 return;
835             }
836             # Without SO_REUSEPORT, parent needs to accept during respawn
837 0 0       0 unless ($self->{_use_reuseport}) {
838 0         0 my $feersum = $self->{endjinn};
839 0 0       0 my @socks = @{$self->{_socks} || [$self->{sock}]};
  0         0  
840 0         0 my $all_valid = 1;
841 0         0 for my $sock (@socks) {
842 0 0       0 unless (defined fileno $sock) {
843 0         0 $all_valid = 0;
844 0         0 last;
845             }
846             }
847 0 0       0 if ($all_valid) {
848 0         0 for my $sock (@socks) {
849 0         0 $feersum->accept_on_fd(fileno $sock);
850             }
851 0         0 $self->_fork_another($slot);
852 0         0 $feersum->unlisten;
853             } else {
854 0         0 carp "fileno returned undef during respawn, cannot respawn worker";
855             }
856             }
857             else {
858             # With SO_REUSEPORT, just spawn new child (it creates its own socket)
859 0         0 $self->_fork_another($slot);
860             }
861 20         2948 };
862 20         1104 return;
863             }
864              
865             sub _start_pre_fork {
866 3     3   12 my $self = shift;
867              
868             # pre_fork value already validated in _prepare()
869 3         24 $self->{endjinn}->set_multiprocess(1);
870              
871 3 50       406 POSIX::setsid() or croak "setsid() failed: $!";
872              
873 3         44 $self->{_kids} = [];
874 3         39 $self->{_n_kids} = 0;
875 3         23 $self->_fork_another($_) for (1 .. $self->{pre_fork});
876              
877             # Parent stops accepting - children handle connections
878 3         466 $self->{endjinn}->unlisten();
879              
880             # With SO_REUSEPORT, parent can close its sockets entirely
881             # Children have their own sockets
882 3 50       71 if ($self->{_use_reuseport}) {
883 0 0       0 for my $sock (@{$self->{_socks} || []}) {
  0         0  
884 0 0       0 close($sock)
885             or warn "close parent socket after fork: $!";
886             }
887 0         0 $self->{sock} = undef;
888 0         0 $self->{_socks} = [];
889             }
890 3         46 return;
891             }
892              
893             sub _daemonize_and_write_pid {
894 3     3   6 my $self = shift;
895              
896 3 50       30 if ($self->{daemonize}) {
    50          
897 0         0 my $pid = fork;
898 0 0       0 croak "daemonize fork: $!" unless defined $pid;
899 0 0       0 if ($pid) {
900 0 0       0 if (my $file = $self->{pid_file}) {
901 0 0       0 open my $fh, '>', $file or croak "Cannot write pid_file '$file': $!";
902 0         0 print $fh "$pid\n";
903 0         0 close $fh;
904             }
905 0         0 POSIX::_exit(0);
906             }
907 0         0 POSIX::setsid();
908 0 0       0 open STDIN, '<', '/dev/null' or croak "redirect stdin: $!";
909 0 0       0 open STDOUT, '>', '/dev/null' or croak "redirect stdout: $!";
910             open STDERR, '>', '/dev/null' or croak "redirect stderr: $!"
911 0 0 0     0 unless $ENV{FEERSUM_DEBUG};
912             } elsif (my $file = $self->{pid_file}) {
913 0 0       0 open my $fh, '>', $file or croak "Cannot write pid_file '$file': $!";
914 0         0 print $fh "$$\n";
915 0         0 close $fh;
916             }
917             }
918              
919             sub _drop_privs {
920 5     5   15 my $self = shift;
921 5 100       17 if (my $group = $self->{group}) {
922 1         127 my $gid = getgrnam($group);
923 1 50       120 croak "Unknown group '$group'" unless defined $gid;
924             # Setting $) clears supplemental groups AND sets effective GID (via
925             # setgroups + setgid). Without this, supplemental groups like wheel,
926             # sudo, docker, shadow inherited from root are retained after setuid.
927 0         0 $) = "$gid $gid";
928 0 0       0 croak "setgroups/setegid($gid): $!" if $!;
929 0 0       0 POSIX::setgid($gid) or croak "setgid($gid): $!";
930             # Verify drop took effect AND supplemental groups were cleared
931             # (some LSMs/seccomp policies silently no-op setgroups).
932 0         0 my @rg = split ' ', $(;
933 0 0 0     0 croak "setgid($gid) verification failed: real GID list is @rg"
934             unless @rg == 1 && $rg[0] == $gid;
935             }
936 4 100       19 if (my $user = $self->{user}) {
937 1         164 my $uid = getpwnam($user);
938 1 50       157 croak "Unknown user '$user'" unless defined $uid;
939 0 0       0 POSIX::setuid($uid) or croak "setuid($uid): $!";
940             # Verify the privilege drop actually happened.
941 0 0 0     0 croak "setuid($uid) verification failed: \$<=$<, \$>=$>"
942             unless $< == $uid && $> == $uid;
943             }
944             }
945              
946             sub quit {
947 6     6 1 37 my $self = shift;
948 6 100       11078 return if $self->{_shutdown};
949              
950 3         40 $self->{_shutdown} = 1;
951 3 50       60 $self->{quiet} or warn "Feersum [$$]: shutting down...\n";
952             my $death = $self->{graceful_timeout}
953             // $ENV{FEERSUM_GRACEFUL_TIMEOUT}
954 3   33     289 // DEATH_TIMER;
      50        
955              
956 3 50       56 if ($self->{_n_kids}) {
957             # in parent, broadcast SIGQUIT to the process group (including self,
958             # but protected by _shutdown flag above)
959 3         493 kill POSIX::SIGQUIT, -$$;
960 3         23 $death += DEATH_TIMER_INCR;
961             }
962             else {
963             # in child or solo process
964 0     0   0 $self->{endjinn}->graceful_shutdown(sub { POSIX::_exit(0) });
  0         0  
965             }
966              
967 3     0   410 $self->{_death} = EV::timer $death, 0, sub { POSIX::_exit(1) };
  0         0  
968 3         80 return;
969             }
970              
971             1;
972             __END__