[PATCH v2 0/4] Only tell people to use -v -x when reporting bugs if they're not using those flags.
The common error function already prints the program name, so we don't need to print it twice. Before: $ virt-resize --expand "" virt-resize: error: virt-resize: empty --expand option After: $ virt-resize --expand "" virt-resize: error: empty --expand option --- resize/resize.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/resize/resize.ml b/resize/resize.ml index 40a777c..33abaab 100644 --- a/resize/resize.ml +++ b/resize/resize.ml @@ -170,7 +170,7 @@ let main () = let dryrun = ref false in let expand = ref "" in let set_expand s = - if s = "" then error (f_"%s: empty --expand option") prog + if s = "" then error (f_"empty --expand option") else if !expand <> "" then error (f_"--expand option given twice") else expand := s in -- 2.3.1
On Friday 15 May 2015 11:40:56 Richard W.M. Jones wrote:
The common error function already prints the program name, so we don't need to print it twice.
Before:
$ virt-resize --expand "" virt-resize: error: virt-resize: empty --expand option
After:
$ virt-resize --expand "" virt-resize: error: empty --expand option --- resize/resize.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/resize/resize.ml b/resize/resize.ml index 40a777c..33abaab 100644 --- a/resize/resize.ml +++ b/resize/resize.ml @@ -170,7 +170,7 @@ let main () = let dryrun = ref false in let expand = ref "" in let set_expand s = - if s = "" then error (f_"%s: empty --expand option") prog + if s = "" then error (f_"empty --expand option") else if !expand <> "" then error (f_"--expand option given twice") else expand := s in
LGTM. I see few cases like that in builder/cmdline.ml, would it be possible to add them to this patch as well? -- Pino Toscano
On Fri, May 15, 2015 at 03:42:20PM +0200, Pino Toscano wrote:
On Friday 15 May 2015 11:40:56 Richard W.M. Jones wrote:
The common error function already prints the program name, so we don't need to print it twice.
Before:
$ virt-resize --expand "" virt-resize: error: virt-resize: empty --expand option
After:
$ virt-resize --expand "" virt-resize: error: empty --expand option --- resize/resize.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/resize/resize.ml b/resize/resize.ml index 40a777c..33abaab 100644 --- a/resize/resize.ml +++ b/resize/resize.ml @@ -170,7 +170,7 @@ let main () = let dryrun = ref false in let expand = ref "" in let set_expand s = - if s = "" then error (f_"%s: empty --expand option") prog + if s = "" then error (f_"empty --expand option") else if !expand <> "" then error (f_"--expand option given twice") else expand := s in
LGTM.
I see few cases like that in builder/cmdline.ml, would it be possible to add them to this patch as well?
I'll send a separate patch in a minute. Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-df lists disk usage of guests without needing to install any software inside the virtual machine. Supports Linux and Windows. http://people.redhat.com/~rjones/virt-df/
This large commit is just code refactoring. Instead of having every OCaml tool define 'prog' the same way, always as: let prog = Filename.basename Sys.executable_name move that into a single place, Common_utils.prog. Then we can use that global value everywhere else, instead of having to pass it as a parameter into a dozen different functions. --- builder/builder.ml | 16 +++++------ builder/cmdline.ml | 6 ++-- builder/downloader.ml | 12 ++++---- builder/downloader.mli | 2 +- builder/index_parser.ml | 6 ++-- builder/index_parser.mli | 2 +- builder/ini_reader.ml | 4 ++- builder/ini_reader.mli | 2 +- builder/paths.ml | 4 +-- builder/sources.ml | 12 ++++---- builder/sources.mli | 2 +- builder/utils.ml | 5 ---- customize/customize_main.ml | 6 ++-- customize/customize_utils.ml | 5 ---- mllib/common_utils.ml | 50 ++++++++++++++++---------------- mllib/common_utils.mli | 21 ++++++++------ mllib/common_utils_tests.ml | 54 +++++++++++++++++------------------ mllib/regedit.ml | 6 ++-- mllib/regedit.mli | 2 +- resize/resize.ml | 12 +++----- sparsify/cmdline.ml | 4 +-- sparsify/sparsify.ml | 2 +- sparsify/utils.ml | 5 ---- sysprep/main.ml | 6 ++-- sysprep/sysprep_operation.ml | 5 ---- sysprep/sysprep_operation.mli | 5 ---- sysprep/sysprep_operation_fs_uuids.ml | 2 +- v2v/OVF.ml | 2 +- v2v/cmdline.ml | 4 +-- v2v/convert_windows.ml | 2 +- v2v/input_libvirt_vcenter_https.ml | 2 +- v2v/input_ova.ml | 2 +- v2v/kvmuid.ml | 1 + v2v/output_rhev.ml | 6 ++-- v2v/utils.ml | 5 ---- v2v/v2v.ml | 4 +-- v2v/v2v_unit_tests.ml | 2 -- 37 files changed, 128 insertions(+), 160 deletions(-) diff --git a/builder/builder.ml b/builder/builder.ml index 0ddf076..7e18065 100644 --- a/builder/builder.ml +++ b/builder/builder.ml @@ -31,8 +31,6 @@ open Customize_cmdline open Unix open Printf -let prog = Filename.basename Sys.executable_name - let () = Random.self_init () let remove_duplicates index = @@ -149,7 +147,7 @@ let main () = (* Download the sources. *) let downloader = Downloader.create ~verbose ~curl ~cache in - let repos = Sources.read_sources ~prog ~verbose in + let repos = Sources.read_sources ~verbose in let sources = List.map ( fun (source, fingerprint) -> { @@ -166,7 +164,7 @@ let main () = let sigchecker = Sigchecker.create ~verbose ~gpg ~check_signature ~gpgkey:source.Sources.gpgkey in - Index_parser.get_index ~prog ~verbose ~downloader ~sigchecker source + Index_parser.get_index ~verbose ~downloader ~sigchecker source ) sources ) in let index = remove_duplicates index in @@ -206,7 +204,7 @@ let main () = let template = name, arch, revision in msg (f_"Downloading: %s") file_uri; let progress_bar = not quiet in - ignore (Downloader.download ~prog downloader ~template ~progress_bar + ignore (Downloader.download downloader ~template ~progress_bar ~proxy file_uri) ) index; exit 0 @@ -264,7 +262,7 @@ let main () = let template = arg, arch, revision in msg (f_"Downloading: %s") file_uri; let progress_bar = not quiet in - Downloader.download ~prog downloader ~template ~progress_bar ~proxy + Downloader.download downloader ~template ~progress_bar ~proxy file_uri in if delete_on_exit then unlink_on_exit template; template in @@ -283,7 +281,7 @@ let main () = | { Index_parser.signature_uri = None } -> None | { Index_parser.signature_uri = Some signature_uri } -> let sigfile, delete_on_exit = - Downloader.download ~prog downloader signature_uri in + Downloader.download downloader signature_uri in if delete_on_exit then unlink_on_exit sigfile; Some sigfile in @@ -323,7 +321,7 @@ let main () = let blockdev_getsize64 dev = let cmd = sprintf "blockdev --getsize64 %s" (quote dev) in - let lines = external_command ~prog cmd in + let lines = external_command cmd in assert (List.length lines >= 1); Int64.of_string (List.hd lines) in @@ -723,4 +721,4 @@ let main () = | None -> () | Some stats -> print_string stats -let () = run_main_and_handle_errors ~prog main +let () = run_main_and_handle_errors main diff --git a/builder/cmdline.ml b/builder/cmdline.ml index ec189ad..61a5cb8 100644 --- a/builder/cmdline.ml +++ b/builder/cmdline.ml @@ -85,7 +85,7 @@ let parse_cmdline () = let quiet = ref false in let size = ref None in - let set_size arg = size := Some (parse_size ~prog arg) in + let set_size arg = size := Some (parse_size arg) in let smp = ref None in let set_smp arg = smp := Some arg in @@ -149,9 +149,9 @@ let parse_cmdline () = "--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.Unit (print_version_and_exit ~prog), + "-V", Arg.Unit print_version_and_exit, " " ^ s_"Display version and exit"; - "--version", Arg.Unit (print_version_and_exit ~prog), + "--version", Arg.Unit print_version_and_exit, " " ^ s_"Display version and exit"; "-x", Arg.Set trace, " " ^ s_"Enable tracing of libguestfs calls"; ] in diff --git a/builder/downloader.ml b/builder/downloader.ml index 8a23bdc..0c91cbb 100644 --- a/builder/downloader.ml +++ b/builder/downloader.ml @@ -44,19 +44,19 @@ let create ~verbose ~curl ~cache = { cache = cache; } -let rec download ~prog t ?template ?progress_bar ?(proxy = SystemProxy) uri = +let rec download t ?template ?progress_bar ?(proxy = SystemProxy) uri = match template with | None -> (* no cache, simple download *) (* Create a temporary name. *) let tmpfile = Filename.temp_file "vbcache" ".txt" in - download_to ~prog t ?progress_bar ~proxy uri tmpfile; + download_to t ?progress_bar ~proxy uri tmpfile; (tmpfile, true) | Some (name, arch, revision) -> match t.cache with | None -> (* Not using the cache at all? *) - download t ~prog ?progress_bar ~proxy uri + download t ?progress_bar ~proxy uri | Some cache -> let filename = Cache.cache_of_name cache name arch revision in @@ -65,11 +65,11 @@ let rec download ~prog t ?template ?progress_bar ?(proxy = SystemProxy) uri = * If not, download it. *) if not (Sys.file_exists filename) then - download_to ~prog t ?progress_bar ~proxy uri filename; + download_to t ?progress_bar ~proxy uri filename; (filename, false) -and download_to ~prog t ?(progress_bar = false) ~proxy uri filename = +and download_to t ?(progress_bar = false) ~proxy uri filename = let parseduri = try URI.parse_uri uri with Invalid_argument "URI.parse_uri" -> @@ -102,7 +102,7 @@ and download_to ~prog t ?(progress_bar = false) ~proxy uri filename = (if t.verbose then "" else " -s -S") (quote uri) in if t.verbose then printf "%s\n%!" cmd; - let lines = external_command ~prog cmd in + 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"); let status_code = List.hd lines in diff --git a/builder/downloader.mli b/builder/downloader.mli index 2721f79..837c879 100644 --- a/builder/downloader.mli +++ b/builder/downloader.mli @@ -35,7 +35,7 @@ type proxy_mode = val create : verbose:bool -> curl:string -> cache:Cache.t option -> t (** Create the abstract type. *) -val download : prog:string -> t -> ?template:(string*string*int) -> ?progress_bar:bool -> ?proxy:proxy_mode -> uri -> (filename * bool) +val download : t -> ?template:(string*string*int) -> ?progress_bar:bool -> ?proxy:proxy_mode -> uri -> (filename * bool) (** Download the URI, returning the downloaded filename and a temporary file flag. The temporary file flag is [true] iff the downloaded file is temporary and should be deleted by the diff --git a/builder/index_parser.ml b/builder/index_parser.ml index 38fe195..d39bb3a 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 ~prog ~verbose ~downloader ~sigchecker +let get_index ~verbose ~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 @@ -119,7 +119,7 @@ let get_index ~prog ~verbose ~downloader ~sigchecker let rec get_index () = (* Get the index page. *) - let tmpfile, delete_tmpfile = Downloader.download ~prog downloader ~proxy uri in + let tmpfile, delete_tmpfile = Downloader.download downloader ~proxy uri in (* Check index file signature (also verifies it was fully * downloaded and not corrupted in transit). @@ -127,7 +127,7 @@ let get_index ~prog ~verbose ~downloader ~sigchecker Sigchecker.verify sigchecker tmpfile; (* Try parsing the file. *) - let sections = Ini_reader.read_ini ~prog tmpfile in + let sections = Ini_reader.read_ini tmpfile in if delete_tmpfile then (try Unix.unlink tmpfile with _ -> ()); diff --git a/builder/index_parser.mli b/builder/index_parser.mli index c7f244d..4687346 100644 --- a/builder/index_parser.mli +++ b/builder/index_parser.mli @@ -38,4 +38,4 @@ and entry = { proxy : Downloader.proxy_mode; } -val get_index : prog:string -> verbose:bool -> downloader:Downloader.t -> sigchecker:Sigchecker.t -> Sources.source -> index +val get_index : verbose:bool -> downloader:Downloader.t -> sigchecker:Sigchecker.t -> Sources.source -> index diff --git a/builder/ini_reader.ml b/builder/ini_reader.ml index c989e1f..50a06f9 100644 --- a/builder/ini_reader.ml +++ b/builder/ini_reader.ml @@ -16,6 +16,8 @@ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. *) +open Common_utils + type sections = section list and section = string * fields (* [name] + fields *) and fields = field list @@ -29,7 +31,7 @@ and c_fields = field array (* Calls yyparse in the C code. *) external parse_index : prog:string -> error_suffix:string -> string -> c_sections = "virt_builder_parse_index" -let read_ini ~prog ?(error_suffix = "") file = +let read_ini ?(error_suffix = "") file = let sections = parse_index ~prog ~error_suffix file in let sections = Array.to_list sections in List.map ( diff --git a/builder/ini_reader.mli b/builder/ini_reader.mli index 82c8e24..62567e8 100644 --- a/builder/ini_reader.mli +++ b/builder/ini_reader.mli @@ -21,4 +21,4 @@ and section = string * fields (* [name] + fields *) and fields = field list and field = string * string option * string (* key + subkey + value *) -val read_ini : prog:string -> ?error_suffix:string -> string -> sections +val read_ini : ?error_suffix:string -> string -> sections diff --git a/builder/paths.ml b/builder/paths.ml index e4f0c7b..2b131c0 100644 --- a/builder/paths.ml +++ b/builder/paths.ml @@ -25,14 +25,14 @@ let xdg_cache_home = with Not_found -> None (* no cache directory *) -let xdg_config_home ~prog = +let xdg_config_home () = try Some (Sys.getenv "XDG_CONFIG_HOME" // prog) with Not_found -> try Some (Sys.getenv "HOME" // ".config" // prog) with Not_found -> None (* no config directory *) -let xdg_config_dirs ~prog = +let xdg_config_dirs () = let dirs = try Sys.getenv "XDG_CONFIG_DIRS" with Not_found -> "/etc/xdg" in diff --git a/builder/sources.ml b/builder/sources.ml index 990a2ac..cec4a04 100644 --- a/builder/sources.ml +++ b/builder/sources.ml @@ -31,11 +31,11 @@ type source = { module StringSet = Set.Make (String) -let parse_conf ~prog ~verbose file = +let parse_conf ~verbose file = if verbose then ( printf (f_"%s: trying to read %s\n") prog file; ); - let sections = Ini_reader.read_ini ~prog ~error_suffix:"[ignored]" file in + let sections = Ini_reader.read_ini ~error_suffix:"[ignored]" file in let sources = List.fold_right ( fun (n, fields) acc -> @@ -101,10 +101,10 @@ let merge_sources current_sources new_sources = let filter_filenames filename = Filename.check_suffix filename ".conf" -let read_sources ~prog ~verbose = - let dirs = Paths.xdg_config_dirs ~prog in +let read_sources ~verbose = + let dirs = Paths.xdg_config_dirs () in let dirs = - match Paths.xdg_config_home ~prog with + match Paths.xdg_config_home () with | None -> dirs | Some dir -> dir :: dirs in let dirs = List.map (fun x -> x // "repos.d") dirs in @@ -118,7 +118,7 @@ let read_sources ~prog ~verbose = List.fold_left ( fun acc file -> try ( - let s = merge_sources acc (parse_conf ~prog ~verbose (dir // file)) in + let s = merge_sources acc (parse_conf ~verbose (dir // file)) in (* Add the current file name to the set only if its parsing * was successful. *) diff --git a/builder/sources.mli b/builder/sources.mli index f7bc016..52c5908 100644 --- a/builder/sources.mli +++ b/builder/sources.mli @@ -23,4 +23,4 @@ type source = { proxy : Downloader.proxy_mode; } -val read_sources : prog:string -> verbose:bool -> source list +val read_sources : verbose:bool -> source list diff --git a/builder/utils.ml b/builder/utils.ml index 5dea74e..a6628eb 100644 --- a/builder/utils.ml +++ b/builder/utils.ml @@ -27,9 +27,4 @@ type gpgkey_type = | Fingerprint of string | KeyFile of string -let prog = Filename.basename Sys.executable_name -let error ?exit_code fs = error ~prog ?exit_code fs -let warning fs = warning ~prog fs -let info fs = info ~prog fs - let quote = Filename.quote diff --git a/customize/customize_main.ml b/customize/customize_main.ml index 6669c30..fe3e7b8 100644 --- a/customize/customize_main.ml +++ b/customize/customize_main.ml @@ -100,9 +100,9 @@ let main () = "--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.Unit (print_version_and_exit ~prog), + "-V", Arg.Unit print_version_and_exit, " " ^ s_"Display version and exit"; - "--version", Arg.Unit (print_version_and_exit ~prog), + "--version", Arg.Unit print_version_and_exit, " " ^ s_"Display version and exit"; "-x", Arg.Set trace, " " ^ s_"Enable tracing of libguestfs calls"; ] in @@ -253,4 +253,4 @@ read the man page virt-customize(1). Gc.compact () (* Finished. *) -let () = run_main_and_handle_errors ~prog main +let () = run_main_and_handle_errors main diff --git a/customize/customize_utils.ml b/customize/customize_utils.ml index 465581a..360c252 100644 --- a/customize/customize_utils.ml +++ b/customize/customize_utils.ml @@ -22,9 +22,4 @@ open Printf open Common_utils -let prog = Filename.basename Sys.executable_name -let error ?exit_code fs = error ~prog ?exit_code fs -let warning fs = warning ~prog fs -let info fs = info ~prog fs - let quote = Filename.quote diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml index 652a412..ed647e5 100644 --- a/mllib/common_utils.ml +++ b/mllib/common_utils.ml @@ -278,7 +278,9 @@ let make_message_function ~quiet fs = in ksprintf p fs -let error ~prog ?(exit_code = 1) fs = +let prog = Filename.basename Sys.executable_name + +let error ?(exit_code = 1) fs = let display str = let chan = stderr in ansi_red ~chan (); @@ -294,7 +296,7 @@ let error ~prog ?(exit_code = 1) fs = in ksprintf display fs -let warning ~prog fs = +let warning fs = let display str = let chan = stderr in ansi_blue ~chan (); @@ -304,7 +306,7 @@ let warning ~prog fs = in ksprintf display fs -let info ~prog fs = +let info fs = let display str = let chan = stdout in ansi_magenta ~chan (); @@ -317,33 +319,33 @@ let info ~prog fs = (* All the OCaml virt-* programs use this wrapper to catch exceptions * and print them nicely. *) -let run_main_and_handle_errors ~prog main = +let run_main_and_handle_errors main = try main () with | Unix.Unix_error (code, fname, "") -> (* from a syscall *) - error ~prog (f_"%s: %s") fname (Unix.error_message code) + error (f_"%s: %s") fname (Unix.error_message code) | Unix.Unix_error (code, fname, param) -> (* from a syscall *) - error ~prog (f_"%s: %s: %s") fname (Unix.error_message code) param + error (f_"%s: %s: %s") fname (Unix.error_message code) param | Sys_error msg -> (* from a syscall *) - error ~prog (f_"%s") msg + error (f_"%s") msg | G.Error msg -> (* from libguestfs *) - error ~prog (f_"libguestfs error: %s") msg + error (f_"libguestfs error: %s") msg | Failure msg -> (* from failwith/failwithf *) - error ~prog (f_"failure: %s") msg + error (f_"failure: %s") msg | Invalid_argument msg -> (* probably should never happen *) - error ~prog (f_"internal error: invalid argument: %s") msg + error (f_"internal error: invalid argument: %s") msg | Assert_failure (file, line, char) -> (* should never happen *) - error ~prog (f_"internal error: assertion failed at %s, line %d, char %d") + error (f_"internal error: assertion failed at %s, line %d, char %d") file line char | Not_found -> (* should never happen *) - error ~prog (f_"internal error: Not_found exception was thrown") + error (f_"internal error: Not_found exception was thrown") | exn -> (* something not matched above *) - error ~prog (f_"exception: %s") (Printexc.to_string exn) + error (f_"exception: %s") (Printexc.to_string exn) (* Print the version number and exit. Used to implement --version in * the OCaml tools. *) -let print_version_and_exit ~prog () = +let print_version_and_exit () = printf "%s %s\n%!" prog Config.package_version_full; exit 0 @@ -366,7 +368,7 @@ let read_whole_file path = (* Parse a size field, eg. "10G". *) let parse_size = let const_re = Str.regexp "^\\([.0-9]+\\)\\([bKMG]\\)$" in - fun ~prog field -> + fun field -> let matches rex = Str.string_match rex field 0 in let sub i = Str.matched_group i field in let size_scaled f = function @@ -381,7 +383,7 @@ let parse_size = size_scaled (float_of_string (sub 1)) (sub 2) ) else - error ~prog "%s: cannot parse size field" field + error "%s: cannot parse size field" field (* Parse a size field, eg. "10G", "+20%" etc. Used particularly by * virt-resize --resize and --resize-force options. @@ -394,7 +396,7 @@ let parse_resize = and plus_percent_re = Str.regexp "^\\+\\([.0-9]+\\)%$" and minus_percent_re = Str.regexp "^-\\([.0-9]+\\)%$" in - fun ~prog oldsize field -> + fun oldsize field -> let matches rex = Str.string_match rex field 0 in let sub i = Str.matched_group i field in let size_scaled f = function @@ -429,7 +431,7 @@ let parse_resize = oldsize -^ oldsize *^ percent /^ 1000L ) else - error ~prog "%s: cannot parse resize field" field + error "%s: cannot parse resize field" field let human_size i = let sign, i = if i < 0L then "-", Int64.neg i else "", i in @@ -535,7 +537,7 @@ let compare_lvm2_uuids uuid1 uuid2 = loop 0 0 (* Run an external command, slurp up the output as a list of lines. *) -let external_command ~prog cmd = +let external_command cmd = let chan = Unix.open_process_in cmd in let lines = ref [] in (try while true do lines := input_line chan :: !lines done @@ -545,17 +547,17 @@ let external_command ~prog cmd = (match stat with | Unix.WEXITED 0 -> () | Unix.WEXITED i -> - error ~prog (f_"external command '%s' exited with error %d") cmd i + error (f_"external command '%s' exited with error %d") cmd i | Unix.WSIGNALED i -> - error ~prog (f_"external command '%s' killed by signal %d") cmd i + error (f_"external command '%s' killed by signal %d") cmd i | Unix.WSTOPPED i -> - error ~prog (f_"external command '%s' stopped by signal %d") cmd i + error (f_"external command '%s' stopped by signal %d") cmd i ); lines (* Run uuidgen to return a random UUID. *) -let uuidgen ~prog () = - let lines = external_command ~prog "uuidgen -r" in +let uuidgen () = + let lines = external_command "uuidgen -r" in assert (List.length lines >= 1); let uuid = List.hd lines in let len = String.length uuid in diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli index f7d83be..957ae81 100644 --- a/mllib/common_utils.mli +++ b/mllib/common_utils.mli @@ -66,29 +66,32 @@ val make_message_function : quiet:bool -> ('a, unit, string, unit) format4 -> 'a (** Timestamped progress messages. Used for ordinary messages when not [--quiet]. *) -val error : prog:string -> ?exit_code:int -> ('a, unit, string, 'b) format4 -> 'a +val prog : string +(** The program name (derived from {!Sys.executable_name}). *) + +val error : ?exit_code:int -> ('a, unit, string, 'b) format4 -> 'a (** Standard error function. *) -val warning : prog:string -> ('a, unit, string, unit) format4 -> 'a +val warning : ('a, unit, string, unit) format4 -> 'a (** Standard warning function. *) -val info : prog:string -> ('a, unit, string, unit) format4 -> 'a +val info : ('a, unit, string, unit) format4 -> 'a (** Standard info function. Note: Use full sentences for this. *) -val run_main_and_handle_errors : prog:string -> (unit -> unit) -> unit +val run_main_and_handle_errors : (unit -> unit) -> unit (** Common function for handling pretty-printing exceptions. *) -val print_version_and_exit : prog:string -> unit -> unit +val print_version_and_exit : unit -> unit (** Print the version number and exit. Implements [--version] flag in the OCaml tools. *) val read_whole_file : string -> string (** Read in the whole file as a string. *) -val parse_size : prog:string -> string -> int64 +val parse_size : string -> int64 (** Parse a size field, eg. [10G] *) -val parse_resize : prog:string -> int64 -> string -> int64 +val parse_resize : int64 -> string -> int64 (** Parse a size field, eg. [10G], [+20%] etc. Used particularly by [virt-resize --resize] and [--resize-force] options. *) @@ -113,10 +116,10 @@ val compare_version : string -> string -> int val compare_lvm2_uuids : string -> string -> int (** Compare two LVM2 UUIDs, ignoring '-' characters. *) -val external_command : prog:string -> string -> string list +val external_command : string -> string list (** Run an external command, slurp up the output as a list of lines. *) -val uuidgen : prog:string -> unit -> string +val uuidgen : unit -> string (** Run uuidgen to return a random UUID. *) val unlink_on_exit : string -> unit diff --git a/mllib/common_utils_tests.ml b/mllib/common_utils_tests.ml index a06476b..6bfc7e1 100644 --- a/mllib/common_utils_tests.ml +++ b/mllib/common_utils_tests.ml @@ -21,8 +21,6 @@ open OUnit2 open Common_utils -let prog = "common_utils_tests" - (* Utils. *) let assert_equal_string = assert_equal ~printer:(fun x -> x) let assert_equal_int = assert_equal ~printer:(fun x -> string_of_int x) @@ -37,41 +35,41 @@ let test_le32 ctx = (* Test Common_utils.parse_size. *) let test_parse_resize ctx = (* For absolute sizes, oldsize is ignored. *) - assert_equal_int64 100_L (parse_resize ~prog 100_L "100b"); - assert_equal_int64 100_L (parse_resize ~prog 1000_L "100b"); - assert_equal_int64 100_L (parse_resize ~prog 10000_L "100b"); - assert_equal_int64 102400_L (parse_resize ~prog 100_L "100K"); + assert_equal_int64 100_L (parse_resize 100_L "100b"); + assert_equal_int64 100_L (parse_resize 1000_L "100b"); + assert_equal_int64 100_L (parse_resize 10000_L "100b"); + assert_equal_int64 102400_L (parse_resize 100_L "100K"); (* Fractions are always rounded down. *) - assert_equal_int64 1126_L (parse_resize ~prog 100_L "1.1K"); - assert_equal_int64 104962457_L (parse_resize ~prog 100_L "100.1M"); - assert_equal_int64 132499741081_L (parse_resize ~prog 100_L "123.4G"); + assert_equal_int64 1126_L (parse_resize 100_L "1.1K"); + assert_equal_int64 104962457_L (parse_resize 100_L "100.1M"); + assert_equal_int64 132499741081_L (parse_resize 100_L "123.4G"); (* oldsize +/- a constant. *) - assert_equal_int64 101_L (parse_resize ~prog 100_L "+1b"); - assert_equal_int64 98_L (parse_resize ~prog 100_L "-2b"); - assert_equal_int64 1124_L (parse_resize ~prog 100_L "+1K"); - assert_equal_int64 0_L (parse_resize ~prog 1024_L "-1K"); - assert_equal_int64 0_L (parse_resize ~prog 1126_L "-1.1K"); - assert_equal_int64 1154457_L (parse_resize ~prog 1024_L "+1.1M"); - assert_equal_int64 107374182_L (parse_resize ~prog 132499741081_L "-123.3G"); + assert_equal_int64 101_L (parse_resize 100_L "+1b"); + assert_equal_int64 98_L (parse_resize 100_L "-2b"); + assert_equal_int64 1124_L (parse_resize 100_L "+1K"); + assert_equal_int64 0_L (parse_resize 1024_L "-1K"); + assert_equal_int64 0_L (parse_resize 1126_L "-1.1K"); + assert_equal_int64 1154457_L (parse_resize 1024_L "+1.1M"); + assert_equal_int64 107374182_L (parse_resize 132499741081_L "-123.3G"); (* oldsize +/- a percentage. *) - assert_equal_int64 101_L (parse_resize ~prog 100_L "+1%"); - assert_equal_int64 99_L (parse_resize ~prog 100_L "-1%"); - assert_equal_int64 101000_L (parse_resize ~prog 100000_L "+1%"); - assert_equal_int64 99000_L (parse_resize ~prog 100000_L "-1%"); - assert_equal_int64 150000_L (parse_resize ~prog 100000_L "+50%"); - assert_equal_int64 50000_L (parse_resize ~prog 100000_L "-50%"); - assert_equal_int64 200000_L (parse_resize ~prog 100000_L "+100%"); - assert_equal_int64 0_L (parse_resize ~prog 100000_L "-100%"); - assert_equal_int64 300000_L (parse_resize ~prog 100000_L "+200%"); - assert_equal_int64 400000_L (parse_resize ~prog 100000_L "+300%"); + assert_equal_int64 101_L (parse_resize 100_L "+1%"); + assert_equal_int64 99_L (parse_resize 100_L "-1%"); + assert_equal_int64 101000_L (parse_resize 100000_L "+1%"); + assert_equal_int64 99000_L (parse_resize 100000_L "-1%"); + assert_equal_int64 150000_L (parse_resize 100000_L "+50%"); + assert_equal_int64 50000_L (parse_resize 100000_L "-50%"); + assert_equal_int64 200000_L (parse_resize 100000_L "+100%"); + assert_equal_int64 0_L (parse_resize 100000_L "-100%"); + assert_equal_int64 300000_L (parse_resize 100000_L "+200%"); + assert_equal_int64 400000_L (parse_resize 100000_L "+300%"); (* Implementation rounds numbers so that only a single digit after * the decimal point is significant. *) - assert_equal_int64 101100_L (parse_resize ~prog 100000_L "+1.1%"); - assert_equal_int64 101100_L (parse_resize ~prog 100000_L "+1.12%") + assert_equal_int64 101100_L (parse_resize 100000_L "+1.1%"); + assert_equal_int64 101100_L (parse_resize 100000_L "+1.12%") (* Test Common_utils.human_size. *) let test_human_size ctx = diff --git a/mllib/regedit.ml b/mllib/regedit.ml index 0291fe4..389dd82 100644 --- a/mllib/regedit.ml +++ b/mllib/regedit.ml @@ -44,16 +44,16 @@ let encode_utf16le str = (* Take a UTF16LE string and decode it to UTF-8. Actually this * fails if the string is not 7 bit ASCII. XXX Use iconv here. *) -let decode_utf16le ~prog str = +let decode_utf16le str = let len = String.length str in if len mod 2 <> 0 then - error ~prog (f_"decode_utf16le: Windows string does not appear to be in UTF16-LE encoding. This could be a bug in %s.") prog; + error (f_"decode_utf16le: Windows string does not appear to be in UTF16-LE encoding. This could be a bug in %s.") prog; let copy = String.create (len/2) in for i = 0 to (len/2)-1 do let cl = String.unsafe_get str (i*2) in let ch = String.unsafe_get str ((i*2)+1) in if ch != '\000' || Char.code cl >= 127 then - error ~prog (f_"decode_utf16le: Windows UTF16-LE string contains non-7-bit characters. This is a bug in %s, please report it.") prog; + error (f_"decode_utf16le: Windows UTF16-LE string contains non-7-bit characters. This is a bug in %s, please report it.") prog; String.unsafe_set copy i cl done; copy diff --git a/mllib/regedit.mli b/mllib/regedit.mli index 985e405..a65f5d3 100644 --- a/mllib/regedit.mli +++ b/mllib/regedit.mli @@ -61,5 +61,5 @@ val reg_import : Guestfs.guestfs -> int64 -> regedits -> unit val encode_utf16le : string -> string (** Helper: Take a 7 bit ASCII string and encode it as UTF-16LE. *) -val decode_utf16le : prog:string -> string -> string +val decode_utf16le : string -> string (** Helper: Take a UTF-16LE string and decode it to UTF-8. *) diff --git a/resize/resize.ml b/resize/resize.ml index 33abaab..ef0f601 100644 --- a/resize/resize.ml +++ b/resize/resize.ml @@ -27,10 +27,6 @@ module G = Guestfs let min_extra_partition = 10L *^ 1024L *^ 1024L (* Command line argument parsing. *) -let prog = Filename.basename Sys.executable_name -let error fs = error ~prog fs -let warning fs = warning ~prog fs - type align_first_t = [ `Never | `Always | `Auto ] (* Source partition type. *) @@ -229,9 +225,9 @@ let main () = "--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.Unit (print_version_and_exit ~prog), + "-V", Arg.Unit print_version_and_exit, " " ^ s_"Display version and exit"; - "--version", Arg.Unit (print_version_and_exit ~prog), ditto; + "--version", Arg.Unit print_version_and_exit, ditto; "-x", Arg.Set trace, " " ^ s_"Enable tracing of libguestfs calls"; ] in long_options := argspec; @@ -722,7 +718,7 @@ read the man page virt-resize(1). (* Parse the size field. *) let oldsize = p.p_part.G.part_size in - let newsize = parse_resize ~prog oldsize sizefield in + let newsize = parse_resize oldsize sizefield in if newsize <= 0L then error (f_"%s: new partition size is zero or negative") dev; @@ -1367,4 +1363,4 @@ read the man page virt-resize(1). if debug_gc then Gc.compact () -let () = run_main_and_handle_errors ~prog main +let () = run_main_and_handle_errors main diff --git a/sparsify/cmdline.ml b/sparsify/cmdline.ml index e8d3e81..290359c 100644 --- a/sparsify/cmdline.ml +++ b/sparsify/cmdline.ml @@ -77,9 +77,9 @@ let parse_cmdline () = "--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.Unit (print_version_and_exit ~prog), + "-V", Arg.Unit print_version_and_exit, " " ^ s_"Display version and exit"; - "--version", Arg.Unit (print_version_and_exit ~prog), ditto; + "--version", Arg.Unit print_version_and_exit, ditto; "-x", Arg.Set trace, " " ^ s_"Enable tracing of libguestfs calls"; "--zero", Arg.String (add zeroes), s_"fs" ^ " " ^ s_"Zero filesystem"; ] in diff --git a/sparsify/sparsify.ml b/sparsify/sparsify.ml index 19f1870..a16af84 100644 --- a/sparsify/sparsify.ml +++ b/sparsify/sparsify.ml @@ -46,4 +46,4 @@ let rec main () = if debug_gc then Gc.compact () -let () = run_main_and_handle_errors ~prog main +let () = run_main_and_handle_errors main diff --git a/sparsify/utils.ml b/sparsify/utils.ml index 19bb85e..73e90b0 100644 --- a/sparsify/utils.ml +++ b/sparsify/utils.ml @@ -24,11 +24,6 @@ open Common_utils module G = Guestfs -let prog = Filename.basename Sys.executable_name -let error ?exit_code fs = error ~prog ?exit_code fs -let warning fs = warning ~prog fs -let info fs = info ~prog fs - let quote = Filename.quote (* Return true if the filesystem is a read-only LV (RHBZ#1185561). *) diff --git a/sysprep/main.ml b/sysprep/main.ml index 4763507..65dc29e 100644 --- a/sysprep/main.ml +++ b/sysprep/main.ml @@ -146,9 +146,9 @@ let main () = "--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.Unit (print_version_and_exit ~prog), + "-V", Arg.Unit print_version_and_exit, " " ^ s_"Display version and exit"; - "--version", Arg.Unit (print_version_and_exit ~prog), + "--version", Arg.Unit print_version_and_exit, " " ^ s_"Display version and exit"; "-x", Arg.Set trace, " " ^ s_"Enable tracing of libguestfs calls"; ] in @@ -289,4 +289,4 @@ read the man page virt-sysprep(1). if debug_gc then Gc.compact () -let () = run_main_and_handle_errors ~prog main +let () = run_main_and_handle_errors main diff --git a/sysprep/sysprep_operation.ml b/sysprep/sysprep_operation.ml index ec5e374..4c4269a 100644 --- a/sysprep/sysprep_operation.ml +++ b/sysprep/sysprep_operation.ml @@ -22,11 +22,6 @@ open Printf open Common_gettext.Gettext -let prog = Filename.basename Sys.executable_name -let error ?exit_code fs = error ~prog ?exit_code fs -let warning fs = warning ~prog fs -let info fs = info ~prog fs - class filesystem_side_effects = object val mutable m_created_file = false diff --git a/sysprep/sysprep_operation.mli b/sysprep/sysprep_operation.mli index bed0266..aab70bc 100644 --- a/sysprep/sysprep_operation.mli +++ b/sysprep/sysprep_operation.mli @@ -18,11 +18,6 @@ (** Defines the interface between the main program and sysprep operations. *) -val prog : string -val error : ?exit_code:int -> ('a, unit, string, 'b) format4 -> 'a -val warning : ('a, unit, string, unit) format4 -> 'a -val info : ('a, unit, string, unit) format4 -> 'a - class filesystem_side_effects : object method created_file : unit -> unit method get_created_file : bool diff --git a/sysprep/sysprep_operation_fs_uuids.ml b/sysprep/sysprep_operation_fs_uuids.ml index b67c131..002bb4d 100644 --- a/sysprep/sysprep_operation_fs_uuids.ml +++ b/sysprep/sysprep_operation_fs_uuids.ml @@ -30,7 +30,7 @@ let rec fs_uuids_perform ~verbose ~quiet g root side_effects = List.iter (function | _, "unknown" -> () | dev, typ -> - let new_uuid = Common_utils.uuidgen ~prog () in + let new_uuid = Common_utils.uuidgen () in try g#set_uuid dev new_uuid with diff --git a/v2v/OVF.ml b/v2v/OVF.ml index 7e5e57e..7129cff 100644 --- a/v2v/OVF.ml +++ b/v2v/OVF.ml @@ -411,7 +411,7 @@ and add_disks targets guestcaps output_alloc sd_uuid image_uuids vol_uuids ovf = "ovf:size", Int64.to_string size_gb; "ovf:fileRef", fileref; "ovf:parentRef", ""; - "ovf:vm_snapshot_id", uuidgen ~prog (); + "ovf:vm_snapshot_id", uuidgen (); "ovf:volume-format", format_for_rhev; "ovf:volume-type", output_alloc_for_rhev; "ovf:format", "http://en.wikipedia.org/wiki/Byte"; (* wtf? *) diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml index 6300b03..4f7ac8c 100644 --- a/v2v/cmdline.ml +++ b/v2v/cmdline.ml @@ -179,9 +179,9 @@ let parse_cmdline () = 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.Unit (print_version_and_exit ~prog), + "-V", Arg.Unit print_version_and_exit, " " ^ s_"Display version and exit"; - "--version", Arg.Unit (print_version_and_exit ~prog), ditto; + "--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"; ] in diff --git a/v2v/convert_windows.ml b/v2v/convert_windows.ml index f9517a8..fd37fad 100644 --- a/v2v/convert_windows.ml +++ b/v2v/convert_windows.ml @@ -114,7 +114,7 @@ let convert ~verbose ~keep_serial_console (g : G.guestfs) inspect source = raise Not_found ); let data = g#hivex_value_value valueh in - let data = decode_utf16le ~prog data in + let data = decode_utf16le data in (* The uninstall program will be uninst.exe. This is a wrapper * around _uninst.exe which prompts the user. As we don't want diff --git a/v2v/input_libvirt_vcenter_https.ml b/v2v/input_libvirt_vcenter_https.ml index d45d602..ac93329 100644 --- a/v2v/input_libvirt_vcenter_https.ml +++ b/v2v/input_libvirt_vcenter_https.ml @@ -166,7 +166,7 @@ and run_curl_get_lines curl_args = close_out chan; let cmd = sprintf "curl -q --config %s" (quote config_file) in - let lines = external_command ~prog cmd in + let lines = external_command cmd in Unix.unlink config_file; lines diff --git a/v2v/input_ova.ml b/v2v/input_ova.ml index 3c13cd2..5f06652 100644 --- a/v2v/input_ova.ml +++ b/v2v/input_ova.ml @@ -146,7 +146,7 @@ object let disk = Str.matched_group 1 line in let expected = Str.matched_group 2 line in let cmd = sprintf "sha1sum %s" (quote (exploded // disk)) in - let out = external_command ~prog cmd in + let out = external_command cmd in match out with | [] -> error (f_"no output from sha1sum command, see previous errors") diff --git a/v2v/kvmuid.ml b/v2v/kvmuid.ml index a5b4195..645af1c 100644 --- a/v2v/kvmuid.ml +++ b/v2v/kvmuid.ml @@ -21,6 +21,7 @@ open Unix open Printf +open Common_utils open Common_gettext.Gettext open Utils diff --git a/v2v/output_rhev.ml b/v2v/output_rhev.ml index 150a7bd..911705e 100644 --- a/v2v/output_rhev.ml +++ b/v2v/output_rhev.ml @@ -188,15 +188,15 @@ object ) in (* Create unique UUIDs for everything *) - vm_uuid <- uuidgen ~prog (); + vm_uuid <- uuidgen (); (* Generate random image and volume UUIDs for each target. *) image_uuids <- List.map ( - fun _ -> uuidgen ~prog () + fun _ -> uuidgen () ) targets; vol_uuids <- List.map ( - fun _ -> uuidgen ~prog () + fun _ -> uuidgen () ) targets; (* We need to create the target image director(ies) so there's a place diff --git a/v2v/utils.ml b/v2v/utils.ml index ad92392..43052bd 100644 --- a/v2v/utils.ml +++ b/v2v/utils.ml @@ -25,11 +25,6 @@ open Common_utils open Types -let prog = Filename.basename Sys.executable_name -let error ?exit_code fs = error ~prog ?exit_code fs -let warning fs = warning ~prog fs -let info fs = info ~prog fs - let quote = Filename.quote (* Quote XML <element attr='...'> content. Note you must use single diff --git a/v2v/v2v.ml b/v2v/v2v.ml index bee626c..2d39ec6 100644 --- a/v2v/v2v.ml +++ b/v2v/v2v.ml @@ -815,10 +815,10 @@ and actual_target_size target = *) and du filename = let cmd = sprintf "du --block-size=1 %s | awk '{print $1}'" (quote filename) in - let lines = external_command ~prog cmd in + let lines = external_command cmd in (* Ignore errors because we want to avoid failures after copying. *) match lines with | line::_ -> (try Some (Int64.of_string line) with _ -> None) | [] -> None -let () = run_main_and_handle_errors ~prog main +let () = run_main_and_handle_errors main diff --git a/v2v/v2v_unit_tests.ml b/v2v/v2v_unit_tests.ml index 5c3b63a..5cfb99a 100644 --- a/v2v/v2v_unit_tests.ml +++ b/v2v/v2v_unit_tests.ml @@ -21,8 +21,6 @@ open OUnit2 open Types -let prog = "v2v_unit_tests" - external identity : 'a -> 'a = "%identity" let test_get_ostype ctx = -- 2.3.1
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..ed68e91 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.Unit set_verbose, " " ^ s_"Enable debugging messages"; + "--verbose", Arg.Unit 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.Unit 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-im... *) -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..9d44ce4 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.Unit set_verbose, " " ^ s_"Enable debugging messages"; + "--verbose", Arg.Unit 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.Unit 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 e52b978..625f43b 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 @@ -87,7 +87,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 -> @@ -203,7 +203,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; @@ -355,7 +355,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"); @@ -372,7 +372,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..cdbe674 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 () = trace := true +let trace () = !trace + +let verbose = ref false +let set_verbose () = verbose := true +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..dcc9d42 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 : unit -> unit +val trace : unit -> bool +val set_verbose : unit -> 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..b3185a3 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.Unit set_verbose, " " ^ s_"Enable debugging messages"; + "--debug", Arg.Unit 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.Unit set_verbose, " " ^ s_"Enable debugging messages"; + "--verbose", Arg.Unit 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.Unit 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..8e62748 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.Unit set_verbose, " " ^ s_"Enable debugging messages"; + "--verbose", Arg.Unit 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.Unit 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..5a6af14 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.Unit set_verbose, " " ^ s_"Enable debugging messages"; + "--verbose", Arg.Unit 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.Unit 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..c0f6617 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.Unit set_verbose, " " ^ s_"Enable debugging messages"; + "--verbose", Arg.Unit 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.Unit 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
When you get an error in tools, it will print a message like: If reporting bugs, run virt-v2v with debugging enabled and include the complete output: virt-v2v -v -x [...] Only print this message if -v or -x were not already specified on the command line. --- mllib/common_utils.ml | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml index cdbe674..085089a 100644 --- a/mllib/common_utils.ml +++ b/mllib/common_utils.ml @@ -297,11 +297,13 @@ let error ?(exit_code = 1) fs = let chan = stderr in ansi_red ~chan (); wrap ~chan (sprintf (f_"%s: error: %s") prog str); - prerr_newline (); - prerr_newline (); - wrap ~chan - (sprintf (f_"If reporting bugs, run %s with debugging enabled and include the complete output:\n\n %s -v -x [...]") - prog prog); + if not (verbose () && trace ()) then ( + prerr_newline (); + prerr_newline (); + wrap ~chan + (sprintf (f_"If reporting bugs, run %s with debugging enabled and include the complete output:\n\n %s -v -x [...]") + prog prog); + ); ansi_restore ~chan (); prerr_newline (); exit exit_code -- 2.3.1
On Friday 15 May 2015 11:40:55 Richard W.M. Jones wrote:
Patches #2, #3, and #4 LGTM. -- Pino Toscano
participants (2)
-
Pino Toscano -
Richard W.M. Jones