Add a simple shell_command, which is mostly a wrapper around Sys.command but with logging of the command run. --- builder/builder.ml | 24 +++++++++--------------- builder/cache.ml | 2 +- builder/downloader.ml | 5 ++--- builder/sigchecker.ml | 18 ++++++------------ dib/dib.ml | 2 +- mllib/common_utils.ml | 7 ++++++- mllib/common_utils.mli | 6 ++++++ sparsify/copying.ml | 3 +-- v2v/copy_to_local.ml | 6 ++---- v2v/input_libvirt_vcenter_https.ml | 3 +-- v2v/input_ova.ml | 9 +++------ v2v/output_glance.ml | 8 +++----- v2v/output_libvirt.ml | 5 ++--- v2v/output_qemu.ml | 2 +- v2v/output_rhev.ml | 6 ++---- v2v/v2v.ml | 6 ++---- 16 files changed, 48 insertions(+), 64 deletions(-) diff --git a/builder/builder.ml b/builder/builder.ml index cd3e972..6645e75 100644 --- a/builder/builder.ml +++ b/builder/builder.ml @@ -129,8 +129,7 @@ let main () = | None -> "" | Some output -> sprintf " --output %s" (quote output)) (quote cmdline.arg) in - debug "%s" cmd; - exit (Sys.command cmd) + exit (shell_command cmd) | `Delete_cache -> (* --delete-cache *) (match cmdline.cache with @@ -150,7 +149,7 @@ let main () = * disables all signature checks. *) let cmd = sprintf "%s --help >/dev/null 2>&1" cmdline.gpg in - if Sys.command cmd <> 0 then ( + if shell_command cmd <> 0 then ( if cmdline.check_signature then error (f_"gpg is not installed (or does not work)\nYou should install gpg, or use --gpg option, or use --no-check-signature.") else if verbose () then @@ -159,12 +158,12 @@ let main () = (* Check that curl works. *) let cmd = sprintf "%s --help >/dev/null 2>&1" cmdline.curl in - if Sys.command cmd <> 0 then + if shell_command cmd <> 0 then error (f_"curl is not installed (or does not work)"); (* Check that virt-resize works. *) let cmd = "virt-resize --help >/dev/null 2>&1" in - if Sys.command cmd <> 0 then + if shell_command cmd <> 0 then error (f_"virt-resize is not installed (or does not work)"); (* Create the cache. *) @@ -552,15 +551,13 @@ let main () = let ofile = List.assoc `Filename otags in message (f_"Copying"); let cmd = sprintf "cp %s %s" (quote ifile) (quote ofile) in - debug "%s" cmd; - if Sys.command cmd <> 0 then exit 1 + if shell_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 - debug "%s" cmd; - if Sys.command cmd <> 0 then exit 1 + if shell_command cmd <> 0 then exit 1 | itags, `Pxzcat, otags -> let ifile = List.assoc `Filename itags in @@ -598,8 +595,7 @@ let main () = | None -> "" | Some lvexpand -> sprintf " --lv-expand %s" (quote lvexpand)) (quote ifile) (quote ofile) in - debug "%s" cmd; - if Sys.command cmd <> 0 then exit 1 + if shell_command cmd <> 0 then exit 1 | itags, `Disk_resize, otags -> let ofile = List.assoc `Filename otags in @@ -609,8 +605,7 @@ let main () = (human_size osize); let cmd = sprintf "qemu-img resize %s %Ld%s" (quote ofile) osize (if verbose () then "" else " >/dev/null") in - debug "%s" cmd; - if Sys.command cmd <> 0 then exit 1 + if shell_command cmd <> 0 then exit 1 | itags, `Convert, otags -> let ifile = List.assoc `Filename itags in @@ -628,8 +623,7 @@ let main () = | Some iformat -> sprintf " -f %s" (quote iformat)) (quote ifile) (quote oformat) (quote (qemu_input_filename ofile)) (if verbose () then "" else " >/dev/null 2>&1") in - debug "%s" cmd; - if Sys.command cmd <> 0 then exit 1 + if shell_command cmd <> 0 then exit 1 ) plan; (* Now mount the output disk so we can make changes. *) diff --git a/builder/cache.ml b/builder/cache.ml index 0791500..9d056a1 100644 --- a/builder/cache.ml +++ b/builder/cache.ml @@ -26,7 +26,7 @@ open Printf let clean_cachedir dir = let cmd = sprintf "rm -rf %s" (quote dir) in - ignore (Sys.command cmd); + ignore (shell_command cmd); type t = { directory : string; diff --git a/builder/downloader.ml b/builder/downloader.ml index 7dc0a29..7406ce8 100644 --- a/builder/downloader.ml +++ b/builder/downloader.ml @@ -88,7 +88,7 @@ and download_to t ?(progress_bar = false) ~proxy uri filename = let cmd = sprintf "cp%s %s %s" (if verbose () then " -v" else "") (quote path) (quote filename_new) in - let r = Sys.command cmd in + let r = shell_command cmd in if r <> 0 then error (f_"cp (download) command failed copying '%s'") path; | _ as protocol -> (* Any other protocol. *) @@ -118,8 +118,7 @@ and download_to t ?(progress_bar = false) ~proxy uri filename = t.curl (if verbose () then "" else if progress_bar then " -#" else " -s -S") (quote filename_new) (quote uri) in - debug "%s" cmd; - let r = Sys.command cmd in + let r = shell_command cmd in if r <> 0 then error (f_"curl (download) command failed downloading '%s'") uri; ); diff --git a/builder/sigchecker.ml b/builder/sigchecker.ml index 39a2766..d30baf5 100644 --- a/builder/sigchecker.ml +++ b/builder/sigchecker.ml @@ -39,8 +39,7 @@ let import_keyfile ~gpg ~gpghome ?(trust = true) keyfile = let cmd = sprintf "%s --homedir %s --status-file %s --import %s%s" gpg gpghome (quote status_file) (quote keyfile) (if verbose () then "" else " >/dev/null 2>&1") in - debug "%s" cmd; - let r = Sys.command cmd in + let r = shell_command cmd in if r <> 0 then error (f_"could not import public key\nUse the '-v' option and look for earlier error messages."); let status = read_whole_file status_file in @@ -59,8 +58,7 @@ let import_keyfile ~gpg ~gpghome ?(trust = true) keyfile = let cmd = sprintf "%s --homedir %s --trusted-key %s --list-keys%s" gpg gpghome (quote !key_id) (if verbose () then "" else " >/dev/null 2>&1") in - debug "%s" cmd; - let r = Sys.command cmd in + let r = shell_command cmd in if r <> 0 then error (f_"GPG failure: could not trust the imported key\nUse the '-v' option and look for earlier error messages."); ); @@ -108,8 +106,7 @@ let rec create ~gpg ~gpgkey ~check_signature = *) let cmd = sprintf "%s --homedir %s --list-keys%s" gpg tmpdir (if verbose () then "" else " >/dev/null 2>&1") in - debug "%s" cmd; - let r = Sys.command cmd in + let r = shell_command cmd in if r <> 0 then error (f_"GPG failure: could not run GPG the first time\nUse the '-v' option and look for earlier error messages."); match gpgkey with @@ -123,8 +120,7 @@ let rec create ~gpg ~gpgkey ~check_signature = let cmd = sprintf "%s --yes --armor --output %s --export %s%s" gpg (quote filename) (quote fp) (if verbose () then "" else " >/dev/null 2>&1") in - debug "%s" cmd; - let r = Sys.command cmd in + let r = shell_command cmd in if r <> 0 then error (f_"could not export public key\nUse the '-v' option and look for earlier error messages."); import_keyfile gpg tmpdir filename @@ -188,8 +184,7 @@ and verify_and_remove_signature t filename = 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 - debug "%s" cmd; - if Sys.command cmd <> 0 then exit 1; + if shell_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 @@ -207,8 +202,7 @@ and do_verify ?(verify_only = true) t args = (if verify_only then "--verify" else "") (if verbose () then "" else " --batch -q --logger-file /dev/null") (quote status_file) args in - debug "%s" cmd; - let r = Sys.command cmd in + let r = shell_command cmd in if r <> 0 then error (f_"GPG failure: could not verify digital signature of file\nTry:\n - Use the '-v' option and look for earlier error messages.\n - Delete the cache: virt-builder --delete-cache\n - Check no one has tampered with the website or your network!"); diff --git a/dib/dib.ml b/dib/dib.ml index 534a072..b988f14 100644 --- a/dib/dib.ml +++ b/dib/dib.ml @@ -624,7 +624,7 @@ let main () = g#rm remotetar in if debug >= 1 then - ignore (Sys.command (sprintf "tree -ps %s" (quote tmpdir))); + ignore (shell_command (sprintf "tree -ps %s" (quote tmpdir))); message (f_"Opening the disks"); diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml index 32071f4..d1aa8d2 100644 --- a/mllib/common_utils.ml +++ b/mllib/common_utils.ml @@ -669,6 +669,11 @@ let external_command ?(echo_cmd = true) cmd = ); lines +let shell_command ?(echo_cmd = true) cmd = + if echo_cmd then + debug "%s" cmd; + Sys.command cmd + (* Run uuidgen to return a random UUID. *) let uuidgen () = let lines = external_command "uuidgen -r" in @@ -713,7 +718,7 @@ let rmdir_on_exit = List.iter ( fun dir -> let cmd = sprintf "rm -rf %s" (Filename.quote dir) in - ignore (Sys.command cmd) + ignore (shell_command cmd) ) !dirs and register_handlers () = (* Remove on exit. *) diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli index a216e21..7f288b4 100644 --- a/mllib/common_utils.mli +++ b/mllib/common_utils.mli @@ -245,6 +245,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 shell_command : ?echo_cmd:bool -> string -> int +(** Run an external shell command, and return its exit code. + + [echo_cmd] specifies whether output the full command on verbose + mode, and it's on by default. *) + val uuidgen : unit -> string (** Run uuidgen to return a random UUID. *) diff --git a/sparsify/copying.ml b/sparsify/copying.ml index b2a7f41..83cbec7 100644 --- a/sparsify/copying.ml +++ b/sparsify/copying.ml @@ -326,8 +326,7 @@ You can ignore this warning or change it to a hard failure using the | None -> "" | Some option -> " -o " ^ quote option) (quote overlaydisk) (quote (qemu_input_filename outdisk)) in - debug "%s" cmd; - if Sys.command cmd <> 0 then + if shell_command cmd <> 0 then error (f_"external command failed: %s") cmd; (* Finished. *) diff --git a/v2v/copy_to_local.ml b/v2v/copy_to_local.ml index 629c8b6..0706f27 100644 --- a/v2v/copy_to_local.ml +++ b/v2v/copy_to_local.ml @@ -194,8 +194,7 @@ read the man page virt-v2v-copy-to-local(1). (if quiet () then "" else " status=progress") (quote local_disk) in - debug "%s" cmd; - if Sys.command cmd <> 0 then + if shell_command cmd <> 0 then error (f_"ssh copy command failed, see earlier errors"); | ESXi _ -> @@ -220,8 +219,7 @@ read the man page virt-v2v-copy-to-local(1). | Test -> let cmd = sprintf "cp %s %s" (quote remote_disk) (quote local_disk) in - debug "%s" cmd; - if Sys.command cmd <> 0 then + if shell_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 2acf966..1d28e17 100644 --- a/v2v/input_libvirt_vcenter_https.ml +++ b/v2v/input_libvirt_vcenter_https.ml @@ -131,8 +131,7 @@ object let cmd = sprintf "qemu-img rebase -u -b %s %s" (quote backing_qemu_uri) (quote overlay.ov_overlay_file) in - debug "%s" cmd; - if Sys.command cmd <> 0 then + if shell_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 65a2028..dd52af5 100644 --- a/v2v/input_ova.ml +++ b/v2v/input_ova.ml @@ -61,8 +61,7 @@ object let untar ?(format = "") file outdir = let cmd = sprintf "tar -x%sf %s -C %s" format (quote file) (quote outdir) in - debug "%s" cmd; - if Sys.command cmd <> 0 then + if shell_command cmd <> 0 then error (f_"error unpacking %s, see earlier error messages") ova in match detect_file_type ova with @@ -77,8 +76,7 @@ object let cmd = sprintf "unzip%s -j -d %s %s" (if verbose () then "" else " -q") (quote tmpdir) (quote ova) in - debug "%s" cmd; - if Sys.command cmd <> 0 then + if shell_command cmd <> 0 then error (f_"error unpacking %s, see earlier error messages") ova; tmpdir | (`GZip|`XZ) as format -> @@ -274,8 +272,7 @@ object let new_filename = tmpdir // String.random8 () ^ ".vmdk" in let cmd = sprintf "zcat %s > %s" (quote filename) (quote new_filename) in - debug "%s" cmd; - if Sys.command cmd <> 0 then + if shell_command cmd <> 0 then error (f_"error uncompressing %s, see earlier error messages") filename; new_filename diff --git a/v2v/output_glance.ml b/v2v/output_glance.ml index 4713287..dc5d868 100644 --- a/v2v/output_glance.ml +++ b/v2v/output_glance.ml @@ -48,7 +48,7 @@ object * 'glance' commands work as the current user. If not then the * program exits early. *) - if Sys.command "glance image-list > /dev/null" <> 0 then + if shell_command "glance image-list > /dev/null" <> 0 then error (f_"glance: glance client is not installed or set up correctly. You may need to set environment variables or source a script to enable authentication. See preceding messages for details."); (* Write targets to a temporary local file - see above for reason. *) @@ -76,8 +76,7 @@ object let cmd = sprintf "glance image-create --name %s --disk-format=%s --container-format=bare --file %s" (quote name) (quote target_format) target_file in - debug "%s" cmd; - if Sys.command cmd <> 0 then + if shell_command cmd <> 0 then error (f_"glance: image upload to glance failed, see earlier errors"); (* Set the properties (ie. metadata). *) @@ -126,8 +125,7 @@ object ) properties )) (quote name) in - debug "%s" cmd; - if Sys.command cmd <> 0 then ( + if shell_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"; diff --git a/v2v/output_libvirt.ml b/v2v/output_libvirt.ml index 7e04a54..db3a3fa 100644 --- a/v2v/output_libvirt.ml +++ b/v2v/output_libvirt.ml @@ -390,8 +390,7 @@ class output_libvirt oc output_pool = object | Some uri -> sprintf "virsh -c %s pool-refresh %s" (quote uri) (quote output_pool) in - debug "%s" cmd; - if Sys.command cmd <> 0 then + if shell_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. *) @@ -423,7 +422,7 @@ class output_libvirt oc output_pool = object | None -> sprintf "virsh define %s" (quote tmpfile) | Some uri -> sprintf "virsh -c %s define %s" (quote uri) (quote tmpfile) in - if Sys.command cmd = 0 then ( + if shell_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_qemu.ml b/v2v/output_qemu.ml index f76b3be..f1d3c5f 100644 --- a/v2v/output_qemu.ml +++ b/v2v/output_qemu.ml @@ -195,7 +195,7 @@ object (* If --qemu-boot option was specified then we should boot the guest. *) if qemu_boot then ( let cmd = sprintf "%s &" (quote file) in - ignore (Sys.command cmd) + ignore (shell_command cmd) ) end diff --git a/v2v/output_rhev.ml b/v2v/output_rhev.ml index 6301d9a..971c1af 100644 --- a/v2v/output_rhev.ml +++ b/v2v/output_rhev.ml @@ -45,15 +45,13 @@ let rec mount_and_check_storage_domain domain_class os = (* Try mounting it. *) let cmd = sprintf "mount %s:%s %s" (quote server) (quote export) (quote mp) in - debug "%s" cmd; - if Sys.command cmd <> 0 then + if shell_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 - debug "%s" cmd; - ignore (Sys.command cmd); + ignore (shell_command cmd); try rmdir mp with _ -> () ); diff --git a/v2v/v2v.ml b/v2v/v2v.ml index 18d343e..b332ced 100644 --- a/v2v/v2v.ml +++ b/v2v/v2v.ml @@ -229,8 +229,7 @@ and create_overlays src_disks = let cmd = sprintf "qemu-img create -q -f qcow2 -b %s -o %s %s" (quote qemu_uri) (quote options) overlay_file in - debug "%s" cmd; - if Sys.command cmd <> 0 then + if shell_command cmd <> 0 then error (f_"qemu-img command failed, see earlier errors"); (* Sanity check created overlay (see below). *) @@ -637,9 +636,8 @@ and copy_targets cmdline targets input output = (if cmdline.compressed then " -c" else "") (quote overlay_file) (quote t.target_file) in - debug "%s" cmd; let start_time = gettimeofday () in - if Sys.command cmd <> 0 then + if shell_command cmd <> 0 then error (f_"qemu-img command failed, see earlier errors"); let end_time = gettimeofday () in -- 2.5.5

