5:40 a.m.
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