(* Copyright (C) 1992, Digital Equipment Corporation                         *)
(* All rights reserved.                                                      *)
(* See the file COPYRIGHT for a full description.                            *)
(*                                                                           *)
(* Last modified on Tue Oct 13 15:53:53 PDT 1992 by muller                   *)
(*      modified on Mon Aug 17 21:27:16 PDT 1992 by meehan                   *)

UNSAFE MODULE UProcess;

IMPORT Ctypes, Fmt, IntRefTbl, M3toC, Rd, Stdio, Thread, Time, Unix, Uexec;
IMPORT UFileRdWr, Utime, Wr, RTMisc, Uerror, SmallIO, Usignal;

FROM Uerror IMPORT errno;

<* PRAGMA LL *>

VAR PidTable := IntRefTbl.New ();
  
TYPE
  Arec = RECORD
           name: Ctypes.CharStar;
           argv: REF ARRAY OF Ctypes.CharStar
         END;
  APipe = ARRAY [0 .. 1] OF Ctypes.int;
  VPipe = Thread.Closure OBJECT
            rd  : Rd.T;
            wr  : Wr.T;
            name: TEXT
          OVERRIDES
            apply := RW
          END;
    
PROCEDURE Close (pid, n: INTEGER) RAISES {Error} =
  BEGIN
    IF Unix.close (n) = -1 THEN
      Gripe (pid, "close " & Fmt.Int (n));
    END;
  END Close;

PROCEDURE Pipe (VAR p: APipe) RAISES {Error} =
  BEGIN
    IF Unix.pipe (p) = -1 THEN
      Gripe (-1, "pipe");
    END;
  END Pipe;

PROCEDURE Dup2 (pid, a, b: INTEGER) RAISES {Error} =
  BEGIN
    IF Unix.dup2 (a, b) = -1 THEN
      Gripe (pid, "dup2 " & Fmt.Int (a) & ", " & Fmt.Int (b));
    END;
  END Dup2;

