open Prelude

(* adapted from unix.ml *)

let try_set_close_on_exec fd =
  try Unix.set_close_on_exec fd; true with Invalid_argument _ -> false

let open_proc cmd input output toclose =
  let cloexec = List.for_all try_set_close_on_exec toclose in
  match Unix.fork () with
     0 -> if input <> Unix.stdin then begin Unix.dup2 input Unix.stdin; Unix.close input end;
          if output <> Unix.stdout then begin Unix.dup2 output Unix.stdout; Unix.close output end;
          if not cloexec then List.iter Unix.close toclose;
          begin try Unix.execvp (head cmd) (Array.of_list cmd)
          with _ -> exit 127
          end
  | id -> id

let popenWithStdin ?(toclose=[]) stdin cmd =
  let (in_read, in_write) = Unix.pipe () in
  ignore (open_proc cmd stdin in_write ([in_read] @ toclose));
  Unix.close in_write;
  Unix.close stdin;
  in_read


let rec buildPipeline ?toclose = foldl (popenWithStdin ?toclose)

let withPipeline cmds f =
  let ifd, ofd = Unix.pipe () in
  let ifd = buildPipeline ~toclose:[ofd] ifd cmds in (* if we don't close ofd, all will hang *)
  let ic = Unix.in_channel_of_descr ifd
  and oc = Unix.out_channel_of_descr ofd in
  finally (fun _ ->  close_out_noerr oc; close_in_noerr ic)
          (f ic) oc

let pipeline = [
  ["tr"; "[:upper:]"; "[:lower:]"];
  ["grep"; "-o"; "ello"];
]

let () =
  withPipeline pipeline
  (fun ic oc ->
    output_string oc "hElLo JeLlo";
    close_out oc;
    puts (readAll ic)
  )