prefork-interp: Perl: new approach

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

diff --git a/perl/Prefork.pm b/perl/Prefork.pm
index a9fc4810ea6d67672d382fb24f524f1a928e86ea..7d1459d4bdb8007857989f21a84874cc6241c12d 100644 (file)
--- a/perl/Prefork.pm
+++ b/perl/Prefork.pm
@@ -129,14 +129,13 @@ sub initialisation_complete {
   my %opts = @_;
 
   # if env var not set, we're not running under prefork-interp
-  my @env_data = split / /, ($ENV{$env_name} // return), 3;
-  croak "$env_name has the wrong number of words" unless @env_data == 3;
+  my @env_data = split / /, ($ENV{$env_name} // return);
+  croak "$env_name has too few words" unless @env_data >= 2;
   my (@vsns) = split /,/, $env_data[0];
   croak "$env_name doesn't offer protocol v1" unless grep { $_ eq 'v1' } @vsns;
   my @env_fds = split /,/, $env_data[1];
-  croak "$env_name has too few fds" unless @env_fds >= 2;;
+  croak "$env_name has too few fds" unless @env_fds >= 4;;
   $#env_fds = 1;
-  $socket_path = $env_data[2];
 
   $num_servers = $opts{max_servers} // 4;
 
@@ -146,7 +145,8 @@ sub initialisation_complete {
     $_ eq ($_+0) or croak "$env_name contains $_, not a number";
   }
   open LISTEN, "+>&=$env_fds[0]" or croak "listen fd: $!";
-  open CALL,   "+>&=$env_fds[1]" or croak "listen fd: $!";
+  open CALL,   "+>&=$env_fds[1]" or croak "call fd: $!";
+  open WATCHE,  "<&=$env_fds[3]" or croak "watch stderr fd: $!";
 
   if (!$opts{no_openlog}) {
     openlog("prefork-interp $0", 'ndelay,nofatal,pid',
@@ -215,39 +215,43 @@ sub initialisation_complete {
     # select for accepting or housekeeping timeout
     my $rbits = '';
     vec($rbits, fileno(LISTEN), 1) = 1;
+    vec($rbits, fileno(WATCHE), 1) = 1;
     my $ebits = $rbits;
     my $nfound = select($rbits, '', $ebits, ($opts{check_interval} // 86400));
 
-    if ($nfound) {
-      if (accept(CALL, LISTEN)) {
-       $child = fork // fail_log("fork for accepted call failed: $!");
-       if (!$child) {
-         #---- monitor [1] ----
-         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;
+    # Has the watcher told us to shut down, or died with a message ?
+    my $msgbuf = '';
+    my $r = sysread WATCHE, $msgbuf, 2048;
+    if ($r > 0) {
+      chomp $msgbuf;
+      fail_log("watcher: $msgbuf");
+    } elsif ($r == 0) {
+      _exit(0);
+    } elsif ($! == EINTR || $! == EAGAIN || $! == EWOULDBLOCK) {
+    } else {
+      fail_log("watcher stderr read: $!");
     }
 
-    # are we still live?
-    my @st_listen = stat(LISTEN) // fail_log("fstat listening socket: $!");
-    my @st_socket = stat($socket_path) // do {
-      if ($! == ENOENT) { server_quit("socket $socket is ENOENT"); }
-      fail_log("stat socket $socket: $!");
-    };
-    if ("@st_listen[0..2]" ne "@st_socket[0..2]") {
-      server_quit("socket $socket is no longer ours");
+    # TODO stat checking, quit here if we are stale
+
+    # Anything to accept ?
+    if (accept(CALL, LISTEN)) {
+      $child = fork // fail_log("fork for accepted call failed: $!");
+      if (!$child) {
+       #---- monitor [1] ----
+       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);
+      }
     }
   }
 }