PROCEDURE Fork (         program     : TEXT;
                READONLY args        : ARRAY OF TEXT;
                         mergeOutput                   := FALSE;
                         ignoreOutput                  := FALSE  ): Handle
  RAISES {Error, Rd.Failure, Wr.Failure} =
  VAR
    stdin, stdout, stderr: APipe;
    h                    : Handle;
    pid                  : INTEGER;
    arec                             := ConvertArgs (program, args);
    oit                  : Utime.struct_itimerval;
  BEGIN
    Pipe (stdin);
    IF NOT ignoreOutput THEN
      Pipe (stdout);
      IF NOT mergeOutput THEN
        Pipe (stderr);
      END;
    END;

    (* Disable the timer BEFORE forking. *)
    VAR nit := Utime.struct_itimerval {
                   it_interval := Utime.struct_timeval {0, 0},
                   it_value    := Utime.struct_timeval {0, 0}}; 
    BEGIN
      IF Utime.setitimer (Utime.ITIMER_VIRTUAL, nit, oit) = -1 THEN
        Gripe (-1, "Couldn't disable virtual timer.");
      END; 
    END;

    TRY                         (* FINALLY re-enable timer *)
      pid := Unix.vfork ();

      IF pid < 0 THEN
        Gripe (pid, "Couldn't fork.");

      ELSIF pid = 0 THEN        (* child *)
        (* connect stdin to end of pipe *)
        Close (pid, stdin [Unix.writeEnd]);
        Dup2 (pid, stdin [Unix.readEnd], SmallIO.stdin);
        Close (pid, stdin [Unix.readEnd]);
    
        IF ignoreOutput THEN
          (* connect stdout and stderr to /dev/null *)
          VAR devnull := Unix.open (M3toC.TtoS ("/dev/null"),
                                    Unix.O_WRONLY, Unix.Mrwrwrw); 
          BEGIN
            IF devnull = -1 THEN 
               Gripe (pid, "Couldn't open /dev/null in child");
            END;
            Dup2 (pid, devnull, SmallIO.stdout);
            Dup2 (pid, devnull, SmallIO.stderr);
            Close (pid, devnull);
          END;
        ELSE
          (* connect stdout to write end of pipe *)
          Close (pid, stdout [Unix.readEnd]);
          Dup2 (pid, stdout [Unix.writeEnd], SmallIO.stdout);
          Close (pid, stdout [Unix.writeEnd]);

          IF mergeOutput THEN
            (* connect stderr to stdout *)
            Dup2 (pid, SmallIO.stdout, SmallIO.stderr);
          ELSE
            Close (pid, stderr [Unix.readEnd]);
            Dup2 (pid, stderr [Unix.writeEnd], SmallIO.stderr);
            Close (pid, stderr [Unix.writeEnd]);
          END;
        END;

        WITH v = Uexec.execvp (arec.name, ADR (arec.argv [0])) DO
          Gripe (pid, Fmt.F ("execvp returned %s!", Fmt.Int (v))); END;


      ELSE                      (* parent *)
        h := NEW (Handle, pid := pid, 
                  condition := NEW (Thread.Condition), childDied := FALSE,
                  stdin_t := NIL, stdout_t := NIL, stderr_t := NIL);

        Close (pid, stdin [Unix.readEnd]);
        h.stdin :=  UFileRdWr.CreateFileWriter (stdin [Unix.writeEnd], TRUE);
        IF ignoreOutput THEN
          h.stdout := NIL;
          h.stderr := NIL; 
        ELSE
          Close (pid, stdout [Unix.writeEnd]);
          h.stdout := UFileRdWr.CreateFileReader (stdout [Unix.readEnd]);
          IF mergeOutput THEN
            h.stderr := NIL;
          ELSE
            Close (pid, stderr [Unix.writeEnd]);
            h.stderr := UFileRdWr.CreateFileReader (stderr [Unix.readEnd]);
          END;
        END; 

        FreeArgs (arec);
        EVAL PidTable.put (pid, h);
        RETURN h
      END

    FINALLY                     (* Restore previous virtual timer. *)
      VAR nit: Utime.struct_itimerval; BEGIN
        IF Utime.setitimer (Utime.ITIMER_VIRTUAL, oit, nit) # 0 THEN
          Gripe (-1, "Couldn't re-enable virtual timer."); END; END;
    END
  END Fork;

PROCEDURE Gripe (pid: INTEGER; msg: TEXT) RAISES {Error} =
  VAR e := errno;
  BEGIN
    msg := Fmt.F ("pid %s, %s Errno = %s: %s", Fmt.Int (pid), msg, Fmt.Int (e),
                  M3toC.StoT (Uerror.GetFrom_sys_errlist (e)));
    IF pid = 0 THEN             (* child *)
      TRY
        Wr.PutText (Stdio.stderr, msg);
        Wr.Flush (Stdio.stderr)
      EXCEPT
      ELSE (* ignore failures at this point *)
      END;
      RTMisc.Exit (99)
    ELSE
      RAISE Error (msg)
    END
  END Gripe;
    

PROCEDURE ConvertArgs (program: TEXT; READONLY args: ARRAY OF TEXT): Arec
  RAISES {Error} =
  VAR
    result: Arec;
    j            := 0;
  BEGIN
    result.argv := NEW (REF ARRAY OF Ctypes.CharStar, 1 + NUMBER (args));
    result.name := M3toC.TtoS (program);
    FOR i := FIRST (args) TO LAST (args) DO
      result.argv [j] := M3toC.TtoS (args [i]);
      INC (j)
    END;
    result.argv [NUMBER (args)] := NIL;
    RETURN result
  END ConvertArgs;

PROCEDURE FreeArgs (VAR arec: Arec) =
  BEGIN
    M3toC.FreeS (arec.name);
    FOR j := FIRST (arec.argv^) TO LAST (arec.argv^) DO
      IF arec.argv [j] = NIL THEN
        EXIT
      ELSE
        M3toC.FreeS (arec.argv [j]);
        arec.argv [j] := NIL
      END
    END
  END FreeArgs;

