Libguestfs - Apr 2017 - [PATCH 1/2] mllib: add new Common_utils.run_commands

Mostly modelled after a snippet implemented in dib, it is an helper
function to run multiple commands in parallel, waiting for all of them
at once, and returning all their exit codes.  It is possible to pass
custom descriptors for collecting stdout and stderr of each command.

Common_utils.run_command is adapted to use it, so all the existing
code using it keeps working.

Add a simple unit tests for it.
---
 mllib/common_utils.ml       | 85 +++++++++++++++++++++++++++++++++------------
 mllib/common_utils.mli      | 19 ++++++++++
 mllib/common_utils_tests.ml | 50 ++++++++++++++++++++++++++
 3 files changed, 132 insertions(+), 22 deletions(-)

diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 73546d7..0008d3a 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -825,29 +825,70 @@ let external_command ?(echo_cmd = true) cmd    );
   lines
 
+let run_commands ?(echo_cmd = true) cmds +  let res = Array.make (List.length
cmds) 0 in
+  let get_fd default = function
+    | None ->
+      default
+    | Some fd ->
+      Unix.set_close_on_exec fd;
+      fd
+  in
+  let pids +    mapi (
+      fun i (args, out, err) ->
+        let app = List.hd args in
+        try
+          let app +            if Filename.is_relative app then which app
+            else (Unix.access app [Unix.X_OK]; app) in
+          let outfd = get_fd Unix.stdout out in
+          let errfd = get_fd Unix.stderr err in
+          if echo_cmd then
+            debug "%s" (stringify_args args);
+          let pid = Unix.create_process app (Array.of_list args) Unix.stdin
+                      outfd errfd in
+          Some (i, pid, app, out, err)
+        with
+        | Executable_not_found _ ->
+          res.(i) <- 127;
+          None
+        | Unix.Unix_error (errcode, _, _) when errcode = Unix.ENOENT ->
+          res.(i) <- 127;
+          None
+    ) cmds in
+  let pids = filter_map (fun x -> x) pids in
+  let pids = ref pids in
+  while !pids <> [] do
+    let pid, stat = Unix.waitpid [] 0 in
+    let matching_pair, new_pids +      List.partition (
+        fun (_, p, _, _, _) ->
+          pid = p
+      ) !pids in
+    if matching_pair <> [] then (
+      let matching_pair = List.hd matching_pair in
+      let idx, _, app, outfd, errfd = matching_pair in
+      may Unix.close outfd;
+      may Unix.close errfd;
+      pids := new_pids;
+      match stat with
+      | Unix.WEXITED i ->
+        res.(idx) <- i
+      | Unix.WSIGNALED i ->
+        error (f_"external command ‘%s’ killed by signal %d")
+          app i
+      | Unix.WSTOPPED i ->
+        error (f_"external command ‘%s’ stopped by signal %d")
+          app i
+    );
+  done;
+  Array.to_list res
+
 let run_command ?(echo_cmd = true) args -  if echo_cmd then
-    debug "%s" (stringify_args args);
-  let app = List.hd args in
-  try
-    let app -      if Filename.is_relative app then which app
-      else (Unix.access app [Unix.X_OK]; app) in
-    let pid -      Unix.create_process app (Array.of_list args) Unix.stdin
-        Unix.stdout Unix.stderr in
-    let _, stat = Unix.waitpid [] pid in
-    match stat with
-    | Unix.WEXITED i -> i
-    | Unix.WSIGNALED i ->
-      error (f_"external command ‘%s’ killed by signal %d")
-        (stringify_args args) i
-    | Unix.WSTOPPED i ->
-      error (f_"external command ‘%s’ stopped by signal %d")
-        (stringify_args args) i
-  with
-  | Executable_not_found tool -> 127
-  | Unix.Unix_error (errcode, _, _) when errcode = Unix.ENOENT -> 127
+  let ret = run_commands ~echo_cmd [(args, None, None)] in
+  assert (List.length ret = 1);
+  List.hd ret
 
 let shell_command ?(echo_cmd = true) cmd    if echo_cmd then
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
index 1cd38ba..90351ad 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -359,6 +359,25 @@ val external_command : ?echo_cmd:bool -> string ->
string list
     [echo_cmd] specifies whether to output the full command on verbose
     mode, and it's on by default. *)
 
