[integrations] fix potential starvation

Summary:
D20416859 introduced a new utility
`Process.create_process_and_wait_with_output` that:
1. executes the process to completion
2. reads stdout in full
3. reads stderr in full

Unfortunately, writing to stdout/stderr can be a blocking operation for
the callee process in that situation. Double unfortunately, reading both
stdout and stderr in a way that avoids starvation requires sophisticated
Unix-fu. Fortunately, callers of this utility only ever need to read
*one* of stdout or stderr.

Fix the starvation by:
1. reading *one* channel only (either stdout or stderr)
2. doing the reading *before* `wait`ing on the process to finish
3. redirecting the other channel to the console

Reviewed By: skcho, ngorogiannis

Differential Revision: D20737388

fbshipit-source-id: 2988ac865

infer/src/base/Process.ml

@@ -9,6 +9,8 @@ open! IStd
 module L = Logging
 module F = Format
 
+[@@@warning "+9"]
+
 (** Prints an error message to a log file, prints a message saying that the error can be found in
     that file, and exits, with default code 1 or a given code. *)
 let print_error_and_exit ?(exit_code = 1) fmt =
@@ -29,26 +31,37 @@ let create_process_and_wait ~prog ~args =
   | Ok () ->
       ()
   | Error _ as status ->
-      L.(die ExternalError)
-        "Error executing: %s@\n%s@\n"
-        (String.concat ~sep:" " (prog :: args))
+      L.die ExternalError "Error executing: %a@\n%s@\n" Pp.cli_args (prog :: args)
         (Unix.Exit_or_signal.to_string_hum status)
 
 
-let create_process_and_wait_with_output ~prog ~args =
+type action = ReadStdout | ReadStderr
+
+let create_process_and_wait_with_output ~prog ~args action =
   let {Unix.Process_info.stdin; stdout; stderr; pid} = Unix.create_process ~prog ~args in
-  let stderr_chan = Unix.in_channel_of_descr stderr in
-  let stdout_chan = Unix.in_channel_of_descr stdout in
   Unix.close stdin ;
+  (* NOTE: this simple implementation works well because we only read on *one* of stdout or
+     stderr. Reading on both is a lot more difficult: we would have to be careful not to block the
+     callee process on writing on either stdout or stderr, so issue non-blocking reads on both
+     stdout and stderr until the end of the program, probably using select(2). *)
+  let in_chan =
+    let redirect_read ~redirect:(dst, src) ~read =
+      (* redirect *)
+      Unix.dup2 ~src ~dst ; Unix.in_channel_of_descr read
+    in
+    match action with
+    | ReadStdout ->
+        redirect_read ~redirect:(stderr, Unix.stderr) ~read:stdout
+    | ReadStderr ->
+        redirect_read ~redirect:(stdout, Unix.stdout) ~read:stderr
+  in
+  let res = In_channel.input_all in_chan in
   match Unix.waitpid pid with
   | Ok () ->
-      let out = In_channel.input_all stdout_chan in
-      let err = In_channel.input_all stderr_chan in
-      In_channel.close stdout_chan ; In_channel.close stderr_chan ; (out, err)
+      Unix.close (Unix.descr_of_in_channel in_chan) ;
+      res
   | Error _ as status ->
-      L.(die ExternalError)
-        "Error executing: %s@\n%s@\n"
-        (String.concat ~sep:" " (prog :: args))
+      L.die ExternalError "Error executing: %a@\n%s@\n" Pp.cli_args (prog :: args)
         (Unix.Exit_or_signal.to_string_hum status)
 
 

infer/src/base/Process.mli

@@ -12,10 +12,13 @@ val create_process_and_wait : prog:string -> args:string list -> unit
     execution. The standard out and error are not redirected. If the commands fails to execute,
     prints an error message and exits. *)
 
