From a52ee88f883ca462154fd14adbd19c60250ba49c Mon Sep 17 00:00:00 2001 From: Pino Toscano Date: Mon, 23 May 2016 14:24:21 +0200 Subject: [PATCH] mllib: add an helper shell_command 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 cd3e972b1..6645e754c 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 0791500ef..9d056a1e7 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 7dc0a29dd..7406ce833 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 39a27661f..d30baf5d5 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 534a07291..b988f14ad 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 32071f4d4..d1aa8d207 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 c55e04cb9..fcb97b23e 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 to 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 to 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 b2a7f4161..83cbec7df 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 629c8b663..0706f2746 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 2acf96631..1d28e17bc 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 08f10dfbe..8a07005b5 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 -> @@ -276,8 +274,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 471328716..dc5d868ef 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 7e04a5481..db3a3faeb 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 f76b3be8a..f1d3c5f33 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 6301d9a00..971c1af94 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 18d343e10..b332ced59 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