prefork-interp: Protocol work

[chiark-utils.git] / perl / Prefork.pm

diff --git a/perl/Prefork.pm b/perl/Prefork.pm
index fb54a91d84297ad3e9bd6599993b851fd9e456db..10c7ec1a70d7b477300285b990ec9b7111136136 100644 (file)
--- a/perl/Prefork.pm
+++ b/perl/Prefork.pm
@@ -6,6 +6,7 @@ our @EXPORT = qw(initialisation_complete);
 
 use Carp;
 use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
+use IO::FDPass;
 use POSIX qw(_exit setsid);
 use Sys::Syslog;
 
@@ -15,10 +16,15 @@ our $env_name = 'PREFORK_INTERP';
 
 our @call_fds;
 our $socket_path;
+our $fail_log = 0;
 
 sub fail_log ($) {
   my ($m) = @_;
-  syslog(LOG_ERR, "$0: prefork [$$]: error: $m");
+  if ($fail_log) {
+    syslog(LOG_ERR, "$0: prefork [$$]: error: $m");
+  } else {
+    croak "$0: prefork: initialisation error: $m";
+  }
   _exit 127;
 }
 
@@ -30,13 +36,18 @@ sub server_quit ($) {
 
 # Returns in the executor process
 sub become_monitor () {
-  my $child = fork // fail("fork executor: $!");
+  close LISTEN;
+  eval { protocol_exchange(); 1; }
+    or fail_log("protocol exchange failed: $@");
+
+  my $child = fork // fail_log("fork executor: $!");
   if (!$child) {
     #---- executor ----
     open ::STDIN , "<& $call_fds[0]" or fail_log("dup for fd0");
     open ::STDOUT, ">& $call_fds[1]" or fail_log("dup for fd1");
     open ::STDERR, ">& $call_fds[2]" or fail_log("dup for fd2");
     close_call_fds();
+    $! = 0;
     return;
   }
 
@@ -50,7 +61,6 @@ sub become_monitor () {
 
 sub close_call_fds () {
   foreach (@call_fds) {
-    next if $_ <= 2;
     POSIX::close($_);
   }
   close CALL;
@@ -76,11 +86,12 @@ sub eintr_retry ($) {
 sub protocol_read_fail ($) {
   my ($what) = @_;
   _exit(0) if $!==ECONNRESET;
-  fail_log("recv $what: $!");
+  die("recv $what: $!");
 }
 
 sub protocol_exchange () {
-  protocol_write("\n");
+  my $greeting = "PFI\n\0\0\0\0";
+  protocol_write($greeting);
 
   @call_fds = map {
     my $r;
@@ -104,12 +115,12 @@ sub protocol_exchange () {
   $r == $len or _exit(0);
 
   @ARGV = split /\0/, $data;
-  @ARGV >= 2 or fail_log("message data has too few strings");
-  length(pop(@ARGV)) and fail_log("message data missing trailing nul");
+  @ARGV >= 2 or die("message data has too few strings");
+  length(pop(@ARGV)) and die("message data missing trailing nul");
   %ENV = ();
   while (my $s = shift @ARGV) {
     last if !length $s;
-    $s =~ m/=/ or fail_log("message data env var missing equals");
+    $s =~ m/=/ or die("message data env var missing equals");
     $ENV{$`} = $';
   }
 }
@@ -118,20 +129,24 @@ 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;
+  my @env_data = split / /, ($ENV{$env_name} // return), 3;
+  croak "$env_name has the wrong number of words" unless @env_data == 3;
+  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 >= 3;;
+  $#env_fds = 1;
+  $socket_path = $env_data[2];
 
   $num_servers = $opts{max_servers} // 4;
 
   #---- setup (pm) [1] ----
 
-  $socket_path = pop @env_params;
-  foreach (@env_params) {
+  foreach (@env_fds) {
     $_ 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);
+  open LISTEN, "+>&=$env_fds[0]" or croak "listen fd: $!";
+  open CALL,   "+>&=$env_fds[1]" or croak "listen fd: $!";
 
   if (!$opts{no_openlog}) {
     openlog("prefork-interp $0", 'ndelay,nofatal,pid',
@@ -161,6 +176,7 @@ sub initialisation_complete {
   
   # --- server(pm) [2] ----
 
+  $fail_log = 1;
   setsid() > 0 or fail_log("setsid: $!");
   open STDIN, "<&NULL" or fail_log("dup null onto stdin: $!");
   open STDOUT, ">&NULL" or fail_log("dup null onto stdout: $!");
@@ -205,9 +221,7 @@ sub initialisation_complete {
        $child = fork // fail_log("fork for accepted call failed: $!");
        if (!$child) {
          #---- monitor [1] ----
-         close LISTEN;
-         protocol_exchange();
-         return become_monitor();
+         become_monitor();
        }
        close(CALL);
        $errcount = 0;