Libguestfs - Jun 2017 - [PATCH v2 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 few helper methods used by
run_commands, so all the existing code using it keeps working; in
addition, it gets labelled parameters for stdout and stderr FDs.

Add a simple unit tests for them.
---
 mllib/common_utils.ml       | 87 ++++++++++++++++++++++++++++++++++++---------
 mllib/common_utils.mli      | 21 ++++++++++-
 mllib/common_utils_tests.ml | 70 ++++++++++++++++++++++++++++++++++++
 3 files changed, 160 insertions(+), 18 deletions(-)

diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 6a9b089..60b43a3 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -846,29 +846,82 @@ let external_command ?(echo_cmd = true) cmd    );
   lines
 
-let run_command ?(echo_cmd = true) args -  if echo_cmd then
-    debug "%s" (stringify_args args);
+let rec run_commands ?(echo_cmd = true) cmds +  let res = Array.make
(List.length cmds) 0 in
+  let pids +    mapi (
+      fun i (args, stdout_chan, stderr_chan) ->
+        let run_res = do_run args ?stdout_chan ?stderr_chan in
+        match run_res with
+        | Either (pid, app, outfd, errfd) ->
+          Some (i, pid, app, outfd, errfd)
+        | Or code ->
+          res.(i) <- code;
+          None
+    ) cmds in
+  let pids = filter_map identity 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
+      pids := new_pids;
+      res.(idx) <- do_teardown app outfd errfd stat
+    );
+  done;
+  Array.to_list res
+
+and run_command ?(echo_cmd = true) ?stdout_chan ?stderr_chan args +  let
run_res = do_run args ~echo_cmd ?stdout_chan ?stderr_chan in
+  match run_res with
+  | Either (pid, app, outfd, errfd) ->
+    let _, stat = Unix.waitpid [] pid in
+    do_teardown app outfd errfd stat
+  | Or code ->
+    code
+
+and do_run ?(echo_cmd = true) ?stdout_chan ?stderr_chan args    let app =
List.hd args in
+  let get_fd default = function
+    | None ->
+      default
+    | Some fd ->
+      Unix.set_close_on_exec fd;
+      fd
+  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
+    let outfd = get_fd Unix.stdout stdout_chan in
+    let errfd = get_fd Unix.stderr stderr_chan 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
+    Either (pid, app, stdout_chan, stderr_chan)
   with
-  | Executable_not_found tool -> 127
-  | Unix.Unix_error (errcode, _, _) when errcode = Unix.ENOENT -> 127
+  | Executable_not_found _ ->
+    Or 127
+  | Unix.Unix_error (errcode, _, _) when errcode = Unix.ENOENT ->
+    Or 127
+
+and do_teardown app outfd errfd exitstat +  may Unix.close outfd;
+  may Unix.close errfd;
+  match exitstat with
+  | Unix.WEXITED i ->
+    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
 
 let shell_command ?(echo_cmd = true) cmd    if echo_cmd then
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
index c088f84..ee8c2e6 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -374,7 +374,26 @@ 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_command : ?echo_cmd:bool -> string list -> int
+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 -> ?stdout_chan:Unix.file_descr ->
?stderr_chan:Unix.file_descr -> string list -> int
 (** Run an external command without using a shell, and return its exit code.
 
     [echo_cmd] specifies whether output the full command on verbose
diff --git a/mllib/common_utils_tests.ml b/mllib/common_utils_tests.ml
index aacc01e..4c9f53f 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,73 @@ 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_command. *)
+let test_run_command ctx +  assert_equal_int 0 (run_command
["true"]);
+  begin
+    let tmpfile, chan = bracket_tmpfile ctx in
+    let res = run_command ["echo"; "this is a test"]
~stdout_chan:(Unix.descr_of_out_channel chan) in
+    assert_equal_int 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_command ["ls";
"/this-directory-is-unlikely-to-exist"]
~stderr_chan:(Unix.descr_of_out_channel chan) in
+    assert_equal_int 2 res;
+    let content = read_whole_file tmpfile in
+    assert_bool "test_run_commands/not-existing/content"
(String.length content > 0)
+  end;
+  ()
+
+(* 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 +211,8 @@ let suite        "strings.is_suffix" >::
test_string_is_suffix;
       "strings.find" >:: test_string_find;
       "strings.lines_split" >:: test_string_lines_split;
+      "run_command" >:: test_run_command;
+      "run_commands" >:: test_run_commands;
     ]
 
 let () -- 
2.9.4

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.4

ACK series.

I pushed this because I want to rebase on top of it asap.

Thanks,

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-builder quickly builds VMs from scratch
http://libguestfs.org/virt-builder.1.html