+val run_commands : ?echo_cmd:bool -> (string list * Unix.file_descr option *
Unix.file_descr option) list -> int list
+(** Run external commands in parallel without using a shell,
+    and return a list with their exit codes.
+
+    The list of commands is composed as tuples:
+    - the first element is a list of command and its arguments
+    - the second element is an optional [Unix.file_descr] descriptor
+      for the stdout of the process; if not specified, [stdout] is
+      used
+    - the third element is an optional [Unix.file_descr] descriptor
+      for the stderr of the process; if not specified, [stderr] is
+      used
+
+    If any descriptor is specified, it is automatically closed at the
+    end of the execution of the command for which it was specified.
+
+    [echo_cmd] specifies whether output the full command on verbose
+    mode, and it's on by default. *)
+
 val run_command : ?echo_cmd:bool -> string list -> int
 (** Run an external command without using a shell, and return its exit code.
 
diff --git a/mllib/common_utils_tests.ml b/mllib/common_utils_tests.ml
index aacc01e..42af7be 100644
--- a/mllib/common_utils_tests.ml
+++ b/mllib/common_utils_tests.ml
@@ -26,6 +26,7 @@ let assert_equal_string = assert_equal ~printer:(fun x ->
x)
 let assert_equal_int = assert_equal ~printer:(fun x -> string_of_int x)
 let assert_equal_int64 = assert_equal ~printer:(fun x -> Int64.to_string x)
 let assert_equal_stringlist = assert_equal ~printer:(fun x -> "("
^ (String.escaped (String.concat "," x)) ^ ")")
+let assert_equal_intlist = assert_equal ~printer:(fun x -> "(" ^
(String.concat ";" (List.map string_of_int x)) ^ ")")
 
 let test_subdirectory ctx    assert_equal_string "" (subdirectory
"/foo" "/foo");
@@ -131,6 +132,54 @@ let test_string_lines_split ctx    assert_equal_stringlist
["A\nB"; ""] (String.lines_split "A\\\nB\n");
   assert_equal_stringlist ["A\nB\n"] (String.lines_split
"A\\\nB\\\n")
 
+(* Test Common_utils.run_commands. *)
+let test_run_commands ctx +  begin
+    let res = run_commands [] in
+    assert_equal_intlist [] res
+  end;
+  begin
+    let res = run_commands [(["true"], None, None)] in
+    assert_equal_intlist [0] res
+  end;
+  begin
+    let res = run_commands [(["true"], None, None);
(["false"], None, None)] in
+    assert_equal_intlist [0; 1] res
+  end;
+  begin
+    let res = run_commands [(["this-command-does-not-really-exist"],
None, None)] in
+    assert_equal_intlist [127] res
+  end;
+  begin
+    let tmpfile, chan = bracket_tmpfile ctx in
+    let res = run_commands [(["echo"; "this is a test"],
Some (Unix.descr_of_out_channel chan), None)] in
+    assert_equal_intlist [0] res;
+    let content = read_whole_file tmpfile in
+    assert_equal_string "this is a test\n" content
+  end;
+  begin
+    let tmpfile, chan = bracket_tmpfile ctx in
+    let res = run_commands [(["ls";
"/this-directory-is-unlikely-to-exist"], None, Some
(Unix.descr_of_out_channel chan))] in
+    assert_equal_intlist [2] res;
+    let content = read_whole_file tmpfile in
+    assert_bool "test_run_commands/not-existing/content"
(String.length content > 0)
+  end;
+  begin
+    let tmpfile, chan = bracket_tmpfile ctx in
+    let res = run_commands [(["echo"; "this is a test"],
Some (Unix.descr_of_out_channel chan), None); (["false"], None, None)]
in
+    assert_equal_intlist [0; 1] res;
+    let content = read_whole_file tmpfile in
+    assert_equal_string "this is a test\n" content
+  end;
+  begin
+    let tmpfile, chan = bracket_tmpfile ctx in
+    let res = run_commands [(["this-command-does-not-really-exist"],
None, None); (["echo"; "this is a test"], Some
(Unix.descr_of_out_channel chan), None)] in
+    assert_equal_intlist [127; 0] res;
+    let content = read_whole_file tmpfile in
+    assert_equal_string "this is a test\n" content
+  end;
+  ()
+
 (* Suites declaration. *)
 let suite    "mllib Common_utils" >:::
@@ -143,6 +192,7 @@ let suite        "strings.is_suffix" >::
test_string_is_suffix;
       "strings.find" >:: test_string_find;
       "strings.lines_split" >:: test_string_lines_split;
+      "run_commands" >:: test_run_commands;
     ]
 
 let () -- 
2.9.3

Use the new helper for spawning parallel commands, and redirecting their
stdout to file.
---
 dib/dib.ml | 42 ++++++++++--------------------------------
 1 file changed, 10 insertions(+), 32 deletions(-)

diff --git a/dib/dib.ml b/dib/dib.ml
index 8d078aa..eca47fa 100644
--- a/dib/dib.ml
+++ b/dib/dib.ml
@@ -980,45 +980,23 @@ let main ()      List.iter (
       fun fn ->
         message (f_"Generating checksums for %s") fn;
-        let pids +        let cmds            List.map (
             fun csum ->
               let csum_fn = fn ^ "." ^ csum in
               let csum_tool = tool_of_checksum csum in
               let outfd = Unix.openfile csum_fn file_flags 0o640 in
-              Unix.set_close_on_exec outfd;
-              let args = [| csum_tool; fn; |] in
-              Common_utils.debug "%s" (stringify_args (Array.to_list
args));
-              let pid = Unix.create_process csum_tool args Unix.stdin
-                          outfd Unix.stderr in
-              (pid, csum_tool, outfd)
+              [ csum_tool; fn ], Some outfd, None
           ) checksums in
-        let pids = ref pids in
-        while !pids <> [] do
-          let pid, stat = Unix.waitpid [] 0 in
-          let matching_pair, new_pids -            List.partition (
-              fun (p, tool, outfd) ->
-                pid = p
-            ) !pids in
-          if matching_pair <> [] then (
-            let matching_pair = List.hd matching_pair in
-            let _, csum_tool, outfd = matching_pair in
-            Unix.close outfd;
-            pids := new_pids;
-            match stat with
-            | Unix.WEXITED 0 -> ()
-            | Unix.WEXITED i ->
+        let res = run_commands cmds in
+        iteri (
+          fun i code ->
+            if code <> 0 then (
+              let args, _, _ = List.nth cmds i in
               error (f_"external command ‘%s’ exited with error %d")
-                csum_tool i
-            | Unix.WSIGNALED i ->
-              error (f_"external command ‘%s’ killed by signal %d")
-                csum_tool i
-            | Unix.WSTOPPED i ->
-              error (f_"external command ‘%s’ stopped by signal %d")
-                csum_tool i
-          );
-        done;
+                (List.hd args) code
+            )
+        ) res;
     ) filenames;
   );
 
-- 
2.9.3