Richard W.M. Jones
2016-May-22 20:35 UTC
[Libguestfs] ocaml tools: Use a common debug function.
Add a Common_utils.debug function for printing messages only when in verbose mode. Rich.
Richard W.M. Jones
2016-May-22 20:35 UTC
[Libguestfs] [PATCH 1/2] customize: Turn print into warning.
It is still only emitted if we are debugging in order not to cause unnecessary alarm. Note this code needs a better long term fix, this is still a hack. --- customize/customize_run.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/customize/customize_run.ml b/customize/customize_run.ml index f2b45af..a4d7c1a 100644 --- a/customize/customize_run.ml +++ b/customize/customize_run.ml @@ -415,6 +415,6 @@ exec >>%s 2>&1 (try ignore (g#debug "sh" [| "fuser"; "-k"; "/sysroot" |]) with exn -> if verbose () then - printf (f_"%s: %s (ignored)\n") prog (Printexc.to_string exn) + warning (f_"%s (ignored)") (Printexc.to_string exn) ); g#ping_daemon () (* tiny delay after kill *) -- 2.7.4
Richard W.M. Jones
2016-May-22 20:35 UTC
[Libguestfs] [PATCH 2/2] ocaml tools: Use a common debug function.
Add a common debug function for printing debugging messages. It only emits the debug message when the verbose (-v) flag is used on the command line. It sends the output to stderr, which is flushed immediately after the message is printed (to help with debugging unexpected crashes). There are good arguments for sending the debug to either stdout or stderr, and almost all existing debug messages replaced by this change went to stdout. However using stderr is consistent with libguestfs's own debug messages which also go to stderr. I only made simple changes to code of the form 'if verbose () then printf ...'. There are more places which could be changed in future. In a few places I removed gettext calls since we probably should translate debug messages. --- builder/builder.ml | 12 ++++----- builder/checksums.ml | 2 +- builder/downloader.ml | 4 +-- builder/sigchecker.ml | 14 +++++----- builder/sources.ml | 38 +++++++++------------------- customize/customize_run.ml | 2 +- mllib/common_utils.ml | 5 ++++ mllib/common_utils.mli | 7 +++++ resize/resize.ml | 33 ++++++++++-------------- sparsify/copying.ml | 8 +++--- v2v/convert_windows.ml | 2 +- v2v/copy_to_local.ml | 23 +++++++---------- v2v/input_libvirt_other.ml | 2 +- v2v/input_libvirt_vcenter_https.ml | 16 +++++------- v2v/input_libvirt_xen_ssh.ml | 8 +++--- v2v/input_libvirtxml.ml | 3 +-- v2v/input_ova.ml | 10 +++----- v2v/inspect_source.ml | 4 +-- v2v/linux.ml | 4 +-- v2v/output_glance.ml | 4 +-- v2v/output_libvirt.ml | 10 ++++---- v2v/output_rhev.ml | 16 ++++-------- v2v/v2v.ml | 52 ++++++++++++++++---------------------- v2v/vCenter.ml | 5 ++-- v2v/windows_virtio.ml | 10 +++----- 25 files changed, 126 insertions(+), 168 deletions(-) diff --git a/builder/builder.ml b/builder/builder.ml index debd7e3..cd3e972 100644 --- a/builder/builder.ml +++ b/builder/builder.ml @@ -129,7 +129,7 @@ let main () | None -> "" | Some output -> sprintf " --output %s" (quote output)) (quote cmdline.arg) in - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; exit (Sys.command cmd) | `Delete_cache -> (* --delete-cache *) @@ -552,14 +552,14 @@ let main () let ofile = List.assoc `Filename otags in message (f_"Copying"); let cmd = sprintf "cp %s %s" (quote ifile) (quote ofile) in - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.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 verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.command cmd <> 0 then exit 1 | itags, `Pxzcat, otags -> @@ -598,7 +598,7 @@ let main () | None -> "" | Some lvexpand -> sprintf " --lv-expand %s" (quote lvexpand)) (quote ifile) (quote ofile) in - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.command cmd <> 0 then exit 1 | itags, `Disk_resize, otags -> @@ -609,7 +609,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 - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.command cmd <> 0 then exit 1 | itags, `Convert, otags -> @@ -628,7 +628,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 - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.command cmd <> 0 then exit 1 ) plan; diff --git a/builder/checksums.ml b/builder/checksums.ml index 31d3cb3..95103e9 100644 --- a/builder/checksums.ml +++ b/builder/checksums.ml @@ -43,7 +43,7 @@ let verify_checksum csum filename in let cmd = sprintf "%s %s" prog (quote filename) in - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; let lines = external_command cmd in match lines with | [] -> diff --git a/builder/downloader.ml b/builder/downloader.ml index 8aa10d3..e31748d 100644 --- a/builder/downloader.ml +++ b/builder/downloader.ml @@ -99,7 +99,7 @@ and download_to t ?(progress_bar = false) ~proxy uri filename t.curl (if verbose () then "" else " -s -S") (quote uri) in - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; let lines = external_command cmd in if List.length lines < 1 then error (f_"unexpected output from curl command, enable debug and look at previous messages"); @@ -119,7 +119,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 - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; let r = Sys.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 77dc36a..2b77193 100644 --- a/builder/sigchecker.ml +++ b/builder/sigchecker.ml @@ -39,7 +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 - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; let r = Sys.command cmd in if r <> 0 then error (f_"could not import public key\nUse the '-v' option and look for earlier error messages."); @@ -59,7 +59,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 - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; let r = Sys.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."); @@ -69,7 +69,7 @@ let import_keyfile ~gpg ~gpghome ?(trust = true) keyfile * fingerprint of the subkeys. *) let cmd = sprintf "%s --homedir %s --with-colons --with-fingerprint --with-fingerprint --list-keys %s" gpg gpghome !fingerprint in - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; let lines = external_command cmd in let current = ref None in let subkeys = ref [] in @@ -109,7 +109,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 - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; let r = Sys.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."); @@ -124,7 +124,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 - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; let r = Sys.command cmd in if r <> 0 then error (f_"could not export public key\nUse the '-v' option and look for earlier error messages."); @@ -189,7 +189,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 - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.command cmd <> 0 then exit 1; let out_file = Filename.temp_file "vbfile" "" in unlink_on_exit out_file; @@ -208,7 +208,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 - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; let r = Sys.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/builder/sources.ml b/builder/sources.ml index 37027d6..4c8d6c7 100644 --- a/builder/sources.ml +++ b/builder/sources.ml @@ -36,9 +36,7 @@ and source_format module StringSet = Set.Make (String) let parse_conf file - if verbose () then ( - printf (f_"%s: trying to read %s\n") prog file; - ); + debug "trying to read %s" file; let sections = Ini_reader.read_ini ~error_suffix:"[ignored]" file in let sources = List.fold_right ( @@ -55,20 +53,16 @@ let parse_conf file try Some (URI.parse_uri (List.assoc ("gpgkey", None) fields)) with | Not_found -> None | Invalid_argument "URI.parse_uri" as ex -> - if verbose () then ( - printf (f_"%s: '%s' has invalid gpgkey URI\n") prog n; - ); - raise ex in + debug "'%s' has invalid gpgkey URI" n; + raise ex in match k with | None -> Utils.No_Key | Some uri -> (match uri.URI.protocol with | "file" -> Utils.KeyFile uri.URI.path | _ -> - if verbose () then ( - printf (f_"%s: '%s' has non-local gpgkey URI\n") prog n; - ); - Utils.No_Key + debug "'%s' has non-local gpgkey URI" n; + Utils.No_Key ) in let proxy try @@ -85,10 +79,8 @@ let parse_conf file | "native" | "" -> FormatNative | "simplestreams" -> FormatSimpleStreams | fmt -> - if verbose () then ( - eprintf (f_"%s: unknown repository type '%s' in %s, skipping it\n") prog fmt file; - ); - invalid_arg fmt + debug "unknown repository type '%s' in %s, skipping it" fmt file; + invalid_arg fmt ) with Not_found -> FormatNative in @@ -101,9 +93,7 @@ let parse_conf file with Not_found | Invalid_argument _ -> acc ) sections [] in - if verbose () then ( - printf (f_"%s: ... read %d sources\n") prog (List.length sources); - ); + debug "read %d sources" (List.length sources); sources @@ -144,14 +134,10 @@ let read_sources () s ) with | Unix_error (code, fname, _) -> - if verbose () then ( - printf (f_"%s: file error: %s: %s\n") prog fname (error_message code) - ); - acc + debug "file error: %s: %s\n" fname (error_message code); + acc | Invalid_argument msg -> - if verbose () then ( - printf (f_"%s: internal error: invalid argument: %s\n") prog msg - ); - acc + debug "internal error: invalid argument: %s" msg; + acc ) acc files ) [] dirs diff --git a/customize/customize_run.ml b/customize/customize_run.ml index a4d7c1a..4b3e13c 100644 --- a/customize/customize_run.ml +++ b/customize/customize_run.ml @@ -85,7 +85,7 @@ exec >>%s 2>&1 %s " (quote logfile) env_vars cmd in - if verbose () then printf "running command:\n%s\n%!" cmd; + debug "running command:\n%s" cmd; try ignore (g#sh cmd) with Guestfs.Error msg -> diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml index e1317a7..0ffa92c 100644 --- a/mllib/common_utils.ml +++ b/mllib/common_utils.ml @@ -384,6 +384,11 @@ let info fs in ksprintf display fs +(* Print a debug message. *) +let debug fs + let display str = if verbose () then prerr_endline str in + ksprintf display fs + (* Common function to create a new Guestfs handle, with common options * (e.g. debug, tracing) already set. *) diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli index b862cd0..666e023 100644 --- a/mllib/common_utils.mli +++ b/mllib/common_utils.mli @@ -191,6 +191,13 @@ val warning : ('a, unit, string, unit) format4 -> 'a val info : ('a, unit, string, unit) format4 -> 'a (** Standard info function. Note: Use full sentences for this. *) +val debug : ('a, unit, string, unit) format4 -> 'a +(** Standard debug function. + + The message is only emitted if the verbose ([-v]) flag was set on + the command line. As with libguestfs debugging messages, it is + sent to [stderr]. *) + val open_guestfs : ?identifier:string -> unit -> Guestfs.guestfs (** Common function to create a new Guestfs handle, with common options (e.g. debug, tracing) already set. *) diff --git a/resize/resize.ml b/resize/resize.ml index 6ac1019..22386ce 100644 --- a/resize/resize.ml +++ b/resize/resize.ml @@ -368,10 +368,8 @@ read the man page virt-resize(1). let sectsize = Int64.of_int (g#blockdev_getss "/dev/sdb") in let insize = g#blockdev_getsize64 "/dev/sda" in let outsize = g#blockdev_getsize64 "/dev/sdb" in - if verbose () then ( - printf "%s size %Ld bytes\n" (fst infile) insize; - printf "%s size %Ld bytes\n" outfile outsize - ); + debug "%s size %Ld bytes" (fst infile) insize; + debug "%s size %Ld bytes" outfile outsize; sectsize, insize, outsize in let max_bootloader @@ -398,7 +396,7 @@ read the man page virt-resize(1). (* Get the source partition type. *) let parttype, parttype_string let pt = g#part_get_parttype "/dev/sda" in - if verbose () then printf "partition table type: %s\n%!" pt; + debug "partition table type: %s" pt; match pt with | "msdos" -> MBR, "msdos" @@ -753,9 +751,8 @@ read the man page virt-resize(1). let surplus = outsize -^ (required +^ overhead) in - if verbose () then - printf "calculate surplus: outsize=%Ld required=%Ld overhead=%Ld surplus=%Ld\n%!" - outsize required overhead surplus; + debug "calculate surplus: outsize=%Ld required=%Ld overhead=%Ld surplus=%Ld" + outsize required overhead surplus; surplus in @@ -767,8 +764,7 @@ read the man page virt-resize(1). if expand <> None || shrink <> None then ( let surplus = calculate_surplus () in - if verbose () then - printf "surplus before --expand or --shrink: %Ld\n" surplus; + debug "surplus before --expand or --shrink: %Ld" surplus; (match expand with | None -> () @@ -1075,9 +1071,8 @@ read the man page virt-resize(1). | `Always, _ | `Auto, true -> true in - if verbose () then - printf "align_first_partition_and_fix_bootloader = %b\n%!" - align_first_partition_and_fix_bootloader; + debug "align_first_partition_and_fix_bootloader = %b" + align_first_partition_and_fix_bootloader; (* Repartition the target disk. *) @@ -1099,9 +1094,8 @@ read the man page virt-resize(1). let end_ = start +^ size in let next = roundup64 end_ alignment in - if verbose () then - printf "target partition %d: ignore or copy: start=%Ld end=%Ld\n%!" - partnum start (end_ -^ 1L); + debug "target partition %d: ignore or copy: start=%Ld end=%Ld" + partnum start (end_ -^ 1L); { p with p_target_start = start; p_target_end = end_ -^ 1L; p_target_partnum = partnum } :: loop (partnum+1) next ps @@ -1113,9 +1107,8 @@ read the man page virt-resize(1). let next = start +^ size in let next = roundup64 next alignment in - if verbose () then - printf "target partition %d: resize: newsize=%Ld start=%Ld end=%Ld\n%!" - partnum newsize start (next -^ 1L); + debug "target partition %d: resize: newsize=%Ld start=%Ld end=%Ld" + partnum newsize start (next -^ 1L); { p with p_target_start = start; p_target_end = next -^ 1L; p_target_partnum = partnum } :: loop (partnum+1) next ps @@ -1259,7 +1252,7 @@ read the man page virt-resize(1). if verbose () then ( let old_hidden = int_of_le32 (g#pread_device target 4 0x1c_L) in - printf "old hidden sectors value: 0x%Lx\n%!" old_hidden + debug "old hidden sectors value: 0x%Lx" old_hidden ); let new_hidden = le32_of_int start in diff --git a/sparsify/copying.ml b/sparsify/copying.ml index 553da67..b2a7f41 100644 --- a/sparsify/copying.ml +++ b/sparsify/copying.ml @@ -96,9 +96,8 @@ let run indisk outdisk check_tmpdir compress convert | Directory tmpdir -> (* Get virtual size of the input disk. *) let virtual_size = (open_guestfs ())#disk_virtual_size indisk in - if verbose () then - printf "input disk virtual size is %Ld bytes (%s)\n%!" - virtual_size (human_size virtual_size); + debug "input disk virtual size is %Ld bytes (%s)" + virtual_size (human_size virtual_size); let print_warning () let free_space = statvfs_free_space tmpdir in @@ -327,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 - if verbose () then - printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.command cmd <> 0 then error (f_"external command failed: %s") cmd; diff --git a/v2v/convert_windows.ml b/v2v/convert_windows.ml index 5daae6c..aa5cb3b 100644 --- a/v2v/convert_windows.ml +++ b/v2v/convert_windows.ml @@ -278,7 +278,7 @@ if errorlevel 3010 exit /b 0 let value = int_of_le32 (g#hivex_value_value valueh) in sprintf "ControlSet%03Ld" value in - if verbose () then printf "current ControlSet is %s\n%!" current_cs; + debug "current ControlSet is %s" current_cs; disable_services root current_cs; disable_autoreboot root current_cs; diff --git a/v2v/copy_to_local.ml b/v2v/copy_to_local.ml index c030fd1..629c8b6 100644 --- a/v2v/copy_to_local.ml +++ b/v2v/copy_to_local.ml @@ -122,23 +122,21 @@ read the man page virt-v2v-copy-to-local(1). error (f_"too many command line parameters. See the virt-v2v-copy-to-local(1) manual page.") in (* Print the version, easier than asking users to tell us. *) - if verbose () then - printf "%s: %s %s (%s)\n%!" - prog Guestfs_config.package_name Guestfs_config.package_version Guestfs_config.host_cpu; + debug "%s: %s %s (%s)" + prog Guestfs_config.package_name + Guestfs_config.package_version Guestfs_config.host_cpu; (* Get the remote libvirt XML. *) message (f_"Fetching the remote libvirt XML metadata ..."); let xml = Domainxml.dumpxml ?password ~conn:input_conn guest_name in - if verbose () then - printf "libvirt XML from remote server:\n%s\n" xml; + debug "libvirt XML from remote server:\n%s" xml; (* Get the disk remote paths from the XML. *) message (f_"Parsing the remote libvirt XML metadata ..."); let disks, dcpath, xml = parse_libvirt_xml guest_name xml in - if verbose () then - printf "libvirt XML after modifying for local disks:\n%s\n" xml; + debug "libvirt XML after modifying for local disks:\n%s" xml; (* For VMware ESXi source, we have to massage the disk path. *) let disks @@ -149,8 +147,7 @@ read the man page virt-v2v-copy-to-local(1). let url, sslverify VCenter.map_source_to_https dcpath parsed_uri server remote_disk in - if verbose () then - printf "esxi: source disk %s (sslverify=%b)\n" url sslverify; + debug "esxi: source disk %s (sslverify=%b)" url sslverify; let cookie VCenter.get_session_cookie password "esx" parsed_uri sslverify url in @@ -197,8 +194,7 @@ read the man page virt-v2v-copy-to-local(1). (if quiet () then "" else " status=progress") (quote local_disk) in - if verbose () then - printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.command cmd <> 0 then error (f_"ssh copy command failed, see earlier errors"); @@ -219,13 +215,12 @@ read the man page virt-v2v-copy-to-local(1). else curl_args in if verbose () then - Curl.print_curl_command stdout curl_args; + Curl.print_curl_command stderr curl_args; ignore (Curl.run curl_args) | Test -> let cmd = sprintf "cp %s %s" (quote remote_disk) (quote local_disk) in - if verbose () then - printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.command cmd <> 0 then error (f_"copy command failed, see earlier errors"); ) disks; diff --git a/v2v/input_libvirt_other.ml b/v2v/input_libvirt_other.ml index 9be6850..6fd8d52 100644 --- a/v2v/input_libvirt_other.ml +++ b/v2v/input_libvirt_other.ml @@ -63,7 +63,7 @@ object inherit input_libvirt password libvirt_uri guest method source () - if verbose () then printf "input_libvirt_other: source()\n%!"; + debug "input_libvirt_other: source()"; (* Get the libvirt XML. This also checks (as a side-effect) * that the domain is not running. (RHBZ#1138586) diff --git a/v2v/input_libvirt_vcenter_https.ml b/v2v/input_libvirt_vcenter_https.ml index 21f2326..2acf966 100644 --- a/v2v/input_libvirt_vcenter_https.ml +++ b/v2v/input_libvirt_vcenter_https.ml @@ -42,9 +42,8 @@ object val mutable dcPath = "" method source () - if verbose () then - printf "input_libvirt_vcenter_https: source: scheme %s server %s\n%!" - scheme server; + debug "input_libvirt_vcenter_https: source: scheme %s server %s" + scheme server; error_if_libvirt_backend (); @@ -72,17 +71,14 @@ object * users to correct any mistakes in v2v or libvirt. *) | Some p, (None|Some _) -> - if verbose () then - printf "vcenter: using --dcpath from the command line: %s\n" p; + debug "vcenter: using --dcpath from the command line: %s" p; p | None, Some p -> - if verbose () then - printf "vcenter: using <vmware:datacenterpath> from libvirt: %s\n" p; + debug "vcenter: using <vmware:datacenterpath> from libvirt: %s" p; p | None, None -> let p = VCenter.guess_dcPath parsed_uri scheme in - if verbose () then - printf "vcenter: guessed dcPath from URI: %s\n" p; + debug "vcenter: guessed dcPath from URI: %s" p; p ); @@ -135,7 +131,7 @@ object let cmd sprintf "qemu-img rebase -u -b %s %s" (quote backing_qemu_uri) (quote overlay.ov_overlay_file) in - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.command cmd <> 0 then warning (f_"qemu-img rebase failed (ignored)") end diff --git a/v2v/input_libvirt_xen_ssh.ml b/v2v/input_libvirt_xen_ssh.ml index 06a2320..310b38b 100644 --- a/v2v/input_libvirt_xen_ssh.ml +++ b/v2v/input_libvirt_xen_ssh.ml @@ -35,9 +35,8 @@ object inherit input_libvirt password libvirt_uri guest method source () - if verbose () then - printf "input_libvirt_xen_ssh: source: scheme %s server %s\n%!" - scheme server; + debug "input_libvirt_xen_ssh: source: scheme %s server %s" + scheme server; error_if_libvirt_backend (); error_if_no_ssh_agent (); @@ -88,8 +87,7 @@ object | None -> json_params | Some user -> ("file.user", JSON.String user) :: json_params in - if verbose () then - printf "ssh: json parameters: %s\n" (JSON.string_of_doc json_params); + debug "ssh: json parameters: %s" (JSON.string_of_doc json_params); (* Turn the JSON parameters into a 'json:' protocol string. *) let qemu_uri = "json: " ^ JSON.string_of_doc json_params in diff --git a/v2v/input_libvirtxml.ml b/v2v/input_libvirtxml.ml index 231931f..24e3b74 100644 --- a/v2v/input_libvirtxml.ml +++ b/v2v/input_libvirtxml.ml @@ -47,8 +47,7 @@ let get_drive_slot str offset None let parse_libvirt_xml ?conn xml - if verbose () then - printf "libvirt xml is:\n%s\n" xml; + debug "libvirt xml is:\n%s" xml; let doc = Xml.parse_memory xml in let xpathctx = Xml.xpath_new_context doc in diff --git a/v2v/input_ova.ml b/v2v/input_ova.ml index 1aba662..65a2028 100644 --- a/v2v/input_ova.ml +++ b/v2v/input_ova.ml @@ -61,7 +61,7 @@ object let untar ?(format = "") file outdir let cmd = sprintf "tar -x%sf %s -C %s" format (quote file) (quote outdir) in - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.command cmd <> 0 then error (f_"error unpacking %s, see earlier error messages") ova in @@ -77,7 +77,7 @@ object let cmd = sprintf "unzip%s -j -d %s %s" (if verbose () then "" else " -q") (quote tmpdir) (quote ova) in - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.command cmd <> 0 then error (f_"error unpacking %s, see earlier error messages") ova; tmpdir @@ -154,9 +154,7 @@ object if actual <> expected then error (f_"checksum of disk %s does not match manifest %s (actual sha1(%s) = %s, expected sha1 (%s) = %s)") disk mf disk actual disk expected; - if verbose () then - printf "sha1 of %s matches expected checksum %s\n%!" - disk expected + debug "sha1 of %s matches expected checksum %s" disk expected | _::_ -> error (f_"cannot parse output of sha1sum command") ) in @@ -276,7 +274,7 @@ object let new_filename = tmpdir // String.random8 () ^ ".vmdk" in let cmd sprintf "zcat %s > %s" (quote filename) (quote new_filename) in - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.command cmd <> 0 then error (f_"error uncompressing %s, see earlier error messages") filename; diff --git a/v2v/inspect_source.ml b/v2v/inspect_source.ml index 2b80f12..65dcb88 100644 --- a/v2v/inspect_source.ml +++ b/v2v/inspect_source.ml @@ -86,7 +86,7 @@ let rec inspect_source root_choice g i_apps_map = apps_map; i_uefi = uefi } in - if verbose () then printf "%s%!" (string_of_inspect inspect); + debug "%s" (string_of_inspect inspect); sanity_check_inspection inspect; @@ -162,7 +162,7 @@ and has_uefi_bootable_device g with G.Error msg as exn -> (* If it's _not_ "unrecognised disk label" then re-raise it. *) if g#last_errno () <> G.Errno.errno_EINVAL then raise exn; - if verbose () then printf "%s (ignored)\n" msg; + debug "%s (ignored)" msg; false and is_uefi_bootable_device dev parttype_is_gpt dev && ( diff --git a/v2v/linux.ml b/v2v/linux.ml index bffe566..01aaf7d 100644 --- a/v2v/linux.ml +++ b/v2v/linux.ml @@ -144,7 +144,7 @@ let file_list_of_package (g : Guestfs.guestfs) inspect app ) else pkg_name in let cmd = [| "rpm"; "-ql"; pkg_name |] in - if verbose () then eprintf "%s\n%!" (String.concat " " (Array.to_list cmd)); + debug "%s" (String.concat " " (Array.to_list cmd)); let files = g#command_lines cmd in let files = Array.to_list files in List.sort compare files @@ -160,7 +160,7 @@ let rec file_owner g inspect path * a file, this deliberately only returns one package. *) let cmd = [| "rpm"; "-qf"; "--qf"; "%{NAME}"; path |] in - if verbose () then eprintf "%s\n%!" (String.concat " " (Array.to_list cmd)); + debug "%s" (String.concat " " (Array.to_list cmd)); (try g#command cmd with Guestfs.Error msg as exn -> if String.find msg "is not owned" >= 0 then diff --git a/v2v/output_glance.ml b/v2v/output_glance.ml index 8562749..4713287 100644 --- a/v2v/output_glance.ml +++ b/v2v/output_glance.ml @@ -76,7 +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 - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.command cmd <> 0 then error (f_"glance: image upload to glance failed, see earlier errors"); @@ -126,7 +126,7 @@ object ) properties )) (quote name) in - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.command cmd <> 0 then ( warning (f_"glance: failed to set image properties (ignored)"); (* Dump out the image properties so the user can set them. *) diff --git a/v2v/output_libvirt.ml b/v2v/output_libvirt.ml index bedd6b4..7e04a54 100644 --- a/v2v/output_libvirt.ml +++ b/v2v/output_libvirt.ml @@ -318,7 +318,7 @@ class output_libvirt oc output_pool = object method prepare_targets source targets (* Get the capabilities from libvirt. *) let xml = Domainxml.capabilities ?conn:oc () in - if verbose () then printf "libvirt capabilities XML:\n%s\n%!" xml; + debug "libvirt capabilities XML:\n%s" xml; (* This just checks that the capabilities XML is well-formed, * early so that we catch parsing errors before conversion. @@ -390,7 +390,7 @@ class output_libvirt oc output_pool = object | Some uri -> sprintf "virsh -c %s pool-refresh %s" (quote uri) (quote output_pool) in - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.command cmd <> 0 then warning (f_"could not refresh libvirt pool %s") output_pool; @@ -412,9 +412,9 @@ class output_libvirt oc output_pool = object close_out chan; if verbose () then ( - printf "resulting XML for libvirt:\n%!"; - DOM.doc_to_chan stdout doc; - printf "\n%!"; + eprintf "resulting XML for libvirt:\n%!"; + DOM.doc_to_chan stderr doc; + eprintf "\n%!"; ); (* Define the domain in libvirt. *) diff --git a/v2v/output_rhev.ml b/v2v/output_rhev.ml index b1c6850..6301d9a 100644 --- a/v2v/output_rhev.ml +++ b/v2v/output_rhev.ml @@ -45,14 +45,14 @@ 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 - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.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 - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; ignore (Sys.command cmd); try rmdir mp with _ -> () ); @@ -161,9 +161,7 @@ object mount_and_check_storage_domain (s_"Export Storage Domain") os in esd_mp <- mp; esd_uuid <- uuid; - if verbose () then - eprintf "RHEV: ESD mountpoint: %s\nRHEV: ESD UUID: %s\n%!" - esd_mp esd_uuid; + debug "RHEV: ESD mountpoint: %s\nRHEV: ESD UUID: %s" esd_mp esd_uuid; (* See if we can write files as UID:GID 36:36. *) let () @@ -172,9 +170,7 @@ object let stat = stat testfile in Changeuid.unlink changeuid_t testfile; let actual_uid = stat.st_uid and actual_gid = stat.st_gid in - if verbose () then - eprintf "RHEV: actual UID:GID of new files is %d:%d\n" - actual_uid actual_gid; + debug "RHEV: actual UID:GID of new files is %d:%d" actual_uid actual_gid; if uid <> actual_uid || gid <> actual_gid then ( if running_as_root then warning (f_"cannot write files to the NFS server as %d:%d, even though we appear to be running as root. This probably means the NFS client or idmapd is not configured properly.\n\nYou will have to chown the files that virt-v2v creates after the run, otherwise RHEV-M will not be able to import the VM.") uid gid @@ -233,9 +229,7 @@ object fun ({ target_overlay = ov } as t, image_uuid, vol_uuid) -> let ov_sd = ov.ov_sd in let target_file = images_dir // image_uuid // vol_uuid in - - if verbose () then - eprintf "RHEV: will export %s to %s\n%!" ov_sd target_file; + debug "RHEV: will export %s to %s" ov_sd target_file; { t with target_file = target_file } ) (combine3 targets image_uuids vol_uuids) in diff --git a/v2v/v2v.ml b/v2v/v2v.ml index e6ff8e2..18d343e 100644 --- a/v2v/v2v.ml +++ b/v2v/v2v.ml @@ -40,9 +40,9 @@ let rec main () let cmdline, input, output = parse_cmdline () in (* Print the version, easier than asking users to tell us. *) - if verbose () then - printf "%s: %s %s (%s)\n%!" - prog Guestfs_config.package_name Guestfs_config.package_version Guestfs_config.host_cpu; + debug "%s: %s %s (%s)" + prog Guestfs_config.package_name + Guestfs_config.package_version Guestfs_config.host_cpu; let source = open_source cmdline input in let source = amend_source cmdline source in @@ -126,8 +126,7 @@ let rec main () let target_buses Target_bus_assignment.target_bus_assignment source targets guestcaps in - if verbose () then - printf "%s%!" (string_of_target_buses target_buses); + debug "%s" (string_of_target_buses target_buses); let targets if not cmdline.do_copy then targets @@ -156,7 +155,7 @@ and open_source cmdline input exit 0 ); - if verbose () then printf "%s%!" (string_of_source source); + debug "%s" (string_of_source source); (match source.s_hypervisor with | OtherHV hv -> @@ -230,7 +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 - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; if Sys.command cmd <> 0 then error (f_"qemu-img command failed, see earlier errors"); @@ -453,16 +452,14 @@ and estimate_target_size mpstats targets sum ( List.map (fun { mp_statvfs = s } -> s.G.blocks *^ s.G.bsize) mpstats ) in - if verbose () then - printf "estimate_target_size: fs_total_size = %Ld [%s]\n%!" - fs_total_size (human_size fs_total_size); + debug "estimate_target_size: fs_total_size = %Ld [%s]" + fs_total_size (human_size fs_total_size); (* (2) *) let source_total_size sum (List.map (fun t -> t.target_overlay.ov_virtual_size) targets) in - if verbose () then - printf "estimate_target_size: source_total_size = %Ld [%s]\n%!" - source_total_size (human_size source_total_size); + debug "estimate_target_size: source_total_size = %Ld [%s]" + source_total_size (human_size source_total_size); if source_total_size = 0L then (* Avoid divide by zero error. *) targets @@ -470,8 +467,7 @@ and estimate_target_size mpstats targets (* (3) Store the ratio as a float to avoid overflows later. *) let ratio Int64.to_float fs_total_size /. Int64.to_float source_total_size in - if verbose () then - printf "estimate_target_size: ratio = %.3f\n%!" ratio; + debug "estimate_target_size: ratio = %.3f" ratio; (* (4) *) let fs_free @@ -494,13 +490,11 @@ and estimate_target_size mpstats targets | _ -> 0L ) mpstats ) in - if verbose () then - printf "estimate_target_size: fs_free = %Ld [%s]\n%!" - fs_free (human_size fs_free); + debug "estimate_target_size: fs_free = %Ld [%s]" + fs_free (human_size fs_free); let scaled_saving = Int64.of_float (Int64.to_float fs_free *. ratio) in - if verbose () then - printf "estimate_target_size: scaled_saving = %Ld [%s]\n%!" - scaled_saving (human_size scaled_saving); + debug "estimate_target_size: scaled_saving = %Ld [%s]" + scaled_saving (human_size scaled_saving); (* (5) *) let targets = List.map ( @@ -510,9 +504,8 @@ and estimate_target_size mpstats targets Int64.to_float size /. Int64.to_float source_total_size in let estimated_size size -^ Int64.of_float (proportion *. Int64.to_float scaled_saving) in - if verbose () then - printf "estimate_target_size: %s: %Ld [%s]\n%!" - ov.ov_sd estimated_size (human_size estimated_size); + debug "estimate_target_size: %s: %Ld [%s]" + ov.ov_sd estimated_size (human_size estimated_size); { t with target_estimated_size = Some estimated_size } ) targets in @@ -540,11 +533,10 @@ and do_convert g inspect source keep_serial_console rcaps with Not_found -> error (f_"virt-v2v is unable to convert this guest type (%s/%s)") inspect.i_type inspect.i_distro in - if verbose () then printf "picked conversion module %s\n%!" conversion_name; - if verbose () then printf "requested caps: %s%!" - (string_of_requested_guestcaps rcaps); + debug "picked conversion module %s" conversion_name; + debug "requested caps: %s" (string_of_requested_guestcaps rcaps); let guestcaps = convert ~keep_serial_console g inspect source rcaps in - if verbose () then printf "%s%!" (string_of_guestcaps guestcaps); + debug "%s" (string_of_guestcaps guestcaps); (* Did we manage to install virtio drivers? *) if not (quiet ()) then ( @@ -597,7 +589,7 @@ and copy_targets cmdline targets input output fun i t -> message (f_"Copying disk %d/%d to %s (%s)") (i+1) nr_disks t.target_file t.target_format; - if verbose () then printf "%s%!" (string_of_target t); + debug "%s" (string_of_target t); (* We noticed that qemu sometimes corrupts the qcow2 file on * exit. This only seemed to happen with lazy_refcounts was @@ -645,7 +637,7 @@ and copy_targets cmdline targets input output (if cmdline.compressed then " -c" else "") (quote overlay_file) (quote t.target_file) in - if verbose () then printf "%s\n%!" cmd; + debug "%s" cmd; let start_time = gettimeofday () in if Sys.command cmd <> 0 then error (f_"qemu-img command failed, see earlier errors"); diff --git a/v2v/vCenter.ml b/v2v/vCenter.ml index 76113b3..d41f223 100644 --- a/v2v/vCenter.ml +++ b/v2v/vCenter.ml @@ -73,7 +73,7 @@ let get_session_cookie password scheme uri sslverify url flush chan in - if verbose () then dump_response stdout; + if verbose () then dump_response stderr; (* Look for the last HTTP/x.y NNN status code in the output. *) let status = ref "" in @@ -240,8 +240,7 @@ let map_source_to_uri readahead dcPath password uri scheme server path | None -> json_params | Some cookie -> ("file.cookie", JSON.String cookie) :: json_params in - if verbose () then - printf "vcenter: json parameters: %s\n" (JSON.string_of_doc json_params); + debug "vcenter: json parameters: %s" (JSON.string_of_doc json_params); (* Turn the JSON parameters into a 'json:' protocol string. * Note this requires qemu-img >= 2.1.0. diff --git a/v2v/windows_virtio.ml b/v2v/windows_virtio.ml index 7e9f735..07b4d4b 100644 --- a/v2v/windows_virtio.ml +++ b/v2v/windows_virtio.ml @@ -230,9 +230,8 @@ and copy_drivers g inspect driverdir let source = virtio_win // path in let target = driverdir // String.lowercase_ascii (Filename.basename path) in - if verbose () then - printf "Copying virtio driver bits: 'host:%s' -> '%s'\n" - source target; + debug "copying virtio driver bits: 'host:%s' -> '%s'" + source target; g#write target (read_whole_file source); ret := true @@ -254,9 +253,8 @@ and copy_drivers g inspect driverdir virtio_iso_path_matches_guest_os path inspect then ( let target = driverdir // String.lowercase_ascii (Filename.basename path) in - if verbose () then - printf "Copying virtio driver bits: '%s:%s' -> '%s'\n" - virtio_win path target; + debug "copying virtio driver bits: '%s:%s' -> '%s'" + virtio_win path target; g#write target (g2#read_file source); ret := true -- 2.7.4
Richard W.M. Jones
2016-May-22 20:51 UTC
Re: [Libguestfs] [PATCH 2/2] ocaml tools: Use a common debug function.
On Sun, May 22, 2016 at 09:35:41PM +0100, Richard W.M. Jones wrote:> In a few places I removed gettext calls since we probably should^ not> translate debug messages.Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com libguestfs lets you edit virtual machines. Supports shell scripting, bindings from many languages. http://libguestfs.org
Apparently Analagous Threads
- [PATCH 3/4] ocaml tools: Use global variables to store trace (-x) and verbose (-v) flags.
- ocaml tools: Use a common debug function.
- [PATCH 02/13] syntax-check: fix error_message_period check
- [PATCH v2 00/17] v2v: add --in-place mode
- Re: [RFC PATCH] resize: add support for MBR logical partitions some question