1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
open Base;;

type fd_operation =
  | Redirect of Unix.file_descr
  | Dup of Unix.file_descr
  | Close
;;

let perform_redirection fd operation =
  match operation with
    | Close -> Unix.close fd;
    | Dup fd_from -> Unix.dup2 ~cloexec:false fd_from fd;
    | Redirect fd_from ->
        Unix.dup2 ~cloexec:false fd_from fd;
        Unix.close fd_from;
;;

external sys_exit : int -> 'a = "caml_sys_exit"

let create_process ?redirects cmd args =
  (* let redirects = Option.value redirects [] *)
  let redirects = match redirects with
    | Some l -> l
    | None -> []
  in
  match Unix.fork() with
    0 ->
      begin try
        List.iter redirects (
          fun (fd, operation) -> perform_redirection fd operation
        );
        Unix.execvp cmd args
      with _ ->
        sys_exit 127
      end
  | id -> id
;;

let waitpid = Unix.waitpid;;

let wait_estatus status = match status with
  | Unix.WEXITED i -> if i >= 128 then 128 else i;
  | Unix.WSIGNALED i -> 128 + i;
  | Unix.WSTOPPED i ->  128 + i;
;;