2020-09-18: Implementing popen and pclose in SML             rak
================================================================

[ This is an I posted on my blog on 2017-09-15 [0] that I ]
[ thought was sufficiently interesting to be worth        ]
[ reposting here.                                         ]

Though Standard ML provides the `OS.Process.system` function to
execute an arbitrary command using the default system shell, and
the `Posix.Process` structure for `fork` and the `exec`
variants, it doesn't (as far as I know) provide a mechanism to
run a process and capture that process's standard out.

I learned from my officemate that I was essentially looking for
an SML implementation of `popen(3)` and `pclose(3)`. Here's what
I came up with:

(**************************************************************)
structure Popen :>
	  sig
		  (* Parent wants to write, read stdout, or read stdout + stderr *)
		  datatype pipe_type = PIPE_W | PIPE_R | PIPE_RE
		  val popen : string * pipe_type -> Posix.IO.file_desc
		  val pclose : Posix.IO.file_desc -> Posix.Process.exit_status option
	  end =
struct

datatype pipe_type = PIPE_W | PIPE_R | PIPE_RE

type pinfo = { fd : Posix.ProcEnv.file_desc, pid : Posix.Process.pid }

val pids : pinfo list ref = ref []

(* Implements popen(3) *)
fun popen (cmd, t) =
  let val { infd = readfd, outfd = writefd } = Posix.IO.pipe ()
  in case (Posix.Process.fork (), t)
	  of (NONE, t) => (* Child *)
	 (( case t
		 of PIPE_W => Posix.IO.dup2 { old = readfd, new = Posix.FileSys.stdin }
		  | PIPE_R => Posix.IO.dup2 { old = writefd, new = Posix.FileSys.stdout }
		  | PIPE_RE => ( Posix.IO.dup2 { old = writefd, new = Posix.FileSys.stdout }
			   ; Posix.IO.dup2 { old = writefd, new = Posix.FileSys.stderr })
	  ; Posix.IO.close writefd
	  ; Posix.IO.close readfd
	  ; Posix.Process.execp ("/bin/sh", ["sh", "-c", cmd]))
	  handle OS.SysErr (err, _) =>
		 ( print ("Fatal error in child: " ^ err ^ "\n")
		 ; OS.Process.exit OS.Process.failure ))
	   | (SOME pid, t) => (* Parent *)
	 let val fd = case t of PIPE_W => (Posix.IO.close readfd; writefd)
				  | PIPE_R => (Posix.IO.close writefd; readfd)
				  | PIPE_RE => (Posix.IO.close writefd; readfd)
		 val _ = pids := ({ fd = fd, pid = pid } :: !pids)
	 in fd end
  end

(* Implements pclose(3) *)
fun pclose fd =
  case List.partition (fn { fd = f, pid = _ } => f = fd) (!pids)
   of ([], _) => NONE
	| ([{ fd = _, pid = pid }], pids') =>
	  let val _ = pids := pids'
	  val (_, status) = Posix.Process.waitpid (Posix.Process.W_CHILD pid, [])
	  val _ = Posix.IO.close fd
	  in SOME status end
	| _ => raise Bind (* This should be impossible. *)
end

(* Examples *)
val f = Popen.popen("ls", Popen.PIPE_R);
val g = Popen.popen("read line; echo $line>/tmp/foo", Popen.PIPE_W);
val _ = Posix.IO.writeVec (g, Word8VectorSlice.full (Byte.stringToBytes "Hello World! I was written by g\n"));
val h = Popen.popen("cat /tmp/foo", Popen.PIPE_R);
val i = Popen.popen("echo 'to stderr i' 1>&2", Popen.PIPE_R);
val j = Popen.popen("echo 'to stderr j' 1>&2", Popen.PIPE_RE);
val _ = app (fn fd => print (Byte.bytesToString (Posix.IO.readVec (fd, 1000)))) [f, h, i, j];
val _ = map Popen.pclose [f, g, h, i, j];
val _ = OS.Process.exit OS.Process.success;
(**************************************************************)

and the corresponding output is:

--------------------8<-------------------------------------
rak@zeta:~/popen$ rm /tmp/foo && ls && sml popen.sml
popen.sml
Standard ML of New Jersey v110.79 [built: Tue Aug  8 16:57:33 2017]
[opening popen.sml]
[autoloading]
[library $SMLNJ-BASIS/basis.cm is stable]
[library $SMLNJ-BASIS/(basis.cm):basis-common.cm is stable]
[autoloading done]
popen.sml:42.52 Warning: calling polyEqual
structure Popen :
  sig
    datatype pipe_type = PIPE_R | PIPE_RE | PIPE_W
    val popen : string * pipe_type -> ?.POSIX_IO.file_desc
    val pclose : ?.POSIX_IO.file_desc -> ?.POSIX_Process.exit_status option
  end
val f = FD {fd=4} : ?.POSIX_IO.file_desc
val g = FD {fd=6} : ?.POSIX_IO.file_desc
[autoloading]
[autoloading done]
val h = FD {fd=5} : ?.POSIX_IO.file_desc
to stderr i
val i = FD {fd=7} : ?.POSIX_IO.file_desc
val j = FD {fd=8} : ?.POSIX_IO.file_desc
popen.sml
Hello World! I was written by g
to stderr j
--------------------8<-------------------------------------

[0] https://rak.ac/2017/09/15/Implementing-popen-and-pclose-in-SML.html