PROCEDURE AttachStreams (h                         : Handle;
                         stdinReader               : Rd.T     := NIL;
                         stdoutWriter, stderrWriter: Wr.T     := NIL  ) =
  BEGIN
    IF stdinReader # NIL AND h.stdin # NIL THEN
      h.stdin_t := Thread.Fork (NEW (VPipe, rd := stdinReader, wr := h.stdin,
                                     name := "stdin"))
    END;
    IF stdoutWriter # NIL AND h.stdout # NIL THEN
      h.stdout_t := Thread.Fork (NEW (VPipe, 
                                      rd := h.stdout, wr := stdoutWriter,
                                      name := "stdout"))
    END;
    IF stderrWriter # NIL AND h.stderr # NIL THEN
      h.stderr_t := Thread.Fork (NEW (VPipe,
                                      rd := h.stderr, wr := stderrWriter,
                                      name := "stderr"))
    END
  END AttachStreams;

PROCEDURE RW (vp: VPipe): REFANY =
  BEGIN
    TRY
      LOOP
        WITH c = Rd.GetChar (vp.rd) DO
          Wr.PutChar (vp.wr, c);
          IF c = '\n' THEN Wr.Flush (vp.wr) END
        END
      END
    EXCEPT
    | Rd.EndOfFile, Rd.Failure, Wr.Failure, Thread.Alerted =>
    END;
    RETURN NIL
  END RW;

VAR
  mu                := NEW (MUTEX);
  c                 := NEW (Thread.Condition); <* LL = mu *>
  waiters: CARDINAL := 0;       <* LL = mu *>
    
PROCEDURE Wait3Forever (<* UNUSED *> cl: Thread.Closure): REFANY =
  VAR
    status: Uexec.w_T;
    h     : Handle;
    ref   : REFANY;
  BEGIN
    LOOP                        (* outer *)
      LOCK mu DO WHILE waiters = 0 DO Thread.Wait (mu, c) END END;
      LOOP                      (* inner *)
        WITH x = Uexec.wait3 (
                   ADR (LOOPHOLE (status, Uexec.w_A)), Uexec.WNOHANG, NIL) DO
          IF x > 0 THEN
            TRY
              IF PidTable.delete (x, ref) THEN
                h := ref;
                LOCK h DO
                  h.status.exitCode := status.w_Retcode;
                  h.status.terminationSignal := status.w_Termsig;
                  h.status.dumpedCore := status.w_Coredump # 0;
                  h.childDied := TRUE;
                  Thread.Broadcast (h.condition)
                END
              END
            EXCEPT
              IntRefTbl.NotFound =>
            END
          ELSE
            (* x might be -1 and errno = ECHILD (no children).  OK *)
            LOCK mu DO
              IF waiters = 0 THEN EXIT END (* resume outer loop *) 
            END;
            Time.Pause (100000) (* and resume inner loop *)
          END                   (* IF x > 0 *)
        END                     (* WITH *)
      END                       (* inner LOOP *)
    END                         (* outer LOOP *)
  END Wait3Forever;

PROCEDURE Wait (h: Handle) =
  BEGIN
    LOCK mu DO INC (waiters); Thread.Signal (c) END;
    LOCK h DO
      WHILE NOT h.childDied DO Thread.Wait (h, h.condition) END
    END;
    IF h.stdin_t # NIL THEN
      EVAL Thread.Join (h.stdin_t);
      h.stdin_t := NIL;
    END;
    IF h.stdout_t # NIL THEN
      EVAL Thread.Join (h.stdout_t);
      h.stdout_t := NIL;
    END;
    IF h.stderr_t # NIL THEN
      EVAL Thread.Join (h.stderr_t);
      h.stderr_t := NIL;
    END;
    LOCK mu DO DEC (waiters) END
  END Wait;

PROCEDURE Signal (h: Handle; signal := Usignal.SIGTERM) RAISES {Error} =
  BEGIN
    IF Usignal.kill (h.pid, signal) # 0 THEN
      Gripe (h.pid, "Couldn't signal child process.")
    END
  END Signal;

BEGIN
  EVAL Thread.Fork (NEW (Thread.Closure, apply := Wait3Forever))
END UProcess.