File Coverage

blib/lib/Feersum/Runner.pm
Criterion Covered Total %
statement 225 591 38.0
branch 75 376 19.9
condition 21 136 15.4
subroutine 34 53 64.1
pod 4 4 100.0
total 359 1160 30.9


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