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