prefork-interp: wip

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>

diff --git a/perl/Prefork.pm b/perl/Prefork.pm
new file mode 100644 (file)
index 0000000..162d5e4
--- /dev/null
+++ b/perl/Prefork.pm
@@ -0,0 +1,145 @@
+
+package Proc::Prefork;
+
+use Carp;
+use POSIX;
+use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
+
+our $logger;
+
+our $env_name = 'PREFORK_INTERP';
+
+our @call_fds;
+our $socket_path;
+
+sub server_quit ($) {
+  my ($m) = @_;
+  syslog(LOG_INFO, "$0 prefork [$$]: $m, quitting");
+  _exit(0);
+}
+
+sub become_monitor () {
+  
+}
+
+sub initialisation_complete {
+  my %opts = @_;
+
+  # if env var not set, we're not running under prefork-interp
+  my @env_params = split /,/, ($ENV{$env_name} // return), 5;
+  croak "$env_name has too few entries" unless @env_params == 5;
+
+  $num_servers = $opts{max_servers} // 4;
+
+  #---- setup (pm) [1] ----
+
+  $socket_path = pop @env_params;
+  foreach (@env_params) {
+    $_ eq ($_+0) or croak "$env_name contains $_, not a number";
+  }
+  open LISTEN, "<>&=$env_params[0]" or croak "listen fd: $!";
+  open CALL,   "<>&=$env_params[1]" or croak "listen fd: $!";
+  @call_fds = ($env_params[2], $env_params[3], 2);
+
+  if (!$opts{no_openlog}) {
+    openlog("prefork-interp $0", 'ndelay,nofatal,pid',
+           $opts{log_facility} // 'log_user');
+  }
+
+  open NULL, "<>/dev/null" or croak "open /dev/null: $!";
+
+  #---- fork for server ----
+
+  my $child = fork // croak "first fork failed: $!";
+  if ($child) {
+    #---- setup (pm) [2], exits ----
+    _exit(0);
+  }
+
+  #---- server(pm) [1] ----
+
+  $child = fork // croak "second fork failed: $!";
+  if (!$child) {
+    # we are the child, i.e. the one fa-monitor
+    become_monitor();
+  }
+
+  our %children;
+  $children{$child} = 1;
+  
+  # --- server(pm) [2] ----
+
+  setsid() > 0 or fail("setsid: $!");
+  open STDIN, "<&NULL" or fail("dup null onto stdin: $!");
+  open STDOUT, ">&NULL" or fail("dup null onto stdout: $!");
+  open STDERR, ">&NULL" or fail("dup null onto stderr: $!");
+  close NULL;
+
+  POSIX::close($_) foreach @call_fds;
+  close CALL;
+
+  my $flags = fcntl(LISTEN, F_GETFL, 0) or fail("F_GETFL listen socket: $!");
+  $flags |= O_NONBLOCK;
+  fcntl(LISTEN, F_SETFL, $flags) or fail("F_SETFL listen socket: $!");
+
+  my $errcount = 0;
+
+  for (;;) {
+    # reap children
+    if (%children) {
+      my $full = %children >= $num_servers;
+      my $got = waitpid -1, ($full ? 0 : WNOHANG);
+      if ($?) {
+       syslog(LOG_WARNING,
+ "$0 prefork [$$]: monitor process [$got] failed with wait status $?");
+      }
+      if (!exists $children{$got}) {
+       syslog(LOG_WARNING,
+ "$0 prefork [$$]: monitor process [$got] wasn't one of ours?!");
+      }
+      delete $children{$got};
+      next;
+    }
+
+    # select for accepting or housekeeping timeout
+    my $rbits = '';
+    vec($rbits, fileno(LISTEN), 1) = 1;
+    my $ebits = $rbits;
+    my $nfound = select($rbits, '', $ebits, ($opts{check_interval} // 300));
+
+    if ($nfound) {
+      if (accept(CALL, LISTEN)) {
+       $child = fork // fail("fork for accepted call failed: $!");
+       if (!$child) {
+         become_monitor();
+       }
+       close(CALL);
+       $errcount = 0;
+       $children{$child} = 1;
+      } elsif ($! == EINTR || $! == EAGAIN || $! == EWOULDBLOCK) {
+      } else {
+       syslog(LOG_WARNING, "$0 prefork [$$]: accept failed: $!");
+       if ($errcount > ($opts{max_errors} // 100)) {
+         syslog(LOG_ERR,
+                "$0 prefork [$$]: too many accept failures, quitting");
+         _exit(16);
+       }
+      }
+      next;
+    }
+
+    # are we still live?
+    my @st_listen = stat(LISTEN) // fail("fstat listening socket: $!");
+    my @st_socket = stat($socket_path) // do {
+      if ($! == ENOENT) { server_quit("socket $socket is ENOENT"); }
+      fail("stat socket $socket: $!");
+    };
+    if ("@st_listen[0..2]" ne "@st_socket[0..2]") {
+      server_quit("socket $socket is no longer ours");
+    }
+  }
+}
+
+1;
+
+__END__