Move the make_dib_args helper function to Common_utils as stringify_args, so it can be used also within Common_utils itself. This is mostly code motion. --- dib/dib.ml | 12 +----------- mllib/common_utils.ml | 10 ++++++++++ mllib/common_utils.mli | 4 ++++ 3 files changed, 15 insertions(+), 11 deletions(-) diff --git a/dib/dib.ml b/dib/dib.ml index b988f14..a76eb5e 100644 --- a/dib/dib.ml +++ b/dib/dib.ml @@ -53,16 +53,6 @@ let read_dib_envvars () = let vars = List.map (fun x -> x ^ "\n") vars in String.concat "" vars -let make_dib_args args = - let args = Array.to_list args in - let rec quote_args = function - | [] -> "" - | x :: xs -> " " ^ (quote x) ^ quote_args xs - in - match args with - | [] -> "" - | app :: xs -> app ^ quote_args xs - let write_script fn text = let oc = open_out fn in output_string oc text; @@ -507,7 +497,7 @@ let main () = printf " (none)\n"; printf "\n"; ); - let dib_args = make_dib_args Sys.argv in + let dib_args = stringify_args Sys.argv in let dib_vars = read_dib_envvars () in if debug >= 1 then ( printf "DIB args:\n%s\n" dib_args; diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml index d1aa8d2..0332510 100644 --- a/mllib/common_utils.ml +++ b/mllib/common_utils.ml @@ -648,6 +648,16 @@ let compare_lvm2_uuids uuid1 uuid2 = in loop 0 0 +let stringify_args args = + let args = Array.to_list args in + let rec quote_args = function + | [] -> "" + | x :: xs -> " " ^ (Filename.quote x) ^ quote_args xs + in + match args with + | [] -> "" + | app :: xs -> app ^ quote_args xs + (* Run an external command, slurp up the output as a list of lines. *) let external_command ?(echo_cmd = true) cmd = if echo_cmd then diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli index 7f288b4..5bcc692 100644 --- a/mllib/common_utils.mli +++ b/mllib/common_utils.mli @@ -239,6 +239,10 @@ val compare_version : string -> string -> int val compare_lvm2_uuids : string -> string -> int (** Compare two LVM2 UUIDs, ignoring '-' characters. *) +val stringify_args : string array -> string +(** Create a "pretty-print" representation of a program invocation + (i.e. executable and its arguments). *) + val external_command : ?echo_cmd:bool -> string -> string list (** Run an external command, slurp up the output as a list of lines. -- 2.5.5

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