Richard W.M. Jones
2017-Oct-08 20:43 UTC
[Libguestfs] [PATCH 0/3] common/mlstdutils: Add Std_utils List and Option modules.
In Std_utils we already extend Char and String. These commits take it a little further by extending List and adding a new Option submodule. All basically simple refactoring. Rich.
Richard W.M. Jones
2017-Oct-08 20:43 UTC
[Libguestfs] [PATCH 1/3] common/mlstdutils: Move list functions into extended List module.
However some existing functions had names which shadowed existing
functions in the List module, so I had to rename them:
assoc -> List.assoc_
append -> List.push_back_list
prepend -> List.push_front_list
This is an extension of the previous commit.
---
builder/builder.ml | 2 +-
builder/cmdline.ml | 8 +-
builder/downloader.ml | 10 +--
builder/languages.ml | 6 +-
builder/sigchecker.ml | 2 +-
builder/simplestreams_parser.ml | 6 +-
builder/yajl.ml | 2 +-
common/mlstdutils/std_utils.ml | 167 ++++++++++++++++++-----------------
common/mlstdutils/std_utils.mli | 149 +++++++++++++++----------------
common/mltools/getopt_tests.ml | 6 +-
common/mltools/tools_utils.ml | 2 +-
customize/customize_main.ml | 4 +-
customize/customize_run.ml | 2 +-
daemon/inspect.ml | 6 +-
daemon/inspect_fs_unix_fstab.ml | 2 +-
daemon/inspect_fs_windows.ml | 4 +-
daemon/listfs.ml | 12 +--
daemon/lvm.ml | 2 +-
daemon/mount.ml | 22 ++---
daemon/parted.ml | 14 +--
dib/cmdline.ml | 14 +--
dib/dib.ml | 2 +-
dib/elements.ml | 2 +-
dib/output_format.ml | 4 +-
generator/UEFI.ml | 2 +-
generator/customize.ml | 20 ++---
generator/tests_c_api.ml | 2 +-
resize/resize.ml | 4 +-
sparsify/cmdline.ml | 4 +-
sparsify/utils.ml | 2 +-
sysprep/main.ml | 4 +-
sysprep/sysprep_operation.ml | 4 +-
sysprep/sysprep_operation_script.ml | 2 +-
v2v/DOM.ml | 2 +-
v2v/cmdline.ml | 6 +-
v2v/convert_linux.ml | 16 ++--
v2v/convert_windows.ml | 2 +-
v2v/copy_to_local.ml | 10 +--
v2v/create_libvirt_xml.ml | 42 ++++-----
v2v/create_ovf.ml | 24 ++---
v2v/input_libvirt_vddk.ml | 2 +-
v2v/input_ova.ml | 2 +-
v2v/input_vmx.ml | 6 +-
v2v/linux_bootloaders.ml | 2 +-
v2v/linux_kernels.ml | 6 +-
v2v/modules_list.ml | 6 +-
v2v/output_glance.ml | 20 ++---
v2v/output_libvirt.ml | 2 +-
v2v/output_qemu.ml | 8 +-
v2v/output_rhv.ml | 2 +-
v2v/output_vdsm.ml | 4 +-
v2v/parse_libvirt_xml.ml | 8 +-
v2v/parse_ovf_from_ova.ml | 6 +-
v2v/parse_vmx.ml | 2 +-
v2v/test-harness/v2v_test_harness.ml | 6 +-
v2v/v2v.ml | 6 +-
v2v/vCenter.ml | 6 +-
57 files changed, 347 insertions(+), 343 deletions(-)
diff --git a/builder/builder.ml b/builder/builder.ml
index 3d0dbe7a8..8b4c20765 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -462,7 +462,7 @@ let main () in
(* Add a transition to the returned list. *)
- let tr task otags = push_front (task, weight task otags, otags) ret in
+ let tr task otags = List.push_front (task, weight task otags, otags) ret in
(* Since the final plan won't run in parallel, we don't only need
* to choose unique tempfiles per transition, so this is OK:
diff --git a/builder/cmdline.ml b/builder/cmdline.ml
index 8cbd4ca68..2b56bd9e6 100644
--- a/builder/cmdline.ml
+++ b/builder/cmdline.ml
@@ -73,7 +73,7 @@ let parse_cmdline () | "auto" ->
attach_format := None
| s -> attach_format := Some s
in
- let attach_disk s = push_front (!attach_format, s) attach in
+ let attach_disk s = List.push_front (!attach_format, s) attach in
let cache = ref Paths.xdg_cache_home in
let set_cache arg = cache := Some arg in
@@ -85,7 +85,7 @@ let parse_cmdline () let delete_on_failure = ref true in
let fingerprints = ref [] in
- let add_fingerprint arg = push_front arg fingerprints in
+ let add_fingerprint arg = List.push_front arg fingerprints in
let format = ref "" in
let gpg @@ -119,7 +119,7 @@ let parse_cmdline () let set_smp arg = smp :=
Some arg in
let sources = ref [] in
- let add_source arg = push_front arg sources in
+ let add_source arg = List.push_front arg sources in
let sync = ref true in
let warn_if_partition = ref true in
@@ -176,7 +176,7 @@ let parse_cmdline () let argspec = argspec @
customize_argspec in
let args = ref [] in
- let anon_fun s = push_front s args in
+ let anon_fun s = List.push_front s args in
let usage_msg sprintf (f_"\
%s: build virtual machine images quickly
diff --git a/builder/downloader.ml b/builder/downloader.ml
index b1119bae4..424c9cd34 100644
--- a/builder/downloader.ml
+++ b/builder/downloader.ml
@@ -103,8 +103,8 @@ and download_to t ?(progress_bar = false) ~proxy uri
filename (* Get the status code first to ensure the file exists. *)
let curl_h let curl_args = ref common_args in
- if not (verbose ()) then append curl_args quiet_args;
- append curl_args [
+ if not (verbose ()) then List.push_back_list curl_args quiet_args;
+ List.push_back_list curl_args [
"output", Some "/dev/null"; (* Write output to
/dev/null. *)
"head", None; (* Request only HEAD. *)
"write-out", Some "%{http_code}" (* HTTP status
code to stdout. *)
@@ -128,11 +128,11 @@ and download_to t ?(progress_bar = false) ~proxy uri
filename (* Now download the file. *)
let curl_h let curl_args = ref common_args in
- push_back curl_args ("output", Some filename_new);
+ List.push_back curl_args ("output", Some filename_new);
if not (verbose ()) then (
- if progress_bar then push_back curl_args ("progress-bar",
None)
- else append curl_args quiet_args
+ if progress_bar then List.push_back curl_args
("progress-bar", None)
+ else List.push_back_list curl_args quiet_args
);
Curl.create ~curl:t.curl ~tmpdir:t.tmpdir !curl_args in
diff --git a/builder/languages.ml b/builder/languages.ml
index e97b1e3da..18b9e1b41 100644
--- a/builder/languages.ml
+++ b/builder/languages.ml
@@ -30,10 +30,10 @@ let split_locale loc let territory = match_or_empty 3
in
(match territory with
| "" -> ()
- | territory -> push_front (lang ^ "_" ^ territory) l);
- push_front lang l;
+ | territory -> List.push_front (lang ^ "_" ^ territory) l);
+ List.push_front lang l;
);
- push_front "" l;
+ List.push_front "" l;
List.rev !l
let languages () diff --git a/builder/sigchecker.ml b/builder/sigchecker.ml
index d7fba405b..088674d66 100644
--- a/builder/sigchecker.ml
+++ b/builder/sigchecker.ml
@@ -82,7 +82,7 @@ let import_keyfile ~gpg ~gpghome ~tmpdir ?(trust = true)
keyfile (match !current with
| None -> ()
| Some k ->
- if String.is_suffix id k then push_front id subkeys;
+ if String.is_suffix id k then List.push_front id subkeys;
current := None
)
| _ -> ()
diff --git a/builder/simplestreams_parser.ml b/builder/simplestreams_parser.ml
index 75592e377..a37d5a8a3 100644
--- a/builder/simplestreams_parser.ml
+++ b/builder/simplestreams_parser.ml
@@ -60,7 +60,7 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy }
uri format;
let index = Array.to_list (object_get_object "index" tree) in
- filter_map (
+ List.filter_map (
fun (_, desc) ->
let format = object_get_string "format" desc in
let datatype = object_get_string "datatype" desc in
@@ -81,11 +81,11 @@ let get_index ~downloader ~sigchecker { Sources.uri; proxy }
let products_node = object_get_object "products" tree in
let products = Array.to_list products_node in
- filter_map (
+ List.filter_map (
fun (prod, prod_desc) ->
let arch = object_get_string "arch" prod_desc in
let prods = Array.to_list (object_get_object "versions"
prod_desc) in
- let prods = filter_map (
+ let prods = List.filter_map (
fun (rel, rel_desc) ->
let pubname = objects_get_string "pubname" [rel_desc;
prod_desc] in
let items = object_find_object "items" rel_desc in
diff --git a/builder/yajl.ml b/builder/yajl.ml
index a555baa22..d95f3932a 100644
--- a/builder/yajl.ml
+++ b/builder/yajl.ml
@@ -55,7 +55,7 @@ let object_find_object key yv | _ -> error (f_"the
value for the key ‘%s’ is not an object") key
let object_find_objects fn = function
- | Yajl_object o -> filter_map fn (Array.to_list o)
+ | Yajl_object o -> List.filter_map fn (Array.to_list o)
| _ -> error (f_"the value is not an object")
let object_get_object key yv diff --git a/common/mlstdutils/std_utils.ml
b/common/mlstdutils/std_utils.ml
index 67d449ac2..558b1e3e2 100644
--- a/common/mlstdutils/std_utils.ml
+++ b/common/mlstdutils/std_utils.ml
@@ -273,6 +273,90 @@ end
module List = struct
include List
+
+ (* Drop elements from a list while a predicate is true. *)
+ let rec dropwhile f = function
+ | [] -> []
+ | x :: xs when f x -> dropwhile f xs
+ | xs -> xs
+
+ (* Take elements from a list while a predicate is true. *)
+ let rec takewhile f = function
+ | x :: xs when f x -> x :: takewhile f xs
+ | _ -> []
+
+ let rec filter_map f = function
+ | [] -> []
+ | x :: xs ->
+ match f x with
+ | Some y -> y :: filter_map f xs
+ | None -> filter_map f xs
+
+ let rec find_map f = function
+ | [] -> raise Not_found
+ | x :: xs ->
+ match f x with
+ | Some y -> y
+ | None -> find_map f xs
+
+ let rec combine3 xs ys zs + match xs, ys, zs with
+ | [], [], [] -> []
+ | x::xs, y::ys, z::zs -> (x, y, z) :: combine3 xs ys zs
+ | _ -> invalid_arg "combine3"
+
+ let rec assoc_ ?(cmp = compare) ~default x = function
+ | [] -> default
+ | (y, y') :: _ when cmp x y = 0 -> y'
+ | _ :: ys -> assoc_ ~cmp ~default x ys
+
+ let uniq ?(cmp = Pervasives.compare) xs + let rec loop acc = function
+ | [] -> acc
+ | [x] -> x :: acc
+ | x :: (y :: _ as xs) when cmp x y = 0 ->
+ loop acc xs
+ | x :: (y :: _ as xs) ->
+ loop (x :: acc) xs
+ in
+ List.rev (loop [] xs)
+
+ (* This is present in OCaml 4.04, so we can remove it when
+ * we depend on OCaml >= 4.04.
+ *)
+ let sort_uniq ?(cmp = Pervasives.compare) xs + let xs = List.sort cmp
xs in
+ let xs = uniq ~cmp xs in
+ xs
+
+ let remove_duplicates xs + let h = Hashtbl.create (List.length xs) in
+ let rec loop = function
+ | [] -> []
+ | x :: xs when Hashtbl.mem h x -> xs
+ | x :: xs -> Hashtbl.add h x true; x :: loop xs
+ in
+ loop xs
+
+ let push_back xsp x = xsp := !xsp @ [x]
+ let push_front x xsp = xsp := x :: !xsp
+ let pop_back xsp + let x, xs + match List.rev !xsp with
+ | x :: xs -> x, xs
+ | [] -> failwith "pop" in
+ xsp := List.rev xs;
+ x
+ let pop_front xsp + let x, xs + match !xsp with
+ | x :: xs -> x, xs
+ | [] -> failwith "shift" in
+ xsp := xs;
+ x
+
+ let push_back_list xsp xs = xsp := !xsp @ xs
+ let push_front_list xs xsp = xsp := xs @ !xsp
end
let (//) = Filename.concat
@@ -489,87 +573,6 @@ and _wrap_find_next_break i len str
and output_spaces chan n = for i = 0 to n-1 do output_char chan ' '
done
-(* Drop elements from a list while a predicate is true. *)
-let rec dropwhile f = function
- | [] -> []
- | x :: xs when f x -> dropwhile f xs
- | xs -> xs
-
-(* Take elements from a list while a predicate is true. *)
-let rec takewhile f = function
- | x :: xs when f x -> x :: takewhile f xs
- | _ -> []
-
-let rec filter_map f = function
- | [] -> []
- | x :: xs ->
- match f x with
- | Some y -> y :: filter_map f xs
- | None -> filter_map f xs
-
-let rec find_map f = function
- | [] -> raise Not_found
- | x :: xs ->
- match f x with
- | Some y -> y
- | None -> find_map f xs
-
-let rec combine3 xs ys zs - match xs, ys, zs with
- | [], [], [] -> []
- | x::xs, y::ys, z::zs -> (x, y, z) :: combine3 xs ys zs
- | _ -> invalid_arg "combine3"
-
-let rec assoc ?(cmp = compare) ~default x = function
- | [] -> default
- | (y, y') :: _ when cmp x y = 0 -> y'
- | _ :: ys -> assoc ~cmp ~default x ys
-
-let uniq ?(cmp = Pervasives.compare) xs - let rec loop acc = function
- | [] -> acc
- | [x] -> x :: acc
- | x :: (y :: _ as xs) when cmp x y = 0 ->
- loop acc xs
- | x :: (y :: _ as xs) ->
- loop (x :: acc) xs
- in
- List.rev (loop [] xs)
-
-let sort_uniq ?(cmp = Pervasives.compare) xs - let xs = List.sort cmp xs in
- let xs = uniq ~cmp xs in
- xs
-
-let remove_duplicates xs - let h = Hashtbl.create (List.length xs) in
- let rec loop = function
- | [] -> []
- | x :: xs when Hashtbl.mem h x -> xs
- | x :: xs -> Hashtbl.add h x true; x :: loop xs
- in
- loop xs
-
-let push_back xsp x = xsp := !xsp @ [x]
-let push_front x xsp = xsp := x :: !xsp
-let pop_back xsp - let x, xs - match List.rev !xsp with
- | x :: xs -> x, xs
- | [] -> failwith "pop" in
- xsp := List.rev xs;
- x
-let pop_front xsp - let x, xs - match !xsp with
- | x :: xs -> x, xs
- | [] -> failwith "shift" in
- xsp := xs;
- x
-
-let append xsp xs = xsp := !xsp @ xs
-let prepend xs xsp = xsp := xs @ !xsp
-
let unique = let i = ref 0 in fun () -> incr i; !i
let may f = function
@@ -593,7 +596,7 @@ let which executable let paths try String.nsplit
":" (Sys.getenv "PATH")
with Not_found -> [] in
- let paths = filter_map (
+ let paths = List.filter_map (
fun p ->
let path = p // executable in
try Unix.access path [Unix.X_OK]; Some path
diff --git a/common/mlstdutils/std_utils.mli b/common/mlstdutils/std_utils.mli
index f3f9c01cb..3895a41cc 100644
--- a/common/mlstdutils/std_utils.mli
+++ b/common/mlstdutils/std_utils.mli
@@ -178,6 +178,81 @@ module List : sig
val stable_sort : ('a -> 'a -> int) -> 'a list ->
'a list
val fast_sort : ('a -> 'a -> int) -> 'a list ->
'a list
val merge : ('a -> 'a -> int) -> 'a list -> 'a
list -> 'a list
+
+ val dropwhile : ('a -> bool) -> 'a list -> 'a list
+ (** [dropwhile f xs] drops leading elements from [xs] until
+ [f] returns false. *)
+ val takewhile : ('a -> bool) -> 'a list -> 'a list
+ (** [takewhile f xs] takes leading elements from [xs] until
+ [f] returns false.
+
+ For any list [xs] and function [f],
+ [xs = takewhile f xs @ dropwhile f xs] *)
+ val filter_map : ('a -> 'b option) -> 'a list ->
'b list
+ (** [filter_map f xs] applies [f] to each element of [xs]. If
+ [f x] returns [Some y] then [y] is added to the returned list. *)
+ val find_map : ('a -> 'b option) -> 'a list -> 'b
+ (** [find_map f xs] applies [f] to each element of [xs] until
+ [f x] returns [Some y]. It returns [y]. If we exhaust the
+ list then this raises [Not_found]. *)
+
+ val combine3 : 'a list -> 'b list -> 'c list ->
('a * 'b * 'c) list
+ (** Like {!List.combine} but for triples.
+ All lists must be the same length. *)
+
+ val assoc_ : ?cmp:('a -> 'a -> int) -> default:'b
-> 'a -> ('a * 'b) list -> 'b
+ (** Like {!assoc} but with a user-defined comparison function, and
+ instead of raising [Not_found], it returns the [~default] value. *)
+
+ val uniq : ?cmp:('a -> 'a -> int) -> 'a list ->
'a list
+ (** Uniquify a list (the list must be sorted first). *)
+
+ val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a list
-> 'a list
+ (** Sort and uniquify a list. *)
+
+ val remove_duplicates : 'a list -> 'a list
+ (** Remove duplicates from an unsorted list; useful when the order
+ of the elements matter.
+
+ Please use [sort_uniq] when the order does not matter. *)
+
+ val push_back : 'a list ref -> 'a -> unit
+ val push_front : 'a -> 'a list ref -> unit
+ val pop_back : 'a list ref -> 'a
+ val pop_front : 'a list ref -> 'a
+ (** Imperative list manipulation functions, similar to C++ STL
+ functions with the same names. (Although the names are similar,
+ the computational complexity of the functions is quite different.)
+
+ These operate on list references, and each function modifies the
+ list reference that is passed to it.
+
+ [push_back xsp x] appends the element [x] to the end of the list
+ [xsp]. This function is not tail-recursive.
+
+ [push_front x xsp] prepends the element [x] to the head of the
+ list [xsp]. (The arguments are reversed compared to the same Perl
+ function, but OCaml is type safe so that's OK.)
+
+ [pop_back xsp] removes the last element of the list [xsp] and
+ returns it. The list is modified to become the list minus the
+ final element. If a zero-length list is passed in, this raises
+ [Failure "pop_back"]. This function is not tail-recursive.
+
+ [pop_front xsp] removes the head element of the list [xsp] and
+ returns it. The list is modified to become the tail of the list.
+ If a zero-length list is passed in, this raises [Failure
+ "pop_front"]. *)
+
+ val push_back_list : 'a list ref -> 'a list -> unit
+ val push_front_list : 'a list -> 'a list ref -> unit
+ (** More imperative list manipulation functions.
+
+ [push_back_list] is like {!push_back} above, except it appends
+ a list to the list reference. This function is not tail-recursive.
+
+ [push_front_list] is like {!push_front} above, except it prepends
+ a list to the list reference. *)
end
(** Override the List module from stdlib. *)
@@ -242,80 +317,6 @@ val wrap : ?chan:out_channel -> ?indent:int -> string
-> unit
val output_spaces : out_channel -> int -> unit
(** Write [n] spaces to [out_channel]. *)
-val dropwhile : ('a -> bool) -> 'a list -> 'a list
-(** [dropwhile f xs] drops leading elements from [xs] until
- [f] returns false. *)
-val takewhile : ('a -> bool) -> 'a list -> 'a list
-(** [takewhile f xs] takes leading elements from [xs] until
- [f] returns false.
-
- For any list [xs] and function [f],
- [xs = takewhile f xs @ dropwhile f xs] *)
-val filter_map : ('a -> 'b option) -> 'a list -> 'b
list
-(** [filter_map f xs] applies [f] to each element of [xs]. If
- [f x] returns [Some y] then [y] is added to the returned list. *)
-val find_map : ('a -> 'b option) -> 'a list -> 'b
-(** [find_map f xs] applies [f] to each element of [xs] until
- [f x] returns [Some y]. It returns [y]. If we exhaust the
- list then this raises [Not_found]. *)
-
-val combine3 : 'a list -> 'b list -> 'c list -> ('a *
'b * 'c) list
-(** Like {!List.combine} but for triples. All lists must be the same length.
*)
-
-val assoc : ?cmp:('a -> 'a -> int) -> default:'b ->
'a -> ('a * 'b) list -> 'b
-(** Like {!List.assoc} but with a user-defined comparison function, and
- instead of raising [Not_found], it returns the [~default] value. *)
-
-val uniq : ?cmp:('a -> 'a -> int) -> 'a list -> 'a
list
-(** Uniquify a list (the list must be sorted first). *)
-
-val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a list ->
'a list
-(** Sort and uniquify a list. *)
-
-val remove_duplicates : 'a list -> 'a list
-(** Remove duplicates from an unsorted list; useful when the order
- of the elements matter.
-
- Please use [sort_uniq] when the order does not matter. *)
-
-val push_back : 'a list ref -> 'a -> unit
-val push_front : 'a -> 'a list ref -> unit
-val pop_back : 'a list ref -> 'a
-val pop_front : 'a list ref -> 'a
-(** Imperative list manipulation functions, similar to C++ STL
- functions with the same names. (Although the names are similar,
- the computational complexity of the functions is quite different.)
-
- These operate on list references, and each function modifies the
- list reference that is passed to it.
-
- [push_back xsp x] appends the element [x] to the end of the list
- [xsp]. This function is not tail-recursive.
-
- [push_front x xsp] prepends the element [x] to the head of the
- list [xsp]. (The arguments are reversed compared to the same Perl
- function, but OCaml is type safe so that's OK.)
-
- [pop_back xsp] removes the last element of the list [xsp] and
- returns it. The list is modified to become the list minus the
- final element. If a zero-length list is passed in, this raises
- [Failure "pop_back"]. This function is not tail-recursive.
-
- [pop_front xsp] removes the head element of the list [xsp] and
- returns it. The list is modified to become the tail of the list.
- If a zero-length list is passed in, this raises [Failure
- "pop_front"]. *)
-
-val append : 'a list ref -> 'a list -> unit
-val prepend : 'a list -> 'a list ref -> unit
-(** More imperative list manipulation functions.
-
- [append] is like {!push_back} above, except it appends a list to
- the list reference. This function is not tail-recursive.
-
- [prepend] is like {!push_front} above, except it prepends a list
- to the list reference. *)
-
val unique : unit -> int
(** Returns a unique number each time called. *)
diff --git a/common/mltools/getopt_tests.ml b/common/mltools/getopt_tests.ml
index 1314d3bca..751bf1d5f 100644
--- a/common/mltools/getopt_tests.ml
+++ b/common/mltools/getopt_tests.ml
@@ -27,13 +27,13 @@ open Tools_utils
open Getopt.OptionName
let adds = ref []
-let add_string = push_back adds
+let add_string = List.push_back adds
let anons = ref []
-let anon_fun = push_back anons
+let anon_fun = List.push_back anons
let ints = ref []
-let add_int = push_back ints
+let add_int = List.push_back ints
let clear_flag = ref true
let set_flag = ref false
diff --git a/common/mltools/tools_utils.ml b/common/mltools/tools_utils.ml
index 9049ab3f1..f66ee9f50 100644
--- a/common/mltools/tools_utils.ml
+++ b/common/mltools/tools_utils.ml
@@ -286,7 +286,7 @@ let rec run_commands ?(echo_cmd = true) cmds
res.(i) <- code;
None
) cmds in
- let pids = filter_map identity pids in
+ let pids = List.filter_map identity pids in
let pids = ref pids in
while !pids <> [] do
let pid, stat = Unix.waitpid [] 0 in
diff --git a/customize/customize_main.ml b/customize/customize_main.ml
index 8bd197b83..f6ffc872d 100644
--- a/customize/customize_main.ml
+++ b/customize/customize_main.ml
@@ -39,7 +39,7 @@ let main () | "auto" -> attach_format :=
None
| s -> attach_format := Some s
in
- let attach_disk s = push_front (!attach_format, s) attach in
+ let attach_disk s = List.push_front (!attach_format, s) attach in
let domain = ref None in
let dryrun = ref false in
let files = ref [] in
@@ -63,7 +63,7 @@ let main () error (f_"error parsing URI
'%s'. Look for error messages printed above.")
arg in
let format = match !format with "auto" -> None | fmt ->
Some fmt in
- push_front (uri, format) files;
+ List.push_front (uri, format) files;
format_consumed := true
and set_domain dom if !domain <> None then
diff --git a/customize/customize_run.ml b/customize/customize_run.ml
index b42dd774d..f37e283f3 100644
--- a/customize/customize_run.ml
+++ b/customize/customize_run.ml
@@ -66,7 +66,7 @@ let run (g : G.guestfs) root (ops : ops) * Also catch
errors and dump the log file completely on error.
*)
let env_vars - filter_map (
+ List.filter_map (
fun name ->
try Some (sprintf "export %s=%s" name (quote (Sys.getenv
name)))
with Not_found -> None
diff --git a/daemon/inspect.ml b/daemon/inspect.ml
index ecc45e7c7..11e977947 100644
--- a/daemon/inspect.ml
+++ b/daemon/inspect.ml
@@ -33,7 +33,7 @@ let rec inspect_os () let fses = Listfs.list_filesystems ()
in
let fses - filter_map (
+ List.filter_map (
fun (mountable, vfs_type) ->
Inspect_fs.check_for_filesystem_on mountable vfs_type
) fses in
@@ -228,7 +228,7 @@ and inspect_get_roots () let fses =
!Inspect_types.inspect_fses in
let roots - filter_map (
+ List.filter_map (
fun fs -> try Some (root_of_fs fs) with Invalid_argument _ -> None
) fses in
if verbose () then (
@@ -257,7 +257,7 @@ and inspect_get_mountpoints root_mountable if fstab = []
then
[ "/", root_mountable ]
else (
- filter_map (
+ List.filter_map (
fun (mountable, mp) ->
if String.length mp > 0 && mp.[0] = '/' then
Some (mp, mountable)
diff --git a/daemon/inspect_fs_unix_fstab.ml b/daemon/inspect_fs_unix_fstab.ml
index e3c7fd1cd..658e0cf10 100644
--- a/daemon/inspect_fs_unix_fstab.ml
+++ b/daemon/inspect_fs_unix_fstab.ml
@@ -52,7 +52,7 @@ and check_fstab_aug mdadm_conf root_mountable os_type aug
let path = "/files/etc/fstab/*[label() != '#comment']" in
let entries = aug_matches_noerrors aug path in
- filter_map (check_fstab_entry md_map root_mountable os_type aug) entries
+ List.filter_map (check_fstab_entry md_map root_mountable os_type aug) entries
and check_fstab_entry md_map root_mountable os_type aug entry if verbose ()
then
diff --git a/daemon/inspect_fs_windows.ml b/daemon/inspect_fs_windows.ml
index 78af7f048..f471835cc 100644
--- a/daemon/inspect_fs_windows.ml
+++ b/daemon/inspect_fs_windows.ml
@@ -110,7 +110,7 @@ and get_windows_systemroot_from_boot_ini boot_ini_path
| Some oses ->
(* Rewrite multi|scsi lines, removing any which we cannot parse. *)
let oses - filter_map (
+ List.filter_map (
fun line ->
if PCRE.matches re_boot_ini_os line then (
let ctrlr_type = PCRE.sub 1
@@ -312,7 +312,7 @@ and get_drive_mappings h root data let values =
Hivex.node_values h node in
let values = Array.to_list values in
let values - filter_map (
+ List.filter_map (
fun value ->
let key = Hivex.value_key h value in
let keylen = String.length key in
diff --git a/daemon/listfs.ml b/daemon/listfs.ml
index 610a1ea78..1ccd3bead 100644
--- a/daemon/listfs.ml
+++ b/daemon/listfs.ml
@@ -44,14 +44,14 @@ let rec list_filesystems () ) devices in
(* Use vfs-type to check for filesystems on devices. *)
- let ret = filter_map check_with_vfs_type devices in
+ let ret = List.filter_map check_with_vfs_type devices in
(* Use vfs-type to check for filesystems on partitions, but
* ignore MBR partition type 42 used by LDM.
*)
let ret ret @
- filter_map (
+ List.filter_map (
fun part ->
if not has_ldm || not (is_mbr_partition_type_42 part) then
check_with_vfs_type part
@@ -60,14 +60,14 @@ let rec list_filesystems () ) partitions in
(* Use vfs-type to check for filesystems on md devices. *)
- let ret = ret @ filter_map check_with_vfs_type mds in
+ let ret = ret @ List.filter_map check_with_vfs_type mds in
(* LVM. *)
let ret if has_lvm2 then (
let lvs = Lvm.lvs () in
(* Use vfs-type to check for filesystems on LVs. *)
- ret @ filter_map check_with_vfs_type lvs
+ ret @ List.filter_map check_with_vfs_type lvs
)
else ret in
@@ -78,8 +78,8 @@ let rec list_filesystems () let ldmparts =
Ldm.list_ldm_partitions () in
(* Use vfs-type to check for filesystems on Windows dynamic disks. *)
ret @
- filter_map check_with_vfs_type ldmvols @
- filter_map check_with_vfs_type ldmparts
+ List.filter_map check_with_vfs_type ldmvols @
+ List.filter_map check_with_vfs_type ldmparts
)
else ret in
diff --git a/daemon/lvm.ml b/daemon/lvm.ml
index 4210c2fb3..39c6d365b 100644
--- a/daemon/lvm.ml
+++ b/daemon/lvm.ml
@@ -84,7 +84,7 @@ and filter_convert_old_lvs_output out let lines =
List.filter ((<>) "") lines in
let lines = List.filter ((<>) "unknown device") lines in
- let lines = filter_map (
+ let lines = List.filter_map (
fun line ->
match String.nsplit ":" line with
| [ lv_attr; vg_name; lv_name ] ->
diff --git a/daemon/mount.ml b/daemon/mount.ml
index fbf4ddc39..db530b138 100644
--- a/daemon/mount.ml
+++ b/daemon/mount.ml
@@ -34,26 +34,26 @@ let mount_vfs options vfs mountable mountpoint (match
options, mountable.m_type with
| (None | Some ""), (MountableDevice | MountablePath) -> ()
| Some options, (MountableDevice | MountablePath) ->
- push_back args "-o";
- push_back args options
+ List.push_back args "-o";
+ List.push_back args options
| (None | Some ""), MountableBtrfsVol subvol ->
- push_back args "-o";
- push_back args ("subvol=" ^ subvol)
+ List.push_back args "-o";
+ List.push_back args ("subvol=" ^ subvol)
| Some options, MountableBtrfsVol subvol ->
- push_back args "-o";
- push_back args ("subvol=" ^ subvol ^ "," ^ options)
+ List.push_back args "-o";
+ List.push_back args ("subvol=" ^ subvol ^ "," ^
options)
);
(* -t vfs *)
(match vfs with
| None | Some "" -> ()
| Some t ->
- push_back args "-t";
- push_back args t
+ List.push_back args "-t";
+ List.push_back args t
);
- push_back args mountable.m_device;
- push_back args mp;
+ List.push_back args mountable.m_device;
+ List.push_back args mp;
ignore (command "mount" !args)
@@ -105,7 +105,7 @@ let rec umount_all () (String.is_prefix mp
sysroot &&
String.length mp > sysroot_len &&
mp.[sysroot_len] = '/') then
- push_front mp mps
+ List.push_front mp mps
)
) info;
diff --git a/daemon/parted.ml b/daemon/parted.ml
index 2e8e744d0..7721b64ca 100644
--- a/daemon/parted.ml
+++ b/daemon/parted.ml
@@ -65,13 +65,13 @@ let print_partition_table_machine_readable device
udev_settle ();
let args = ref [] in
- push_back args "-m";
- push_back args "-s";
- push_back args "--";
- push_back args device;
- push_back args "unit";
- push_back args "b";
- push_back args "print";
+ List.push_back args "-m";
+ List.push_back args "-s";
+ List.push_back args "--";
+ List.push_back args device;
+ List.push_back args "unit";
+ List.push_back args "b";
+ List.push_back args "print";
let out try command "parted" !args
diff --git a/dib/cmdline.ml b/dib/cmdline.ml
index 9f0a70a72..d013a181e 100644
--- a/dib/cmdline.ml
+++ b/dib/cmdline.ml
@@ -71,16 +71,16 @@ read the man page virt-dib(1).
prog in
let elements = ref [] in
- let append_element element = push_front element elements in
+ let append_element element = List.push_front element elements in
let excluded_elements = ref [] in
- let append_excluded_element element = push_front element excluded_elements in
+ let append_excluded_element element = List.push_front element
excluded_elements in
let element_paths = ref [] in
- let append_element_path arg = push_front arg element_paths in
+ let append_element_path arg = List.push_front arg element_paths in
let excluded_scripts = ref [] in
- let append_excluded_script arg = push_front arg excluded_scripts in
+ let append_excluded_script arg = List.push_front arg excluded_scripts in
let debug = ref 0 in
let set_debug arg @@ -107,7 +107,7 @@ read the man page virt-dib(1).
let formats = ref None in
let set_format arg - let fmts = remove_duplicates (String.nsplit
"," arg) in
+ let fmts = List.remove_duplicates (String.nsplit "," arg) in
let fmtset List.fold_left (
fun fmtset fmt ->
@@ -118,7 +118,7 @@ read the man page virt-dib(1).
formats := Some fmtset in
let envvars = ref [] in
- let append_envvar arg = push_front arg envvars in
+ let append_envvar arg = List.push_front arg envvars in
let use_base = ref true in
@@ -149,7 +149,7 @@ read the man page virt-dib(1).
let extra_packages = ref [] in
let append_extra_packages arg - prepend (List.rev (String.nsplit
"," arg)) extra_packages in
+ List.push_front_list (List.rev (String.nsplit "," arg))
extra_packages in
let checksum = ref false in
diff --git a/dib/dib.ml b/dib/dib.ml
index 9429d2371..f8595636a 100644
--- a/dib/dib.ml
+++ b/dib/dib.ml
@@ -41,7 +41,7 @@ let exclude_elements elements = function
| excl -> StringSet.filter (not_in_list excl) elements
let read_envvars envvars - filter_map (
+ List.filter_map (
fun var ->
let i = String.find var "=" in
if i = -1 then (
diff --git a/dib/elements.ml b/dib/elements.ml
index d8eb6c145..5a904baef 100644
--- a/dib/elements.ml
+++ b/dib/elements.ml
@@ -82,7 +82,7 @@ let load_scripts (g : Guestfs.guestfs) path | _ ->
false
) listing in
let scripts = List.filter (fun x -> valid_script_name x.Guestfs.name)
scripts in
- filter_map (
+ List.filter_map (
fun x ->
let { Guestfs.st_mode = mode } = g#statns (path ^ "/" ^
x.Guestfs.name) in
if mode &^ 0o111_L > 0_L then Some x.Guestfs.name
diff --git a/dib/output_format.ml b/dib/output_format.ml
index 79a90ae35..a39e807fe 100644
--- a/dib/output_format.ml
+++ b/dib/output_format.ml
@@ -69,7 +69,7 @@ let set_cardinal set FormatSet.cardinal set
let register_format op - push_front op all_formats
+ List.push_front op all_formats
let baked = ref false
let rec bake () @@ -183,7 +183,7 @@ let get_filenames ~formats image_name (*
Run the formats in alphabetical, rather than random order. *)
let formats = List.sort compare_formats (FormatSet.elements formats) in
- filter_map (
+ List.filter_map (
function
| { output_to_file = true; name } ->
Some (output_filename image_name name)
diff --git a/generator/UEFI.ml b/generator/UEFI.ml
index 17418f473..5161e28ee 100644
--- a/generator/UEFI.ml
+++ b/generator/UEFI.ml
@@ -77,7 +77,7 @@ let firmware = [
[];
]
-let arches = sort_uniq (List.map (fun (arch, _, _, _, _) -> arch) firmware)
+let arches = List.sort_uniq (List.map (fun (arch, _, _, _, _) -> arch)
firmware)
let generate_uefi_c () generate_header CStyle LGPLv2plus;
diff --git a/generator/customize.ml b/generator/customize.ml
index 75984c9d5..c278347c1 100644
--- a/generator/customize.ml
+++ b/generator/customize.ml
@@ -688,7 +688,7 @@ let rec argspec () op_shortdesc = shortdesc;
op_pod_longdesc = longdesc } ->
pr " (\n";
pr " [ L\"%s\" ],\n" name;
- pr " Getopt.Unit (fun () -> push_front %s ops),\n"
discrim;
+ pr " Getopt.Unit (fun () -> List.push_front %s ops),\n"
discrim;
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
pr " None, %S;\n" longdesc
@@ -696,7 +696,7 @@ let rec argspec () op_shortdesc = shortdesc;
op_pod_longdesc = longdesc } ->
pr " (\n";
pr " [ L\"%s\" ],\n" name;
- pr " Getopt.String (s_\"%s\", fun s -> push_front
(%s s) ops),\n" v discrim;
+ pr " Getopt.String (s_\"%s\", fun s ->
List.push_front (%s s) ops),\n" v discrim;
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
pr " Some %S, %S;\n" v longdesc
@@ -708,7 +708,7 @@ let rec argspec () pr "
s_\"%s\",\n" v;
pr " fun s ->\n";
pr " let p = split_string_pair \"%s\" s
in\n" name;
- pr " push_front (%s p) ops\n" discrim;
+ pr " List.push_front (%s p) ops\n" discrim;
pr " ),\n";
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
@@ -721,7 +721,7 @@ let rec argspec () pr "
s_\"%s\",\n" v;
pr " fun s ->\n";
pr " let ss = split_string_list s in\n";
- pr " push_front (%s ss) ops\n" discrim;
+ pr " List.push_front (%s ss) ops\n" discrim;
pr " ),\n";
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
@@ -734,7 +734,7 @@ let rec argspec () pr "
s_\"%s\",\n" v;
pr " fun s ->\n";
pr " let ss = split_links_list \"%s\" s
in\n" name;
- pr " push_front (%s ss) ops\n" discrim;
+ pr " List.push_front (%s ss) ops\n" discrim;
pr " ),\n";
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
@@ -747,7 +747,7 @@ let rec argspec () pr "
s_\"%s\",\n" v;
pr " fun s ->\n";
pr " let sel = Password.parse_selector s in\n";
- pr " push_front (%s sel) ops\n" discrim;
+ pr " List.push_front (%s sel) ops\n" discrim;
pr " ),\n";
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
@@ -761,7 +761,7 @@ let rec argspec () pr " fun s
->\n";
pr " let user, sel = split_string_pair \"%s\" s
in\n" name;
pr " let sel = Password.parse_selector sel in\n";
- pr " push_front (%s (user, sel)) ops\n" discrim;
+ pr " List.push_front (%s (user, sel)) ops\n" discrim;
pr " ),\n";
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
@@ -775,7 +775,7 @@ let rec argspec () pr " fun s
->\n";
pr " let user, selstr = String.split \":\" s
in\n";
pr " let sel = Ssh_key.parse_selector selstr in\n";
- pr " push_front (%s (user, sel)) ops\n" discrim;
+ pr " List.push_front (%s (user, sel)) ops\n" discrim;
pr " ),\n";
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
@@ -788,7 +788,7 @@ let rec argspec () pr "
s_\"%s\",\n" v;
pr " fun s ->\n";
pr " %s s;\n" fn;
- pr " push_front (%s s) ops\n" discrim;
+ pr " List.push_front (%s s) ops\n" discrim;
pr " ),\n";
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
@@ -801,7 +801,7 @@ let rec argspec () pr "
s_\"%s\",\n" v;
pr " fun s ->\n";
pr " let sel = Subscription_manager.parse_pool_selector s
in\n";
- pr " push_front (%s sel) ops\n" discrim;
+ pr " List.push_front (%s sel) ops\n" discrim;
pr " ),\n";
pr " s_\"%s\"\n" shortdesc;
pr " ),\n";
diff --git a/generator/tests_c_api.ml b/generator/tests_c_api.ml
index 33da61181..b569b9317 100644
--- a/generator/tests_c_api.ml
+++ b/generator/tests_c_api.ml
@@ -70,7 +70,7 @@ let rec generate_c_api_tests () let hash : (string, bool)
Hashtbl.t = Hashtbl.create 13 in
List.iter (
fun { tests } ->
- let seqs = filter_map (
+ let seqs = List.filter_map (
function
| (_, (Always|IfAvailable _|IfNotCrossAppliance), test, cleanup) ->
Some (seq_of_test test @ cleanup)
diff --git a/resize/resize.ml b/resize/resize.ml
index f428f3ebe..4eeb0a170 100644
--- a/resize/resize.ml
+++ b/resize/resize.ml
@@ -158,7 +158,7 @@ let main () lv_expands, machine_readable,
ntfsresize_force, output_format,
resizes, resizes_force, shrink, sparse, unknown_fs_mode
- let add xs s = push_front s xs in
+ let add xs s = List.push_front s xs in
let align_first = ref "auto" in
let alignment = ref 128 in
@@ -214,7 +214,7 @@ let main ()
s_"Behaviour on expand unknown filesystems (default: warn)";
] in
let disks = ref [] in
- let anon_fun s = push_front s disks in
+ let anon_fun s = List.push_front s disks in
let usage_msg sprintf (f_"\
%s: resize a virtual machine disk
diff --git a/sparsify/cmdline.ml b/sparsify/cmdline.ml
index 521f6733d..f435bbf5e 100644
--- a/sparsify/cmdline.ml
+++ b/sparsify/cmdline.ml
@@ -43,7 +43,7 @@ and mode_t and check_t = [`Ignore|`Continue|`Warn|`Fail]
let parse_cmdline () - let add xs s = push_front s xs in
+ let add xs s = List.push_front s xs in
let check_tmpdir = ref `Warn in
let set_check_tmpdir = function
@@ -78,7 +78,7 @@ let parse_cmdline () [ L"zero" ],
Getopt.String (s_"fs", add zeroes), s_"Zero filesystem";
] in
let disks = ref [] in
- let anon_fun s = push_front s disks in
+ let anon_fun s = List.push_front s disks in
let usage_msg sprintf (f_"\
%s: sparsify a virtual machine disk
diff --git a/sparsify/utils.ml b/sparsify/utils.ml
index facf466a8..7f0c02cf6 100644
--- a/sparsify/utils.ml
+++ b/sparsify/utils.ml
@@ -27,7 +27,7 @@ module G = Guestfs
(* Return true if the filesystem is a read-only LV (RHBZ#1185561). *)
let is_read_only_lv (g : G.guestfs) let lvs = Array.to_list (g#lvs_full ())
in
- let ro_uuids = filter_map (
+ let ro_uuids = List.filter_map (
fun { G.lv_uuid; lv_attr } ->
if lv_attr.[1] = 'r' then Some lv_uuid else None
) lvs in
diff --git a/sysprep/main.ml b/sysprep/main.ml
index 3ba0c7b82..218ac43ef 100644
--- a/sysprep/main.ml
+++ b/sysprep/main.ml
@@ -58,7 +58,7 @@ let main () with URI.Parse_failed ->
error (f_"error parsing URI ‘%s’. Look for error messages
printed above.") arg in
let format = match !format with "auto" -> None | fmt ->
Some fmt in
- push_front (uri, format) files;
+ List.push_front (uri, format) files;
format_consumed := true
and set_domain dom if !domain <> None then
@@ -203,7 +203,7 @@ read the man page virt-sysprep(1).
let mount_opts = !mount_opts in
let mount_opts List.map (String.split ":") (String.nsplit
";" mount_opts) in
- let mount_opts mp = assoc ~default:"" mp mount_opts in
+ let mount_opts mp = List.assoc_ ~default:"" mp mount_opts in
message (f_"Examining the guest ...");
diff --git a/sysprep/sysprep_operation.ml b/sysprep/sysprep_operation.ml
index 0c70258db..2ddce302a 100644
--- a/sysprep/sysprep_operation.ml
+++ b/sysprep/sysprep_operation.ml
@@ -110,9 +110,9 @@ let remove_all_from_set set empty_set
let register_operation op - push_front op all_operations;
+ List.push_front op all_operations;
if op.enabled_by_default then
- push_front op enabled_by_default_operations
+ List.push_front op enabled_by_default_operations
let baked = ref false
let rec bake () diff --git a/sysprep/sysprep_operation_script.ml
b/sysprep/sysprep_operation_script.ml
index fd9e62aa0..bb105f57f 100644
--- a/sysprep/sysprep_operation_script.ml
+++ b/sysprep/sysprep_operation_script.ml
@@ -36,7 +36,7 @@ let set_scriptdir dir scriptdir := Some dir
let scripts = ref []
-let add_script script = push_front script scripts
+let add_script script = List.push_front script scripts
let rec script_perform (g : Guestfs.guestfs) root side_effects let scripts =
List.rev !scripts in
diff --git a/v2v/DOM.ml b/v2v/DOM.ml
index 3ba93b4f6..8fd40e6b4 100644
--- a/v2v/DOM.ml
+++ b/v2v/DOM.ml
@@ -123,7 +123,7 @@ let path_to_nodes (Doc doc) path ) nodes
| p :: ps ->
let children - filter_map (
+ List.filter_map (
function
| PCData _ -> None
| Comment _ -> None
diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
index 6d4219bd8..2180b656f 100644
--- a/v2v/cmdline.ml
+++ b/v2v/cmdline.ml
@@ -165,10 +165,10 @@ let parse_cmdline () in
let vdsm_image_uuids = ref [] in
- let add_vdsm_image_uuid s = push_front s vdsm_image_uuids in
+ let add_vdsm_image_uuid s = List.push_front s vdsm_image_uuids in
let vdsm_vol_uuids = ref [] in
- let add_vdsm_vol_uuid s = push_front s vdsm_vol_uuids in
+ let add_vdsm_vol_uuid s = List.push_front s vdsm_vol_uuids in
let vmtype_warning _ warning (f_"the --vmtype option has been
removed and now does nothing")
@@ -241,7 +241,7 @@ let parse_cmdline ()
s_"Ignored for backwards compatibility";
] in
let args = ref [] in
- let anon_fun s = push_front s args in
+ let anon_fun s = List.push_front s args in
let usage_msg sprintf (f_"\
%s: convert a guest to use KVM
diff --git a/v2v/convert_linux.ml b/v2v/convert_linux.ml
index 81e195866..ea44b262c 100644
--- a/v2v/convert_linux.ml
+++ b/v2v/convert_linux.ml
@@ -139,7 +139,7 @@ let convert (g : G.guestfs) inspect source output rcaps
and unconfigure_xen () (* Remove kmod-xenpv-* (RHEL 3). *)
let xenmods - filter_map (
+ List.filter_map (
fun { G.app2_name = name } ->
if name = "kmod-xenpv" || String.is_prefix name
"kmod-xenpv-" then
Some name
@@ -235,7 +235,7 @@ let convert (g : G.guestfs) inspect source output rcaps
let lines = g#read_lines vboxconfig in
let lines = Array.to_list lines in
let rex = PCRE.compile "^INSTALL_DIR=(.*)$" in
- let lines = filter_map (
+ let lines = List.filter_map (
fun line ->
if PCRE.matches rex line then (
let path = PCRE.sub 1 in
@@ -279,13 +279,13 @@ let convert (g : G.guestfs) inspect source output rcaps
List.iter (
fun { G.app2_name = name } ->
if String.is_prefix name "vmware-tools-libraries-" then
- push_front name libraries
+ List.push_front name libraries
else if String.is_prefix name "vmware-tools-" then
- push_front name remove
+ List.push_front name remove
else if name = "VMwareTools" then
- push_front name remove
+ List.push_front name remove
else if String.is_prefix name "kmod-vmware-tools" then
- push_front name remove
+ List.push_front name remove
) inspect.i_apps;
let libraries = !libraries in
@@ -333,13 +333,13 @@ let convert (g : G.guestfs) inspect source output rcaps
let cmd = Array.of_list cmd in
(try
ignore (g#command cmd);
- push_front library remove
+ List.push_front library remove
with G.Error msg ->
eprintf "%s: could not install replacement for %s. Error
was: %s. %s was not removed.\n"
prog library msg library
);
) else (
- push_front library remove;
+ List.push_front library remove;
);
) libraries
)
diff --git a/v2v/convert_windows.ml b/v2v/convert_windows.ml
index 247ffff3f..41e734b67 100644
--- a/v2v/convert_windows.ml
+++ b/v2v/convert_windows.ml
@@ -166,7 +166,7 @@ let convert (g : G.guestfs) inspect source output rcaps
* uninstaller still shows a no-way-out reboot dialog *)
" PREVENT_REBOOT=Yes LAUNCHED_BY_SETUP_EXE=Yes"
in
- push_front uninst uninsts
+ List.push_front uninst uninsts
with
Not_found -> ()
) uninstnodes
diff --git a/v2v/copy_to_local.ml b/v2v/copy_to_local.ml
index d92ad0f88..d2471a546 100644
--- a/v2v/copy_to_local.ml
+++ b/v2v/copy_to_local.ml
@@ -50,7 +50,7 @@ let rec main ()
s_"Use password from file";
] in
let args = ref [] in
- let anon_fun s = push_front s args in
+ let anon_fun s = List.push_front s args in
let usage_msg sprintf (f_"\
%s: copy a remote guest to the local machine
@@ -205,12 +205,12 @@ read the man page virt-v2v-copy-to-local(1).
"url", Some remote_disk;
"output", Some local_disk;
] in
- if not sslverify then push_back curl_args ("insecure", None);
+ if not sslverify then List.push_back curl_args ("insecure",
None);
(match cookie with
| None -> ()
- | Some cookie -> push_back curl_args ("cookie", Some
cookie)
+ | Some cookie -> List.push_back curl_args ("cookie", Some
cookie)
);
- if quiet () then push_back curl_args ("silent", None);
+ if quiet () then List.push_back curl_args ("silent", None);
let curl_h = Curl.create !curl_args in
if verbose () then
@@ -261,7 +261,7 @@ and parse_libvirt_xml guest_name xml incr i;
let local_disk = sprintf "%s-disk%d" guest_name !i in
- push_front (remote_disk, local_disk) disks;
+ List.push_front (remote_disk, local_disk) disks;
local_disk
in
get_disks, add_disk
diff --git a/v2v/create_libvirt_xml.ml b/v2v/create_libvirt_xml.ml
index 70c04cc64..ecf0d14c5 100644
--- a/v2v/create_libvirt_xml.ml
+++ b/v2v/create_libvirt_xml.ml
@@ -35,13 +35,13 @@ let create_libvirt_xml ?pool source target_buses guestcaps
(* The main body of the libvirt XML document. *)
let body = ref [] in
- append body [
+ List.push_back_list body [
Comment generated_by;
e "name" [] [PCData source.s_name];
];
let memory_k = source.s_memory /^ 1024L in
- append body [
+ List.push_back_list body [
e "memory" ["unit", "KiB"] [PCData
(Int64.to_string memory_k)];
e "currentMemory" ["unit", "KiB"] [PCData
(Int64.to_string memory_k)];
e "vcpu" [] [PCData (string_of_int source.s_vcpu)]
@@ -55,32 +55,32 @@ let create_libvirt_xml ?pool source target_buses guestcaps
(match source.s_cpu_vendor with
| None -> ()
| Some vendor ->
- push_back cpu (e "vendor" [] [PCData vendor])
+ List.push_back cpu (e "vendor" [] [PCData vendor])
);
(match source.s_cpu_model with
| None -> ()
| Some model ->
- push_back cpu (e "model" ["fallback",
"allow"] [PCData model])
+ List.push_back cpu (e "model" ["fallback",
"allow"] [PCData model])
);
if source.s_cpu_sockets <> None || source.s_cpu_cores <> None
||
source.s_cpu_threads <> None then (
let topology_attrs = ref [] in
(match source.s_cpu_sockets with
| None -> ()
- | Some v -> push_back topology_attrs ("sockets",
string_of_int v)
+ | Some v -> List.push_back topology_attrs ("sockets",
string_of_int v)
);
(match source.s_cpu_cores with
| None -> ()
- | Some v -> push_back topology_attrs ("cores",
string_of_int v)
+ | Some v -> List.push_back topology_attrs ("cores",
string_of_int v)
);
(match source.s_cpu_threads with
| None -> ()
- | Some v -> push_back topology_attrs ("threads",
string_of_int v)
+ | Some v -> List.push_back topology_attrs ("threads",
string_of_int v)
);
- push_back cpu (e "topology" !topology_attrs [])
+ List.push_back cpu (e "topology" !topology_attrs [])
);
- append body [ e "cpu" [ "match", "minimum" ]
!cpu ]
+ List.push_back_list body [ e "cpu" [ "match",
"minimum" ] !cpu ]
);
let uefi_firmware @@ -140,7 +140,7 @@ let create_libvirt_xml ?pool source
target_buses guestcaps
let features = List.sort compare (StringSet.elements features) in
- append body [
+ List.push_back_list body [
e "features" [] (List.map (fun s -> e s [] []) features);
];
@@ -161,7 +161,7 @@ let create_libvirt_xml ?pool source target_buses guestcaps
(e "type" (["arch", guestcaps.gcaps_arch] @ machine)
[PCData "hvm"])
:: loader in
- append body [
+ List.push_back_list body [
e "os" [] os_section;
e "on_poweroff" [] [PCData "destroy"];
@@ -236,7 +236,7 @@ let create_libvirt_xml ?pool source target_buses guestcaps
(Array.mapi (make_disk "floppy" "fd")
target_buses.target_floppy_bus)
] in
- append devices disks;
+ List.push_back_list devices disks;
let nics let net_model @@ -269,7 +269,7 @@ let create_libvirt_xml ?pool
source target_buses guestcaps
nic
) source.s_nics in
- append devices nics;
+ List.push_back_list devices nics;
(* Same as old virt-v2v, we always add a display here even if it was
* missing from the old metadata.
@@ -281,7 +281,7 @@ let create_libvirt_xml ?pool source target_buses guestcaps
| Cirrus -> e "model" [ "type",
"cirrus"; "vram", "9216" ] [] in
append_attr ("heads", "1") video_model;
e "video" [] [ video_model ] in
- push_back devices video;
+ List.push_back devices video;
let graphics match source.s_display with
@@ -326,7 +326,7 @@ let create_libvirt_xml ?pool source target_buses guestcaps
| Some { s_port = None } | None ->
append_attr ("autoport", "yes") graphics;
append_attr ("port", "-1") graphics);
- push_back devices graphics;
+ List.push_back devices graphics;
let sound match source.s_sound with
@@ -336,11 +336,11 @@ let create_libvirt_xml ?pool source target_buses guestcaps
[ e "sound" [ "model",
string_of_source_sound_model model ] [] ]
else
[] in
- append devices sound;
+ List.push_back_list devices sound;
(* Miscellaneous KVM devices. *)
if guestcaps.gcaps_virtio_rng then
- push_back devices (
+ List.push_back devices (
e "rng" ["model", "virtio"] [
(* XXX Using /dev/urandom requires libvirt >= 1.3.4. Libvirt
* was broken before that.
@@ -351,27 +351,27 @@ let create_libvirt_xml ?pool source target_buses guestcaps
(* For the balloon device, libvirt adds an implicit device
* unless we use model='none', hence this:
*)
- push_back devices (
+ List.push_back devices (
e "memballoon"
["model",
if guestcaps.gcaps_virtio_balloon then "virtio" else
"none"]
[]
);
if guestcaps.gcaps_isa_pvpanic then
- push_back devices (
+ List.push_back devices (
e "panic" ["model", "isa"] [
e "address" ["type", "isa";
"iobase", "0x505"] []
]
);
(* Standard devices added to every guest. *)
- append devices [
+ List.push_back_list devices [
e "input" ["type", "tablet"; "bus",
"usb"] [];
e "input" ["type", "mouse"; "bus",
"ps2"] [];
e "console" ["type", "pty"] [];
];
- append body [
+ List.push_back_list body [
e "devices" [] !devices;
];
diff --git a/v2v/create_ovf.ml b/v2v/create_ovf.ml
index 1b851b0e9..aebdf6230 100644
--- a/v2v/create_ovf.ml
+++ b/v2v/create_ovf.ml
@@ -314,18 +314,18 @@ let rec create_ovf source targets guestcaps inspect
(match source.s_cpu_model with
| None -> ()
| Some model ->
- push_back content_subnodes (e "CustomCpuName" [] [PCData
model])
+ List.push_back content_subnodes (e "CustomCpuName" []
[PCData model])
);
(* Add the <Origin/> element if we can. *)
(match origin_of_source_hypervisor source.s_hypervisor with
| None -> ()
| Some origin ->
- push_back content_subnodes
+ List.push_back content_subnodes
(e "Origin" [] [PCData (string_of_int origin)])
);
- push_back content_subnodes (
+ List.push_back content_subnodes (
e "Section" ["ovf:id", vm_uuid;
"ovf:required", "false";
"xsi:type",
"ovf:OperatingSystemSection_Type"] [
e "Info" [] [PCData inspect.i_product_name];
@@ -338,7 +338,7 @@ let rec create_ovf source targets guestcaps inspect
source.s_vcpu memsize_mb)]
] in
- push_back virtual_hardware_section_items (
+ List.push_back virtual_hardware_section_items (
e "Item" [] ([
e "rasd:Caption" [] [PCData (sprintf "%d virtual
cpu" source.s_vcpu)];
e "rasd:Description" [] [PCData "Number of virtual
CPU"];
@@ -370,7 +370,7 @@ let rec create_ovf source targets guestcaps inspect
)
);
- append virtual_hardware_section_items [
+ List.push_back_list virtual_hardware_section_items [
e "Item" [] [
e "rasd:Caption" [] [PCData (sprintf "%Ld MB of
memory" memsize_mb)];
e "rasd:Description" [] [PCData "Memory Size"];
@@ -403,7 +403,7 @@ let rec create_ovf source targets guestcaps inspect
(* Add the miscellaneous KVM devices. *)
if guestcaps.gcaps_virtio_rng then
- push_back virtual_hardware_section_items (
+ List.push_back virtual_hardware_section_items (
e "Item" [] [
e "rasd:Caption" [] [PCData "RNG Device"];
e "rasd:InstanceId" [] [PCData (uuidgen ())];
@@ -413,7 +413,7 @@ let rec create_ovf source targets guestcaps inspect
]
);
if guestcaps.gcaps_virtio_balloon then
- push_back virtual_hardware_section_items (
+ List.push_back virtual_hardware_section_items (
e "Item" [] [
e "rasd:Caption" [] [PCData "Memory Ballooning
Device"];
e "rasd:InstanceId" [] [PCData (uuidgen ())];
@@ -423,7 +423,7 @@ let rec create_ovf source targets guestcaps inspect
]
);
- push_back content_subnodes (
+ List.push_back content_subnodes (
e "Section" ["xsi:type",
"ovf:VirtualHardwareSection_Type"]
!virtual_hardware_section_items
);
@@ -554,7 +554,7 @@ and add_disks targets guestcaps output_alloc sd_uuid
image_uuids vol_uuids ovf (match actual_size_gb with
| None -> ()
| Some actual_size_gb ->
- push_back attrs ("ovf:actual_size", Int64.to_string
actual_size_gb)
+ List.push_back attrs ("ovf:actual_size", Int64.to_string
actual_size_gb)
);
e "Disk" !attrs [] in
if is_estimate then (
@@ -585,12 +585,12 @@ and add_disks targets guestcaps output_alloc sd_uuid
image_uuids vol_uuids ovf e "rasd:last_modified_date" []
[PCData iso_time];
] in
if is_bootable_drive then
- push_back item_subnodes
+ List.push_back item_subnodes
(e "BootOrder" [] [PCData (string_of_int
boot_order)]);
e "Item" [] !item_subnodes in
append_child item virtualhardware_section;
- ) (combine3 targets image_uuids vol_uuids)
+ ) (List.combine3 targets image_uuids vol_uuids)
(* This modifies the OVF DOM, adding a section for each NIC. *)
and add_networks nics guestcaps ovf @@ -641,7 +641,7 @@ and add_networks nics
guestcaps ovf (match mac with
| None -> ()
| Some mac ->
- push_back item_subnodes
+ List.push_back item_subnodes
(e "rasd:MACAddress" [] [PCData mac])
);
e "Item" [] !item_subnodes in
diff --git a/v2v/input_libvirt_vddk.ml b/v2v/input_libvirt_vddk.ml
index 8fa33fbeb..9afa9ed32 100644
--- a/v2v/input_libvirt_vddk.ml
+++ b/v2v/input_libvirt_vddk.ml
@@ -151,7 +151,7 @@ object
let args let add_arg, get_args let args = ref [] in
- let add_arg a = push_front a args in
+ let add_arg a = List.push_front a args in
let get_args () = List.rev !args in
add_arg, get_args in
diff --git a/v2v/input_ova.ml b/v2v/input_ova.ml
index 5f313b6fb..abb0654a5 100644
--- a/v2v/input_ova.ml
+++ b/v2v/input_ova.ml
@@ -76,7 +76,7 @@ let untar ?format ?(paths = []) file outdir let
untar_metadata file outdir let files = external_command (sprintf "tar
-tf %s" (Filename.quote file)) in
let files - filter_map (
+ List.filter_map (
fun f ->
if Filename.check_suffix f ".ovf" ||
Filename.check_suffix f ".mf" then Some f
diff --git a/v2v/input_vmx.ml b/v2v/input_vmx.ml
index 366e63560..649e86cac 100644
--- a/v2v/input_vmx.ml
+++ b/v2v/input_vmx.ml
@@ -108,7 +108,7 @@ and find_hdds vmx vmx_filename
Some (c, t, s)
| _ -> None
) hdds in
- let hdds = filter_map identity hdds in
+ let hdds = List.filter_map identity hdds in
(* We don't have a way to return the controllers and targets, so
* just make sure the disks are sorted into order, since Parse_vmx
@@ -188,7 +188,7 @@ and find_removables vmx Some s
| _ -> None
) devs in
- let devs = filter_map identity devs in
+ let devs = List.filter_map identity devs in
(* Sort by slot. *)
let devs @@ -260,7 +260,7 @@ and find_nics vmx
s_vnet_type = vnet_type })
| _ -> None
) nics in
- let nics = filter_map identity nics in
+ let nics = List.filter_map identity nics in
(* Sort by port. *)
let nics = List.sort compare nics in
diff --git a/v2v/linux_bootloaders.ml b/v2v/linux_bootloaders.ml
index 4ddc6d0dd..bc015740a 100644
--- a/v2v/linux_bootloaders.ml
+++ b/v2v/linux_bootloaders.ml
@@ -84,7 +84,7 @@ object
let paths = Array.to_list paths in
(* Remove duplicates. *)
- let paths = remove_duplicates paths in
+ let paths = List.remove_duplicates paths in
(* Get the default kernel from grub if it's set. *)
let default diff --git a/v2v/linux_kernels.ml b/v2v/linux_kernels.ml
index 59948cb61..438a00afa 100644
--- a/v2v/linux_kernels.ml
+++ b/v2v/linux_kernels.ml
@@ -89,7 +89,7 @@ let detect_kernels (g : G.guestfs) inspect family bootloader
PCRE.compile "^initrd.img-.*$"
else
PCRE.compile "^initr(?:d|amfs)-.*(?:\\.img)?$" in
- filter_map (
+ List.filter_map (
function
| { G.app2_name = name } as app
when name = "kernel" || String.is_prefix name
"kernel-"
@@ -177,7 +177,7 @@ let detect_kernels (g : G.guestfs) inspect family bootloader
g#file_architecture any_module in
(* Just return the module names, without path or extension. *)
- let modules = filter_map (
+ let modules = List.filter_map (
fun m ->
if PCRE.matches rex_ko_extract m then
Some (PCRE.sub 1)
@@ -259,7 +259,7 @@ let detect_kernels (g : G.guestfs) inspect family bootloader
let vmlinuzes = bootloader#list_kernels in
(* Map these to installed kernels. *)
- filter_map (
+ List.filter_map (
fun vmlinuz ->
try
let statbuf = g#statns vmlinuz in
diff --git a/v2v/modules_list.ml b/v2v/modules_list.ml
index e3c6d5934..d5120b70b 100644
--- a/v2v/modules_list.ml
+++ b/v2v/modules_list.ml
@@ -21,8 +21,8 @@ open Std_utils
let input_modules = ref []
and output_modules = ref []
-let register_input_module name = push_front name input_modules
-and register_output_module name = push_front name output_modules
+let register_input_module name = List.push_front name input_modules
+and register_output_module name = List.push_front name output_modules
let input_modules () = List.sort compare !input_modules
and output_modules () = List.sort compare !output_modules
@@ -36,7 +36,7 @@ type conversion_fn let convert_modules = ref []
let register_convert_module inspect_fn name conversion_fn - push_front
(inspect_fn, (name, conversion_fn)) convert_modules
+ List.push_front (inspect_fn, (name, conversion_fn)) convert_modules
let find_convert_module inspect let rec loop = function
diff --git a/v2v/output_glance.ml b/v2v/output_glance.ml
index 4e4f965c1..6ce637c59 100644
--- a/v2v/output_glance.ml
+++ b/v2v/output_glance.ml
@@ -99,42 +99,42 @@ object
] in
if source.s_cpu_sockets <> None || source.s_cpu_cores <> None
||
source.s_cpu_threads <> None then (
- push_back properties ("hw_cpu_sockets",
+ List.push_back properties ("hw_cpu_sockets",
match source.s_cpu_sockets with
| None -> "1"
| Some v -> string_of_int v);
- push_back properties ("hw_cpu_cores",
+ List.push_back properties ("hw_cpu_cores",
match source.s_cpu_cores with
| None -> "1"
| Some v -> string_of_int v);
- push_back properties ("hw_cpu_threads",
+ List.push_back properties ("hw_cpu_threads",
match source.s_cpu_threads with
| None -> "1"
| Some v -> string_of_int v);
)
else (
- push_back properties ("hw_cpu_sockets", "1");
- push_back properties ("hw_cpu_cores", string_of_int
source.s_vcpu);
+ List.push_back properties ("hw_cpu_sockets", "1");
+ List.push_back properties ("hw_cpu_cores", string_of_int
source.s_vcpu);
);
(match guestcaps.gcaps_block_bus with
| Virtio_SCSI ->
- push_back properties ("hw_scsi_model",
"virtio-scsi")
+ List.push_back properties ("hw_scsi_model",
"virtio-scsi")
| Virtio_blk | IDE -> ()
);
(match inspect.i_major_version, inspect.i_minor_version with
| 0, 0 -> ()
- | x, 0 -> push_back properties ("os_version", string_of_int
x)
- | x, y -> push_back properties ("os_version", sprintf
"%d.%d" x y)
+ | x, 0 -> List.push_back properties ("os_version",
string_of_int x)
+ | x, y -> List.push_back properties ("os_version", sprintf
"%d.%d" x y)
);
if guestcaps.gcaps_virtio_rng then
- push_back properties ("hw_rng_model", "virtio");
+ List.push_back properties ("hw_rng_model",
"virtio");
(* XXX Neither memory balloon nor pvpanic are supported by
* Glance at this time.
*)
(match target_firmware with
| TargetBIOS -> ()
| TargetUEFI ->
- push_back properties ("hw_firmware_type", "uefi")
+ List.push_back properties ("hw_firmware_type",
"uefi")
);
!properties in
diff --git a/v2v/output_libvirt.ml b/v2v/output_libvirt.ml
index 02b4d54ff..3fb449d5a 100644
--- a/v2v/output_libvirt.ml
+++ b/v2v/output_libvirt.ml
@@ -61,7 +61,7 @@ let target_features_of_capabilities_doc doc arch for i =
0 to Xml.xpathobj_nr_nodes obj - 1 do
let feature_node = Xml.xpathobj_node obj i in
let feature_name = Xml.node_name feature_node in
- push_front feature_name features
+ List.push_front feature_name features
done;
!features
)
diff --git a/v2v/output_qemu.ml b/v2v/output_qemu.ml
index d18b4b7c9..5304329ae 100644
--- a/v2v/output_qemu.ml
+++ b/v2v/output_qemu.ml
@@ -99,16 +99,16 @@ object
if source.s_cpu_sockets <> None || source.s_cpu_cores <> None
||
source.s_cpu_threads <> None then (
let a = ref [] in
- push_back a (sprintf "cpus=%d" source.s_vcpu);
- push_back a (sprintf "sockets=%d"
+ List.push_back a (sprintf "cpus=%d" source.s_vcpu);
+ List.push_back a (sprintf "sockets=%d"
(match source.s_cpu_sockets with
| None -> 1
| Some v -> v));
- push_back a (sprintf "cores=%d"
+ List.push_back a (sprintf "cores=%d"
(match source.s_cpu_cores with
| None -> 1
| Some v -> v));
- push_back a (sprintf "threads=%d"
+ List.push_back a (sprintf "threads=%d"
(match source.s_cpu_threads with
| None -> 1
| Some v -> v));
diff --git a/v2v/output_rhv.ml b/v2v/output_rhv.ml
index ce2d75c1d..2bcd988c1 100644
--- a/v2v/output_rhv.ml
+++ b/v2v/output_rhv.ml
@@ -233,7 +233,7 @@ object
debug "RHV: will export %s to %s" ov_sd target_file;
{ t with target_file = target_file }
- ) (combine3 targets image_uuids vol_uuids) in
+ ) (List.combine3 targets image_uuids vol_uuids) in
(* Generate the .meta file associated with each volume. *)
let metas diff --git a/v2v/output_vdsm.ml b/v2v/output_vdsm.ml
index f60b6b4c7..0aeee289d 100644
--- a/v2v/output_vdsm.ml
+++ b/v2v/output_vdsm.ml
@@ -85,7 +85,7 @@ object
let mp, uuid let fields = String.nsplit "/" os in (* ...
"data-center" "UUID" *)
let fields = List.rev fields in (* "UUID"
"data-center" ... *)
- let fields = dropwhile ((=) "") fields in
+ let fields = List.dropwhile ((=) "") fields in
match fields with
| uuid :: rest when String.length uuid = 36 ->
let mp = String.concat "/" (List.rev rest) in
@@ -135,7 +135,7 @@ object
debug "VDSM: will export %s to %s" ov_sd target_file;
{ t with target_file = target_file }
- ) (combine3 targets vdsm_params.image_uuids vdsm_params.vol_uuids) in
+ ) (List.combine3 targets vdsm_params.image_uuids vdsm_params.vol_uuids)
in
(* Generate the .meta files associated with each volume. *)
let metas diff --git a/v2v/parse_libvirt_xml.ml b/v2v/parse_libvirt_xml.ml
index 40d558a5e..7a03156f3 100644
--- a/v2v/parse_libvirt_xml.ml
+++ b/v2v/parse_libvirt_xml.ml
@@ -122,7 +122,7 @@ let parse_libvirt_xml ?conn xml let nr_nodes =
Xml.xpathobj_nr_nodes obj in
for i = 0 to nr_nodes-1 do
let node = Xml.xpathobj_node obj i in
- push_front (Xml.node_name node) features
+ List.push_front (Xml.node_name node) features
done;
!features in
@@ -253,7 +253,7 @@ let parse_libvirt_xml ?conn xml
s_controller = controller };
p_source = p_source
} in
- push_front disk disks
+ List.push_front disk disks
in
get_disks, add_disk
in
@@ -402,7 +402,7 @@ let parse_libvirt_xml ?conn xml { s_removable_type
= typ;
s_removable_controller = controller;
s_removable_slot = slot } in
- push_front disk disks
+ List.push_front disk disks
done;
List.rev !disks in
@@ -446,7 +446,7 @@ let parse_libvirt_xml ?conn xml s_vnet_orig =
vnet;
s_vnet_type = vnet_type
} in
- push_front nic nics
+ List.push_front nic nics
in
match xpath_string "source/@network | source/@bridge" with
| None -> ()
diff --git a/v2v/parse_ovf_from_ova.ml b/v2v/parse_ovf_from_ova.ml
index e3518e30d..1c113eca2 100644
--- a/v2v/parse_ovf_from_ova.ml
+++ b/v2v/parse_ovf_from_ova.ml
@@ -174,7 +174,7 @@ let parse_ovf_from_ova ovf_filename href = href;
compressed = compressed
} in
- push_front disk disks;
+ List.push_front disk disks;
) else
error (f_"could not parse disk rasd:HostResource from OVF
document")
done;
@@ -217,7 +217,7 @@ let parse_ovf_from_ova ovf_filename
s_removable_controller = controller;
s_removable_slot = slot;
} in
- push_front disk removables;
+ List.push_front disk removables;
done;
List.rev !removables
@@ -239,7 +239,7 @@ let parse_ovf_from_ova ovf_filename s_vnet_orig =
vnet;
s_vnet_type = Network;
} in
- push_front nic nics
+ List.push_front nic nics
done;
List.rev !nics
in
diff --git a/v2v/parse_vmx.ml b/v2v/parse_vmx.ml
index 3c72527b9..65d5a0edd 100644
--- a/v2v/parse_vmx.ml
+++ b/v2v/parse_vmx.ml
@@ -290,7 +290,7 @@ and parse_string str ) lines in
(* Parse the lines into key = "value". *)
- let lines = filter_map (
+ let lines = List.filter_map (
fun line ->
if PCRE.matches rex line then (
let key = PCRE.sub 1 and value = PCRE.sub 2 in
diff --git a/v2v/test-harness/v2v_test_harness.ml
b/v2v/test-harness/v2v_test_harness.ml
index ae0033dde..a2eeab0ff 100644
--- a/v2v/test-harness/v2v_test_harness.ml
+++ b/v2v/test-harness/v2v_test_harness.ml
@@ -93,7 +93,7 @@ let run ~test ?input_disk ?input_xml ?(test_plan =
default_plan) () let nodes_of_xpathobj doc xpathobj let nodes = ref []
in
for i = 0 to Xml.xpathobj_nr_nodes xpathobj - 1 do
- push_front (Xml.xpathobj_node xpathobj i) nodes
+ List.push_front (Xml.xpathobj_node xpathobj i) nodes
done;
List.rev !nodes
in
@@ -209,7 +209,7 @@ let run ~test ?input_disk ?input_xml ?(test_plan =
default_plan) () printf "%s\n%!" cmd;
let chan = open_process_in cmd in
let lines = ref [] in
- (try while true do push_front (input_line chan) lines done
+ (try while true do List.push_front (input_line chan) lines done
with End_of_file -> ());
let lines = List.rev !lines in
let stat = close_process_in chan in
@@ -282,7 +282,7 @@ let run ~test ?input_disk ?input_xml ?(test_plan =
default_plan) () printf "%s\n%!" cmd;
let chan = open_process_in cmd in
let lines = ref [] in
- (try while true do push_front (input_line chan) lines done
+ (try while true do List.push_front (input_line chan) lines done
with End_of_file -> ());
let lines = List.rev !lines in
let stat = close_process_in chan in
diff --git a/v2v/v2v.ml b/v2v/v2v.ml
index 92aa6102b..9e609b526 100644
--- a/v2v/v2v.ml
+++ b/v2v/v2v.ml
@@ -447,7 +447,7 @@ and do_fstrim g inspect (* Get all filesystems. *)
let fses = g#list_filesystems () in
- let fses = filter_map (
+ let fses = List.filter_map (
function (_, ("unknown"|"swap")) -> None | (dev, _)
-> Some dev
) fses in
@@ -788,7 +788,7 @@ and rcaps_from_source source let source_block_types
List.map (fun sd -> sd.s_controller) source.s_disks in
let source_block_type - match sort_uniq source_block_types with
+ match List.sort_uniq source_block_types with
| [] -> error (f_"source has no hard disks!")
| [t] -> t
| _ -> error (f_"source has multiple hard disk types!") in
@@ -804,7 +804,7 @@ and rcaps_from_source source let source_net_types
List.map (fun nic -> nic.s_nic_model) source.s_nics in
let source_net_type - match sort_uniq source_net_types with
+ match List.sort_uniq source_net_types with
| [] -> None
| [t] -> t
| _ -> error (f_"source has multiple network adapter model!")
in
diff --git a/v2v/vCenter.ml b/v2v/vCenter.ml
index 18879432b..41bdbdd01 100644
--- a/v2v/vCenter.ml
+++ b/v2v/vCenter.ml
@@ -42,11 +42,11 @@ let get_session_cookie password scheme uri sslverify url
| None, Some _ ->
warning (f_"--password-file parameter ignored because
'user@' was not given in the URL")
| Some user, None ->
- push_back curl_args ("user", Some user)
+ List.push_back curl_args ("user", Some user)
| Some user, Some password ->
- push_back curl_args ("user", Some (user ^ ":" ^
password))
+ List.push_back curl_args ("user", Some (user ^ ":"
^ password))
);
- if not sslverify then push_back curl_args ("insecure", None);
+ if not sslverify then List.push_back curl_args ("insecure",
None);
let curl_h = Curl.create !curl_args in
let lines = Curl.run curl_h in
--
2.13.2
Richard W.M. Jones
2017-Oct-08 20:44 UTC
[Libguestfs] [PATCH 2/3] common/mlstdutils: Introduce Option submodule.
Inspired by ocaml-extlib, introduce a module for handling option
types.
We already had the ‘may’ function (which becomes ‘Option.may’). This
adds also ‘Option.map’ (unused), and ‘Option.default’ functions.
Note this does *not* introduce the unsafe ‘Option.get’ function from
extlib.
---
builder/builder.ml | 6 ++---
builder/index.ml | 27 +++++++++------------
builder/list_entries.ml | 20 +++++++---------
common/mlstdutils/std_utils.ml | 18 ++++++++++----
common/mlstdutils/std_utils.mli | 15 +++++++++---
common/mltools/tools_utils.ml | 6 ++---
customize/customize_main.ml | 4 ++--
daemon/inspect_types.ml | 52 ++++++++++++++++++++---------------------
dib/dib.ml | 4 ++--
resize/resize.ml | 6 ++---
sysprep/sysprep_operation.ml | 16 ++++++-------
v2v/changeuid.ml | 4 ++--
v2v/cmdline.ml | 6 ++---
v2v/input_libvirt_vddk.ml | 3 ++-
v2v/parse_libvirt_xml.ml | 6 ++---
v2v/types.ml | 7 +++---
v2v/v2v.ml | 6 ++---
17 files changed, 107 insertions(+), 99 deletions(-)
diff --git a/builder/builder.ml b/builder/builder.ml
index 8b4c20765..9b907ac8e 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -688,8 +688,8 @@ let main () let g let g = open_guestfs () in
- may g#set_memsize cmdline.memsize;
- may g#set_smp cmdline.smp;
+ Option.may g#set_memsize cmdline.memsize;
+ Option.may g#set_smp cmdline.smp;
g#set_network cmdline.network;
(* The output disk is being created, so use cache=unsafe here. *)
@@ -781,6 +781,6 @@ let main () Pervasives.flush Pervasives.stdout;
Pervasives.flush Pervasives.stderr;
- may print_string stats
+ Option.may print_string stats
let () = run_main_and_handle_errors main
diff --git a/builder/index.ml b/builder/index.ml
index b895e3f52..84f66c265 100644
--- a/builder/index.ml
+++ b/builder/index.ml
@@ -53,34 +53,29 @@ let print_entry chan (name, { printable_name; file_uri;
arch; osinfo;
notes; aliases; hidden }) let fp fs = fprintf
chan fs in
fp "[%s]\n" name;
- may (fp "name=%s\n") printable_name;
- may (fp "osinfo=%s\n") osinfo;
+ Option.may (fp "name=%s\n") printable_name;
+ Option.may (fp "osinfo=%s\n") osinfo;
fp "file=%s\n" file_uri;
fp "arch=%s\n" arch;
- may (fp "sig=%s\n") signature_uri;
- (match checksums with
- | None -> ()
- | Some checksums ->
+ Option.may (fp "sig=%s\n") signature_uri;
+ Option.may (
List.iter (
fun c ->
fp "checksum[%s]=%s\n"
(Checksums.string_of_csum_t c) (Checksums.string_of_csum c)
- ) checksums
- );
+ )
+ ) checksums;
fp "revision=%s\n" (string_of_revision revision);
- may (fp "format=%s\n") format;
+ Option.may (fp "format=%s\n") format;
fp "size=%Ld\n" size;
- may (fp "compressed_size=%Ld\n") compressed_size;
- may (fp "expand=%s\n") expand;
- may (fp "lvexpand=%s\n") lvexpand;
+ Option.may (fp "compressed_size=%Ld\n") compressed_size;
+ Option.may (fp "expand=%s\n") expand;
+ Option.may (fp "lvexpand=%s\n") lvexpand;
List.iter (
fun (lang, notes) ->
match lang with
| "" -> fp "notes=%s\n" notes
| lang -> fp "notes[%s]=%s\n" lang notes
) notes;
- (match aliases with
- | None -> ()
- | Some l -> fp "aliases=%s\n" (String.concat " " l)
- );
+ Option.may (fun l -> fp "aliases=%s\n" (String.concat "
" l)) aliases;
if hidden then fp "hidden=true\n"
diff --git a/builder/list_entries.ml b/builder/list_entries.ml
index 2cd030fca..af1d2419b 100644
--- a/builder/list_entries.ml
+++ b/builder/list_entries.ml
@@ -47,7 +47,7 @@ and list_entries_short index if not hidden then (
printf "%-24s" name;
printf " %-10s" arch;
- may (printf " %s") printable_name;
+ Option.may (printf " %s") printable_name;
printf "\n"
)
) index
@@ -73,19 +73,15 @@ and list_entries_long ~sources index
notes; aliases; hidden }) ->
if not hidden then (
printf "%-24s %s\n" "os-version:" name;
- may (printf "%-24s %s\n" (s_"Full name:"))
printable_name;
+ Option.may (printf "%-24s %s\n" (s_"Full name:"))
printable_name;
printf "%-24s %s\n" (s_"Architecture:") arch;
printf "%-24s %s\n" (s_"Minimum/default size:")
(human_size size);
- (match compressed_size with
- | None -> ()
- | Some size ->
- printf "%-24s %s\n" (s_"Download size:")
(human_size size);
- );
- (match aliases with
- | None -> ()
- | Some l -> printf "%-24s %s\n" (s_"Aliases:")
- (String.concat " " l);
- );
+ Option.may (fun size ->
+ printf "%-24s %s\n" (s_"Download size:")
(human_size size)
+ ) compressed_size;
+ Option.may (
+ fun l -> printf "%-24s %s\n" (s_"Aliases:")
(String.concat " " l)
+ ) aliases;
let notes = Languages.find_notes langs notes in
(match notes with
| notes :: _ ->
diff --git a/common/mlstdutils/std_utils.ml b/common/mlstdutils/std_utils.ml
index 558b1e3e2..32bba4113 100644
--- a/common/mlstdutils/std_utils.ml
+++ b/common/mlstdutils/std_utils.ml
@@ -359,6 +359,20 @@ module List = struct
let push_front_list xs xsp = xsp := xs @ !xsp
end
+module Option = struct
+ let may f = function
+ | None -> ()
+ | Some x -> f x
+
+ let map f = function
+ | None -> None
+ | Some x -> Some (f x)
+
+ let default def = function
+ | None -> def
+ | Some x -> x
+end
+
let (//) = Filename.concat
let quote = Filename.quote
@@ -575,10 +589,6 @@ and output_spaces chan n = for i = 0 to n-1 do output_char
chan ' ' done
let unique = let i = ref 0 in fun () -> incr i; !i
-let may f = function
- | None -> ()
- | Some x -> f x
-
type ('a, 'b) maybe = Either of 'a | Or of 'b
let protect ~f ~finally diff --git a/common/mlstdutils/std_utils.mli
b/common/mlstdutils/std_utils.mli
index 3895a41cc..b3cfdcd55 100644
--- a/common/mlstdutils/std_utils.mli
+++ b/common/mlstdutils/std_utils.mli
@@ -256,6 +256,18 @@ module List : sig
end
(** Override the List module from stdlib. *)
+module Option : sig
+ val may : ('a -> unit) -> 'a option -> unit
+ (** [may f (Some x)] runs [f x]. [may f None] does nothing. *)
+
+ val map : ('a -> 'b) -> 'a option -> 'b option
+ (** [map f (Some x)] returns [Some (f x)]. [map f None] returns [None]. *)
+
+ val default : 'a -> 'a option -> 'a
+ (** [default x (Some y)] returns [y]. [default x None] returns [x]. *)
+end
+(** Functions for dealing with option types. *)
+
val ( // ) : string -> string -> string
(** Concatenate directory and filename. *)
@@ -320,9 +332,6 @@ val output_spaces : out_channel -> int -> unit
val unique : unit -> int
(** Returns a unique number each time called. *)
-val may : ('a -> unit) -> 'a option -> unit
-(** [may f (Some x)] runs [f x]. [may f None] does nothing. *)
-
type ('a, 'b) maybe = Either of 'a | Or of 'b
(** Like the Haskell [Either] type. *)
diff --git a/common/mltools/tools_utils.ml b/common/mltools/tools_utils.ml
index f66ee9f50..8140ba84d 100644
--- a/common/mltools/tools_utils.ml
+++ b/common/mltools/tools_utils.ml
@@ -109,7 +109,7 @@ let open_guestfs ?identifier () let g = new
Guestfs.guestfs () in
if trace () then g#set_trace true;
if verbose () then g#set_verbose true;
- may g#set_identifier identifier;
+ Option.may g#set_identifier identifier;
g
(* All the OCaml virt-* programs use this wrapper to catch exceptions
@@ -340,8 +340,8 @@ and do_run ?(echo_cmd = true) ?stdout_chan ?stderr_chan args
Or 127
and do_teardown app outfd errfd exitstat - may Unix.close outfd;
- may Unix.close errfd;
+ Option.may Unix.close outfd;
+ Option.may Unix.close errfd;
match exitstat with
| Unix.WEXITED i ->
i
diff --git a/customize/customize_main.ml b/customize/customize_main.ml
index f6ffc872d..8ba4f5ce7 100644
--- a/customize/customize_main.ml
+++ b/customize/customize_main.ml
@@ -157,8 +157,8 @@ read the man page virt-customize(1).
(* Connect to libguestfs. *)
let g let g = open_guestfs () in
- may g#set_memsize memsize;
- may g#set_smp smp;
+ Option.may g#set_memsize memsize;
+ Option.may g#set_smp smp;
g#set_network network;
(* Add disks. *)
diff --git a/daemon/inspect_types.ml b/daemon/inspect_types.ml
index a687ea08c..1da41064d 100644
--- a/daemon/inspect_types.ml
+++ b/daemon/inspect_types.ml
@@ -143,38 +143,38 @@ and string_of_root { root_location; inspection_data } and
string_of_inspection_data data let b = Buffer.create 1024 in
let bpf fs = bprintf b fs in
- may (fun v -> bpf " type: %s\n" (string_of_os_type v))
- data.os_type;
- may (fun v -> bpf " distro: %s\n" (string_of_distro v))
- data.distro;
- may (fun v -> bpf " package_format: %s\n"
(string_of_package_format v))
- data.package_format;
- may (fun v -> bpf " package_management: %s\n"
(string_of_package_management v))
- data.package_management;
- may (fun v -> bpf " product_name: %s\n" v)
- data.product_name;
- may (fun v -> bpf " product_variant: %s\n" v)
- data.product_variant;
- may (fun (major, minor) -> bpf " version: %d.%d\n" major
minor)
- data.version;
- may (fun v -> bpf " arch: %s\n" v)
- data.arch;
- may (fun v -> bpf " hostname: %s\n" v)
- data.hostname;
+ Option.may (fun v -> bpf " type: %s\n" (string_of_os_type v))
+ data.os_type;
+ Option.may (fun v -> bpf " distro: %s\n" (string_of_distro
v))
+ data.distro;
+ Option.may (fun v -> bpf " package_format: %s\n"
(string_of_package_format v))
+ data.package_format;
+ Option.may (fun v -> bpf " package_management: %s\n"
(string_of_package_management v))
+ data.package_management;
+ Option.may (fun v -> bpf " product_name: %s\n" v)
+ data.product_name;
+ Option.may (fun v -> bpf " product_variant: %s\n" v)
+ data.product_variant;
+ Option.may (fun (major, minor) -> bpf " version: %d.%d\n"
major minor)
+ data.version;
+ Option.may (fun v -> bpf " arch: %s\n" v)
+ data.arch;
+ Option.may (fun v -> bpf " hostname: %s\n" v)
+ data.hostname;
if data.fstab <> [] then (
let v = List.map (
fun (a, b) -> sprintf "(%s, %s)" (Mountable.to_string a) b
) data.fstab in
bpf " fstab: [%s]\n" (String.concat ", " v)
);
- may (fun v -> bpf " windows_systemroot: %s\n" v)
- data.windows_systemroot;
- may (fun v -> bpf " windows_software_hive: %s\n" v)
- data.windows_software_hive;
- may (fun v -> bpf " windows_system_hive: %s\n" v)
- data.windows_system_hive;
- may (fun v -> bpf " windows_current_control_set: %s\n" v)
- data.windows_current_control_set;
+ Option.may (fun v -> bpf " windows_systemroot: %s\n" v)
+ data.windows_systemroot;
+ Option.may (fun v -> bpf " windows_software_hive: %s\n" v)
+ data.windows_software_hive;
+ Option.may (fun v -> bpf " windows_system_hive: %s\n" v)
+ data.windows_system_hive;
+ Option.may (fun v -> bpf " windows_current_control_set: %s\n"
v)
+ data.windows_current_control_set;
if data.drive_mappings <> [] then (
let v List.map (fun (a, b) -> sprintf "(%s, %s)" a b)
data.drive_mappings in
diff --git a/dib/dib.ml b/dib/dib.ml
index f8595636a..9a8d86bd9 100644
--- a/dib/dib.ml
+++ b/dib/dib.ml
@@ -720,8 +720,8 @@ let main ()
let g, tmpdisk, tmpdiskfmt, drive_partition let g = open_guestfs () in
- may g#set_memsize cmdline.memsize;
- may g#set_smp cmdline.smp;
+ Option.may g#set_memsize cmdline.memsize;
+ Option.may g#set_smp cmdline.smp;
g#set_network cmdline.network;
(* Main disk with the built image. *)
diff --git a/resize/resize.ml b/resize/resize.ml
index 4eeb0a170..837c3ce9e 100644
--- a/resize/resize.ml
+++ b/resize/resize.ml
@@ -1005,7 +1005,7 @@ read the man page virt-resize(1).
let ok try
g#part_init "/dev/sdb" parttype_string;
- may (g#part_set_disk_guid "/dev/sdb") disk_guid;
+ Option.may (g#part_set_disk_guid "/dev/sdb") disk_guid;
true
with G.Error error -> last_error := error; false in
if ok then g, true
@@ -1195,8 +1195,8 @@ read the man page virt-resize(1).
if p.p_bootable then
g#part_set_bootable "/dev/sdb" p.p_target_partnum true;
- may (g#part_set_name "/dev/sdb" p.p_target_partnum) p.p_label;
- may (g#part_set_gpt_guid "/dev/sdb" p.p_target_partnum)
p.p_guid;
+ Option.may (g#part_set_name "/dev/sdb" p.p_target_partnum)
p.p_label;
+ Option.may (g#part_set_gpt_guid "/dev/sdb" p.p_target_partnum)
p.p_guid;
match parttype, p.p_id with
| GPT, GPT_Type gpt_type ->
diff --git a/sysprep/sysprep_operation.ml b/sysprep/sysprep_operation.ml
index 2ddce302a..0013ff504 100644
--- a/sysprep/sysprep_operation.ml
+++ b/sysprep/sysprep_operation.ml
@@ -187,15 +187,13 @@ let dump_pod () if op.enabled_by_default then
printf "*\n";
printf "\n";
printf "%s.\n\n" op.heading;
- may (printf "%s\n\n") op.pod_description;
- (match op.pod_notes with
- | None -> ()
- | Some notes ->
- printf "=head3 ";
- printf (f_"Notes on %s") op.name;
- printf "\n\n";
- printf "%s\n\n" notes
- )
+ Option.may (printf "%s\n\n") op.pod_description;
+ Option.may (fun notes ->
+ printf "=head3 ";
+ printf (f_"Notes on %s") op.name;
+ printf "\n\n";
+ printf "%s\n\n" notes
+ ) op.pod_notes;
) !all_operations
let dump_pod_options () diff --git a/v2v/changeuid.ml b/v2v/changeuid.ml
index d02f2f5cf..49290c298 100644
--- a/v2v/changeuid.ml
+++ b/v2v/changeuid.ml
@@ -40,8 +40,8 @@ let with_fork { uid; gid } name f
if pid = 0 then (
(* Child. *)
- may setgid gid;
- may setuid uid;
+ Option.may setgid gid;
+ Option.may setuid uid;
(try f ()
with exn ->
eprintf "%s: changeuid: %s: %s\n%!" prog name
(Printexc.to_string exn);
diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml
index 2180b656f..1ae018bcd 100644
--- a/v2v/cmdline.ml
+++ b/v2v/cmdline.ml
@@ -319,8 +319,7 @@ read the man page virt-v2v(1).
let vdsm_image_uuids = List.rev !vdsm_image_uuids in
let vdsm_vol_uuids = List.rev !vdsm_vol_uuids in
let vdsm_vm_uuid = !vdsm_vm_uuid in
- let vdsm_ovf_output - match !vdsm_ovf_output with None -> "."
| Some s -> s in
+ let vdsm_ovf_output = Option.default "." !vdsm_ovf_output in
(* No arguments and machine-readable mode? Print out some facts
* about what this binary supports.
@@ -422,8 +421,7 @@ read the man page virt-v2v(1).
| `Not_set
| `Libvirt ->
- let output_storage - match output_storage with None ->
"default" | Some os -> os in
+ let output_storage = Option.default "default" output_storage in
if qemu_boot then
error_option_cannot_be_used_in_output_mode "libvirt"
"--qemu-boot";
if not do_copy then
diff --git a/v2v/input_libvirt_vddk.ml b/v2v/input_libvirt_vddk.ml
index 9afa9ed32..13a6a1561 100644
--- a/v2v/input_libvirt_vddk.ml
+++ b/v2v/input_libvirt_vddk.ml
@@ -210,7 +210,8 @@ object
add_arg (sprintf "libdir=%s" libdir);
(* The passthrough parameters. *)
- let pt name = may (fun field -> add_arg (sprintf "%s=%s"
name field)) in
+ let pt name + Option.may (fun field -> add_arg (sprintf
"%s=%s" name field)) in
pt "config" vddk_options.vddk_config;
pt "cookie" vddk_options.vddk_cookie;
pt "nfchostport" vddk_options.vddk_nfchostport;
diff --git a/v2v/parse_libvirt_xml.ml b/v2v/parse_libvirt_xml.ml
index 7a03156f3..2f90bee0c 100644
--- a/v2v/parse_libvirt_xml.ml
+++ b/v2v/parse_libvirt_xml.ml
@@ -111,9 +111,9 @@ let parse_libvirt_xml ?conn xml | Some vcpu, _, _,
_ -> vcpu
| None, None, None, None -> 1
| None, _, _, _ ->
- let sockets = match cpu_sockets with None -> 1 | Some v -> v in
- let cores = match cpu_cores with None -> 1 | Some v -> v in
- let threads = match cpu_threads with None -> 1 | Some v -> v in
+ let sockets = Option.default 1 cpu_sockets
+ and cores = Option.default 1 cpu_cores
+ and threads = Option.default 1 cpu_threads in
sockets * cores * threads in
let features diff --git a/v2v/types.ml b/v2v/types.ml
index 1b4e57845..fbf616c3d 100644
--- a/v2v/types.ml
+++ b/v2v/types.ml
@@ -18,8 +18,9 @@
open Printf
-open Common_gettext.Gettext
+open Std_utils
open Tools_utils
+open Common_gettext.Gettext
(* Types. See types.mli for documentation. *)
@@ -126,8 +127,8 @@ NICs:
(string_of_source_hypervisor s.s_hypervisor)
s.s_memory
s.s_vcpu
- (match s.s_cpu_vendor with None -> "" | Some v -> v)
- (match s.s_cpu_model with None -> "" | Some v -> v)
+ (Option.default "" s.s_cpu_vendor)
+ (Option.default "" s.s_cpu_model)
(match s.s_cpu_sockets with None -> "-" | Some v ->
string_of_int v)
(match s.s_cpu_cores with None -> "-" | Some v ->
string_of_int v)
(match s.s_cpu_threads with None -> "-" | Some v ->
string_of_int v)
diff --git a/v2v/v2v.ml b/v2v/v2v.ml
index 9e609b526..2864d728d 100644
--- a/v2v/v2v.ml
+++ b/v2v/v2v.ml
@@ -214,9 +214,9 @@ and open_source cmdline input (match
source.s_cpu_sockets, source.s_cpu_cores, source.s_cpu_threads with
| None, None, None -> () (* no topology specified *)
| sockets, cores, threads ->
- let sockets = match sockets with None -> 1 | Some v -> v in
- let cores = match cores with None -> 1 | Some v -> v in
- let threads = match threads with None -> 1 | Some v -> v in
+ let sockets = Option.default 1 sockets
+ and cores = Option.default 1 cores
+ and threads = Option.default 1 threads in
let expected_vcpu = sockets * cores * threads in
if expected_vcpu <> source.s_vcpu then
warning (f_"source sockets * cores * threads <> number of
vCPUs.\nSockets %d * cores per socket %d * threads %d = %d, but number of vCPUs
= %d.\n\nThis is a problem with either the source metadata or the virt-v2v input
module. In some circumstances this could stop the guest from booting on the
target.")
--
2.13.2
Richard W.M. Jones
2017-Oct-08 20:44 UTC
[Libguestfs] [PATCH 3/3] common/mltools: xpath_helpers: Get rid of xpath_*_default functions.
Instead of using ‘xpath_(string|int|int64)_default’ we can write the
equivalent code using ‘Option.default’. This is not quite so concise,
but may be easier to understand.
eg:
xpath_int_default xctx "xpath_expr" 10
->
Option.default 10 (xpath_int xctx "xpath_expr")
---
common/mltools/xpath_helpers.ml | 12 ------------
common/mltools/xpath_helpers.mli | 6 ------
v2v/copy_to_local.ml | 6 +++---
v2v/parse_libvirt_xml.ml | 9 ++++-----
v2v/parse_ovf_from_ova.ml | 16 ++++++++--------
5 files changed, 15 insertions(+), 34 deletions(-)
diff --git a/common/mltools/xpath_helpers.ml b/common/mltools/xpath_helpers.ml
index 05fad89a4..3afee8b21 100644
--- a/common/mltools/xpath_helpers.ml
+++ b/common/mltools/xpath_helpers.ml
@@ -40,15 +40,3 @@ let xpath_eval parsefn xpathctx expr let xpath_string =
xpath_eval identity
let xpath_int = xpath_eval int_of_string
let xpath_int64 = xpath_eval Int64.of_string
-
-(* Parse an xpath expression and return a string/int; if the expression
- * doesn't match, return the default.
- *)
-let xpath_eval_default parsefn xpath expr default - match xpath_eval parsefn
xpath expr with
- | None -> default
- | Some s -> s
-
-let xpath_string_default = xpath_eval_default identity
-let xpath_int_default = xpath_eval_default int_of_string
-let xpath_int64_default = xpath_eval_default Int64.of_string
diff --git a/common/mltools/xpath_helpers.mli b/common/mltools/xpath_helpers.mli
index 7434ba645..3a8190b05 100644
--- a/common/mltools/xpath_helpers.mli
+++ b/common/mltools/xpath_helpers.mli
@@ -25,9 +25,3 @@ val xpath_int : Xml.xpathctx -> string -> int option
val xpath_int64 : Xml.xpathctx -> string -> int64 option
(** Parse an xpath expression and return a string/int. Returns
[Some v], or [None] if the expression doesn't match. *)
-
-val xpath_string_default : Xml.xpathctx -> string -> string -> string
-val xpath_int_default : Xml.xpathctx -> string -> int -> int
-val xpath_int64_default : Xml.xpathctx -> string -> int64 -> int64
-(** Parse an xpath expression and return a string/int; if the expression
- doesn't match, return the default. *)
diff --git a/v2v/copy_to_local.ml b/v2v/copy_to_local.ml
index d2471a546..8a64f3a58 100644
--- a/v2v/copy_to_local.ml
+++ b/v2v/copy_to_local.ml
@@ -243,14 +243,14 @@ and parse_libvirt_xml guest_name xml let xpathctx =
Xml.xpath_new_context doc in
Xml.xpath_register_ns xpathctx
"vmware"
"http://libvirt.org/schemas/domain/vmware/1.0";
- let xpath_string = xpath_string xpathctx
- and xpath_string_default = xpath_string_default xpathctx in
+ let xpath_string = xpath_string xpathctx in
(* Get the dcpath, only present for libvirt >= 1.2.20 so use a
* sensible default for older versions.
*)
let dcpath - xpath_string_default
"/domain/vmware:datacenterpath" "ha-datacenter" in
+ Option.default "ha-datacenter"
+ (xpath_string "/domain/vmware:datacenterpath") in
(* Parse the disks. *)
let get_disks, add_disk diff --git a/v2v/parse_libvirt_xml.ml
b/v2v/parse_libvirt_xml.ml
index 2f90bee0c..421175373 100644
--- a/v2v/parse_libvirt_xml.ml
+++ b/v2v/parse_libvirt_xml.ml
@@ -77,10 +77,8 @@ let parse_libvirt_xml ?conn xml let doc = Xml.parse_memory
xml in
let xpathctx = Xml.xpath_new_context doc in
let xpath_string = xpath_string xpathctx
- and xpath_string_default = xpath_string_default xpathctx
and xpath_int = xpath_int xpathctx
- (*and xpath_int_default = xpath_int_default xpathctx*)
- and xpath_int64_default = xpath_int64_default xpathctx in
+ and xpath_int64 = xpath_int64 xpathctx in
let hypervisor match xpath_string "/domain/@type" with
@@ -92,7 +90,8 @@ let parse_libvirt_xml ?conn xml | None | Some
"" ->
error (f_"in the libvirt XML metadata, <name> is missing or
empty")
| Some s -> s in
- let memory = xpath_int64_default "/domain/memory/text()" (1024L *^
1024L) in
+ let memory + Option.default (1024L *^ 1024L) (xpath_int64
"/domain/memory/text()") in
let memory = memory *^ 1024L in
let cpu_vendor = xpath_string "/domain/cpu/vendor/text()" in
@@ -317,7 +316,7 @@ let parse_libvirt_xml ?conn xml (* This is for
testing curl, eg for testing VMware conversions
* without needing VMware around.
*)
- let path = xpath_string_default "source/@name"
"" in
+ let path = Option.default "" (xpath_string
"source/@name") in
let qemu_uri = create_curl_qemu_uri driver host port path in
add_disk qemu_uri format controller P_dont_rewrite
| Some protocol, _, _ ->
diff --git a/v2v/parse_ovf_from_ova.ml b/v2v/parse_ovf_from_ova.ml
index 1c113eca2..1d7c632bc 100644
--- a/v2v/parse_ovf_from_ova.ml
+++ b/v2v/parse_ovf_from_ova.ml
@@ -52,9 +52,7 @@ let parse_ovf_from_ova ovf_filename
let xpath_string = xpath_string xpathctx
and xpath_int = xpath_int xpathctx
- and xpath_string_default = xpath_string_default xpathctx
- and xpath_int_default = xpath_int_default xpathctx
- and xpath_int64_default = xpath_int64_default xpathctx in
+ and xpath_int64 = xpath_int64 xpathctx in
let rec parse_top () (* Search for vm name. *)
@@ -64,11 +62,11 @@ let parse_ovf_from_ova ovf_filename | Some _ as name
-> name in
(* Search for memory. *)
- let memory = xpath_int64_default
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=4]/rasd:VirtualQuantity/text()"
(1024L *^ 1024L) in
+ let memory = Option.default (1024L *^ 1024L) (xpath_int64
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=4]/rasd:VirtualQuantity/text()")
in
let memory = memory *^ 1024L *^ 1024L in
(* Search for number of vCPUs. *)
- let vcpu = xpath_int_default
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=3]/rasd:VirtualQuantity/text()"
1 in
+ let vcpu = Option.default 1 (xpath_int
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/ovf:Item[rasd:ResourceType/text()=3]/rasd:VirtualQuantity/text()")
in
(* CPU topology. coresPerSocket is a VMware proprietary extension.
* I couldn't find out how hyperthreads is specified in the OVF.
@@ -91,7 +89,7 @@ let parse_ovf_from_ova ovf_filename Some sockets,
Some cores_per_socket in
(* BIOS or EFI firmware? *)
- let firmware = xpath_string_default
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/vmw:Config[@vmw:key=\"firmware\"]/@vmw:value"
"bios" in
+ let firmware = Option.default "bios" (xpath_string
"/ovf:Envelope/ovf:VirtualSystem/ovf:VirtualHardwareSection/vmw:Config[@vmw:key=\"firmware\"]/@vmw:value")
in
let firmware match firmware with
| "bios" -> BIOS
@@ -141,7 +139,8 @@ let parse_ovf_from_ova ovf_filename | Some id ->
parent_controller id in
Xml.xpathctx_set_current_context xpathctx n;
- let file_id = xpath_string_default "rasd:HostResource/text()"
"" in
+ let file_id + Option.default "" (xpath_string
"rasd:HostResource/text()") in
let rex = PCRE.compile "^(?:ovf:)?/disk/(.*)" in
if PCRE.matches rex file_id then (
(* Chase the references through to the actual file name. *)
@@ -231,7 +230,8 @@ let parse_ovf_from_ova ovf_filename let n =
Xml.xpathobj_node obj i in
Xml.xpathctx_set_current_context xpathctx n;
let vnet - xpath_string_default
"rasd:ElementName/text()" (sprintf"eth%d" i) in
+ Option.default (sprintf"eth%d" i)
+ (xpath_string "rasd:ElementName/text()") in
let nic = {
s_mac = None;
s_nic_model = None;
--
2.13.2
Richard W.M. Jones
2017-Oct-08 21:26 UTC
Re: [Libguestfs] [PATCH 0/3] common/mlstdutils: Add Std_utils List and Option modules.
On Sun, Oct 08, 2017 at 09:43:58PM +0100, Richard W.M. Jones wrote:> In Std_utils we already extend Char and String. These commits take it > a little further by extending List and adding a new Option submodule. > > All basically simple refactoring.Ooops, I missed out the first commit. I'll post this again including the first commit this time ... Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-builder quickly builds VMs from scratch http://libguestfs.org/virt-builder.1.html
Apparently Analagous Threads
- [[PATCH v2 0/4] common/mlstdutils: Add Std_utils List and Option modules.
- [PATCH v3 0/2] common/mlstdutils: Extend the List module.
- [PATCH v3 0/8] v2v: Move Curl wrapper to mllib and more.
- [PATCH v2 0/8] v2v: Move Curl wrapper to mllib and use it for virt-builder (and more).
- [PATCH v2 0/6] v2v: Pass CPU vendor, model and topology from source to target.