[Libguestfs] [PATCH 3/4] ocaml tools: Use global variables to store trace (-x) and verbose (-v) flags.
Richard W.M. Jones
rjones at redhat.com
Fri May 15 10:18:49 UTC 2015
Don't pass these flags to dozens of functions.
---
builder/builder.ml | 47 +++++++++--------
builder/cache.ml | 4 +-
builder/cache.mli | 2 +-
builder/cmdline.ml | 13 ++---
builder/downloader.ml | 14 +++--
builder/downloader.mli | 2 +-
builder/get_kernel.ml | 6 +--
builder/get_kernel.mli | 2 +-
builder/index_parser.ml | 4 +-
builder/index_parser.mli | 2 +-
builder/sigchecker.ml | 32 ++++++------
builder/sigchecker.mli | 2 +-
builder/sources.ml | 18 +++----
builder/sources.mli | 2 +-
customize/customize_main.ml | 16 +++---
customize/customize_run.ml | 10 ++--
customize/customize_run.mli | 2 +-
customize/perl_edit.ml | 5 +-
customize/perl_edit.mli | 2 +-
mllib/common_utils.ml | 12 +++++
mllib/common_utils.mli | 6 +++
resize/resize.ml | 52 +++++++++----------
sparsify/cmdline.ml | 12 ++---
sparsify/copying.ml | 16 +++---
sparsify/in_place.ml | 6 +--
sparsify/sparsify.ml | 7 ++-
sysprep/main.ml | 22 ++++----
sysprep/sysprep_operation.ml | 10 ++--
sysprep/sysprep_operation.mli | 8 +--
sysprep/sysprep_operation_abrt_data.ml | 2 +-
sysprep/sysprep_operation_bash_history.ml | 2 +-
sysprep/sysprep_operation_blkid_tab.ml | 2 +-
sysprep/sysprep_operation_ca_certificates.ml | 2 +-
sysprep/sysprep_operation_crash_data.ml | 2 +-
sysprep/sysprep_operation_cron_spool.ml | 2 +-
sysprep/sysprep_operation_customize.ml | 4 +-
sysprep/sysprep_operation_dhcp_client_state.ml | 2 +-
sysprep/sysprep_operation_dhcp_server_state.ml | 2 +-
sysprep/sysprep_operation_dovecot_data.ml | 2 +-
sysprep/sysprep_operation_firewall_rules.ml | 2 +-
sysprep/sysprep_operation_flag_reconfiguration.ml | 2 +-
sysprep/sysprep_operation_fs_uuids.ml | 2 +-
sysprep/sysprep_operation_kerberos_data.ml | 2 +-
sysprep/sysprep_operation_logfiles.ml | 2 +-
sysprep/sysprep_operation_lvm_uuids.ml | 2 +-
sysprep/sysprep_operation_machine_id.ml | 2 +-
sysprep/sysprep_operation_mail_spool.ml | 2 +-
sysprep/sysprep_operation_net_hostname.ml | 2 +-
sysprep/sysprep_operation_net_hwaddr.ml | 2 +-
sysprep/sysprep_operation_pacct_log.ml | 2 +-
sysprep/sysprep_operation_package_manager_cache.ml | 2 +-
sysprep/sysprep_operation_pam_data.ml | 2 +-
sysprep/sysprep_operation_puppet_data_log.ml | 2 +-
.../sysprep_operation_rh_subscription_manager.ml | 2 +-
sysprep/sysprep_operation_rhn_systemid.ml | 2 +-
sysprep/sysprep_operation_rpm_db.ml | 2 +-
sysprep/sysprep_operation_samba_db_log.ml | 2 +-
sysprep/sysprep_operation_script.ml | 2 +-
sysprep/sysprep_operation_smolt_uuid.ml | 2 +-
sysprep/sysprep_operation_ssh_hostkeys.ml | 2 +-
sysprep/sysprep_operation_ssh_userdir.ml | 2 +-
sysprep/sysprep_operation_sssd_db_log.ml | 2 +-
sysprep/sysprep_operation_tmp_files.ml | 2 +-
sysprep/sysprep_operation_udev_persistent_net.ml | 2 +-
sysprep/sysprep_operation_user_account.ml | 4 +-
sysprep/sysprep_operation_utmp.ml | 2 +-
sysprep/sysprep_operation_yum_uuid.ml | 2 +-
v2v/OVF.ml | 6 +--
v2v/OVF.mli | 4 +-
v2v/cmdline.ml | 34 ++++++------
v2v/convert_linux.ml | 32 ++++++------
v2v/convert_windows.ml | 5 +-
v2v/input_disk.ml | 4 +-
v2v/input_disk.mli | 4 +-
v2v/input_libvirt.ml | 12 ++---
v2v/input_libvirt.mli | 2 +-
v2v/input_libvirt_other.ml | 13 ++---
v2v/input_libvirt_other.mli | 4 +-
v2v/input_libvirt_vcenter_https.ml | 24 ++++-----
v2v/input_libvirt_vcenter_https.mli | 2 +-
v2v/input_libvirt_xen_ssh.ml | 10 ++--
v2v/input_libvirt_xen_ssh.mli | 2 +-
v2v/input_libvirtxml.ml | 10 ++--
v2v/input_libvirtxml.mli | 6 +--
v2v/input_ova.ml | 14 ++---
v2v/input_ova.mli | 2 +-
v2v/linux.ml | 26 +++++-----
v2v/linux.mli | 14 ++---
v2v/modules_list.ml | 2 +-
v2v/modules_list.mli | 2 +-
v2v/output_glance.ml | 8 +--
v2v/output_glance.mli | 4 +-
v2v/output_libvirt.ml | 8 +--
v2v/output_libvirt.mli | 4 +-
v2v/output_local.ml | 4 +-
v2v/output_local.mli | 4 +-
v2v/output_null.ml | 6 +--
v2v/output_null.mli | 4 +-
v2v/output_qemu.ml | 4 +-
v2v/output_qemu.mli | 4 +-
v2v/output_rhev.ml | 28 +++++-----
v2v/output_rhev.mli | 6 +--
v2v/output_vdsm.ml | 14 ++---
v2v/output_vdsm.mli | 4 +-
v2v/types.ml | 4 +-
v2v/types.mli | 4 +-
v2v/v2v.ml | 60 +++++++++++-----------
107 files changed, 405 insertions(+), 415 deletions(-)
diff --git a/builder/builder.ml b/builder/builder.ml
index 7e18065..260281c 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -73,15 +73,14 @@ let main () =
let mode, arg,
arch, attach, cache, check_signature, curl,
delete_on_failure, format, gpg, list_format, memsize,
- network, ops, output, quiet, size, smp, sources, sync,
- trace, verbose =
+ network, ops, output, quiet, size, smp, sources, sync =
parse_cmdline () in
(* Timestamped messages in ordinary, non-debug non-quiet mode. *)
let msg fs = make_message_function ~quiet fs in
(* If debugging, echo the command line arguments and the sources. *)
- if verbose then (
+ if verbose () then (
printf "command line:";
List.iter (printf " %s") (Array.to_list Sys.argv);
print_newline ();
@@ -95,7 +94,7 @@ let main () =
let mode =
match mode with
| `Get_kernel -> (* --get-kernel is really a different program ... *)
- Get_kernel.get_kernel ~trace ~verbose ?format ?output arg;
+ Get_kernel.get_kernel ?format ?output arg;
exit 0
| `Delete_cache -> (* --delete-cache *)
@@ -119,7 +118,7 @@ let main () =
if Sys.command cmd <> 0 then (
if 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
+ else if verbose () then
warning (f_"gpg program is not available")
);
@@ -138,7 +137,7 @@ let main () =
match cache with
| None -> None
| Some dir ->
- try Some (Cache.create ~verbose ~directory:dir)
+ try Some (Cache.create ~directory:dir)
with exn ->
warning (f_"cache %s: %s") dir (Printexc.to_string exn);
warning (f_"disabling the cache");
@@ -146,8 +145,8 @@ let main () =
in
(* Download the sources. *)
- let downloader = Downloader.create ~verbose ~curl ~cache in
- let repos = Sources.read_sources ~verbose in
+ let downloader = Downloader.create ~curl ~cache in
+ let repos = Sources.read_sources () in
let sources = List.map (
fun (source, fingerprint) ->
{
@@ -162,9 +161,9 @@ let main () =
List.map (
fun source ->
let sigchecker =
- Sigchecker.create ~verbose ~gpg ~check_signature
+ Sigchecker.create ~gpg ~check_signature
~gpgkey:source.Sources.gpgkey in
- Index_parser.get_index ~verbose ~downloader ~sigchecker source
+ Index_parser.get_index ~downloader ~sigchecker source
) sources
) in
let index = remove_duplicates index in
@@ -467,7 +466,7 @@ let main () =
in
(* Print out the plan. *)
- if verbose then (
+ if verbose () then (
let print_tags tags =
(try
let v = List.assoc `Filename tags in printf " +filename=%s" v
@@ -523,14 +522,14 @@ let main () =
let ofile = List.assoc `Filename otags in
msg (f_"Copying");
let cmd = sprintf "cp %s %s" (quote ifile) (quote ofile) in
- if verbose then printf "%s\n%!" cmd;
+ if verbose () then printf "%s\n%!" 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;
+ if verbose () then printf "%s\n%!" cmd;
if Sys.command cmd <> 0 then exit 1
| itags, `Pxzcat, otags ->
@@ -553,12 +552,12 @@ let main () =
let preallocation = if oformat = "qcow2" then Some "metadata" else None in
let () =
let g = new G.guestfs () in
- if trace then g#set_trace true;
- if verbose then g#set_verbose true;
+ if trace () then g#set_trace true;
+ if verbose () then g#set_verbose true;
g#disk_create ?preallocation ofile oformat osize in
let cmd =
sprintf "virt-resize%s%s%s --output-format %s%s%s %s %s"
- (if verbose then " --verbose" else " --quiet")
+ (if verbose () then " --verbose" else " --quiet")
(if is_block_device ofile then " --no-sparse" else "")
(match iformat with
| None -> ""
@@ -571,7 +570,7 @@ let main () =
| None -> ""
| Some lvexpand -> sprintf " --lv-expand %s" (quote lvexpand))
(quote ifile) (quote ofile) in
- if verbose then printf "%s\n%!" cmd;
+ if verbose () then printf "%s\n%!" cmd;
if Sys.command cmd <> 0 then exit 1
| itags, `Disk_resize, otags ->
@@ -581,8 +580,8 @@ let main () =
msg (f_"Resizing container (but not filesystems) to expand the disk to %s")
(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;
+ (quote ofile) osize (if verbose () then "" else " >/dev/null") in
+ if verbose () then printf "%s\n%!" cmd;
if Sys.command cmd <> 0 then exit 1
| itags, `Convert, otags ->
@@ -598,8 +597,8 @@ let main () =
| None -> ""
| Some iformat -> sprintf " -f %s" (quote iformat))
(quote ifile) (quote oformat) (quote ofile)
- (if verbose then "" else " >/dev/null 2>&1") in
- if verbose then printf "%s\n%!" cmd;
+ (if verbose () then "" else " >/dev/null 2>&1") in
+ if verbose () then printf "%s\n%!" cmd;
if Sys.command cmd <> 0 then exit 1
) plan;
@@ -607,8 +606,8 @@ let main () =
msg (f_"Opening the new disk");
let g =
let g = new G.guestfs () in
- if trace then g#set_trace true;
- if verbose then g#set_verbose true;
+ if trace () then g#set_trace true;
+ if verbose () then g#set_verbose true;
(match memsize with None -> () | Some memsize -> g#set_memsize memsize);
(match smp with None -> () | Some smp -> g#set_smp smp);
@@ -651,7 +650,7 @@ let main () =
error (f_"no guest operating systems or multiboot OS found in this disk image\nThis is a failure of the source repository. Use -v for more information.")
in
- Customize_run.run ~verbose ~quiet g root ops;
+ Customize_run.run ~quiet g root ops;
(* Collect some stats about the final output file.
* Notes:
diff --git a/builder/cache.ml b/builder/cache.ml
index 86ac41b..e73bcfd 100644
--- a/builder/cache.ml
+++ b/builder/cache.ml
@@ -29,15 +29,13 @@ let clean_cachedir dir =
ignore (Sys.command cmd);
type t = {
- verbose : bool;
directory : string;
}
-let create ~verbose ~directory =
+let create ~directory =
if not (is_directory directory) then
mkdir_p directory 0o755;
{
- verbose = verbose;
directory = directory;
}
diff --git a/builder/cache.mli b/builder/cache.mli
index 1ff02a9..7edc670 100644
--- a/builder/cache.mli
+++ b/builder/cache.mli
@@ -24,7 +24,7 @@ val clean_cachedir : string -> unit
type t
(** The abstract data type. *)
-val create : verbose:bool -> directory:string -> t
+val create : directory:string -> t
(** Create the abstract type. *)
val cache_of_name : t -> string -> string -> int -> string
diff --git a/builder/cmdline.ml b/builder/cmdline.ml
index 61a5cb8..1ae5d97 100644
--- a/builder/cmdline.ml
+++ b/builder/cmdline.ml
@@ -94,8 +94,6 @@ let parse_cmdline () =
let add_source arg = sources := arg :: !sources in
let sync = ref true in
- let trace = ref false in
- let verbose = ref false in
let argspec = [
"--arch", Arg.Set_string arch, "arch" ^ " " ^ s_"Set the output architecture";
@@ -147,13 +145,13 @@ let parse_cmdline () =
"--smp", Arg.Int set_smp, "vcpus" ^ " " ^ s_"Set number of vCPUs";
"--source", Arg.String add_source, "URL" ^ " " ^ s_"Set source URL";
"--no-sync", Arg.Clear sync, " " ^ s_"Do not fsync output file on exit";
- "-v", Arg.Set verbose, " " ^ s_"Enable debugging messages";
- "--verbose", Arg.Set verbose, " " ^ s_"Enable debugging messages";
+ "-v", Arg.Bool set_verbose, " " ^ s_"Enable debugging messages";
+ "--verbose", Arg.Bool set_verbose, " " ^ s_"Enable debugging messages";
"-V", Arg.Unit print_version_and_exit,
" " ^ s_"Display version and exit";
"--version", Arg.Unit print_version_and_exit,
" " ^ s_"Display version and exit";
- "-x", Arg.Set trace, " " ^ s_"Enable tracing of libguestfs calls";
+ "-x", Arg.Bool set_trace, " " ^ s_"Enable tracing of libguestfs calls";
] in
let customize_argspec, get_customize_ops = Customize_cmdline.argspec () in
let customize_argspec =
@@ -211,8 +209,6 @@ read the man page virt-builder(1).
let smp = !smp in
let sources = List.rev !sources in
let sync = !sync in
- let trace = !trace in
- let verbose = !verbose in
(* No arguments and machine-readable mode? Print some facts. *)
if args = [] && machine_readable then (
@@ -336,5 +332,4 @@ read the man page virt-builder(1).
mode, arg,
arch, attach, cache, check_signature, curl,
delete_on_failure, format, gpg, list_format, memsize,
- network, ops, output, quiet, size, smp, sources, sync,
- trace, verbose
+ network, ops, output, quiet, size, smp, sources, sync
diff --git a/builder/downloader.ml b/builder/downloader.ml
index 0c91cbb..30ca212 100644
--- a/builder/downloader.ml
+++ b/builder/downloader.ml
@@ -28,7 +28,6 @@ type uri = string
type filename = string
type t = {
- verbose : bool;
curl : string;
cache : Cache.t option; (* cache for templates *)
}
@@ -38,8 +37,7 @@ type proxy_mode =
| SystemProxy
| ForcedProxy of string
-let create ~verbose ~curl ~cache = {
- verbose = verbose;
+let create ~curl ~cache = {
curl = curl;
cache = cache;
}
@@ -88,7 +86,7 @@ and download_to t ?(progress_bar = false) ~proxy uri filename =
| "file" ->
let path = parseduri.URI.path in
let cmd = sprintf "cp%s %s %s"
- (if t.verbose then " -v" else "")
+ (if verbose () then " -v" else "")
(quote path) (quote filename_new) in
let r = Sys.command cmd in
if r <> 0 then
@@ -99,9 +97,9 @@ and download_to t ?(progress_bar = false) ~proxy uri filename =
let cmd = sprintf "%s%s%s -g -o /dev/null -I -w '%%{http_code}' %s"
outenv
t.curl
- (if t.verbose then "" else " -s -S")
+ (if verbose () then "" else " -s -S")
(quote uri) in
- if t.verbose then printf "%s\n%!" cmd;
+ if verbose () then printf "%s\n%!" 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,9 +117,9 @@ and download_to t ?(progress_bar = false) ~proxy uri filename =
let cmd = sprintf "%s%s%s -g -o %s %s"
outenv
t.curl
- (if t.verbose then "" else if progress_bar then " -#" else " -s -S")
+ (if verbose () then "" else if progress_bar then " -#" else " -s -S")
(quote filename_new) (quote uri) in
- if t.verbose then printf "%s\n%!" cmd;
+ if verbose () then printf "%s\n%!" cmd;
let r = Sys.command cmd in
if r <> 0 then
error (f_"curl (download) command failed downloading '%s'") uri;
diff --git a/builder/downloader.mli b/builder/downloader.mli
index 837c879..5e3cdaa 100644
--- a/builder/downloader.mli
+++ b/builder/downloader.mli
@@ -32,7 +32,7 @@ type proxy_mode =
*)
| ForcedProxy of string (* The proxy is forced to the specified URL. *)
-val create : verbose:bool -> curl:string -> cache:Cache.t option -> t
+val create : curl:string -> cache:Cache.t option -> t
(** Create the abstract type. *)
val download : t -> ?template:(string*string*int) -> ?progress_bar:bool -> ?proxy:proxy_mode -> uri -> (filename * bool)
diff --git a/builder/get_kernel.ml b/builder/get_kernel.ml
index 9ac37b9..5cea647 100644
--- a/builder/get_kernel.ml
+++ b/builder/get_kernel.ml
@@ -28,10 +28,10 @@ open Printf
(* Originally:
* http://rwmj.wordpress.com/2013/09/13/get-kernel-and-initramfs-from-a-disk-image/
*)
-let rec get_kernel ~trace ~verbose ?format ?output disk =
+let rec get_kernel ?format ?output disk =
let g = new G.guestfs () in
- if trace then g#set_trace true;
- if verbose then g#set_verbose true;
+ if trace () then g#set_trace true;
+ if verbose () then g#set_verbose true;
g#add_drive_opts ?format ~readonly:true disk;
g#launch ();
diff --git a/builder/get_kernel.mli b/builder/get_kernel.mli
index 20f9ddd..5f47ca1 100644
--- a/builder/get_kernel.mli
+++ b/builder/get_kernel.mli
@@ -16,4 +16,4 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
-val get_kernel : trace:bool -> verbose:bool -> ?format:string -> ?output:string -> string -> unit
+val get_kernel : ?format:string -> ?output:string -> string -> unit
diff --git a/builder/index_parser.ml b/builder/index_parser.ml
index d39bb3a..aff0b00 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -111,7 +111,7 @@ let print_entry chan (name, { printable_name = printable_name;
);
if hidden then fp "hidden=true\n"
-let get_index ~verbose ~downloader ~sigchecker
+let get_index ~downloader ~sigchecker
{ Sources.uri = uri; proxy = proxy } =
let corrupt_file () =
error (f_"The index file downloaded from '%s' is corrupt.\nYou need to ask the supplier of this file to fix it and upload a fixed version.") uri
@@ -278,7 +278,7 @@ let get_index ~verbose ~downloader ~sigchecker
n, entry
) sections in
- if verbose then (
+ if verbose () then (
printf "index file (%s) after parsing (C parser):\n" uri;
List.iter (print_entry Pervasives.stdout) entries
);
diff --git a/builder/index_parser.mli b/builder/index_parser.mli
index 4687346..2e6ba77 100644
--- a/builder/index_parser.mli
+++ b/builder/index_parser.mli
@@ -38,4 +38,4 @@ and entry = {
proxy : Downloader.proxy_mode;
}
-val get_index : verbose:bool -> downloader:Downloader.t -> sigchecker:Sigchecker.t -> Sources.source -> index
+val get_index : downloader:Downloader.t -> sigchecker:Sigchecker.t -> Sources.source -> index
diff --git a/builder/sigchecker.ml b/builder/sigchecker.ml
index 29f271b..a8cc704 100644
--- a/builder/sigchecker.ml
+++ b/builder/sigchecker.ml
@@ -25,7 +25,6 @@ open Printf
open Unix
type t = {
- verbose : bool;
gpg : string;
fingerprint : string;
check_signature : bool;
@@ -33,13 +32,13 @@ type t = {
}
(* Import the specified key file. *)
-let import_keyfile ~gpg ~gpghome ~verbose ?(trust = true) keyfile =
+let import_keyfile ~gpg ~gpghome ?(trust = true) keyfile =
let status_file = Filename.temp_file "vbstat" ".txt" in
unlink_on_exit status_file;
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;
+ (if verbose () then "" else " >/dev/null 2>&1") in
+ if verbose () then printf "%s\n%!" 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.");
@@ -58,15 +57,15 @@ let import_keyfile ~gpg ~gpghome ~verbose ?(trust = true) keyfile =
if trust then (
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;
+ (if verbose () then "" else " >/dev/null 2>&1") in
+ if verbose () then printf "%s\n%!" 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.");
);
!fingerprint
-let rec create ~verbose ~gpg ~gpgkey ~check_signature =
+let rec create ~gpg ~gpgkey ~check_signature =
(* Create a temporary directory for gnupg. *)
let tmpdir = Mkdtemp.temp_dir "vb.gpghome." "" in
rmdir_on_exit tmpdir;
@@ -81,8 +80,8 @@ let rec create ~verbose ~gpg ~gpgkey ~check_signature =
* cannot.
*)
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;
+ gpg tmpdir (if verbose () then "" else " >/dev/null 2>&1") in
+ if verbose () then printf "%s\n%!" 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.");
@@ -90,23 +89,22 @@ let rec create ~verbose ~gpg ~gpgkey ~check_signature =
| No_Key ->
assert false
| KeyFile kf ->
- import_keyfile gpg tmpdir verbose kf
+ import_keyfile gpg tmpdir kf
| Fingerprint fp ->
let filename = Filename.temp_file "vbpubkey" ".asc" in
unlink_on_exit filename;
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;
+ (if verbose () then "" else " >/dev/null 2>&1") in
+ if verbose () then printf "%s\n%!" 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.");
- ignore (import_keyfile gpg tmpdir verbose filename);
+ ignore (import_keyfile gpg tmpdir filename);
fp
) else
"" in
{
- verbose = verbose;
gpg = gpg;
fingerprint = fingerprint;
check_signature = check_signature;
@@ -159,9 +157,9 @@ and do_verify t args =
let cmd =
sprintf "%s --homedir %s --verify%s --status-file %s %s"
t.gpg t.gpghome
- (if t.verbose then "" else " --batch -q --logger-file /dev/null")
+ (if verbose () then "" else " --batch -q --logger-file /dev/null")
(quote status_file) args in
- if t.verbose then printf "%s\n%!" cmd;
+ if verbose () then printf "%s\n%!" 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!");
@@ -190,7 +188,7 @@ let verify_checksum t (SHA512 csum) filename =
unlink_on_exit csum_file;
let cmd = sprintf "sha512sum %s | awk '{print $1}' > %s"
(quote filename) (quote csum_file) in
- if t.verbose then printf "%s\n%!" cmd;
+ if verbose () then printf "%s\n%!" cmd;
let r = Sys.command cmd in
if r <> 0 then
error (f_"could not run sha512sum command to verify checksum");
diff --git a/builder/sigchecker.mli b/builder/sigchecker.mli
index 4eb7a88..b670957 100644
--- a/builder/sigchecker.mli
+++ b/builder/sigchecker.mli
@@ -18,7 +18,7 @@
type t
-val create : verbose:bool -> gpg:string -> gpgkey:Utils.gpgkey_type -> check_signature:bool -> t
+val create : gpg:string -> gpgkey:Utils.gpgkey_type -> check_signature:bool -> t
val verify : t -> string -> unit
(** Verify the file is signed (if check_signature is true). *)
diff --git a/builder/sources.ml b/builder/sources.ml
index cec4a04..b774762 100644
--- a/builder/sources.ml
+++ b/builder/sources.ml
@@ -31,8 +31,8 @@ type source = {
module StringSet = Set.Make (String)
-let parse_conf ~verbose file =
- if verbose then (
+let parse_conf file =
+ if verbose () then (
printf (f_"%s: trying to read %s\n") prog file;
);
let sections = Ini_reader.read_ini ~error_suffix:"[ignored]" file in
@@ -51,7 +51,7 @@ let parse_conf ~verbose 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 (
+ if verbose () then (
printf (f_"%s: '%s' has invalid gpgkey URI\n") prog n;
);
raise ex in
@@ -61,7 +61,7 @@ let parse_conf ~verbose file =
(match uri.URI.protocol with
| "file" -> Utils.KeyFile uri.URI.path
| _ ->
- if verbose then (
+ if verbose () then (
printf (f_"%s: '%s' has non-local gpgkey URI\n") prog n;
);
Utils.No_Key
@@ -83,7 +83,7 @@ let parse_conf ~verbose file =
with Not_found | Invalid_argument _ -> acc
) sections [] in
- if verbose then (
+ if verbose () then (
printf (f_"%s: ... read %d sources\n") prog (List.length sources);
);
@@ -101,7 +101,7 @@ let merge_sources current_sources new_sources =
let filter_filenames filename =
Filename.check_suffix filename ".conf"
-let read_sources ~verbose =
+let read_sources () =
let dirs = Paths.xdg_config_dirs () in
let dirs =
match Paths.xdg_config_home () with
@@ -118,7 +118,7 @@ let read_sources ~verbose =
List.fold_left (
fun acc file ->
try (
- let s = merge_sources acc (parse_conf ~verbose (dir // file)) in
+ let s = merge_sources acc (parse_conf (dir // file)) in
(* Add the current file name to the set only if its parsing
* was successful.
*)
@@ -126,12 +126,12 @@ let read_sources ~verbose =
s
) with
| Unix_error (code, fname, _) ->
- if verbose then (
+ if verbose () then (
printf (f_"%s: file error: %s: %s\n") prog fname (error_message code)
);
acc
| Invalid_argument msg ->
- if verbose then (
+ if verbose () then (
printf (f_"%s: internal error: invalid argument: %s\n") prog msg
);
acc
diff --git a/builder/sources.mli b/builder/sources.mli
index 52c5908..2a94c54 100644
--- a/builder/sources.mli
+++ b/builder/sources.mli
@@ -23,4 +23,4 @@ type source = {
proxy : Downloader.proxy_mode;
}
-val read_sources : verbose:bool -> source list
+val read_sources : unit -> source list
diff --git a/customize/customize_main.ml b/customize/customize_main.ml
index fe3e7b8..d5ba705 100644
--- a/customize/customize_main.ml
+++ b/customize/customize_main.ml
@@ -56,8 +56,6 @@ let main () =
let quiet = ref false in
let smp = ref None in
let set_smp arg = smp := Some arg in
- let trace = ref false in
- let verbose = ref false in
let add_file arg =
let uri =
@@ -98,13 +96,13 @@ let main () =
"-q", Arg.Set quiet, " " ^ s_"Don't print log messages";
"--quiet", Arg.Set quiet, " " ^ s_"Don't print log messages";
"--smp", Arg.Int set_smp, "vcpus" ^ " " ^ s_"Set number of vCPUs";
- "-v", Arg.Set verbose, " " ^ s_"Enable debugging messages";
- "--verbose", Arg.Set verbose, " " ^ s_"Enable debugging messages";
+ "-v", Arg.Bool set_verbose, " " ^ s_"Enable debugging messages";
+ "--verbose", Arg.Bool set_verbose, " " ^ s_"Enable debugging messages";
"-V", Arg.Unit print_version_and_exit,
" " ^ s_"Display version and exit";
"--version", Arg.Unit print_version_and_exit,
" " ^ s_"Display version and exit";
- "-x", Arg.Set trace, " " ^ s_"Enable tracing of libguestfs calls";
+ "-x", Arg.Bool set_trace, " " ^ s_"Enable tracing of libguestfs calls";
] in
let customize_argspec, get_customize_ops =
Customize_cmdline.argspec () in
@@ -183,8 +181,6 @@ read the man page virt-customize(1).
let network = !network in
let quiet = !quiet in
let smp = !smp in
- let trace = !trace in
- let verbose = !verbose in
let ops = get_customize_ops () in
@@ -195,8 +191,8 @@ read the man page virt-customize(1).
(* Connect to libguestfs. *)
let g =
let g = new G.guestfs () in
- if trace then g#set_trace true;
- if verbose then g#set_verbose true;
+ if trace () then g#set_trace true;
+ if verbose () then g#set_verbose true;
(match memsize with None -> () | Some memsize -> g#set_memsize memsize);
(match smp with None -> () | Some smp -> g#set_smp smp);
@@ -239,7 +235,7 @@ read the man page virt-customize(1).
) mps;
(* Do the customization. *)
- Customize_run.run ~verbose ~quiet g root ops;
+ Customize_run.run ~quiet g root ops;
g#umount_all ();
) roots;
diff --git a/customize/customize_run.ml b/customize/customize_run.ml
index cd4616c..327fb17 100644
--- a/customize/customize_run.ml
+++ b/customize/customize_run.ml
@@ -26,7 +26,7 @@ open Customize_utils
open Customize_cmdline
open Password
-let run ~verbose ~quiet (g : Guestfs.guestfs) root (ops : ops) =
+let run ~quiet (g : Guestfs.guestfs) root (ops : ops) =
(* Timestamped messages in ordinary, non-debug non-quiet mode. *)
let msg fs = make_message_function ~quiet fs in
@@ -90,7 +90,7 @@ exec >>%s 2>&1
%s
" (quote logfile) env_vars cmd in
- if verbose then printf "running command:\n%s\n%!" cmd;
+ if verbose () then printf "running command:\n%s\n%!" cmd;
try ignore (g#sh cmd)
with
Guestfs.Error msg ->
@@ -206,7 +206,7 @@ exec >>%s 2>&1
if not (g#is_file path) then
error (f_"%s is not a regular file in the guest") path;
- Perl_edit.edit_file ~verbose g#ocaml_handle path expr
+ Perl_edit.edit_file g#ocaml_handle path expr
| `FirstbootCommand cmd ->
msg (f_"Installing firstboot command: %s") cmd;
@@ -358,7 +358,7 @@ exec >>%s 2>&1
* If debugging, dump out the log file.
* Then if asked, scrub the log file.
*)
- if verbose then debug_logfile ();
+ if verbose () then debug_logfile ();
if ops.flags.scrub_logfile && g#exists logfile then (
msg (f_"Scrubbing the log file");
@@ -375,7 +375,7 @@ exec >>%s 2>&1
*)
(try ignore (g#debug "sh" [| "fuser"; "-k"; "/sysroot" |])
with exn ->
- if verbose then
+ if verbose () then
printf (f_"%s: %s (ignored)\n") prog (Printexc.to_string exn)
);
g#ping_daemon () (* tiny delay after kill *)
diff --git a/customize/customize_run.mli b/customize/customize_run.mli
index 6289813..c330f9f 100644
--- a/customize/customize_run.mli
+++ b/customize/customize_run.mli
@@ -23,4 +23,4 @@
* filesystems must be mounted up.
*)
-val run : verbose:bool -> quiet:bool -> Guestfs.guestfs -> string -> Customize_cmdline.ops -> unit
+val run : quiet:bool -> Guestfs.guestfs -> string -> Customize_cmdline.ops -> unit
diff --git a/customize/perl_edit.ml b/customize/perl_edit.ml
index 96c4062..f1f06cc 100644
--- a/customize/perl_edit.ml
+++ b/customize/perl_edit.ml
@@ -16,5 +16,8 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
-external edit_file : verbose:bool -> Guestfs.t -> string -> string -> unit
+open Common_utils
+
+external c_edit_file : verbose:bool -> Guestfs.t -> string -> string -> unit
= "virt_customize_edit_file_perl"
+let edit_file g file expr = c_edit_file (verbose ()) g file expr
diff --git a/customize/perl_edit.mli b/customize/perl_edit.mli
index dbb76c9..0a2d2c9 100644
--- a/customize/perl_edit.mli
+++ b/customize/perl_edit.mli
@@ -16,4 +16,4 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
-val edit_file : verbose:bool -> Guestfs.t -> string -> string -> unit
+val edit_file : Guestfs.t -> string -> string -> unit
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index ed647e5..071cb1e 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -278,8 +278,20 @@ let make_message_function ~quiet fs =
in
ksprintf p fs
+
+(* Program name. *)
let prog = Filename.basename Sys.executable_name
+(* Stores the trace (-x) and verbose (-v) flags in a global variable. *)
+let trace = ref false
+let set_trace b = trace := b
+let trace () = !trace
+
+let verbose = ref false
+let set_verbose b = verbose := b
+let verbose () = !verbose
+
+(* Error messages etc. *)
let error ?(exit_code = 1) fs =
let display str =
let chan = stderr in
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
index 957ae81..cca3284 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -69,6 +69,12 @@ val make_message_function : quiet:bool -> ('a, unit, string, unit) format4 -> 'a
val prog : string
(** The program name (derived from {!Sys.executable_name}). *)
+val set_trace : bool -> unit
+val trace : unit -> bool
+val set_verbose : bool -> unit
+val verbose : unit -> bool
+(** Stores the trace ([-x]) and verbose ([-v]) flags in a global variable. *)
+
val error : ?exit_code:int -> ('a, unit, string, 'b) format4 -> 'a
(** Standard error function. *)
diff --git a/resize/resize.ml b/resize/resize.ml
index ef0f601..12d864d 100644
--- a/resize/resize.ml
+++ b/resize/resize.ml
@@ -154,7 +154,7 @@ let main () =
debug_gc, deletes,
dryrun, expand, expand_content, extra_partition, format, ignores,
lv_expands, machine_readable, ntfsresize_force, output_format,
- quiet, resizes, resizes_force, shrink, sparse, trace, verbose =
+ quiet, resizes, resizes_force, shrink, sparse =
let add xs s = xs := s :: !xs in
@@ -188,16 +188,14 @@ let main () =
else shrink := s
in
let sparse = ref true in
- let trace = ref false in
- let verbose = ref false in
let ditto = " -\"-" in
let argspec = Arg.align [
"--align-first", Arg.Set_string align_first, s_"never|always|auto" ^ " " ^ s_"Align first partition (default: auto)";
"--alignment", Arg.Set_int alignment, s_"sectors" ^ " " ^ s_"Set partition alignment (default: 128 sectors)";
"--no-copy-boot-loader", Arg.Clear copy_boot_loader, " " ^ s_"Don't copy boot loader";
- "-d", Arg.Set verbose, " " ^ s_"Enable debugging messages";
- "--debug", Arg.Set verbose, ditto;
+ "-d", Arg.Bool set_verbose, " " ^ s_"Enable debugging messages";
+ "--debug", Arg.Bool set_verbose, ditto;
"--debug-gc",Arg.Set debug_gc, " " ^ s_"Debug GC and memory allocations";
"--delete", Arg.String (add deletes), s_"part" ^ " " ^ s_"Delete partition";
"--expand", Arg.String set_expand, s_"part" ^ " " ^ s_"Expand partition";
@@ -223,12 +221,12 @@ let main () =
"--resize-force", Arg.String (add resizes_force), s_"part=size" ^ " " ^ s_"Forcefully resize partition";
"--shrink", Arg.String set_shrink, s_"part" ^ " " ^ s_"Shrink partition";
"--no-sparse", Arg.Clear sparse, " " ^ s_"Turn off sparse copying";
- "-v", Arg.Set verbose, " " ^ s_"Enable debugging messages";
- "--verbose", Arg.Set verbose, ditto;
+ "-v", Arg.Bool set_verbose, " " ^ s_"Enable debugging messages";
+ "--verbose", Arg.Bool set_verbose, ditto;
"-V", Arg.Unit print_version_and_exit,
" " ^ s_"Display version and exit";
"--version", Arg.Unit print_version_and_exit, ditto;
- "-x", Arg.Set trace, " " ^ s_"Enable tracing of libguestfs calls";
+ "-x", Arg.Bool set_trace, " " ^ s_"Enable tracing of libguestfs calls";
] in
long_options := argspec;
let disks = ref [] in
@@ -243,8 +241,7 @@ read the man page virt-resize(1).
prog in
Arg.parse argspec anon_fun usage_msg;
- let verbose = !verbose in
- if verbose then (
+ if verbose () then (
printf "command line:";
List.iter (printf " %s") (Array.to_list Sys.argv);
print_newline ()
@@ -270,7 +267,6 @@ read the man page virt-resize(1).
let resizes_force = List.rev !resizes_force in
let shrink = match !shrink with "" -> None | str -> Some str in
let sparse = !sparse in
- let trace = !trace in
if alignment < 1 then
error (f_"alignment cannot be < 1");
@@ -333,7 +329,7 @@ read the man page virt-resize(1).
debug_gc, deletes,
dryrun, expand, expand_content, extra_partition, format, ignores,
lv_expands, machine_readable, ntfsresize_force, output_format,
- quiet, resizes, resizes_force, shrink, sparse, trace, verbose in
+ quiet, resizes, resizes_force, shrink, sparse in
(* Timestamped messages. *)
let msg fs = make_message_function ~quiet fs in
@@ -346,8 +342,8 @@ read the man page virt-resize(1).
(* Add in and out disks to the handle and launch. *)
let connect_both_disks () =
let g = new G.guestfs () in
- if trace then g#set_trace true;
- if verbose then g#set_verbose true;
+ if trace () then g#set_trace true;
+ if verbose () then g#set_verbose true;
let _, { URI.path = path; protocol = protocol;
server = server; username = username;
password = password } = infile in
@@ -386,7 +382,7 @@ 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 (
+ if verbose () then (
printf "%s size %Ld bytes\n" (fst infile) insize;
printf "%s size %Ld bytes\n" outfile outsize
);
@@ -416,7 +412,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;
+ if verbose () then printf "partition table type: %s\n%!" pt;
match pt with
| "msdos" -> MBR, "msdos"
@@ -543,7 +539,7 @@ read the man page virt-resize(1).
let partitions = find_partitions () in
- if verbose then (
+ if verbose () then (
printf "%d partitions found\n" (List.length partitions);
List.iter (debug_partition ~sectsize) partitions
);
@@ -564,7 +560,7 @@ read the man page virt-resize(1).
{ lv_name = name; lv_type = typ; lv_operation = LVOpNone }
) lvs in
- if verbose then (
+ if verbose () then (
printf "%d logical volumes found\n" (List.length lvs);
List.iter debug_logvol lvs
);
@@ -584,7 +580,7 @@ read the man page virt-resize(1).
| ContentFS (("btrfs"), _) when !btrfs_available -> true
| ContentFS (("xfs"), _) when !xfs_available -> true
| ContentFS (fs, _) ->
- if verbose then
+ if verbose () then
warning (f_"unknown/unavailable method for expanding filesystem %s")
fs;
false
@@ -776,7 +772,7 @@ read the man page virt-resize(1).
let surplus = outsize -^ (required +^ overhead) in
- if verbose then
+ if verbose () then
printf "calculate surplus: outsize=%Ld required=%Ld overhead=%Ld surplus=%Ld\n%!"
outsize required overhead surplus;
@@ -790,7 +786,7 @@ read the man page virt-resize(1).
if expand <> None || shrink <> None then (
let surplus = calculate_surplus () in
- if verbose then
+ if verbose () then
printf "surplus before --expand or --shrink: %Ld\n" surplus;
(match expand with
@@ -1031,7 +1027,7 @@ read the man page virt-resize(1).
| `Always, _
| `Auto, true -> true in
- if verbose then
+ if verbose () then
printf "align_first_partition_and_fix_bootloader = %b\n%!"
align_first_partition_and_fix_bootloader;
@@ -1055,7 +1051,7 @@ read the man page virt-resize(1).
let end_ = start +^ size in
let next = roundup64 end_ alignment in
- if verbose then
+ if verbose () then
printf "target partition %d: ignore or copy: start=%Ld end=%Ld\n%!"
partnum start (end_ -^ 1L);
@@ -1070,7 +1066,7 @@ read the man page virt-resize(1).
let next = start +^ size in
let next = roundup64 next alignment in
- if verbose then
+ if verbose () then
printf "target partition %d: resize: newsize=%Ld start=%Ld end=%Ld\n%!"
partnum newsize start (next -^ 1L);
@@ -1119,7 +1115,7 @@ read the man page virt-resize(1).
calculate_target_partitions 1 start ~create_surplus:true partitions in
- if verbose then (
+ if verbose () then (
printf "After calculate target partitions:\n";
List.iter (debug_partition ~sectsize) partitions
);
@@ -1232,7 +1228,7 @@ read the man page virt-resize(1).
else (
msg (f_"Fixing first NTFS partition boot record");
- if verbose then (
+ 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
);
@@ -1274,8 +1270,8 @@ read the man page virt-resize(1).
g#close ();
let g = new G.guestfs () in
- if trace then g#set_trace true;
- if verbose then g#set_verbose true;
+ if trace () then g#set_trace true;
+ if verbose () then g#set_verbose true;
(* The output disk is being created, so use cache=unsafe here. *)
g#add_drive ?format:output_format ~readonly:false ~cachemode:"unsafe"
outfile;
diff --git a/sparsify/cmdline.ml b/sparsify/cmdline.ml
index 290359c..807470b 100644
--- a/sparsify/cmdline.ml
+++ b/sparsify/cmdline.ml
@@ -54,8 +54,6 @@ let parse_cmdline () =
let option = ref "" in
let quiet = ref false in
let tmp = ref "" in
- let verbose = ref false in
- let trace = ref false in
let zeroes = ref [] in
let ditto = " -\"-" in
@@ -75,12 +73,12 @@ let parse_cmdline () =
"-q", Arg.Set quiet, " " ^ s_"Quiet output";
"--quiet", Arg.Set quiet, ditto;
"--tmp", Arg.Set_string tmp, s_"block|dir|prebuilt:file" ^ " " ^ s_"Set temporary block device, directory or prebuilt file";
- "-v", Arg.Set verbose, " " ^ s_"Enable debugging messages";
- "--verbose", Arg.Set verbose, ditto;
+ "-v", Arg.Bool set_verbose, " " ^ s_"Enable debugging messages";
+ "--verbose", Arg.Bool set_verbose, ditto;
"-V", Arg.Unit print_version_and_exit,
" " ^ s_"Display version and exit";
"--version", Arg.Unit print_version_and_exit, ditto;
- "-x", Arg.Set trace, " " ^ s_"Enable tracing of libguestfs calls";
+ "-x", Arg.Bool set_trace, " " ^ s_"Enable tracing of libguestfs calls";
"--zero", Arg.String (add zeroes), s_"fs" ^ " " ^ s_"Zero filesystem";
] in
long_options := argspec;
@@ -112,8 +110,6 @@ read the man page virt-sparsify(1).
let option = match !option with "" -> None | str -> Some str in
let quiet = !quiet in
let tmp = match !tmp with "" -> None | str -> Some str in
- let verbose = !verbose in
- let trace = !trace in
let zeroes = List.rev !zeroes in
(* No arguments and machine-readable mode? Print out some facts
@@ -195,4 +191,4 @@ read the man page virt-sparsify(1).
Mode_in_place in
indisk, debug_gc, format, ignores, machine_readable,
- quiet, verbose, trace, zeroes, mode
+ quiet, zeroes, mode
diff --git a/sparsify/copying.ml b/sparsify/copying.ml
index 9f788b9..9f20fa3 100644
--- a/sparsify/copying.ml
+++ b/sparsify/copying.ml
@@ -39,7 +39,7 @@ type tmp_place =
let run indisk outdisk check_tmpdir compress convert
format ignores machine_readable option tmp_param
- quiet verbose trace zeroes =
+ quiet zeroes =
(* Once we have got past argument parsing and start to create
* temporary files (including the potentially massive overlay file), we
@@ -81,8 +81,8 @@ let run indisk outdisk check_tmpdir compress convert
if not (Sys.file_exists file) then
error (f_"--tmp prebuilt:file: %s: file does not exist") file;
let g = new G.guestfs () in
- if trace then g#set_trace true;
- if verbose then g#set_verbose true;
+ if trace () then g#set_trace true;
+ if verbose () then g#set_verbose true;
if g#disk_format file <> "qcow2" then
error (f_"--tmp prebuilt:file: %s: file format is not qcow2") file;
if not (g#disk_has_backing_file file) then
@@ -158,8 +158,8 @@ You can ignore this warning or change it to a hard failure using the
(* Create 'tmp' with the indisk as the backing file. *)
let create tmp =
let g = new G.guestfs () in
- if trace then g#set_trace true;
- if verbose then g#set_verbose true;
+ if trace () then g#set_trace true;
+ if verbose () then g#set_verbose true;
g#disk_create
~backingfile:indisk ?backingformat:format ~compat:"1.1"
tmp "qcow2" Int64.minus_one
@@ -186,8 +186,8 @@ You can ignore this warning or change it to a hard failure using the
(* Connect to libguestfs. *)
let g =
let g = new G.guestfs () in
- if trace then g#set_trace true;
- if verbose then g#set_verbose true;
+ if trace () then g#set_trace true;
+ if verbose () then g#set_verbose true;
(* Note that the temporary overlay disk is always qcow2 format. *)
g#add_drive ~format:"qcow2" ~readonly:false ~cachemode:"unsafe" overlaydisk;
@@ -346,7 +346,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
+ if verbose () then
printf "%s\n%!" cmd;
if Sys.command cmd <> 0 then
error (f_"external command failed: %s") cmd;
diff --git a/sparsify/in_place.ml b/sparsify/in_place.ml
index 268784c..9cd2982 100644
--- a/sparsify/in_place.ml
+++ b/sparsify/in_place.ml
@@ -29,11 +29,11 @@ open Cmdline
module G = Guestfs
-let rec run disk format ignores machine_readable quiet verbose trace zeroes =
+let rec run disk format ignores machine_readable quiet zeroes =
(* Connect to libguestfs. *)
let g = new G.guestfs () in
- if trace then g#set_trace true;
- if verbose then g#set_verbose true;
+ if trace () then g#set_trace true;
+ if verbose () then g#set_verbose true;
try
perform g disk format ignores machine_readable quiet zeroes
diff --git a/sparsify/sparsify.ml b/sparsify/sparsify.ml
index a16af84..9362f36 100644
--- a/sparsify/sparsify.ml
+++ b/sparsify/sparsify.ml
@@ -31,16 +31,15 @@ let () = Random.self_init ()
let rec main () =
let indisk, debug_gc, format, ignores, machine_readable,
- quiet, verbose, trace, zeroes, mode =
+ quiet, zeroes, mode =
parse_cmdline () in
(match mode with
| Mode_copying (outdisk, check_tmpdir, compress, convert, option, tmp) ->
Copying.run indisk outdisk check_tmpdir compress convert
- format ignores machine_readable option tmp quiet verbose trace zeroes
+ format ignores machine_readable option tmp quiet zeroes
| Mode_in_place ->
- In_place.run indisk format ignores machine_readable
- quiet verbose trace zeroes
+ In_place.run indisk format ignores machine_readable quiet zeroes
);
if debug_gc then
diff --git a/sysprep/main.ml b/sysprep/main.ml
index 65dc29e..8d2a63d 100644
--- a/sysprep/main.ml
+++ b/sysprep/main.ml
@@ -34,7 +34,7 @@ let () = Sysprep_operation.bake ()
let () = Random.self_init ()
let main () =
- let debug_gc, operations, g, quiet, mount_opts, verbose =
+ let debug_gc, operations, g, quiet, mount_opts =
let debug_gc = ref false in
let domain = ref None in
let dryrun = ref false in
@@ -43,8 +43,6 @@ let main () =
let libvirturi = ref "" in
let mount_opts = ref "" in
let operations = ref None in
- let trace = ref false in
- let verbose = ref false in
let format = ref "auto" in
let format_consumed = ref true in
@@ -144,13 +142,13 @@ let main () =
"--operations", Arg.String set_operations, " " ^ s_"Enable/disable specific operations";
"-q", Arg.Set quiet, " " ^ s_"Don't print log messages";
"--quiet", Arg.Set quiet, " " ^ s_"Don't print log messages";
- "-v", Arg.Set verbose, " " ^ s_"Enable debugging messages";
- "--verbose", Arg.Set verbose, " " ^ s_"Enable debugging messages";
+ "-v", Arg.Bool set_verbose, " " ^ s_"Enable debugging messages";
+ "--verbose", Arg.Bool set_verbose, " " ^ s_"Enable debugging messages";
"-V", Arg.Unit print_version_and_exit,
" " ^ s_"Display version and exit";
"--version", Arg.Unit print_version_and_exit,
" " ^ s_"Display version and exit";
- "-x", Arg.Set trace, " " ^ s_"Enable tracing of libguestfs calls";
+ "-x", Arg.Bool set_trace, " " ^ s_"Enable tracing of libguestfs calls";
] in
let args = basic_args @ Sysprep_operation.extra_args () in
let args =
@@ -214,8 +212,6 @@ read the man page virt-sysprep(1).
let dryrun = !dryrun in
let operations = !operations in
let quiet = !quiet in
- let trace = !trace in
- let verbose = !verbose in
(* At this point we know which operations are enabled. So call the
* not_enabled_check_args method of all *disabled* operations, so
@@ -236,12 +232,12 @@ read the man page virt-sysprep(1).
(* Connect to libguestfs. *)
let g = new G.guestfs () in
- if trace then g#set_trace true;
- if verbose then g#set_verbose true;
+ if trace () then g#set_trace true;
+ if verbose () then g#set_verbose true;
add g dryrun;
g#launch ();
- debug_gc, operations, g, quiet, mount_opts, verbose in
+ debug_gc, operations, g, quiet, mount_opts in
(* Inspection. *)
(match Array.to_list (g#inspect_os ()) with
@@ -269,7 +265,7 @@ read the man page virt-sysprep(1).
(* Perform the filesystem operations. *)
Sysprep_operation.perform_operations_on_filesystems
- ?operations ~verbose ~quiet g root side_effects;
+ ?operations ~quiet g root side_effects;
(* Unmount everything in this guest. *)
g#umount_all ();
@@ -278,7 +274,7 @@ read the man page virt-sysprep(1).
(* Perform the block device operations. *)
Sysprep_operation.perform_operations_on_devices
- ?operations ~verbose ~quiet g root side_effects;
+ ?operations ~quiet g root side_effects;
) roots
);
diff --git a/sysprep/sysprep_operation.ml b/sysprep/sysprep_operation.ml
index 4c4269a..88eaee5 100644
--- a/sysprep/sysprep_operation.ml
+++ b/sysprep/sysprep_operation.ml
@@ -34,7 +34,7 @@ end
class device_side_effects = object end
-type 'a callback = verbose:bool -> quiet:bool -> Guestfs.guestfs -> string -> 'a -> unit
+type 'a callback = quiet:bool -> Guestfs.guestfs -> string -> 'a -> unit
type operation = {
order : int;
@@ -269,7 +269,7 @@ let compare_operations { order = o1; name = n1 } { order = o2; name = n2 } =
let i = compare o1 o2 in
if i <> 0 then i else compare n1 n2
-let perform_operations_on_filesystems ?operations ~verbose ~quiet g root
+let perform_operations_on_filesystems ?operations ~quiet g root
side_effects =
assert !baked;
@@ -288,11 +288,11 @@ let perform_operations_on_filesystems ?operations ~verbose ~quiet g root
function
| { name = name; perform_on_filesystems = Some fn } ->
msg "Performing %S ..." name;
- fn ~verbose ~quiet g root side_effects
+ fn ~quiet g root side_effects
| { perform_on_filesystems = None } -> ()
) ops
-let perform_operations_on_devices ?operations ~verbose ~quiet g root
+let perform_operations_on_devices ?operations ~quiet g root
side_effects =
assert !baked;
@@ -311,6 +311,6 @@ let perform_operations_on_devices ?operations ~verbose ~quiet g root
function
| { name = name; perform_on_devices = Some fn } ->
msg "Performing %S ..." name;
- fn ~verbose ~quiet g root side_effects
+ fn ~quiet g root side_effects
| { perform_on_devices = None } -> ()
) ops
diff --git a/sysprep/sysprep_operation.mli b/sysprep/sysprep_operation.mli
index aab70bc..4bdfcb9 100644
--- a/sysprep/sysprep_operation.mli
+++ b/sysprep/sysprep_operation.mli
@@ -30,8 +30,8 @@ end
class device_side_effects : object end
(** There are currently no device side-effects. For future use. *)
-type 'side_effects callback = verbose:bool -> quiet:bool -> Guestfs.guestfs -> string -> 'side_effects -> unit
-(** [callback ~verbose ~quiet g root side_effects] is called to do work.
+type 'side_effects callback = quiet:bool -> Guestfs.guestfs -> string -> 'side_effects -> unit
+(** [callback ~quiet g root side_effects] is called to do work.
If the operation has side effects such as creating files, it
should indicate that by calling the [side_effects] object. *)
@@ -178,8 +178,8 @@ val not_enabled_check_args : ?operations:set -> unit -> unit
(** Call [not_enabled_check_args] on all operations in the set
which are {i not} enabled. *)
-val perform_operations_on_filesystems : ?operations:set -> verbose:bool -> quiet:bool -> Guestfs.guestfs -> string -> filesystem_side_effects -> unit
+val perform_operations_on_filesystems : ?operations:set -> quiet:bool -> Guestfs.guestfs -> string -> filesystem_side_effects -> unit
(** Perform all operations, or the subset listed in the [operations] set. *)
-val perform_operations_on_devices : ?operations:set -> verbose:bool -> quiet:bool -> Guestfs.guestfs -> string -> device_side_effects -> unit
+val perform_operations_on_devices : ?operations:set -> quiet:bool -> Guestfs.guestfs -> string -> device_side_effects -> unit
(** Perform all operations, or the subset listed in the [operations] set. *)
diff --git a/sysprep/sysprep_operation_abrt_data.ml b/sysprep/sysprep_operation_abrt_data.ml
index fb16ea2..df80a79 100644
--- a/sysprep/sysprep_operation_abrt_data.ml
+++ b/sysprep/sysprep_operation_abrt_data.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let abrt_data_perform ~verbose ~quiet g root side_effects =
+let abrt_data_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
let paths = g#glob_expand "/var/spool/abrt/*" in
diff --git a/sysprep/sysprep_operation_bash_history.ml b/sysprep/sysprep_operation_bash_history.ml
index 01f9962..e88dc5c 100644
--- a/sysprep/sysprep_operation_bash_history.ml
+++ b/sysprep/sysprep_operation_bash_history.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let bash_history_perform ~verbose ~quiet g root side_effects =
+let bash_history_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
let files = g#glob_expand "/home/*/.bash_history" in
diff --git a/sysprep/sysprep_operation_blkid_tab.ml b/sysprep/sysprep_operation_blkid_tab.ml
index 54d066f..7599612 100644
--- a/sysprep/sysprep_operation_blkid_tab.ml
+++ b/sysprep/sysprep_operation_blkid_tab.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let blkid_tab_perform ~verbose ~quiet g root side_effects =
+let blkid_tab_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
let files = [ "/var/run/blkid.tab";
diff --git a/sysprep/sysprep_operation_ca_certificates.ml b/sysprep/sysprep_operation_ca_certificates.ml
index aa2e115..7077e43 100644
--- a/sysprep/sysprep_operation_ca_certificates.ml
+++ b/sysprep/sysprep_operation_ca_certificates.ml
@@ -22,7 +22,7 @@ open Common_gettext.Gettext
module StringSet = Set.Make (String)
module G = Guestfs
-let ca_certificates_perform ~verbose ~quiet g root side_effects =
+let ca_certificates_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
let paths = [ "/etc/pki/CA/certs/*.crt";
diff --git a/sysprep/sysprep_operation_crash_data.ml b/sysprep/sysprep_operation_crash_data.ml
index 370f695..8c41eb6 100644
--- a/sysprep/sysprep_operation_crash_data.ml
+++ b/sysprep/sysprep_operation_crash_data.ml
@@ -26,7 +26,7 @@ let globs = [
"/var/log/dump/*";
]
-let crash_data_perform ~verbose ~quiet g root side_effects =
+let crash_data_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ = "linux" then (
List.iter (fun glob -> Array.iter g#rm_rf (g#glob_expand glob)) globs
diff --git a/sysprep/sysprep_operation_cron_spool.ml b/sysprep/sysprep_operation_cron_spool.ml
index 9a78e85..c6cf60e 100644
--- a/sysprep/sysprep_operation_cron_spool.ml
+++ b/sysprep/sysprep_operation_cron_spool.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let cron_spool_perform ~verbose ~quiet (g : Guestfs.guestfs) root side_effects =
+let cron_spool_perform ~quiet (g : Guestfs.guestfs) root side_effects =
Array.iter g#rm_rf (g#glob_expand "/var/spool/cron/*");
Array.iter g#rm (g#glob_expand "/var/spool/atjobs/*");
Array.iter g#rm (g#glob_expand "/var/spool/atjobs/.SEQ");
diff --git a/sysprep/sysprep_operation_customize.ml b/sysprep/sysprep_operation_customize.ml
index c602640..be90e4a 100644
--- a/sysprep/sysprep_operation_customize.ml
+++ b/sysprep/sysprep_operation_customize.ml
@@ -30,9 +30,9 @@ let customize_args, get_ops =
) args in
args, get_ops
-let customize_perform ~verbose ~quiet g root side_effects =
+let customize_perform ~quiet g root side_effects =
let ops = get_ops () in
- Customize_run.run ~verbose ~quiet g root ops;
+ Customize_run.run ~quiet g root ops;
side_effects#created_file () (* XXX Did we? *)
let op = {
diff --git a/sysprep/sysprep_operation_dhcp_client_state.ml b/sysprep/sysprep_operation_dhcp_client_state.ml
index 9bc320c..846a317 100644
--- a/sysprep/sysprep_operation_dhcp_client_state.ml
+++ b/sysprep/sysprep_operation_dhcp_client_state.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let dhcp_client_state_perform ~verbose ~quiet g root side_effects =
+let dhcp_client_state_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ = "linux" then (
List.iter (
diff --git a/sysprep/sysprep_operation_dhcp_server_state.ml b/sysprep/sysprep_operation_dhcp_server_state.ml
index ea42b38..72775bd 100644
--- a/sysprep/sysprep_operation_dhcp_server_state.ml
+++ b/sysprep/sysprep_operation_dhcp_server_state.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let dhcp_server_state_perform ~verbose ~quiet g root side_effects =
+let dhcp_server_state_perform ~quiet g root side_effects =
Array.iter g#rm_rf (g#glob_expand "/var/lib/dhcpd/*")
let op = {
diff --git a/sysprep/sysprep_operation_dovecot_data.ml b/sysprep/sysprep_operation_dovecot_data.ml
index e000ab0..9820a7c 100644
--- a/sysprep/sysprep_operation_dovecot_data.ml
+++ b/sysprep/sysprep_operation_dovecot_data.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let dovecot_data_perform ~verbose ~quiet g root side_effects =
+let dovecot_data_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
let files = g#glob_expand "/var/lib/dovecot/*" in
diff --git a/sysprep/sysprep_operation_firewall_rules.ml b/sysprep/sysprep_operation_firewall_rules.ml
index 22dd5e8..5c97648 100644
--- a/sysprep/sysprep_operation_firewall_rules.ml
+++ b/sysprep/sysprep_operation_firewall_rules.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let firewall_rules_perform ~verbose ~quiet g root side_effects =
+let firewall_rules_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
let paths = [ "/etc/sysconfig/iptables";
diff --git a/sysprep/sysprep_operation_flag_reconfiguration.ml b/sysprep/sysprep_operation_flag_reconfiguration.ml
index f56017e..20d5923 100644
--- a/sysprep/sysprep_operation_flag_reconfiguration.ml
+++ b/sysprep/sysprep_operation_flag_reconfiguration.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let flag_reconfiguration ~verbose ~quiet g root side_effects =
+let flag_reconfiguration ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
g#touch "/.unconfigured";
diff --git a/sysprep/sysprep_operation_fs_uuids.ml b/sysprep/sysprep_operation_fs_uuids.ml
index 002bb4d..c5cbcfc 100644
--- a/sysprep/sysprep_operation_fs_uuids.ml
+++ b/sysprep/sysprep_operation_fs_uuids.ml
@@ -25,7 +25,7 @@ open Sysprep_operation
module G = Guestfs
-let rec fs_uuids_perform ~verbose ~quiet g root side_effects =
+let rec fs_uuids_perform ~quiet g root side_effects =
let fses = g#list_filesystems () in
List.iter (function
| _, "unknown" -> ()
diff --git a/sysprep/sysprep_operation_kerberos_data.ml b/sysprep/sysprep_operation_kerberos_data.ml
index 063f967..c410331 100644
--- a/sysprep/sysprep_operation_kerberos_data.ml
+++ b/sysprep/sysprep_operation_kerberos_data.ml
@@ -22,7 +22,7 @@ open Common_gettext.Gettext
module StringSet = Set.Make (String)
module G = Guestfs
-let kerberos_data_perform ~verbose ~quiet g root side_effects =
+let kerberos_data_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
let excepts = [ "/var/kerberos/krb5kdc/kadm5.acl";
diff --git a/sysprep/sysprep_operation_logfiles.ml b/sysprep/sysprep_operation_logfiles.ml
index 7659a18..ba09cc5 100644
--- a/sysprep/sysprep_operation_logfiles.ml
+++ b/sysprep/sysprep_operation_logfiles.ml
@@ -132,7 +132,7 @@ let globs = List.sort compare [
]
let globs_as_pod = String.concat "\n" (List.map ((^) " ") globs)
-let logfiles_perform ~verbose ~quiet g root side_effects =
+let logfiles_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ = "linux" then (
List.iter (fun glob -> Array.iter g#rm_rf (g#glob_expand glob)) globs
diff --git a/sysprep/sysprep_operation_lvm_uuids.ml b/sysprep/sysprep_operation_lvm_uuids.ml
index 6771a22..32497b7 100644
--- a/sysprep/sysprep_operation_lvm_uuids.ml
+++ b/sysprep/sysprep_operation_lvm_uuids.ml
@@ -23,7 +23,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let rec lvm_uuids_perform ~verbose ~quiet g root side_effects =
+let rec lvm_uuids_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ = "linux" then (
let has_lvm2_feature =
diff --git a/sysprep/sysprep_operation_machine_id.ml b/sysprep/sysprep_operation_machine_id.ml
index acf8757..0345da0 100644
--- a/sysprep/sysprep_operation_machine_id.ml
+++ b/sysprep/sysprep_operation_machine_id.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let machine_id_perform ~verbose ~quiet g root side_effects =
+let machine_id_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
let path = "/etc/machine-id" in
diff --git a/sysprep/sysprep_operation_mail_spool.ml b/sysprep/sysprep_operation_mail_spool.ml
index 3b56184..691a0dc 100644
--- a/sysprep/sysprep_operation_mail_spool.ml
+++ b/sysprep/sysprep_operation_mail_spool.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let mail_spool_perform ~verbose ~quiet g root side_effects =
+let mail_spool_perform ~quiet g root side_effects =
List.iter (
fun glob -> Array.iter g#rm_rf (g#glob_expand glob)
) [
diff --git a/sysprep/sysprep_operation_net_hostname.ml b/sysprep/sysprep_operation_net_hostname.ml
index 5bf4b07..558b228 100644
--- a/sysprep/sysprep_operation_net_hostname.ml
+++ b/sysprep/sysprep_operation_net_hostname.ml
@@ -22,7 +22,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let net_hostname_perform ~verbose ~quiet g root side_effects =
+let net_hostname_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
let distro = g#inspect_get_distro root in
match typ, distro with
diff --git a/sysprep/sysprep_operation_net_hwaddr.ml b/sysprep/sysprep_operation_net_hwaddr.ml
index ea24997..fe30345 100644
--- a/sysprep/sysprep_operation_net_hwaddr.ml
+++ b/sysprep/sysprep_operation_net_hwaddr.ml
@@ -22,7 +22,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let net_hwaddr_perform ~verbose ~quiet g root side_effects =
+let net_hwaddr_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
let distro = g#inspect_get_distro root in
match typ, distro with
diff --git a/sysprep/sysprep_operation_pacct_log.ml b/sysprep/sysprep_operation_pacct_log.ml
index 0abd349..87bc8d0 100644
--- a/sysprep/sysprep_operation_pacct_log.ml
+++ b/sysprep/sysprep_operation_pacct_log.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let pacct_log_perform ~verbose ~quiet g root side_effects =
+let pacct_log_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
let distro = g#inspect_get_distro root in
match typ, distro with
diff --git a/sysprep/sysprep_operation_package_manager_cache.ml b/sysprep/sysprep_operation_package_manager_cache.ml
index bd6b2e5..ff549ed 100644
--- a/sysprep/sysprep_operation_package_manager_cache.ml
+++ b/sysprep/sysprep_operation_package_manager_cache.ml
@@ -22,7 +22,7 @@ open Common_utils
module G = Guestfs
-let package_manager_cache_perform ~verbose ~quiet g root side_effects =
+let package_manager_cache_perform ~quiet g root side_effects =
let packager = g#inspect_get_package_management root in
let cache_dirs =
match packager with
diff --git a/sysprep/sysprep_operation_pam_data.ml b/sysprep/sysprep_operation_pam_data.ml
index 16b073a..93292b7 100644
--- a/sysprep/sysprep_operation_pam_data.ml
+++ b/sysprep/sysprep_operation_pam_data.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let pam_data_perform ~verbose ~quiet g root side_effects =
+let pam_data_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
let paths = [ "/var/run/console/*";
diff --git a/sysprep/sysprep_operation_puppet_data_log.ml b/sysprep/sysprep_operation_puppet_data_log.ml
index 6bc14f5..22bcf47 100644
--- a/sysprep/sysprep_operation_puppet_data_log.ml
+++ b/sysprep/sysprep_operation_puppet_data_log.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let puppet_data_log_perform ~verbose ~quiet g root side_effects =
+let puppet_data_log_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
let paths = [ "/var/log/puppet/*";
diff --git a/sysprep/sysprep_operation_rh_subscription_manager.ml b/sysprep/sysprep_operation_rh_subscription_manager.ml
index 3c1ca09..b1bb972 100644
--- a/sysprep/sysprep_operation_rh_subscription_manager.ml
+++ b/sysprep/sysprep_operation_rh_subscription_manager.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let rh_subscription_manager_perform ~verbose ~quiet g root side_effects =
+let rh_subscription_manager_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
let distro = g#inspect_get_distro root in
diff --git a/sysprep/sysprep_operation_rhn_systemid.ml b/sysprep/sysprep_operation_rhn_systemid.ml
index 5f32537..e144998 100644
--- a/sysprep/sysprep_operation_rhn_systemid.ml
+++ b/sysprep/sysprep_operation_rhn_systemid.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let rhn_systemid_perform ~verbose ~quiet g root side_effects =
+let rhn_systemid_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
let distro = g#inspect_get_distro root in
diff --git a/sysprep/sysprep_operation_rpm_db.ml b/sysprep/sysprep_operation_rpm_db.ml
index e15bf97..94bdc2d 100644
--- a/sysprep/sysprep_operation_rpm_db.ml
+++ b/sysprep/sysprep_operation_rpm_db.ml
@@ -22,7 +22,7 @@ open Common_gettext.Gettext
module StringSet = Set.Make (String)
module G = Guestfs
-let rpm_db_perform ~verbose ~quiet g root side_effects =
+let rpm_db_perform ~quiet g root side_effects =
let pf = g#inspect_get_package_format root in
if pf = "rpm" then (
let paths = g#glob_expand "/var/lib/rpm/__db.*" in
diff --git a/sysprep/sysprep_operation_samba_db_log.ml b/sysprep/sysprep_operation_samba_db_log.ml
index 6ad9068..c02b81e 100644
--- a/sysprep/sysprep_operation_samba_db_log.ml
+++ b/sysprep/sysprep_operation_samba_db_log.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let samba_db_log_perform ~verbose ~quiet g root side_effects =
+let samba_db_log_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
let paths = [ "/var/log/samba/old/*";
diff --git a/sysprep/sysprep_operation_script.ml b/sysprep/sysprep_operation_script.ml
index a8bbac5..459eace 100644
--- a/sysprep/sysprep_operation_script.ml
+++ b/sysprep/sysprep_operation_script.ml
@@ -35,7 +35,7 @@ let set_scriptdir dir =
let scripts = ref []
let add_script script = scripts := script :: !scripts
-let rec script_perform ~verbose ~quiet (g : Guestfs.guestfs) root side_effects =
+let rec script_perform ~quiet (g : Guestfs.guestfs) root side_effects =
let scripts = List.rev !scripts in
if scripts <> [] then (
(* Create a temporary directory? *)
diff --git a/sysprep/sysprep_operation_smolt_uuid.ml b/sysprep/sysprep_operation_smolt_uuid.ml
index 8096c4f..00d6ac3 100644
--- a/sysprep/sysprep_operation_smolt_uuid.ml
+++ b/sysprep/sysprep_operation_smolt_uuid.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let smolt_uuid_perform ~verbose ~quiet g root side_effects =
+let smolt_uuid_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ = "linux" then (
let files = [ "/etc/sysconfig/hw-uuid";
diff --git a/sysprep/sysprep_operation_ssh_hostkeys.ml b/sysprep/sysprep_operation_ssh_hostkeys.ml
index 15a4fd6..7668236 100644
--- a/sysprep/sysprep_operation_ssh_hostkeys.ml
+++ b/sysprep/sysprep_operation_ssh_hostkeys.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let ssh_hostkeys_perform ~verbose ~quiet g root side_effects =
+let ssh_hostkeys_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
let files = g#glob_expand "/etc/ssh/*_host_*" in
diff --git a/sysprep/sysprep_operation_ssh_userdir.ml b/sysprep/sysprep_operation_ssh_userdir.ml
index 60cf778..bec1d56 100644
--- a/sysprep/sysprep_operation_ssh_userdir.ml
+++ b/sysprep/sysprep_operation_ssh_userdir.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let ssh_userdir_perform ~verbose ~quiet g root side_effects =
+let ssh_userdir_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
let dirs = g#glob_expand "/home/*/.ssh" in
diff --git a/sysprep/sysprep_operation_sssd_db_log.ml b/sysprep/sysprep_operation_sssd_db_log.ml
index 654e733..91a7765 100644
--- a/sysprep/sysprep_operation_sssd_db_log.ml
+++ b/sysprep/sysprep_operation_sssd_db_log.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let sssd_db_log_perform ~verbose ~quiet g root side_effects =
+let sssd_db_log_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
let paths = [ "/var/log/sssd/*";
diff --git a/sysprep/sysprep_operation_tmp_files.ml b/sysprep/sysprep_operation_tmp_files.ml
index 593acbf..3b9e58f 100644
--- a/sysprep/sysprep_operation_tmp_files.ml
+++ b/sysprep/sysprep_operation_tmp_files.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let tmp_files_perform ~verbose ~quiet g root side_effects =
+let tmp_files_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
let paths = [ "/tmp";
diff --git a/sysprep/sysprep_operation_udev_persistent_net.ml b/sysprep/sysprep_operation_udev_persistent_net.ml
index 9cf74c8..2ceeef5 100644
--- a/sysprep/sysprep_operation_udev_persistent_net.ml
+++ b/sysprep/sysprep_operation_udev_persistent_net.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let udev_persistent_net_perform ~verbose ~quiet g root side_effects =
+let udev_persistent_net_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ = "linux" then (
try g#rm "/etc/udev/rules.d/70-persistent-net.rules"
diff --git a/sysprep/sysprep_operation_user_account.ml b/sysprep/sysprep_operation_user_account.ml
index e53e5cc..0f676ec 100644
--- a/sysprep/sysprep_operation_user_account.ml
+++ b/sysprep/sysprep_operation_user_account.ml
@@ -53,7 +53,7 @@ let check_remove_user user =
else
false
-let user_account_perform ~verbose ~quiet g root side_effects =
+let user_account_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
let changed = ref false in
if typ <> "windows" then (
@@ -78,7 +78,7 @@ let user_account_perform ~verbose ~quiet g root side_effects =
let home_dir =
try Some (g#aug_get (userpath ^ "/home"))
with _ ->
- if verbose then
+ if verbose () then
warning (f_"Cannot get the home directory for %s")
username;
None in
diff --git a/sysprep/sysprep_operation_utmp.ml b/sysprep/sysprep_operation_utmp.ml
index b306b99..6c1ac41 100644
--- a/sysprep/sysprep_operation_utmp.ml
+++ b/sysprep/sysprep_operation_utmp.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let utmp_perform ~verbose ~quiet g root side_effects =
+let utmp_perform ~quiet g root side_effects =
let typ = g#inspect_get_type root in
if typ <> "windows" then (
try g#rm "/var/run/utmp"
diff --git a/sysprep/sysprep_operation_yum_uuid.ml b/sysprep/sysprep_operation_yum_uuid.ml
index 77f30fb..ed52929 100644
--- a/sysprep/sysprep_operation_yum_uuid.ml
+++ b/sysprep/sysprep_operation_yum_uuid.ml
@@ -21,7 +21,7 @@ open Common_gettext.Gettext
module G = Guestfs
-let yum_uuid_perform ~verbose ~quiet g root side_effects =
+let yum_uuid_perform ~quiet g root side_effects =
let packager = g#inspect_get_package_management root in
if packager = "yum" then (
try g#rm "/var/lib/yum/uuid" with G.Error _ -> ()
diff --git a/v2v/OVF.ml b/v2v/OVF.ml
index 7129cff..b342ccb 100644
--- a/v2v/OVF.ml
+++ b/v2v/OVF.ml
@@ -187,7 +187,7 @@ and get_ostype = function
"Unassigned"
(* Generate the .meta file associated with each volume. *)
-let create_meta_files verbose output_alloc sd_uuid image_uuids targets =
+let create_meta_files output_alloc sd_uuid image_uuids targets =
(* Note: Upper case in the .meta, mixed case in the OVF. *)
let output_alloc_for_rhev =
match output_alloc with
@@ -230,7 +230,7 @@ let create_meta_files verbose output_alloc sd_uuid image_uuids targets =
) (List.combine targets image_uuids)
(* Create the OVF file. *)
-let rec create_ovf verbose source targets guestcaps inspect
+let rec create_ovf source targets guestcaps inspect
output_alloc vmtype sd_uuid image_uuids vol_uuids vm_uuid =
assert (List.length targets = List.length vol_uuids);
@@ -332,7 +332,7 @@ let rec create_ovf verbose source targets guestcaps inspect
warning (f_"This guest required a password for connection to its display, but this is not supported by RHEV. Therefore the converted guest's display will not require a separate password to connect.");
| _ -> ());
- if verbose then (
+ if verbose () then (
eprintf "OVF:\n";
doc_to_chan Pervasives.stderr ovf
);
diff --git a/v2v/OVF.mli b/v2v/OVF.mli
index 0a354e7..c806276 100644
--- a/v2v/OVF.mli
+++ b/v2v/OVF.mli
@@ -18,7 +18,7 @@
(** Functions for dealing with OVF files. *)
-val create_meta_files : bool -> Types.output_allocation -> string -> string list -> Types.target list -> string list
+val create_meta_files : Types.output_allocation -> string -> string list -> Types.target list -> string list
(** Create the .meta file associated with each target.
Note this does not write them, since output_rhev has to do a
@@ -26,7 +26,7 @@ val create_meta_files : bool -> Types.output_allocation -> string -> string list
file is returned (one per target), and they must be written to
[target_file ^ ".meta"]. *)
-val create_ovf : bool -> Types.source -> Types.target list -> Types.guestcaps -> Types.inspect -> Types.output_allocation -> Types.vmtype option -> string -> string list -> string list -> string -> DOM.doc
+val create_ovf : Types.source -> Types.target list -> Types.guestcaps -> Types.inspect -> Types.output_allocation -> Types.vmtype option -> string -> string list -> string list -> string -> DOM.doc
(** Create the OVF file. *)
(**/**)
diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
index 4f7ac8c..ec4e57f 100644
--- a/v2v/cmdline.ml
+++ b/v2v/cmdline.ml
@@ -43,8 +43,6 @@ let parse_cmdline () =
let quiet = ref false in
let vdsm_vm_uuid = ref "" in
let vdsm_ovf_output = ref "." in
- let verbose = ref false in
- let trace = ref false in
let vmtype = ref "" in
let input_mode = ref `Not_set in
@@ -177,13 +175,13 @@ let parse_cmdline () =
Arg.Set_string vdsm_vm_uuid, "uuid " ^ s_"Output VM UUID";
"--vdsm-ovf-output",
Arg.Set_string vdsm_ovf_output, " " ^ s_"Output OVF file";
- "-v", Arg.Set verbose, " " ^ s_"Enable debugging messages";
- "--verbose", Arg.Set verbose, ditto;
+ "-v", Arg.Bool set_verbose, " " ^ s_"Enable debugging messages";
+ "--verbose", Arg.Bool set_verbose, ditto;
"-V", Arg.Unit print_version_and_exit,
" " ^ s_"Display version and exit";
"--version", Arg.Unit print_version_and_exit, ditto;
"--vmtype", Arg.Set_string vmtype, "server|desktop " ^ s_"Set vmtype (for RHEV)";
- "-x", Arg.Set trace, " " ^ s_"Enable tracing of libguestfs calls";
+ "-x", Arg.Bool set_trace, " " ^ s_"Enable tracing of libguestfs calls";
] in
long_options := argspec;
let args = ref [] in
@@ -238,8 +236,6 @@ read the man page virt-v2v(1).
let vdsm_vol_uuids = List.rev !vdsm_vol_uuids in
let vdsm_vm_uuid = !vdsm_vm_uuid in
let vdsm_ovf_output = !vdsm_ovf_output in
- let verbose = !verbose in
- let trace = !trace in
let vmtype =
match !vmtype with
| "server" -> Some Server
@@ -278,7 +274,7 @@ read the man page virt-v2v(1).
| [disk] -> disk
| _ ->
error (f_"expecting a disk image (filename) on the command line") in
- Input_disk.input_disk verbose input_format disk
+ Input_disk.input_disk input_format disk
| `Not_set
| `Libvirt ->
@@ -290,7 +286,7 @@ read the man page virt-v2v(1).
| [guest] -> guest
| _ ->
error (f_"expecting a libvirt guest name on the command line") in
- Input_libvirt.input_libvirt verbose password input_conn guest
+ Input_libvirt.input_libvirt password input_conn guest
| `LibvirtXML ->
(* -i libvirtxml: Expecting a filename (XML file). *)
@@ -299,7 +295,7 @@ read the man page virt-v2v(1).
| [filename] -> filename
| _ ->
error (f_"expecting a libvirt XML file name on the command line") in
- Input_libvirtxml.input_libvirtxml verbose filename
+ Input_libvirtxml.input_libvirtxml filename
| `OVA ->
(* -i ova: Expecting an ova filename (tar file). *)
@@ -308,7 +304,7 @@ read the man page virt-v2v(1).
| [filename] -> filename
| _ ->
error (f_"expecting an OVA file name on the command line") in
- Input_ova.input_ova verbose filename in
+ Input_ova.input_ova filename in
(* Parse the output mode. *)
let output =
@@ -324,7 +320,7 @@ read the man page virt-v2v(1).
error (f_"--vmtype option cannot be used with '-o glance'");
if not do_copy then
error (f_"--no-copy and '-o glance' cannot be used at the same time");
- Output_glance.output_glance verbose
+ Output_glance.output_glance ()
| `Not_set
| `Libvirt ->
@@ -336,7 +332,7 @@ read the man page virt-v2v(1).
error (f_"--vmtype option cannot be used with '-o libvirt'");
if not do_copy then
error (f_"--no-copy and '-o libvirt' cannot be used at the same time");
- Output_libvirt.output_libvirt verbose output_conn output_storage
+ Output_libvirt.output_libvirt output_conn output_storage
| `Local ->
if output_storage = "" then
@@ -348,7 +344,7 @@ read the man page virt-v2v(1).
error (f_"-o local: --qemu-boot option cannot be used in this output mode");
if vmtype <> None then
error (f_"--vmtype option cannot be used with '-o local'");
- Output_local.output_local verbose output_storage
+ Output_local.output_local output_storage
| `Null ->
if output_conn <> None then
@@ -359,20 +355,20 @@ read the man page virt-v2v(1).
error (f_"-o null: --qemu-boot option cannot be used in this output mode");
if vmtype <> None then
error (f_"--vmtype option cannot be used with '-o null'");
- Output_null.output_null verbose
+ Output_null.output_null ()
| `QEmu ->
if not (is_directory output_storage) then
error (f_"-os %s: output directory does not exist or is not a directory")
output_storage;
- Output_qemu.output_qemu verbose output_storage qemu_boot
+ Output_qemu.output_qemu output_storage qemu_boot
| `RHEV ->
if output_storage = "" then
error (f_"-o rhev: output storage was not specified, use '-os'");
if qemu_boot then
error (f_"-o rhev: --qemu-boot option cannot be used in this output mode");
- Output_rhev.output_rhev verbose output_storage vmtype output_alloc
+ Output_rhev.output_rhev output_storage vmtype output_alloc
| `VDSM ->
if output_storage = "" then
@@ -387,10 +383,10 @@ read the man page virt-v2v(1).
vm_uuid = vdsm_vm_uuid;
ovf_output = vdsm_ovf_output;
} in
- Output_vdsm.output_vdsm verbose output_storage vdsm_params
+ Output_vdsm.output_vdsm output_storage vdsm_params
vmtype output_alloc in
input, output,
debug_gc, debug_overlays, do_copy, network_map, no_trim,
output_alloc, output_format, output_name,
- print_source, quiet, root_choice, trace, verbose
+ print_source, quiet, root_choice
diff --git a/v2v/convert_linux.ml b/v2v/convert_linux.ml
index a24a7fa..7967c0f 100644
--- a/v2v/convert_linux.ml
+++ b/v2v/convert_linux.ml
@@ -59,7 +59,7 @@ let string_of_kernel_info ki =
ki.ki_supports_virtio ki.ki_is_xen_kernel ki.ki_is_debug
(* The conversion function. *)
-let rec convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
+let rec convert ~keep_serial_console (g : G.guestfs) inspect source =
(*----------------------------------------------------------------------*)
(* Inspect the guest first. We already did some basic inspection in
* the common v2v.ml code, but that has to deal with generic guests
@@ -82,7 +82,7 @@ let rec convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
assert (inspect.i_package_format = "rpm");
(* We use Augeas for inspection and conversion, so initialize it early. *)
- Linux.augeas_init verbose g;
+ Linux.augeas_init g;
(* Clean RPM database. This must be done early to avoid RHBZ#1143866. *)
let dbfiles = g#glob_expand "/var/lib/rpm/__db.00?" in
@@ -132,7 +132,7 @@ let rec convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
when name = "kernel" || string_prefix name "kernel-" ->
(try
(* For each kernel, list the files directly owned by the kernel. *)
- let files = Linux.file_list_of_package verbose g inspect app in
+ let files = Linux.file_list_of_package g inspect app in
if files = [] then (
warning (f_"package '%s' contains no files") name;
@@ -254,7 +254,7 @@ let rec convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
| _ -> None
) inspect.i_apps in
- if verbose then (
+ if verbose () then (
printf "installed kernel packages in this guest:\n";
List.iter (
fun kernel -> printf "\t%s\n" (string_of_kernel_info kernel)
@@ -365,7 +365,7 @@ let rec convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
with Not_found -> None
) vmlinuzes in
- if verbose then (
+ if verbose () then (
printf "grub kernels in this guest (first in list is default):\n";
List.iter (
fun kernel -> printf "\t%s\n" (string_of_kernel_info kernel)
@@ -392,7 +392,7 @@ let rec convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
List.exists (fun incl -> g#aug_get incl = grub_config) incls in
if not incls_contains_conf then (
g#aug_set "/augeas/load/Grub/incl[last()+1]" grub_config;
- Linux.augeas_reload verbose g;
+ Linux.augeas_reload g;
)
| `Grub2 -> () (* Not necessary for grub2. *)
@@ -414,7 +414,7 @@ let rec convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
else
None
) inspect.i_apps in
- Linux.remove verbose g inspect xenmods;
+ Linux.remove g inspect xenmods;
(* Undo related nastiness if kmod-xenpv was installed. *)
if xenmods <> [] then (
@@ -429,7 +429,7 @@ let rec convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
(* Check it's not owned by an installed application. *)
let dirs = List.filter (
- fun d -> not (Linux.is_file_owned verbose g inspect d)
+ fun d -> not (Linux.is_file_owned g inspect d)
) dirs in
(* Remove any unowned xenpv directories. *)
@@ -487,7 +487,7 @@ let rec convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
fun { G.app2_name = name } -> name = package_name
) inspect.i_apps in
if has_guest_additions then
- Linux.remove verbose g inspect [package_name];
+ Linux.remove g inspect [package_name];
(* Guest Additions might have been installed from a tarball. The
* above code won't detect this case. Look for the uninstall tool
@@ -519,7 +519,7 @@ let rec convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
ignore (g#command [| vboxuninstall |]);
(* Reload Augeas to detect changes made by vbox tools uninst. *)
- Linux.augeas_reload verbose g
+ Linux.augeas_reload g
with
G.Error msg ->
warning (f_"VirtualBox Guest Additions were detected, but uninstallation failed. The error message was: %s (ignored)")
@@ -598,7 +598,7 @@ let rec convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
);
let remove = !remove in
- Linux.remove verbose g inspect remove;
+ Linux.remove g inspect remove;
(* VMware Tools may have been installed from a tarball, so the
* above code won't remove it. Look for the uninstall tool and run
@@ -610,7 +610,7 @@ let rec convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
ignore (g#command [| uninstaller |]);
(* Reload Augeas to detect changes made by vbox tools uninst. *)
- Linux.augeas_reload verbose g
+ Linux.augeas_reload g
with
G.Error msg ->
warning (f_"VMware tools was detected, but uninstallation failed. The error message was: %s (ignored)")
@@ -625,7 +625,7 @@ let rec convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
let pkgs = List.map (fun { G.app2_name = name } -> name) pkgs in
if pkgs <> [] then (
- Linux.remove verbose g inspect pkgs;
+ Linux.remove g inspect pkgs;
(* Installing these guest utilities automatically unconfigures
* ttys in /etc/inittab if the system uses it. We need to put
@@ -807,7 +807,7 @@ let rec convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
(* Dracut. *)
let args =
[ "/sbin/dracut" ]
- @ (if verbose then [ "--verbose" ] else [])
+ @ (if verbose () then [ "--verbose" ] else [])
@ [ "--add-drivers"; String.concat " " modules; initrd; mkinitrd_kv ]
in
ignore (g#command (Array.of_list args))
@@ -1244,7 +1244,7 @@ let rec convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
"xvd" ^ drive_name i, block_prefix_after_conversion ^ drive_name i
) source.s_disks in
- if verbose then (
+ if verbose () then (
printf "block device map:\n";
List.iter (
fun (source_dev, target_dev) ->
@@ -1349,7 +1349,7 @@ let rec convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
if grub = `Grub2 then
ignore (g#command [| "grub2-mkconfig"; "-o"; grub_config |]);
- Linux.augeas_reload verbose g
+ Linux.augeas_reload g
);
(* Delete blkid caches if they exist, since they will refer to the old
diff --git a/v2v/convert_windows.ml b/v2v/convert_windows.ml
index fd37fad..d373dba 100644
--- a/v2v/convert_windows.ml
+++ b/v2v/convert_windows.ml
@@ -41,7 +41,7 @@ module G = Guestfs
type ('a, 'b) maybe = Either of 'a | Or of 'b
-let convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
+let convert ~keep_serial_console (g : G.guestfs) inspect source =
(* Get the data directory. *)
let virt_tools_data_dir =
try Sys.getenv "VIRT_TOOLS_DATA_DIR"
@@ -74,6 +74,7 @@ let convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source =
let rec with_hive name ~write f =
let filename = sprintf "%s/system32/config/%s" systemroot name in
let filename = g#case_sensitive_path filename in
+ let verbose = verbose () in
g#hivex_open ~write ~verbose (* ~debug:verbose *) filename;
let r =
try
@@ -191,7 +192,7 @@ echo uninstalling Xen PV driver
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;
+ if verbose () then printf "current ControlSet is %s\n%!" current_cs;
disable_services root current_cs;
disable_autoreboot root current_cs;
diff --git a/v2v/input_disk.ml b/v2v/input_disk.ml
index 84a2f85..970f552 100644
--- a/v2v/input_disk.ml
+++ b/v2v/input_disk.ml
@@ -24,8 +24,8 @@ open Common_utils
open Types
open Utils
-class input_disk verbose input_format disk = object
- inherit input verbose
+class input_disk input_format disk = object
+ inherit input
method as_options =
sprintf "-i disk%s %s"
diff --git a/v2v/input_disk.mli b/v2v/input_disk.mli
index 44f99b1..4f8d5cd 100644
--- a/v2v/input_disk.mli
+++ b/v2v/input_disk.mli
@@ -18,7 +18,7 @@
(** [-i disk] source. *)
-val input_disk : bool -> string option -> string -> Types.input
-(** [input_disk verbose input_format disk] creates and returns a new
+val input_disk : string option -> string -> Types.input
+(** [input_disk input_format disk] creates and returns a new
{!Types.input} object specialized for reading input from local
disk images. *)
diff --git a/v2v/input_libvirt.ml b/v2v/input_libvirt.ml
index aa97f7d..5cc0114 100644
--- a/v2v/input_libvirt.ml
+++ b/v2v/input_libvirt.ml
@@ -27,10 +27,10 @@ open Types
open Utils
(* Choose the right subclass based on the URI. *)
-let input_libvirt verbose password libvirt_uri guest =
+let input_libvirt password libvirt_uri guest =
match libvirt_uri with
| None ->
- Input_libvirt_other.input_libvirt_other verbose password libvirt_uri guest
+ Input_libvirt_other.input_libvirt_other password libvirt_uri guest
| Some orig_uri ->
let { Xml.uri_server = server; uri_scheme = scheme } as parsed_uri =
@@ -45,15 +45,15 @@ let input_libvirt verbose password libvirt_uri guest =
| Some _, None (* No scheme? *)
| Some _, Some "" ->
- Input_libvirt_other.input_libvirt_other verbose password libvirt_uri guest
+ Input_libvirt_other.input_libvirt_other password libvirt_uri guest
| Some server, Some ("esx"|"gsx"|"vpx" as scheme) -> (* vCenter over https *)
Input_libvirt_vcenter_https.input_libvirt_vcenter_https
- verbose password libvirt_uri parsed_uri scheme server guest
+ password libvirt_uri parsed_uri scheme server guest
| Some server, Some ("xen+ssh" as scheme) -> (* Xen over SSH *)
Input_libvirt_xen_ssh.input_libvirt_xen_ssh
- verbose password libvirt_uri parsed_uri scheme server guest
+ password libvirt_uri parsed_uri scheme server guest
(* Old virt-v2v also supported qemu+ssh://. However I am
* deliberately not supporting this in new virt-v2v. Don't
@@ -63,6 +63,6 @@ let input_libvirt verbose password libvirt_uri guest =
| Some _, Some _ -> (* Unknown remote scheme. *)
warning (f_"no support for remote libvirt connections to '-ic %s'. The conversion may fail when it tries to read the source disks.")
orig_uri;
- Input_libvirt_other.input_libvirt_other verbose password libvirt_uri guest
+ Input_libvirt_other.input_libvirt_other password libvirt_uri guest
let () = Modules_list.register_input_module "libvirt"
diff --git a/v2v/input_libvirt.mli b/v2v/input_libvirt.mli
index 6b2897b..94d2785 100644
--- a/v2v/input_libvirt.mli
+++ b/v2v/input_libvirt.mli
@@ -18,7 +18,7 @@
(** [-i libvirt] source. *)
-val input_libvirt : bool -> string option -> string option -> string -> Types.input
+val input_libvirt : string option -> string option -> string -> Types.input
(** [input_libvirt verbose password libvirt_uri guest] creates and returns a
new {!Types.input} object specialized for reading input from
libvirt sources. *)
diff --git a/v2v/input_libvirt_other.ml b/v2v/input_libvirt_other.ml
index 48c6092..df819a3 100644
--- a/v2v/input_libvirt_other.ml
+++ b/v2v/input_libvirt_other.ml
@@ -43,9 +43,9 @@ let error_if_no_ssh_agent () =
error (f_"ssh-agent authentication has not been set up ($SSH_AUTH_SOCK is not set). Please read \"INPUT FROM RHEL 5 XEN\" in the virt-v2v(1) man page.")
(* Superclass. *)
-class virtual input_libvirt verbose password libvirt_uri guest =
+class virtual input_libvirt password libvirt_uri guest =
object
- inherit input verbose
+ inherit input
method as_options =
sprintf "-i libvirt%s %s"
@@ -58,19 +58,20 @@ end
(* Subclass specialized for handling anything that's *not* VMware vCenter
* or Xen.
*)
-class input_libvirt_other verbose password libvirt_uri guest =
+class input_libvirt_other password libvirt_uri guest =
object
- inherit input_libvirt verbose password libvirt_uri guest
+ inherit input_libvirt password libvirt_uri guest
method source () =
- if verbose then printf "input_libvirt_other: source()\n%!";
+ if verbose () then printf "input_libvirt_other: source()\n%!";
(* Get the libvirt XML. This also checks (as a side-effect)
* that the domain is not running. (RHBZ#1138586)
*)
let xml = Domainxml.dumpxml ?password ?conn:libvirt_uri guest in
- let source, disks = Input_libvirtxml.parse_libvirt_xml ?conn:libvirt_uri ~verbose xml in
+ let source, disks =
+ Input_libvirtxml.parse_libvirt_xml ?conn:libvirt_uri xml in
let disks =
List.map (fun { Input_libvirtxml.p_source_disk = disk } -> disk) disks in
{ source with s_disks = disks }
diff --git a/v2v/input_libvirt_other.mli b/v2v/input_libvirt_other.mli
index 87652d7..df5a37f 100644
--- a/v2v/input_libvirt_other.mli
+++ b/v2v/input_libvirt_other.mli
@@ -21,10 +21,10 @@
val error_if_libvirt_backend : unit -> unit
val error_if_no_ssh_agent : unit -> unit
-class virtual input_libvirt : bool -> string option -> string option -> string -> object
+class virtual input_libvirt : string option -> string option -> string -> object
method as_options : string
method virtual source : unit -> Types.source
method adjust_overlay_parameters : Types.overlay -> unit
end
-val input_libvirt_other : bool -> string option -> string option -> string -> Types.input
+val input_libvirt_other : string option -> string option -> string -> Types.input
diff --git a/v2v/input_libvirt_vcenter_https.ml b/v2v/input_libvirt_vcenter_https.ml
index ac93329..01a6c89 100644
--- a/v2v/input_libvirt_vcenter_https.ml
+++ b/v2v/input_libvirt_vcenter_https.ml
@@ -38,7 +38,7 @@ let readahead_for_copying = Some (64 * 1024 * 1024)
*)
let rec get_session_cookie =
let session_cookie = ref "" in
- fun verbose password scheme uri sslverify url ->
+ fun password scheme uri sslverify url ->
if !session_cookie <> "" then
Some !session_cookie
else (
@@ -83,7 +83,7 @@ let rec get_session_cookie =
flush chan
in
- if verbose then dump_response stdout;
+ if verbose () then dump_response stdout;
(* Look for the last HTTP/x.y NNN status code in the output. *)
let status = ref "" in
@@ -210,7 +210,7 @@ let get_datacenter uri scheme =
*)
let source_re = Str.regexp "^\\[\\(.*\\)\\] \\(.*\\)\\.vmdk$"
-let map_source_to_uri ?readahead verbose password uri scheme server path =
+let map_source_to_uri ?readahead password uri scheme server path =
if not (Str.string_match source_re path 0) then
path
else (
@@ -244,7 +244,7 @@ let map_source_to_uri ?readahead verbose password uri scheme server path =
(* Now we have to query the server to get the session cookie. *)
let session_cookie =
- get_session_cookie verbose password scheme uri sslverify url in
+ get_session_cookie password scheme uri sslverify url in
(* Construct the JSON parameters. *)
let json_params = [
@@ -268,7 +268,7 @@ let map_source_to_uri ?readahead verbose password uri scheme server path =
| None -> json_params
| Some cookie -> ("file.cookie", JSON.String cookie) :: json_params in
- if verbose then
+ if verbose () then
printf "vcenter: json parameters: %s\n" (JSON.string_of_doc json_params);
(* Turn the JSON parameters into a 'json:' protocol string.
@@ -281,14 +281,14 @@ let map_source_to_uri ?readahead verbose password uri scheme server path =
(* Subclass specialized for handling VMware vCenter over https. *)
class input_libvirt_vcenter_https
- verbose password libvirt_uri parsed_uri scheme server guest =
+ password libvirt_uri parsed_uri scheme server guest =
object
- inherit input_libvirt verbose password libvirt_uri guest
+ inherit input_libvirt password libvirt_uri guest
val saved_source_paths = Hashtbl.create 13
method source () =
- if verbose then
+ if verbose () then
printf "input_libvirt_vcenter_https: source: scheme %s server %s\n%!"
scheme server;
@@ -298,7 +298,7 @@ object
* that the domain is not running. (RHBZ#1138586)
*)
let xml = Domainxml.dumpxml ?password ?conn:libvirt_uri guest in
- let source, disks = parse_libvirt_xml ?conn:libvirt_uri ~verbose xml in
+ let source, disks = parse_libvirt_xml ?conn:libvirt_uri xml in
(* Save the original source paths, so that we can remap them again
* in [#adjust_overlay_parameters].
@@ -321,7 +321,7 @@ object
| { p_source_disk = disk; p_source = P_dont_rewrite } -> disk
| { p_source_disk = disk; p_source = P_source_file path } ->
let qemu_uri = map_source_to_uri ?readahead
- verbose password parsed_uri scheme server path in
+ password parsed_uri scheme server path in
(* The libvirt ESX driver doesn't normally specify a format, but
* the format of the -flat file is *always* raw, so force it here.
@@ -342,13 +342,13 @@ object
let readahead = readahead_for_copying in
let backing_qemu_uri =
map_source_to_uri ?readahead
- verbose password parsed_uri scheme server orig_path in
+ password 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 verbose then printf "%s\n%!" cmd;
+ if verbose () then printf "%s\n%!" cmd;
if Sys.command cmd <> 0 then
warning (f_"qemu-img rebase failed (ignored)")
end
diff --git a/v2v/input_libvirt_vcenter_https.mli b/v2v/input_libvirt_vcenter_https.mli
index 0d17323..302d0ae 100644
--- a/v2v/input_libvirt_vcenter_https.mli
+++ b/v2v/input_libvirt_vcenter_https.mli
@@ -18,4 +18,4 @@
(** [-i libvirt] when the source is VMware vCenter *)
-val input_libvirt_vcenter_https : bool -> string option -> string option -> Xml.uri -> string -> string -> string -> Types.input
+val input_libvirt_vcenter_https : string option -> string option -> Xml.uri -> string -> string -> string -> Types.input
diff --git a/v2v/input_libvirt_xen_ssh.ml b/v2v/input_libvirt_xen_ssh.ml
index f8b0c7a..a9c97df 100644
--- a/v2v/input_libvirt_xen_ssh.ml
+++ b/v2v/input_libvirt_xen_ssh.ml
@@ -30,12 +30,12 @@ open Input_libvirt_other
open Printf
(* Subclass specialized for handling Xen over SSH. *)
-class input_libvirt_xen_ssh verbose password libvirt_uri parsed_uri scheme server guest =
+class input_libvirt_xen_ssh password libvirt_uri parsed_uri scheme server guest =
object
- inherit input_libvirt verbose password libvirt_uri guest
+ inherit input_libvirt password libvirt_uri guest
method source () =
- if verbose then
+ if verbose () then
printf "input_libvirt_xen_ssh: source: scheme %s server %s\n%!"
scheme server;
@@ -46,7 +46,7 @@ object
* that the domain is not running. (RHBZ#1138586)
*)
let xml = Domainxml.dumpxml ?password ?conn:libvirt_uri guest in
- let source, disks = parse_libvirt_xml ?conn:libvirt_uri ~verbose xml in
+ let source, disks = parse_libvirt_xml ?conn:libvirt_uri xml in
(* Map the <source/> filename (which is relative to the remote
* Xen server) to an ssh URI. This is a JSON URI looking something
@@ -87,7 +87,7 @@ object
| None -> json_params
| Some user -> ("file.user", JSON.String user) :: json_params in
- if verbose then
+ if verbose () then
printf "ssh: json parameters: %s\n" (JSON.string_of_doc json_params);
(* Turn the JSON parameters into a 'json:' protocol string. *)
diff --git a/v2v/input_libvirt_xen_ssh.mli b/v2v/input_libvirt_xen_ssh.mli
index ad33cc4..84fd1c7 100644
--- a/v2v/input_libvirt_xen_ssh.mli
+++ b/v2v/input_libvirt_xen_ssh.mli
@@ -18,4 +18,4 @@
(** [-i libvirt] when the source is Xen *)
-val input_libvirt_xen_ssh : bool -> string option -> string option -> Xml.uri -> string -> string -> string -> Types.input
+val input_libvirt_xen_ssh : string option -> string option -> Xml.uri -> string -> string -> string -> Types.input
diff --git a/v2v/input_libvirtxml.ml b/v2v/input_libvirtxml.ml
index 4e019d4..ba00d94 100644
--- a/v2v/input_libvirtxml.ml
+++ b/v2v/input_libvirtxml.ml
@@ -33,8 +33,8 @@ and parsed_source =
| P_source_file of string
| P_dont_rewrite
-let parse_libvirt_xml ?conn ~verbose xml =
- if verbose then
+let parse_libvirt_xml ?conn xml =
+ if verbose () then
printf "libvirt xml is:\n%s\n" xml;
let doc = Xml.parse_memory xml in
@@ -355,16 +355,16 @@ let parse_libvirt_xml ?conn ~verbose xml =
},
disks)
-class input_libvirtxml verbose file =
+class input_libvirtxml file =
object
- inherit input verbose
+ inherit input
method as_options = "-i libvirtxml " ^ file
method source () =
let xml = read_whole_file file in
- let source, disks = parse_libvirt_xml ~verbose xml in
+ let source, disks = parse_libvirt_xml xml in
(* When reading libvirt XML from a file (-i libvirtxml) we allow
* paths to disk images in the libvirt XML to be relative (to the XML
diff --git a/v2v/input_libvirtxml.mli b/v2v/input_libvirtxml.mli
index abe0c43..08cff6b 100644
--- a/v2v/input_libvirtxml.mli
+++ b/v2v/input_libvirtxml.mli
@@ -27,7 +27,7 @@ and parsed_source =
| P_source_file of string (** <source file> *)
| P_dont_rewrite (** s_qemu_uri is already set. *)
-val parse_libvirt_xml : ?conn:string -> verbose:bool -> string -> Types.source * parsed_disk list
+val parse_libvirt_xml : ?conn:string -> string -> Types.source * parsed_disk list
(** Take libvirt XML and parse it into a {!Types.source} structure and a
list of source disks.
@@ -37,7 +37,7 @@ val parse_libvirt_xml : ?conn:string -> verbose:bool -> string -> Types.source *
This function is also used by {!Input_libvirt}, hence it is
exported. *)
-val input_libvirtxml : bool -> string -> Types.input
-(** [input_libvirtxml verbose xml_file] creates and returns a new
+val input_libvirtxml : string -> Types.input
+(** [input_libvirtxml xml_file] creates and returns a new
{!Types.input} object specialized for reading input from local
libvirt XML files. *)
diff --git a/v2v/input_ova.ml b/v2v/input_ova.ml
index 5f06652..066af73 100644
--- a/v2v/input_ova.ml
+++ b/v2v/input_ova.ml
@@ -24,14 +24,14 @@ open Common_utils
open Types
open Utils
-class input_ova verbose ova =
+class input_ova ova =
let tmpdir =
let base_dir = (new Guestfs.guestfs ())#get_cachedir () in
let t = Mkdtemp.temp_dir ~base_dir "ova." "" in
rmdir_on_exit t;
t in
object
- inherit input verbose
+ inherit input
method as_options = "-i ova " ^ ova
@@ -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;
+ if verbose () then printf "%s\n%!" cmd;
if Sys.command cmd <> 0 then
error (f_"error unpacking %s, see earlier error messages") ova in
@@ -75,9 +75,9 @@ object
* zip files as ova too.
*)
let cmd = sprintf "unzip%s -j -d %s %s"
- (if verbose then "" else " -q")
+ (if verbose () then "" else " -q")
(quote tmpdir) (quote ova) in
- if verbose then printf "%s\n%!" cmd;
+ if verbose () then printf "%s\n%!" cmd;
if Sys.command cmd <> 0 then
error (f_"error unpacking %s, see earlier error messages") ova;
tmpdir
@@ -155,7 +155,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
+ if verbose () then
printf "sha1 of %s matches expected checksum %s\n%!"
disk expected
| _::_ -> error (f_"cannot parse output of sha1sum command")
@@ -285,7 +285,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;
+ if verbose () then printf "%s\n%!" cmd;
if Sys.command cmd <> 0 then
error (f_"error uncompressing %s, see earlier error messages")
filename;
diff --git a/v2v/input_ova.mli b/v2v/input_ova.mli
index 733f61d..32fa346 100644
--- a/v2v/input_ova.mli
+++ b/v2v/input_ova.mli
@@ -18,5 +18,5 @@
(** [-i ova] source. *)
-val input_ova : bool -> string -> Types.input
+val input_ova : string -> Types.input
(** [input_ova filename] sets up an input from vmware ova file. *)
diff --git a/v2v/linux.ml b/v2v/linux.ml
index 86cb3bb..c8d5b9b 100644
--- a/v2v/linux.ml
+++ b/v2v/linux.ml
@@ -29,13 +29,13 @@ module G = Guestfs
(* Wrappers around aug_init & aug_load which can dump out full Augeas
* parsing problems when debugging is enabled.
*)
-let rec augeas_init verbose g =
+let rec augeas_init g =
g#aug_init "/" 1;
- if verbose then augeas_debug_errors g
+ if verbose () then augeas_debug_errors g
-and augeas_reload verbose g =
+and augeas_reload g =
g#aug_load ();
- if verbose then augeas_debug_errors g
+ if verbose () then augeas_debug_errors g
and augeas_debug_errors g =
try
@@ -97,10 +97,10 @@ and augeas_debug_errors g =
with
Guestfs.Error msg -> eprintf "%s: augeas: %s (ignored)\n" prog msg
-let install verbose g inspect packages =
+let install g inspect packages =
assert false
-let remove verbose g inspect packages =
+let remove g inspect packages =
if packages <> [] then (
let package_format = inspect.i_package_format in
match package_format with
@@ -110,14 +110,14 @@ let remove verbose g inspect packages =
ignore (g#command cmd);
(* Reload Augeas in case anything changed. *)
- augeas_reload verbose g
+ augeas_reload g
| format ->
error (f_"don't know how to remove packages using %s: packages: %s")
format (String.concat " " packages)
)
-let file_list_of_package verbose (g : Guestfs.guestfs) inspect app =
+let file_list_of_package (g : Guestfs.guestfs) inspect app =
let package_format = inspect.i_package_format in
match package_format with
@@ -147,7 +147,7 @@ let file_list_of_package verbose (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));
+ if verbose () then eprintf "%s\n%!" (String.concat " " (Array.to_list cmd));
let files = g#command_lines cmd in
let files = Array.to_list files in
List.sort compare files
@@ -155,7 +155,7 @@ let file_list_of_package verbose (g : Guestfs.guestfs) inspect app =
error (f_"don't know how to get list of files from package using %s")
format
-let rec file_owner verbose g inspect path =
+let rec file_owner g inspect path =
let package_format = inspect.i_package_format in
match package_format with
| "rpm" ->
@@ -163,7 +163,7 @@ let rec file_owner verbose 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));
+ if verbose () then eprintf "%s\n%!" (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
@@ -175,6 +175,6 @@ let rec file_owner verbose g inspect path =
| format ->
error (f_"don't know how to find file owner using %s") format
-and is_file_owned verbose g inspect path =
- try file_owner verbose g inspect path; true
+and is_file_owned g inspect path =
+ try file_owner g inspect path; true
with Not_found -> false
diff --git a/v2v/linux.mli b/v2v/linux.mli
index 15784ba..35f2f17 100644
--- a/v2v/linux.mli
+++ b/v2v/linux.mli
@@ -18,24 +18,24 @@
(** Common Linux functions. *)
-val augeas_init : bool -> Guestfs.guestfs -> unit
-val augeas_reload : bool -> Guestfs.guestfs -> unit
+val augeas_init : Guestfs.guestfs -> unit
+val augeas_reload : Guestfs.guestfs -> unit
(** Wrappers around [g#aug_init] and [g#aug_load], which (if verbose)
provide additional debugging information about parsing problems
that augeas found. *)
-val install : bool -> Guestfs.guestfs -> Types.inspect -> string list -> unit
+val install : Guestfs.guestfs -> Types.inspect -> string list -> unit
(** Install package(s) from the list in the guest (or ensure they are
installed). *)
-val remove : bool -> Guestfs.guestfs -> Types.inspect -> string list -> unit
+val remove : Guestfs.guestfs -> Types.inspect -> string list -> unit
(** Uninstall package(s). *)
-val file_list_of_package : bool -> Guestfs.guestfs -> Types.inspect -> Guestfs.application2 -> string list
+val file_list_of_package : Guestfs.guestfs -> Types.inspect -> Guestfs.application2 -> string list
(** Return list of files owned by package. *)
-val file_owner : bool -> Guestfs.guestfs -> Types.inspect -> string -> string
+val file_owner : Guestfs.guestfs -> Types.inspect -> string -> string
(** Return the name of the package that owns a file. *)
-val is_file_owned : bool -> Guestfs.guestfs -> Types.inspect -> string -> bool
+val is_file_owned : Guestfs.guestfs -> Types.inspect -> string -> bool
(** Returns true if the file is owned by an installed package. *)
diff --git a/v2v/modules_list.ml b/v2v/modules_list.ml
index ac6908d..7869c9c 100644
--- a/v2v/modules_list.ml
+++ b/v2v/modules_list.ml
@@ -28,7 +28,7 @@ let input_modules () = List.sort compare !input_modules
and output_modules () = List.sort compare !output_modules
type conversion_fn =
- verbose:bool -> keep_serial_console:bool ->
+ keep_serial_console:bool ->
Guestfs.guestfs -> Types.inspect -> Types.source -> Types.guestcaps
let convert_modules = ref []
diff --git a/v2v/modules_list.mli b/v2v/modules_list.mli
index 4c9fdf3..7ae5dd2 100644
--- a/v2v/modules_list.mli
+++ b/v2v/modules_list.mli
@@ -31,7 +31,7 @@ val output_modules : unit -> string list
(** Return the list of output modules. *)
type conversion_fn =
- verbose:bool -> keep_serial_console:bool ->
+ keep_serial_console:bool ->
Guestfs.guestfs -> Types.inspect -> Types.source -> Types.guestcaps
val register_convert_module : (Types.inspect -> bool) -> string -> conversion_fn -> unit
diff --git a/v2v/output_glance.ml b/v2v/output_glance.ml
index 4880151..ad9ec18 100644
--- a/v2v/output_glance.ml
+++ b/v2v/output_glance.ml
@@ -24,7 +24,7 @@ open Common_utils
open Types
open Utils
-class output_glance verbose =
+class output_glance () =
(* Although glance can slurp in a stream from stdin, unfortunately
* 'qemu-img convert' cannot write to a stream (although I guess
* it could be implemented at least for raw). Therefore we have
@@ -36,7 +36,7 @@ class output_glance verbose =
rmdir_on_exit t;
t in
object
- inherit output verbose
+ inherit output
method as_options = "-o glance"
@@ -72,7 +72,7 @@ object
let cmd =
sprintf "glance image-create --name %s --disk-format=%s --container-format=bare --file %s"
(quote source.s_name) (quote target_format) target_file in
- if verbose then printf "%s\n%!" cmd;
+ if verbose () then printf "%s\n%!" cmd;
if Sys.command cmd <> 0 then
error (f_"glance: image upload to glance failed, see earlier errors");
@@ -117,7 +117,7 @@ object
) properties
))
(quote source.s_name) in
- if verbose then printf "%s\n%!" cmd;
+ if verbose () then printf "%s\n%!" 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_glance.mli b/v2v/output_glance.mli
index 1ff7376..60920c3 100644
--- a/v2v/output_glance.mli
+++ b/v2v/output_glance.mli
@@ -18,7 +18,7 @@
(** [-o glance] target. *)
-val output_glance : bool -> Types.output
-(** [output_glance verbose] creates and returns a new
+val output_glance : unit -> Types.output
+(** [output_glance ()] creates and returns a new
{!Types.output} object specialized for writing output to OpenStack
glance. *)
diff --git a/v2v/output_libvirt.ml b/v2v/output_libvirt.ml
index 6e76c92..b540b47 100644
--- a/v2v/output_libvirt.ml
+++ b/v2v/output_libvirt.ml
@@ -305,8 +305,8 @@ let create_libvirt_xml ?pool source targets guestcaps
doc
-class output_libvirt verbose oc output_pool = object
- inherit output verbose
+class output_libvirt oc output_pool = object
+ inherit output
val mutable capabilities_doc = None
@@ -320,7 +320,7 @@ class output_libvirt verbose 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;
+ if verbose () then printf "libvirt capabilities XML:\n%s\n%!" xml;
(* This just checks that the capabilities XML is well-formed,
* early so that we catch parsing errors before conversion.
@@ -385,7 +385,7 @@ class output_libvirt verbose 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;
+ if verbose () then printf "%s\n%!" cmd;
if Sys.command cmd <> 0 then
warning (f_"could not refresh libvirt pool %s") output_pool;
diff --git a/v2v/output_libvirt.mli b/v2v/output_libvirt.mli
index 6370912..9f2c20b 100644
--- a/v2v/output_libvirt.mli
+++ b/v2v/output_libvirt.mli
@@ -18,8 +18,8 @@
(** [-o libvirt] target. *)
-val output_libvirt : bool -> string option -> string -> Types.output
-(** [output_libvirt verbose oc output_pool] creates and returns a new
+val output_libvirt : string option -> string -> Types.output
+(** [output_libvirt oc output_pool] creates and returns a new
{!Types.output} object specialized for writing output to
libvirt. *)
diff --git a/v2v/output_local.ml b/v2v/output_local.ml
index 3b10791..0e82a3a 100644
--- a/v2v/output_local.ml
+++ b/v2v/output_local.ml
@@ -24,8 +24,8 @@ open Common_utils
open Types
open Utils
-class output_local verbose dir = object
- inherit output verbose
+class output_local dir = object
+ inherit output
method as_options = sprintf "-o local -os %s" dir
diff --git a/v2v/output_local.mli b/v2v/output_local.mli
index 6a505b3..5fa30e2 100644
--- a/v2v/output_local.mli
+++ b/v2v/output_local.mli
@@ -18,7 +18,7 @@
(** [-o local] target. *)
-val output_local : bool -> string -> Types.output
-(** [output_local verbose filename] creates and returns a new
+val output_local : string -> Types.output
+(** [output_local filename] creates and returns a new
{!Types.output} object specialized for writing output to local
files. *)
diff --git a/v2v/output_null.ml b/v2v/output_null.ml
index de44615..5cc89a2 100644
--- a/v2v/output_null.ml
+++ b/v2v/output_null.ml
@@ -24,7 +24,7 @@ open Common_utils
open Types
open Utils
-class output_null verbose =
+class output_null =
(* It would be nice to be able to write to /dev/null.
* Unfortunately qemu-img convert cannot do that. Instead create a
* temporary directory which is always deleted at exit.
@@ -35,7 +35,7 @@ class output_null verbose =
rmdir_on_exit t;
t in
object
- inherit output verbose
+ inherit output
method as_options = "-o null"
@@ -51,5 +51,5 @@ object
method create_metadata _ _ _ _ _ = ()
end
-let output_null = new output_null
+let output_null () = new output_null
let () = Modules_list.register_output_module "null"
diff --git a/v2v/output_null.mli b/v2v/output_null.mli
index 7db8656..72ab884 100644
--- a/v2v/output_null.mli
+++ b/v2v/output_null.mli
@@ -18,6 +18,6 @@
(** [-o null] target. *)
-val output_null : bool -> Types.output
-(** [output_null filename] creates and returns a new {!Types.output}
+val output_null : unit -> Types.output
+(** [output_null ()] creates and returns a new {!Types.output}
object specialized discarding output. *)
diff --git a/v2v/output_qemu.ml b/v2v/output_qemu.ml
index 1d8dbdb..81d819e 100644
--- a/v2v/output_qemu.ml
+++ b/v2v/output_qemu.ml
@@ -24,9 +24,9 @@ open Common_utils
open Types
open Utils
-class output_qemu verbose dir qemu_boot =
+class output_qemu dir qemu_boot =
object
- inherit output verbose
+ inherit output
method as_options =
sprintf "-o qemu -os %s%s" dir (if qemu_boot then " --qemu-boot" else "")
diff --git a/v2v/output_qemu.mli b/v2v/output_qemu.mli
index 867425b..f6b9d90 100644
--- a/v2v/output_qemu.mli
+++ b/v2v/output_qemu.mli
@@ -18,7 +18,7 @@
(** [-o qemu] target. *)
-val output_qemu : bool -> string -> bool -> Types.output
-(** [output_qemu verbose filename qemu_boot] creates and returns a new
+val output_qemu : string -> bool -> Types.output
+(** [output_qemu filename qemu_boot] creates and returns a new
{!Types.output} object specialized for writing output to local
files with a qemu script to start the guest locally. *)
diff --git a/v2v/output_rhev.ml b/v2v/output_rhev.ml
index 911705e..365c35e 100644
--- a/v2v/output_rhev.ml
+++ b/v2v/output_rhev.ml
@@ -26,13 +26,13 @@ open Types
open Utils
open DOM
-let rec mount_and_check_storage_domain verbose domain_class os =
+let rec mount_and_check_storage_domain domain_class os =
(* The user can either specify -os nfs:/export, or a local directory
* which is assumed to be the already-mounted NFS export.
*)
match string_split ":/" os with
| mp, "" -> (* Already mounted directory. *)
- check_storage_domain verbose domain_class os mp
+ check_storage_domain domain_class os mp
| server, export ->
let export = "/" ^ export in
@@ -45,21 +45,21 @@ let rec mount_and_check_storage_domain verbose 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;
+ if verbose () then printf "%s\n%!" 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;
+ if verbose () then printf "%s\n%!" cmd;
ignore (Sys.command cmd);
try rmdir mp with _ -> ()
);
- check_storage_domain verbose domain_class os mp
+ check_storage_domain domain_class os mp
-and check_storage_domain verbose domain_class os mp =
+and check_storage_domain domain_class os mp =
(* Typical SD mountpoint looks like this:
* $ ls /tmp/mnt
* 39b6af0e-1d64-40c2-97e4-4f094f1919c7 __DIRECT_IO_TEST__ lost+found
@@ -102,7 +102,7 @@ and check_storage_domain verbose domain_class os mp =
(* UID:GID required for files and directories when writing to ESD. *)
let uid = 36 and gid = 36
-class output_rhev verbose os vmtype output_alloc =
+class output_rhev os vmtype output_alloc =
(* Create a UID-switching handle. If we're not root, create a dummy
* one because we cannot switch UIDs.
*)
@@ -113,7 +113,7 @@ class output_rhev verbose os vmtype output_alloc =
else
Kvmuid.create () in
object
- inherit output verbose
+ inherit output
method as_options =
sprintf "-o rhev -os %s%s" os
@@ -163,10 +163,10 @@ object
*)
method prepare_targets _ targets =
let mp, uuid =
- mount_and_check_storage_domain verbose (s_"Export Storage Domain") os in
+ mount_and_check_storage_domain (s_"Export Storage Domain") os in
esd_mp <- mp;
esd_uuid <- uuid;
- if verbose then
+ if verbose () then
eprintf "RHEV: ESD mountpoint: %s\nRHEV: ESD UUID: %s\n%!"
esd_mp esd_uuid;
@@ -177,7 +177,7 @@ object
let stat = stat testfile in
Kvmuid.unlink kvmuid_t testfile;
let actual_uid = stat.st_uid and actual_gid = stat.st_gid in
- if verbose then
+ if verbose () then
eprintf "RHEV: actual UID:GID of new files is %d:%d\n"
actual_uid actual_gid;
if uid <> actual_uid || gid <> actual_gid then (
@@ -239,7 +239,7 @@ object
let ov_sd = ov.ov_sd in
let target_file = images_dir // image_uuid // vol_uuid in
- if verbose then
+ if verbose () then
eprintf "RHEV: will export %s to %s\n%!" ov_sd target_file;
{ t with target_file = target_file }
@@ -247,7 +247,7 @@ object
(* Generate the .meta file associated with each volume. *)
let metas =
- OVF.create_meta_files verbose output_alloc esd_uuid image_uuids
+ OVF.create_meta_files output_alloc esd_uuid image_uuids
targets in
List.iter (
fun ({ target_file = target_file }, meta) ->
@@ -283,7 +283,7 @@ object
assert (target_firmware = TargetBIOS);
(* Create the metadata. *)
- let ovf = OVF.create_ovf verbose source targets guestcaps inspect
+ let ovf = OVF.create_ovf source targets guestcaps inspect
output_alloc vmtype esd_uuid image_uuids vol_uuids vm_uuid in
(* Write it to the metadata file. *)
diff --git a/v2v/output_rhev.mli b/v2v/output_rhev.mli
index cb4b80e..68702f9 100644
--- a/v2v/output_rhev.mli
+++ b/v2v/output_rhev.mli
@@ -18,10 +18,10 @@
(** [-o rhev] target. *)
-val mount_and_check_storage_domain : bool -> string -> string -> (string * string)
+val mount_and_check_storage_domain : string -> string -> (string * string)
(** This helper function is also used by the VDSM target. *)
-val output_rhev : bool -> string -> Types.vmtype option -> Types.output_allocation -> Types.output
-(** [output_rhev verbose os vmtype output_alloc] creates and
+val output_rhev : string -> Types.vmtype option -> Types.output_allocation -> Types.output
+(** [output_rhev os vmtype output_alloc] creates and
returns a new {!Types.output} object specialized for writing
output to RHEV-M or oVirt Export Storage Domain. *)
diff --git a/v2v/output_vdsm.ml b/v2v/output_vdsm.ml
index aa56e23..44f0041 100644
--- a/v2v/output_vdsm.ml
+++ b/v2v/output_vdsm.ml
@@ -33,9 +33,9 @@ type vdsm_params = {
ovf_output : string;
}
-class output_vdsm verbose os vdsm_params vmtype output_alloc =
+class output_vdsm os vdsm_params vmtype output_alloc =
object
- inherit output verbose
+ inherit output
method as_options =
sprintf "-o vdsm -os %s%s%s --vdsm-vm-uuid %s --vdsm-ovf-output %s%s" os
@@ -94,7 +94,7 @@ object
dd_mp <- mp;
dd_uuid <- uuid;
- if verbose then
+ if verbose () then
eprintf "VDSM: DD mountpoint: %s\nVDSM: DD UUID: %s\n%!"
dd_mp dd_uuid;
@@ -113,7 +113,7 @@ object
error (f_"OVF (metadata) directory (%s) does not exist or is not a directory")
vdsm_params.ovf_output;
- if verbose then
+ if verbose () then
eprintf "VDSM: OVF (metadata) directory: %s\n%!" vdsm_params.ovf_output;
(* The final directory structure should look like this:
@@ -133,7 +133,7 @@ object
let ov_sd = ov.ov_sd in
let target_file = images_dir // image_uuid // vol_uuid in
- if verbose then
+ if verbose () then
eprintf "VDSM: will export %s to %s\n%!" ov_sd target_file;
{ t with target_file = target_file }
@@ -141,7 +141,7 @@ object
(* Generate the .meta files associated with each volume. *)
let metas =
- OVF.create_meta_files verbose output_alloc dd_uuid
+ OVF.create_meta_files output_alloc dd_uuid
vdsm_params.image_uuids targets in
List.iter (
fun ({ target_file = target_file }, meta) ->
@@ -170,7 +170,7 @@ object
assert (target_firmware = TargetBIOS);
(* Create the metadata. *)
- let ovf = OVF.create_ovf verbose source targets guestcaps inspect
+ let ovf = OVF.create_ovf source targets guestcaps inspect
output_alloc vmtype dd_uuid
vdsm_params.image_uuids
vdsm_params.vol_uuids
diff --git a/v2v/output_vdsm.mli b/v2v/output_vdsm.mli
index 161a108..2bc0255 100644
--- a/v2v/output_vdsm.mli
+++ b/v2v/output_vdsm.mli
@@ -26,7 +26,7 @@ type vdsm_params = {
}
(** Miscellaneous extra command line parameters used by VDSM. *)
-val output_vdsm : bool -> string -> vdsm_params -> Types.vmtype option -> Types.output_allocation -> Types.output
-(** [output_vdsm verbose os rhev_params output_alloc] creates and
+val output_vdsm : string -> vdsm_params -> Types.vmtype option -> Types.output_allocation -> Types.output
+(** [output_vdsm os rhev_params output_alloc] creates and
returns a new {!Types.output} object specialized for writing
output to Data Domains directly under VDSM control. *)
diff --git a/v2v/types.ml b/v2v/types.ml
index e241d02..c583554 100644
--- a/v2v/types.ml
+++ b/v2v/types.ml
@@ -347,13 +347,13 @@ gcaps_acpi = %b
gcaps.gcaps_arch
gcaps.gcaps_acpi
-class virtual input verbose = object
+class virtual input = object
method virtual as_options : string
method virtual source : unit -> source
method adjust_overlay_parameters (_ : overlay) = ()
end
-class virtual output verbose = object
+class virtual output = object
method virtual as_options : string
method virtual prepare_targets : source -> target list -> target list
method virtual supported_firmware : target_firmware list
diff --git a/v2v/types.mli b/v2v/types.mli
index e587850..b76ef52 100644
--- a/v2v/types.mli
+++ b/v2v/types.mli
@@ -195,7 +195,7 @@ and guestcaps_video_type = QXL | Cirrus
val string_of_guestcaps : guestcaps -> string
-class virtual input : bool -> object
+class virtual input : object
method virtual as_options : string
(** Converts the input object back to the equivalent command line options.
This is just used for pretty-printing log messages. *)
@@ -207,7 +207,7 @@ class virtual input : bool -> object
end
(** Encapsulates all [-i], etc input arguments as an object. *)
-class virtual output : bool -> object
+class virtual output : object
method virtual as_options : string
(** Converts the output object back to the equivalent command line options.
This is just used for pretty-printing log messages. *)
diff --git a/v2v/v2v.ml b/v2v/v2v.ml
index 2d39ec6..d93366a 100644
--- a/v2v/v2v.ml
+++ b/v2v/v2v.ml
@@ -48,13 +48,13 @@ let rec main () =
let input, output,
debug_gc, debug_overlays, do_copy, network_map, no_trim,
output_alloc, output_format, output_name,
- print_source, quiet, root_choice, trace, verbose =
+ print_source, quiet, root_choice =
Cmdline.parse_cmdline () in
let msg fs = make_message_function ~quiet fs in
(* Print the version, easier than asking users to tell us. *)
- if verbose then
+ if verbose () then
printf "%s: %s %s (%s)\n%!"
prog Config.package_name Config.package_version Config.host_cpu;
@@ -71,7 +71,7 @@ let rec main () =
exit 0
);
- if verbose then printf "%s%!" (string_of_source source);
+ if verbose () then printf "%s%!" (string_of_source source);
(match source.s_hypervisor with
| OtherHV hv ->
@@ -143,7 +143,7 @@ let rec main () =
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;
+ if verbose () then printf "%s\n%!" cmd;
if Sys.command cmd <> 0 then
error (f_"qemu-img command failed, see earlier errors");
@@ -157,8 +157,8 @@ let rec main () =
(* Open the guestfs handle. *)
msg (f_"Opening the overlay");
let g = new G.guestfs () in
- if trace then g#set_trace true;
- if verbose then g#set_verbose true;
+ if trace () then g#set_trace true;
+ if verbose () then g#set_verbose true;
g#set_network true;
List.iter (
fun (overlay_file, _) ->
@@ -222,7 +222,7 @@ let rec main () =
(* Inspection - this also mounts up the filesystems. *)
msg (f_"Inspecting the overlay");
- let inspect = inspect_source ~verbose g root_choice in
+ let inspect = inspect_source g root_choice in
(* Does the guest require UEFI on the target? *)
let target_firmware =
@@ -252,7 +252,7 @@ let rec main () =
{ mp_dev = dev; mp_path = path; mp_statvfs = statvfs; mp_vfs = vfs }
) (g#mountpoints ()) in
- if verbose then (
+ if verbose () then (
(* This is useful for debugging speed / fstrim issues. *)
printf "mpstats:\n";
List.iter (print_mpstat Pervasives.stdout) mpstats
@@ -264,7 +264,7 @@ let rec main () =
(* Estimate space required on target for each disk. Note this is a max. *)
msg (f_"Estimating space required on target for each disk");
- let targets = estimate_target_size ~verbose mpstats targets in
+ let targets = estimate_target_size mpstats targets in
output#check_target_free_space source targets;
@@ -285,9 +285,9 @@ let rec main () =
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;
- let guestcaps = convert ~verbose ~keep_serial_console g inspect source in
- if verbose then printf "%s%!" (string_of_guestcaps guestcaps);
+ if verbose () then printf "picked conversion module %s\n%!" conversion_name;
+ let guestcaps = convert ~keep_serial_console g inspect source in
+ if verbose () then printf "%s%!" (string_of_guestcaps guestcaps);
guestcaps in
(* Did we manage to install virtio drivers? *)
@@ -306,7 +306,7 @@ let rec main () =
* not have to be copied.
*)
msg (f_"Mapping filesystem data to avoid copying unused and blank areas");
- do_fstrim ~verbose g no_trim inspect;
+ do_fstrim g no_trim inspect;
);
msg (f_"Closing the overlay");
@@ -332,7 +332,7 @@ let rec main () =
fun i t ->
msg (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);
+ if verbose () then printf "%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
@@ -380,7 +380,7 @@ let rec main () =
(if not quiet then " -p" else "")
(quote t.target_format) (quote overlay_file)
(quote t.target_file) in
- if verbose then printf "%s\n%!" cmd;
+ if verbose () then printf "%s\n%!" cmd;
let start_time = gettimeofday () in
if Sys.command cmd <> 0 then
error (f_"qemu-img command failed, see earlier errors");
@@ -393,7 +393,7 @@ let rec main () =
(* If verbose, print the virtual and real copying rates. *)
let elapsed_time = end_time -. start_time in
- if verbose && elapsed_time > 0. then (
+ if verbose () && elapsed_time > 0. then (
let mbps size time =
Int64.to_float size /. 1024. /. 1024. *. 10. /. time
in
@@ -412,7 +412,7 @@ let rec main () =
* for developer information only - so we can increase the
* accuracy of the estimate.
*)
- if verbose then (
+ if verbose () then (
match t.target_estimated_size, t.target_actual_size with
| None, None | None, Some _ | Some _, None | Some _, Some 0L -> ()
| Some estimate, Some actual ->
@@ -453,7 +453,7 @@ let rec main () =
if debug_gc then
Gc.compact ()
-and inspect_source ~verbose g root_choice =
+and inspect_source g root_choice =
let roots = g#inspect_os () in
let roots = Array.to_list roots in
@@ -581,7 +581,7 @@ and inspect_source ~verbose g root_choice =
i_apps_map = apps_map;
i_uefi = uefi
} in
- if verbose then printf "%s%!" (string_of_inspect inspect);
+ if verbose () then printf "%s%!" (string_of_inspect inspect);
inspect
(* Conversion can fail if there is no space on the guest filesystems
@@ -622,7 +622,7 @@ and check_free_space mpstats =
(* Perform the fstrim. The trimming bit is easy. Dealing with the
* [--no-trim] parameter .. not so much.
*)
-and do_fstrim ~verbose g no_trim inspect =
+and do_fstrim g no_trim inspect =
(* Get all filesystems. *)
let fses = g#list_filesystems () in
@@ -633,7 +633,7 @@ and do_fstrim ~verbose g no_trim inspect =
let fses =
if no_trim = [] then fses
else (
- if verbose then (
+ if verbose () then (
printf "no_trim: %s\n" (String.concat " " no_trim);
printf "filesystems before considering no_trim: %s\n"
(String.concat " " fses)
@@ -655,7 +655,7 @@ and do_fstrim ~verbose g no_trim inspect =
with Not_found -> true
) fses in
- if verbose then
+ if verbose () then
printf "filesystems after considering no_trim: %s\n%!"
(String.concat " " fses);
@@ -673,7 +673,7 @@ and do_fstrim ~verbose g no_trim inspect =
(* Only emit this warning when debugging, because otherwise
* it causes distress (RHBZ#1168144).
*)
- if verbose then
+ if verbose () then
warning (f_"%s (ignored)") msg
)
) fses
@@ -732,7 +732,7 @@ and do_fstrim ~verbose g no_trim inspect =
* sdb has 3/4 of total virtual size, so it gets a saving of 3 * 1.35 / 4
* sdb final estimate size = 3 - (3*1.35/4) = 1.9875 GB
*)
-and estimate_target_size ~verbose mpstats targets =
+and estimate_target_size mpstats targets =
let sum = List.fold_left (+^) 0L in
(* (1) *)
@@ -740,14 +740,14 @@ and estimate_target_size ~verbose mpstats targets =
sum (
List.map (fun { mp_statvfs = s } -> s.G.blocks *^ s.G.bsize) mpstats
) in
- if verbose then
+ if verbose () then
printf "estimate_target_size: fs_total_size = %Ld [%s]\n%!"
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
+ if verbose () then
printf "estimate_target_size: source_total_size = %Ld [%s]\n%!"
source_total_size (human_size source_total_size);
@@ -757,7 +757,7 @@ and estimate_target_size ~verbose 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
+ if verbose () then
printf "estimate_target_size: ratio = %.3f\n%!" ratio;
(* (4) *)
@@ -781,11 +781,11 @@ and estimate_target_size ~verbose mpstats targets =
| _ -> 0L
) mpstats
) in
- if verbose then
+ if verbose () then
printf "estimate_target_size: fs_free = %Ld [%s]\n%!"
fs_free (human_size fs_free);
let scaled_saving = Int64.of_float (Int64.to_float fs_free *. ratio) in
- if verbose then
+ if verbose () then
printf "estimate_target_size: scaled_saving = %Ld [%s]\n%!"
scaled_saving (human_size scaled_saving);
@@ -797,7 +797,7 @@ and estimate_target_size ~verbose 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
+ if verbose () then
printf "estimate_target_size: %s: %Ld [%s]\n%!"
ov.ov_sd estimated_size (human_size estimated_size);
{ t with target_estimated_size = Some estimated_size }
--
2.3.1
More information about the Libguestfs
mailing list