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
