11:25 a.m.
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 | 62 ++++++++++++++++++--------------------
builder/cache.ml | 4 +--
builder/downloader.ml | 8 ++---
builder/sigchecker.ml | 4 +--
dib/dib.ml | 57 ++++++++++++++---------------------
dib/utils.ml | 6 ++--
mllib/common_utils.ml | 15 +++++++++
mllib/common_utils.mli | 6 ++++
v2v/copy_to_local.ml | 4 +--
v2v/input_libvirt_vcenter_https.ml | 7 ++---
v2v/input_ova.ml | 12 ++++----
v2v/output_glance.ml | 23 +++++++-------
v2v/output_libvirt.ml | 15 ++++-----
v2v/output_rhev.ml | 9 +++---
v2v/v2v.ml | 21 ++++++-------
15 files changed, 124 insertions(+), 129 deletions(-)
diff --git a/builder/builder.ml b/builder/builder.ml
index 6645e75..b7a1da0 100644
--- a/builder/builder.ml
+++ b/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 (Array.of_list 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 (Array.of_list cmd) <> 0 then exit 1
| itags, `Disk_resize, otags ->
let ofile = List.assoc `Filename otags in
diff --git a/builder/cache.ml b/builder/cache.ml
index 9d056a1..becf73a 100644
--- a/builder/cache.ml
+++ b/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;
diff --git a/builder/downloader.ml b/builder/downloader.ml
index 7406ce8..f4c65c4 100644
--- a/builder/downloader.ml
+++ b/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 (Array.of_list cmd) in
if r <> 0 then
error (f_"cp (download) command failed copying '%s'") path;
| _ as protocol -> (* Any other protocol. *)
diff --git a/builder/sigchecker.ml b/builder/sigchecker.ml
index d30baf5..5289d30 100644
--- a/builder/sigchecker.ml
+++ b/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
diff --git a/dib/dib.ml b/dib/dib.ml
index a76eb5e..4073d47 100644
--- a/dib/dib.ml
+++ b/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,9 +594,9 @@ 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
@@ -604,9 +604,9 @@ let main () =
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 |]);
@@ -614,7 +614,7 @@ let main () =
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 (Array.of_list 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
diff --git a/dib/utils.ml b/dib/utils.ml
index a3be394..6494627 100644
--- a/dib/utils.ml
+++ b/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"
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 0332510..2fcbbae 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -679,6 +679,21 @@ 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 args.(0) 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;
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
index 5bcc692..1845ce4 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -249,6 +249,12 @@ val external_command : ?echo_cmd:bool -> string -> string list
[echo_cmd] specifies whether output the full command on verbose
mode, and it's on by default. *)
+val run_command : ?echo_cmd:bool -> string array -> 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.
diff --git a/v2v/copy_to_local.ml b/v2v/copy_to_local.ml
index 0706f27..ed53277 100644
--- a/v2v/copy_to_local.ml
+++ b/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;
diff --git a/v2v/input_libvirt_vcenter_https.ml b/v2v/input_libvirt_vcenter_https.ml
index 1d28e17..66329a1 100644
--- a/v2v/input_libvirt_vcenter_https.ml
+++ b/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
diff --git a/v2v/input_ova.ml b/v2v/input_ova.ml
index dd52af5..b914960 100644
--- a/v2v/input_ova.ml
+++ b/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 (Array.of_list cmd) <> 0 then
error (f_"error unpacking %s, see earlier error messages") ova;
tmpdir
| (`GZip|`XZ) as format ->
diff --git a/v2v/output_glance.ml b/v2v/output_glance.ml
index dc5d868..6dd2995 100644
--- a/v2v/output_glance.ml
+++ b/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 (Array.of_list 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";
diff --git a/v2v/output_libvirt.ml b/v2v/output_libvirt.ml
index db3a3fa..219388a 100644
--- a/v2v/output_libvirt.ml
+++ b/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.")
diff --git a/v2v/output_rhev.ml b/v2v/output_rhev.ml
index 971c1af..7daa727 100644
--- a/v2v/output_rhev.ml
+++ b/v2v/output_rhev.ml
@@ -43,15 +43,14 @@ let rec mount_and_check_storage_domain domain_class os =
chmod mp 0o755;
(* Try mounting it. *)
- let cmd =
- sprintf "mount %s:%s %s" (quote server) (quote export) (quote mp) in
- if shell_command cmd <> 0 then
+ let cmd = [| "mount"; sprintf "%s:%s" server export; mp |] in
+ if run_command cmd <> 0 then
error (f_"mount command failed, see earlier errors.\n\nThis probably means you
didn't specify the right %s path [-os %s], or else you need to rerun virt-v2v as
root.") domain_class os;
(* Make sure it is unmounted at exit. *)
at_exit (fun () ->
- let cmd = sprintf "umount %s" (quote mp) in
- ignore (shell_command cmd);
+ let cmd = [| "umount"; mp |] in
+ ignore (run_command cmd);
try rmdir mp with _ -> ()
);
diff --git a/v2v/v2v.ml b/v2v/v2v.ml
index b332ced..81aec7e 100644
--- a/v2v/v2v.ml
+++ b/v2v/v2v.ml
@@ -226,10 +226,9 @@ and create_overlays src_disks =
"compat=1.1" ^
(match format with None -> ""
| Some fmt -> ",backing_fmt=" ^ fmt) in
- let cmd =
- sprintf "qemu-img create -q -f qcow2 -b %s -o %s %s"
- (quote qemu_uri) (quote options) overlay_file in
- if shell_command cmd <> 0 then
+ let cmd = [| "qemu-img"; "create"; "-q";
"-f"; "qcow2"; "-b"; qemu_uri;
+ "-o"; options; overlay_file |] in
+ if run_command cmd <> 0 then
error (f_"qemu-img command failed, see earlier errors");
(* Sanity check created overlay (see below). *)
@@ -629,15 +628,13 @@ and copy_targets cmdline targets input output =
t.target_file t.target_format t.target_overlay.ov_virtual_size
?preallocation ?compat;
- let cmd =
- sprintf "qemu-img convert%s -n -f qcow2 -O %s%s %s %s"
- (if not (quiet ()) then " -p" else "")
- (quote t.target_format)
- (if cmdline.compressed then " -c" else "")
- (quote overlay_file)
- (quote t.target_file) in
+ let cmd = [ "qemu-img"; "convert" ] @
+ (if not (quiet ()) then [ "-p" ] else []) @
+ [ "-n"; "-f"; "qcow2"; "-O";
t.target_format ] @
+ (if cmdline.compressed then [ "-c" ] else []) @
+ [ overlay_file; t.target_file ] in
let start_time = gettimeofday () in
- if shell_command cmd <> 0 then
+ if run_command (Array.of_list cmd) <> 0 then
error (f_"qemu-img command failed, see earlier errors");
let end_time = gettimeofday () in
--
2.5.5