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

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