Skip to content

Commit

Permalink
Delay opening redirected files until execing cmd
Browse files Browse the repository at this point in the history
This avoids an issue where the redirected output would be opened
before there was a slot available to execute a command, consuming
fds unnecessarily.

Issue ocaml#1633 was an instance of this hitting the default limit on
MacOS of 256 fds.

Fixes: ocaml#1633

Signed-off-by: Jon Ludlam <[email protected]>
  • Loading branch information
jonludlam committed Dec 11, 2018
1 parent c665c8f commit 991a3ed
Show file tree
Hide file tree
Showing 4 changed files with 16 additions and 27 deletions.
36 changes: 10 additions & 26 deletions src/action_exec.ml
Original file line number Diff line number Diff line change
Expand Up @@ -8,12 +8,8 @@ type exec_context =
}

let get_std_output : _ -> Process.std_output_to = function
| None -> Terminal
| Some (fn, oc) ->
Opened_file { filename = fn
; tail = false
; desc = Channel oc }

| None -> Terminal
| Some fn -> File fn

let exec_run_direct ~ectx ~dir ~env ~stdout_to ~stderr_to prog args =
begin match ectx.context with
Expand Down Expand Up @@ -44,7 +40,7 @@ let exec_echo stdout_to str =
Fiber.return
(match stdout_to with
| None -> print_string str; flush stdout
| Some (_, oc) -> output_string oc str)
| Some fn -> Io.write_file fn str)

let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to =
match (t : Action.t) with
Expand All @@ -60,15 +56,6 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to =
| Redirect (Stdout, fn, Echo s) ->
Io.write_file fn (String.concat s ~sep:" ");
Fiber.return ()
| Redirect (outputs, fn, Run (Ok prog, args)) ->
let out = Process.File fn in
let stdout_to, stderr_to =
match outputs with
| Stdout -> (out, get_std_output stderr_to)
| Stderr -> (get_std_output stdout_to, out)
| Outputs -> (out, out)
in
exec_run_direct ~ectx ~dir ~env ~stdout_to ~stderr_to prog args
| Redirect (outputs, fn, t) ->
redirect ~ectx ~dir outputs fn t ~env ~stdout_to ~stderr_to
| Ignore (outputs, t) ->
Expand All @@ -78,12 +65,9 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to =
| Echo strs -> exec_echo stdout_to (String.concat strs ~sep:" ")
| Cat fn ->
Io.with_file_in fn ~f:(fun ic ->
let oc =
match stdout_to with
| None -> stdout
| Some (_, oc) -> oc
in
Io.copy_channels ic oc);
match stdout_to with
| None -> Io.copy_channels ic stdout
| Some fn -> Io.with_file_out fn ~f:(fun oc -> Io.copy_channels ic oc));
Fiber.return ()
| Copy (src, dst) ->
Io.copy_file ~src ~dst ();
Expand Down Expand Up @@ -195,16 +179,16 @@ let rec exec t ~ectx ~dir ~env ~stdout_to ~stderr_to =
Fiber.return ()

and redirect outputs fn t ~ectx ~dir ~env ~stdout_to ~stderr_to =
let oc = Io.open_out fn in
let out = Some (fn, oc) in
(* We resolve the path to an absolute one here to ensure no
Chdir actions change the eventual path of the file *)
let out = Some (Path.to_absolute fn) in
let stdout_to, stderr_to =
match outputs with
| Stdout -> (out, stderr_to)
| Stderr -> (stdout_to, out)
| Outputs -> (out, out)
in
exec t ~ectx ~dir ~env ~stdout_to ~stderr_to >>| fun () ->
close_out oc
exec t ~ectx ~dir ~env ~stdout_to ~stderr_to

and exec_list l ~ectx ~dir ~env ~stdout_to ~stderr_to =
match l with
Expand Down
2 changes: 1 addition & 1 deletion src/build.ml
Original file line number Diff line number Diff line change
Expand Up @@ -249,7 +249,7 @@ let symlink ~src ~dst =
action ~targets:[dst] (Symlink (src, dst))

let create_file fn =
action ~targets:[fn] (Redirect (Stdout, fn, Progn []))
action ~targets:[fn] (Redirect (Stdout, fn, Echo []))

let remove_tree dir =
arr (fun _ -> Action.Remove_tree dir)
Expand Down
2 changes: 2 additions & 0 deletions src/stdune/path.ml
Original file line number Diff line number Diff line change
Expand Up @@ -643,6 +643,8 @@ let of_filename_relative_to_initial_cwd fn =

let to_absolute_filename t = Kind.to_absolute_filename (kind t)

let to_absolute t = external_ (External.of_string (to_absolute_filename t))

let external_of_local x ~root =
External.to_string (External.relative root (Local.to_string x))

Expand Down
3 changes: 3 additions & 0 deletions src/stdune/path.mli
Original file line number Diff line number Diff line change
Expand Up @@ -76,6 +76,9 @@ val of_filename_relative_to_initial_cwd : string -> t
root has been set. [root] is the root directory of local paths *)
val to_absolute_filename : t -> string

(** Convert any path to an absolute path *)
val to_absolute : t -> t

val reach : t -> from:t -> string

(** [from] defaults to [Path.root] *)
Expand Down

0 comments on commit 991a3ed

Please sign in to comment.