prefork-interp: Protocol work

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

diff --git a/perl/Prefork.pm b/perl/Prefork.pm
index d79eb5bf522514ccd2ceaf6ead5c51efdc74181d..10c7ec1a70d7b477300285b990ec9b7111136136 100644 (file)
--- a/perl/Prefork.pm
+++ b/perl/Prefork.pm
@@ -16,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;
 }
 
@@ -31,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;
   }
 
@@ -51,7 +61,6 @@ sub become_monitor () {
 
 sub close_call_fds () {
   foreach (@call_fds) {
-    next if $_ <= 2;
     POSIX::close($_);
   }
   close CALL;
@@ -81,7 +90,8 @@ sub protocol_read_fail ($) {
 }
 
 sub protocol_exchange () {
-  protocol_write("\n");
+  my $greeting = "PFI\n\0\0\0\0";
+  protocol_write($greeting);
 
   @call_fds = map {
     my $r;
@@ -166,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: $!");
@@ -210,10 +221,7 @@ sub initialisation_complete {
        $child = fork // fail_log("fork for accepted call failed: $!");
        if (!$child) {
          #---- monitor [1] ----
-         close LISTEN;
-         eval { protocol_exchange(); 1; }
-           or fail_log("protocol exchange failed: $@");
-         return become_monitor();
+         become_monitor();
        }
        close(CALL);
        $errcount = 0;