mllib: add a new run_command helper

Add a simple helper to run a command from a sequence of arguments,
without using a shell: this should help reducing the amount of quoting
ineeded, since arguments are passed straight as such.

Make use of it in the places currently using shell_command, and which
don't assume they can run anything (so no shell redirections, `env`,
etc).

builder/builder.ml

@@ -118,18 +118,17 @@ let main () =
   let mode =
     match cmdline.mode with
     | `Get_kernel -> (* --get-kernel is really a different program ... *)
-      let cmd =
-        sprintf "virt-get-kernel%s%s%s%s --add %s"
-          (if verbose () then " --verbose" else "")
-          (if trace () then " -x" else "")
-          (match cmdline.format with
-          | None -> ""
-          | Some format -> sprintf " --format %s" (quote format))
-          (match cmdline.output with
-          | None -> ""
-          | Some output -> sprintf " --output %s" (quote output))
-          (quote cmdline.arg) in
-      exit (shell_command cmd)
+      let cmd = [ "virt-get-kernel" ] @
+        (if verbose () then [ "--verbose" ] else []) @
+        (if trace () then [ "-x" ] else []) @
+        (match cmdline.format with
+        | None -> []
+        | Some format -> [ "--format"; format ]) @
+        (match cmdline.output with
+        | None -> []
+        | Some output -> [ "--output"; output ]) @
+        [ "--add"; cmdline.arg ] in
+      exit (run_command cmd)
 
     | `Delete_cache ->                  (* --delete-cache *)
       (match cmdline.cache with
@@ -550,14 +549,14 @@ let main () =
       let ifile = List.assoc `Filename itags in
       let ofile = List.assoc `Filename otags in
       message (f_"Copying");
-      let cmd = sprintf "cp %s %s" (quote ifile) (quote ofile) in
-      if shell_command cmd <> 0 then exit 1
+      let cmd = [ "cp"; ifile; ofile ] in
+      if run_command cmd <> 0 then exit 1
 
     | itags, `Rename, otags ->
       let ifile = List.assoc `Filename itags in
       let ofile = List.assoc `Filename otags in
-      let cmd = sprintf "mv %s %s" (quote ifile) (quote ofile) in
-      if shell_command cmd <> 0 then exit 1
+      let cmd = [ "mv"; ifile; ofile ] in
+      if run_command cmd <> 0 then exit 1
 
     | itags, `Pxzcat, otags ->
       let ifile = List.assoc `Filename itags in
@@ -580,22 +579,21 @@ let main () =
       let () =
         let g = open_guestfs () in
         g#disk_create ?preallocation ofile oformat osize in
-      let cmd =
-        sprintf "virt-resize%s%s%s --output-format %s%s%s --unknown-filesystems error %s %s"
-          (if verbose () then " --verbose" else " --quiet")
-          (if is_block_device ofile then " --no-sparse" else "")
-          (match iformat with
-          | None -> ""
-          | Some iformat -> sprintf " --format %s" (quote iformat))
-          (quote oformat)
-          (match expand with
-          | None -> ""
-          | Some expand -> sprintf " --expand %s" (quote expand))
-          (match lvexpand with
-          | None -> ""
-          | Some lvexpand -> sprintf " --lv-expand %s" (quote lvexpand))
-          (quote ifile) (quote ofile) in
-      if shell_command cmd <> 0 then exit 1
+      let cmd = [ "virt-resize" ] @
+        (if verbose () then [ "--verbose" ] else [ "--quiet" ]) @
+        (if is_block_device ofile then [ "--no-sparse" ] else []) @
+        (match iformat with
+        | None -> []
+        | Some iformat -> [ "--format"; iformat ]) @
+        [ "--output-format"; oformat ] @
+        (match expand with
+        | None -> []
+        | Some expand -> [ "--expand"; expand ]) @
+        (match lvexpand with
+        | None -> []
+        | Some lvexpand -> [ "--lv-expand"; lvexpand ]) @
+        [ "--unknown-filesystems"; "error"; ifile; ofile ] in
+      if run_command cmd <> 0 then exit 1
 
     | itags, `Disk_resize, otags ->
       let ofile = List.assoc `Filename otags in

builder/cache.ml

@@ -25,8 +25,8 @@ open Unix
 open Printf
 
 let clean_cachedir dir =
-  let cmd = sprintf "rm -rf %s" (quote dir) in
-  ignore (shell_command cmd);
+  let cmd = [ "rm"; "-rf"; dir ] in
+  ignore (run_command cmd);
 
 type t = {
   directory : string;

builder/downloader.ml

@@ -85,10 +85,10 @@ and download_to t ?(progress_bar = false) ~proxy uri filename =
   (match parseduri.URI.protocol with
   | "file" ->
     let path = parseduri.URI.path in
-    let cmd = sprintf "cp%s %s %s"
-      (if verbose () then " -v" else "")
-      (quote path) (quote filename_new) in
-    let r = shell_command cmd in
+    let cmd = [ "cp" ] @
+      (if verbose () then [ "-v" ] else []) @
+      [ path; filename_new ] in
+    let r = run_command cmd in
     if r <> 0 then
       error (f_"cp (download) command failed copying '%s'") path;
   | _ as protocol -> (* Any other protocol. *)

builder/sigchecker.ml

@@ -183,8 +183,8 @@ and verify_and_remove_signature t filename =
      * so gpg recognises that format. *)
     let asc_file = Filename.temp_file "vbfile" ".asc" in
     unlink_on_exit asc_file;
-    let cmd = sprintf "cp %s %s" (quote filename) (quote asc_file) in
-    if shell_command cmd <> 0 then exit 1;
+    let cmd = [ "cp"; filename; asc_file ] in
+    if run_command cmd <> 0 then exit 1;
     let out_file = Filename.temp_file "vbfile" "" in
     unlink_on_exit out_file;
     let args = sprintf "--yes --output %s %s" (quote out_file) (quote filename) in

dib/dib.ml

@@ -392,7 +392,7 @@ let run_parts_host ~debug hooks_dir hook_name scripts run_script =
   List.iter (
     fun x ->
       message (f_"Running: %s/%s") hook_name x;
-      let cmd = sprintf "%s %s %s" (quote run_script) (quote hook_dir) (quote x) in
+      let cmd = [ run_script; hook_dir; x ] in
       let run () =
         run_command cmd in
       let delta_t = timed_run run in
@@ -594,27 +594,27 @@ let main () =
 
   let copy_in (g : Guestfs.guestfs) srcdir destdir =
     let desttar = Filename.temp_file ~temp_dir:tmpdir "virt-dib." ".tar.gz" in
-    let cmd = sprintf "tar czf %s -C %s --owner=root --group=root ."
-      (quote desttar) (quote srcdir) in
-    run_command cmd;
+    let cmd = [ "tar"; "czf"; desttar; "-C"; srcdir; "--owner=root";
+                "--group=root"; "." ] in
+    if run_command cmd <> 0 then exit 1;
     g#mkdir_p destdir;
     g#tar_in ~compress:"gzip" desttar destdir;
     Sys.remove desttar in
 
   let copy_preserve_in (g : Guestfs.guestfs) srcdir destdir =
     let desttar = Filename.temp_file ~temp_dir:tmpdir "virt-dib." ".tar.gz" in
     let remotetar = "/tmp/aux/" ^ (Filename.basename desttar) in
-    let cmd = sprintf "tar czf %s -C %s --owner=root --group=root ."
-      (quote desttar) (quote srcdir) in
-    run_command cmd;
+    let cmd = [ "tar"; "czf"; desttar; "-C"; srcdir; "--owner=root";
+                "--group=root"; "." ] in
+    if run_command cmd <> 0 then exit 1;
     g#upload desttar remotetar;
     let verbose_flag = if debug > 0 then "v" else "" in
     ignore (g#debug "sh" [| "tar"; "-C"; "/sysroot" ^ destdir; "--no-overwrite-dir"; "-x" ^ verbose_flag ^ "zf"; "/sysroot" ^ remotetar |]);
     Sys.remove desttar;
     g#rm remotetar in
 
   if debug >= 1 then
-    ignore (shell_command (sprintf "tree -ps %s" (quote tmpdir)));
+    ignore (run_command [ "tree"; "-ps"; tmpdir ]);
 
   message (f_"Opening the disks");
 
@@ -877,35 +877,22 @@ let main () =
         message (f_"Converting to %s") fmt;
         match fmt with
         | "qcow2" ->
-          let cmd =
-            sprintf "qemu-img convert%s -f %s %s -O %s%s %s"
-              (if cmdline.compressed then " -c" else "")
-              tmpdiskfmt
-              (quote tmpdisk)
-              fmt
-              (match cmdline.qemu_img_options with
-              | None -> ""
-              | Some opt -> " -o " ^ quote opt)
-              (quote (qemu_input_filename fn)) in
-          if debug >= 1 then
-            printf "%s\n%!" cmd;
-          run_command cmd
+          let cmd = [ "qemu-img"; "convert" ] @
+            (if cmdline.compressed then [ "-c" ] else []) @
+            [ "-f"; tmpdiskfmt; tmpdisk; "-O"; fmt ] @
+            (match cmdline.qemu_img_options with
+            | None -> []
+            | Some opt -> [ "-o"; opt ]) @
+            [ qemu_input_filename fn ] in
+          if run_command cmd <> 0 then exit 1;
         | "vhd" ->
           let fn_intermediate = Filename.temp_file ~temp_dir:tmpdir "vhd-intermediate." "" in
-          let cmd =
-            sprintf "vhd-util convert -s 0 -t 1 -i %s -o %s"
-              (quote tmpdisk)
-              (quote fn_intermediate) in
-          if debug >= 1 then
-            printf "%s\n%!" cmd;
-          run_command cmd;
-          let cmd =
-            sprintf "vhd-util convert -s 1 -t 2 -i %s -o %s"
-              (quote fn_intermediate)
-              (quote fn) in
-          if debug >= 1 then
-            printf "%s\n%!" cmd;
-          run_command cmd;
+          let cmd = [ "vhd-util"; "convert"; "-s"; "0"; "-t"; "1";
+                      "-i"; tmpdisk; "-o"; fn_intermediate ] in
+          if run_command cmd <> 0 then exit 1;
+          let cmd = [ "vhd-util"; "convert"; "-s"; "1"; "-t"; "2";
+                      "-i"; fn_intermediate; "-o"; fn ] in
+          if run_command cmd <> 0 then exit 1;
           if not (Sys.file_exists fn) then
             error (f_"VHD output not produced, most probably vhd-util is old or not patched for 'convert'")
         | _ as fmt -> error "unhandled format: %s" fmt

dib/utils.ml

@@ -109,16 +109,14 @@ let which tool =
   | [] -> raise (Tool_not_found tool)
   | x :: _ -> x
 
-let run_command cmd =
-  ignore (external_command cmd)
-
 let require_tool tool =
   try ignore (which tool)
   with Tool_not_found tool ->
     error (f_"%s needed but not found") tool
 
 let do_cp src destdir =
-  run_command (sprintf "cp -t %s -a %s" (quote destdir) (quote src))
+  let cmd = [ "cp"; "-t"; destdir; "-a"; src ] in
+  if run_command cmd <> 0 then exit 1
 
 let ensure_trailing_newline str =
   if String.length str > 0 && str.[String.length str - 1] <> '\n' then str ^ "\n"

mllib/common_utils.ml

@@ -678,6 +678,22 @@ 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 pid =
+    Unix.create_process (List.hd args) (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 shell_command ?(echo_cmd = true) cmd =
   if echo_cmd then
     debug "%s" cmd;

mllib/common_utils.mli

@@ -249,6 +249,12 @@ 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
+(** Run an external command without using a shell, and return its exit code.
+
+    [echo_cmd] specifies whether output the full command on verbose
+    mode, and it's on by default. *)
+
 val shell_command : ?echo_cmd:bool -> string -> int
 (** Run an external shell command, and return its exit code.
 

v2v/copy_to_local.ml

@@ -218,8 +218,8 @@ read the man page virt-v2v-copy-to-local(1).
        ignore (Curl.run curl_args)
 
     | Test ->
-       let cmd = sprintf "cp %s %s" (quote remote_disk) (quote local_disk) in
-       if shell_command cmd <> 0 then
+       let cmd = [ "cp"; remote_disk; local_disk ] in
+       if run_command cmd <> 0 then
          error (f_"copy command failed, see earlier errors");
   ) disks;
 

v2v/input_libvirt_vcenter_https.ml

@@ -128,10 +128,9 @@ object
                                   parsed_uri scheme server orig_path in
 
       (* Rebase the qcow2 overlay to adjust the readahead parameter. *)
-      let cmd =
-        sprintf "qemu-img rebase -u -b %s %s"
-          (quote backing_qemu_uri) (quote overlay.ov_overlay_file) in
-      if shell_command cmd <> 0 then
+      let cmd = [ "qemu-img"; "rebase"; "-u"; "-b"; backing_qemu_uri;
+                  overlay.ov_overlay_file ] in
+      if run_command cmd <> 0 then
         warning (f_"qemu-img rebase failed (ignored)")
 end
 

v2v/input_ova.ml

@@ -60,8 +60,8 @@ object
           tmpfile in
 
         let untar ?(format = "") file outdir =
-          let cmd = sprintf "tar -x%sf %s -C %s" format (quote file) (quote outdir) in
-          if shell_command cmd <> 0 then
+          let cmd = [ "tar"; sprintf "-x%sf" format; file; "-C"; outdir ] in
+          if run_command cmd <> 0 then
             error (f_"error unpacking %s, see earlier error messages") ova in
 
         match detect_file_type ova with
@@ -73,10 +73,10 @@ object
           (* However, although not permitted by the spec, people ship
            * zip files as ova too.
            *)
-          let cmd = sprintf "unzip%s -j -d %s %s"
-            (if verbose () then "" else " -q")
-            (quote tmpdir) (quote ova) in
-          if shell_command cmd <> 0 then
+          let cmd = [ "unzip" ] @
+            (if verbose () then [] else [ "-q" ]) @
+            [ "-j"; "-d"; tmpdir; ova ] in
+          if run_command cmd <> 0 then
             error (f_"error unpacking %s, see earlier error messages") ova;
           tmpdir
         | (`GZip|`XZ) as format ->

v2v/output_glance.ml

@@ -73,10 +73,10 @@ object
           if i == 0 then source.s_name
           else sprintf "%s-disk%d" source.s_name (i+1) in
 
-        let cmd =
-          sprintf "glance image-create --name %s --disk-format=%s --container-format=bare --file %s"
-                  (quote name) (quote target_format) target_file in
-        if shell_command cmd <> 0 then
+        let cmd = [ "glance"; "image-create"; "--name"; name;
+                    "--disk-format=" ^ target_format;
+                    "--container-format=bare"; "--file"; target_file ] in
+        if run_command cmd <> 0 then
           error (f_"glance: image upload to glance failed, see earlier errors");
 
         (* Set the properties (ie. metadata). *)
@@ -115,17 +115,16 @@ object
           | x, y -> ("os_version", sprintf "%d.%d" x y) :: properties in
 
         (* Glance doesn't appear to check the properties. *)
-        let cmd =
-          sprintf "glance image-update --min-ram %Ld %s %s"
-                  min_ram
-                  (String.concat " "
+        let cmd = [ "glance"; "image-update"; "--min-ram";
+                    Int64.to_string min_ram ] @
+                  (List.flatten
                     (List.map (
                        fun (k, v) ->
-                         sprintf "--property %s=%s" (quote k) (quote v)
+                         [ "--property"; sprintf "%s=%s" k v ]
                     ) properties
-                  ))
-                  (quote name) in
-        if shell_command cmd <> 0 then (
+                  )) @
+                  [ name ] in
+        if run_command cmd <> 0 then (
           warning (f_"glance: failed to set image properties (ignored)");
           (* Dump out the image properties so the user can set them. *)
           printf "Image properties:\n";

v2v/output_libvirt.ml

@@ -386,11 +386,9 @@ class output_libvirt oc output_pool = object
      *)
     let cmd =
       match oc with
-      | None -> sprintf "virsh pool-refresh %s" (quote output_pool)
-      | Some uri ->
-        sprintf "virsh -c %s pool-refresh %s"
-          (quote uri) (quote output_pool) in
-    if shell_command cmd <> 0 then
+      | None -> [ "virsh"; "pool-refresh"; output_pool ]
+      | Some uri -> [ "virsh"; "-c"; uri; "pool-refresh"; output_pool ] in
+    if run_command cmd <> 0 then
       warning (f_"could not refresh libvirt pool %s") output_pool;
 
     (* Parse the capabilities XML in order to get the supported features. *)
@@ -419,10 +417,9 @@ class output_libvirt oc output_pool = object
     (* Define the domain in libvirt. *)
     let cmd =
       match oc with
-      | None -> sprintf "virsh define %s" (quote tmpfile)
-      | Some uri ->
-        sprintf "virsh -c %s define %s" (quote uri) (quote tmpfile) in
-    if shell_command cmd = 0 then (
+      | None -> [ "virsh"; "define"; tmpfile ]
+      | Some uri -> [ "virsh"; "-c"; uri; "define"; tmpfile ] in
+    if run_command cmd = 0 then (
       try Unix.unlink tmpfile with _ -> ()
     ) else (
       warning (f_"could not define libvirt domain.  The libvirt XML is still available in '%s'.  Try running 'virsh define %s' yourself instead.")