-val create_process_and_wait_with_output : prog:string -> args:string list -> string * string
+type action = ReadStdout | ReadStderr
+
+val create_process_and_wait_with_output : prog:string -> args:string list -> action -> string
 (** Given an command to be executed, creates a process to execute this command, and waits for its
-    execution. The standard out and error are returned. If the commands fails to execute, prints an
-    error message and exits. *)
+    execution. Depending on the action passed, either stdout or stderr is returned, with the other
+    being streamed to the console. If the commands fails to execute, prints an error message and
+    exits. *)
 
 val print_error_and_exit : ?exit_code:int -> ('a, Format.formatter, unit, 'b) format4 -> 'a
 (** Prints an error message to a log file, prints a message saying that the error can be found in

infer/src/integration/Ant.ml

@@ -26,16 +26,20 @@ let extract_javac_args line =
 type fold_state = {collecting: bool; rev_javac_args: string list}
 
 let capture ~prog ~args =
-  let _, java_version =
-    Process.create_process_and_wait_with_output ~prog:"java" ~args:["-version"]
+  let java_version =
+    Process.create_process_and_wait_with_output ~prog:"java" ~args:["-version"] ReadStderr
   in
-  let _, javac_version =
-    Process.create_process_and_wait_with_output ~prog:"javac" ~args:["-version"]
+  let javac_version =
+    Process.create_process_and_wait_with_output ~prog:"javac" ~args:["-version"] ReadStderr
+  in
+  let ant_version =
+    Process.create_process_and_wait_with_output ~prog ~args:["-version"] ReadStdout
+  in
+  L.environment_info "%s %s %s@\n" java_version javac_version ant_version ;
+  L.debug Capture Quiet "%s %a@." prog Pp.cli_args args ;
+  let ant_out =
+    Process.create_process_and_wait_with_output ~prog ~args:("-verbose" :: args) ReadStdout
   in
-  let ant_version, _ = Process.create_process_and_wait_with_output ~prog ~args:["-version"] in
-  L.environment_info "%s %s %s@." java_version javac_version ant_version ;
-  L.debug Capture Verbose "%s %s@." prog @@ String.concat ~sep:" " args ;
-  let ant_out, _ = Process.create_process_and_wait_with_output ~prog ~args:("-verbose" :: args) in
   L.debug Capture Verbose "%s" ant_out ;
   let res =
     List.fold (String.split_lines ant_out) ~init:{collecting= false; rev_javac_args= []}

infer/src/integration/Gradle.ml

@@ -40,13 +40,15 @@ let parse_gradle_line ~line =
 let normalize path = if String.is_substring path ~substring:" " then "\"" ^ path ^ "\"" else path
 
 let capture ~prog ~args =
-  let _, java_version =
-    Process.create_process_and_wait_with_output ~prog:"java" ~args:["-version"]
+  let java_version =
+    Process.create_process_and_wait_with_output ~prog:"java" ~args:["-version"] ReadStderr
   in
-  let _, javac_version =
-    Process.create_process_and_wait_with_output ~prog:"javac" ~args:["-version"]
+  let javac_version =
+    Process.create_process_and_wait_with_output ~prog:"javac" ~args:["-version"] ReadStderr
+  in
+  let gradle_version =
+    Process.create_process_and_wait_with_output ~prog ~args:["--version"] ReadStdout
   in
-  let gradle_version, _ = Process.create_process_and_wait_with_output ~prog ~args:["--version"] in
   L.environment_info "%s %s %s@." java_version javac_version gradle_version ;
   let process_gradle_line seen line =
     match String.substr_index line ~pattern:arg_start_pattern with

infer/src/integration/XcodeBuild.ml

@@ -9,14 +9,14 @@ module L = Logging
 
 let capture ~prog ~args =
   let apple_clang =
-    Process.create_process_and_wait_with_output ~prog:"xcrun" ~args:["--find"; "clang"]
-    |> fst |> String.strip
+    Process.create_process_and_wait_with_output ~prog:"xcrun" ~args:["--find"; "clang"] ReadStdout
+    |> String.strip
   in
-  let xcode_version, _ =
-    Process.create_process_and_wait_with_output ~prog:"xcodebuild" ~args:["-version"]
+  let xcode_version =
+    Process.create_process_and_wait_with_output ~prog:"xcodebuild" ~args:["-version"] ReadStdout
   in
-  let apple_clang_version, _ =
-    Process.create_process_and_wait_with_output ~prog:apple_clang ~args:["--version"]
+  let apple_clang_version =
+    Process.create_process_and_wait_with_output ~prog:apple_clang ~args:["--version"] ReadStdout
   in
   L.environment_info "Xcode version: %s@." xcode_version ;
   L.environment_info "clang version: %s@." apple_clang_version ;