Introduce and use a new inspect_mount_root function to mount all the
mountpoints of a root in the guest, replacing the same code doing that
in different tools.
inspect_mount_root_ro is inspect_mount_root with readonly mount option.
---
builder/builder.ml | 10 +---------
customize/customize_main.ml | 9 +--------
get-kernel/get_kernel.ml | 9 +--------
mllib/common_utils.ml | 18 ++++++++++++++++++
mllib/common_utils.mli | 11 +++++++++++
sysprep/main.ml | 12 +-----------
v2v/test-harness/v2v_test_harness.ml | 9 +--------
7 files changed, 34 insertions(+), 44 deletions(-)
diff --git a/builder/builder.ml b/builder/builder.ml
index 1f9a472..debd7e3 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -664,15 +664,7 @@ let main () =
let root =
match Array.to_list (g#inspect_os ()) with
| [root] ->
- let mps = g#inspect_get_mountpoints root in
- let cmp (a,_) (b,_) =
- compare (String.length a) (String.length b) in
- let mps = List.sort cmp mps in
- List.iter (
- fun (mp, dev) ->
- try g#mount dev mp
- with G.Error msg -> warning (f_"%s (ignored)") msg
- ) mps;
+ inspect_mount_root g root;
root
| _ ->
error (f_"no guest operating systems or multiboot OS found in this disk
image\nThis is a failure of the source repository. Use -v for more information.")
diff --git a/customize/customize_main.ml b/customize/customize_main.ml
index 13d40bc..55cff2d 100644
--- a/customize/customize_main.ml
+++ b/customize/customize_main.ml
@@ -197,14 +197,7 @@ read the man page virt-customize(1).
(* Mount up the disks, like guestfish -i.
* See [ocaml/examples/inspect_vm.ml].
*)
- let mps = g#inspect_get_mountpoints root in
- let cmp (a,_) (b,_) = compare (String.length a) (String.length b) in
- let mps = List.sort cmp mps in
- List.iter (
- fun (mp, dev) ->
- try g#mount dev mp;
- with Guestfs.Error msg -> warning (f_"%s (ignored)") msg
- ) mps;
+ inspect_mount_root g root;
(* Do the customization. *)
Customize_run.run g root ops;
diff --git a/get-kernel/get_kernel.ml b/get-kernel/get_kernel.ml
index 6f26ca4..ed88d11 100644
--- a/get-kernel/get_kernel.ml
+++ b/get-kernel/get_kernel.ml
@@ -122,14 +122,7 @@ read the man page virt-get-kernel(1).
let rec do_fetch ~transform_fn ~outputdir g root =
(* Mount up the disks. *)
- let mps = g#inspect_get_mountpoints root in
- let cmp (a,_) (b,_) = compare (String.length a) (String.length b) in
- let mps = List.sort cmp mps in
- List.iter (
- fun (mp, dev) ->
- try g#mount_ro dev mp
- with Guestfs.Error msg -> warning (f_"%s (ignored)") msg
- ) mps;
+ inspect_mount_root_ro g root;
let files =
let typ = g#inspect_get_type root in
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 6bf99cd..de83dd7 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -833,3 +833,21 @@ let read_first_line_from_file filename =
let is_regular_file path = (* NB: follows symlinks. *)
try (Unix.stat path).Unix.st_kind = Unix.S_REG
with Unix.Unix_error _ -> false
+
+let inspect_mount_root g ?mount_opts_fn root =
+ let mps = g#inspect_get_mountpoints root in
+ let cmp (a,_) (b,_) =
+ compare (String.length a) (String.length b) in
+ let mps = List.sort cmp mps in
+ List.iter (
+ fun (mp, dev) ->
+ let mountfn =
+ match mount_opts_fn with
+ | Some fn -> g#mount_options (fn mp)
+ | None -> g#mount in
+ try mountfn dev mp
+ with Guestfs.Error msg -> warning (f_"%s (ignored)") msg
+ ) mps
+
+let inspect_mount_root_ro =
+ inspect_mount_root ~mount_opts_fn:(fun _ -> "ro")
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
index 7172da9..68b4c1d 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -273,3 +273,14 @@ val read_first_line_from_file : string -> string
val is_regular_file : string -> bool
(** Checks whether the file is a regular file. *)
+
+val inspect_mount_root : Guestfs.guestfs -> ?mount_opts_fn:(string -> string) ->
string -> unit
+(** Mounts all the mount points of the specified root, just like
+ [guestfish -i] does.
+
+ [mount_opts_fn] represents a function providing the mount options
+ for each mount point. *)
+
+val inspect_mount_root_ro : Guestfs.guestfs -> string -> unit
+(** Like [inspect_mount_root], but mounting every mount point as
+ read-only. *)
diff --git a/sysprep/main.ml b/sysprep/main.ml
index 4849311..1441619 100644
--- a/sysprep/main.ml
+++ b/sysprep/main.ml
@@ -227,17 +227,7 @@ read the man page virt-sysprep(1).
(* Mount up the disks, like guestfish -i.
* See [ocaml/examples/inspect_vm.ml].
*)
- let mps = g#inspect_get_mountpoints root in
- let cmp (a,_) (b,_) = compare (String.length a) (String.length b) in
- let mps = List.sort cmp mps in
- List.iter (
- fun (mp, dev) ->
- (* Get mount options for this mountpoint. *)
- let opts = mount_opts mp in
-
- try g#mount_options opts dev mp;
- with Guestfs.Error msg -> warning (f_"%s (ignored)") msg
- ) mps;
+ inspect_mount_root ~mount_opts_fn:mount_opts g root;
let side_effects = new Sysprep_operation.filesystem_side_effects in
diff --git a/v2v/test-harness/v2v_test_harness.ml b/v2v/test-harness/v2v_test_harness.ml
index d5b53fa..70ce73e 100644
--- a/v2v/test-harness/v2v_test_harness.ml
+++ b/v2v/test-harness/v2v_test_harness.ml
@@ -86,14 +86,7 @@ let run ~test ?input_disk ?input_xml ?(test_plan = default_plan) () =
| _ ->
failwithf "multiple roots found in disk image %s" filename in
- let mps = g#inspect_get_mountpoints root in
- let cmp (a,_) (b,_) = compare (String.length a) (String.length b) in
- let mps = List.sort cmp mps in
- List.iter (
- fun (mp, dev) ->
- try g#mount_ro dev mp
- with G.Error msg -> eprintf "%s (ignored)\n" msg
- ) mps;
+ inspect_mount_root_ro g root;
g, root
in
--
2.5.0