This way the Mount module contains only the OCaml implementations of
mount-related daemon APIs.
This is simple refactoring, with no functional changes.
---
daemon/Makefile.am | 2 ++
daemon/inspect.ml | 2 +-
daemon/inspect_fs.ml | 2 +-
daemon/mount.ml | 61 -------------------------------------
daemon/mount.mli | 2 --
daemon/mount_utils.ml | 83 ++++++++++++++++++++++++++++++++++++++++++++++++++
daemon/mount_utils.mli | 19 ++++++++++++
7 files changed, 106 insertions(+), 65 deletions(-)
create mode 100644 daemon/mount_utils.ml
create mode 100644 daemon/mount_utils.mli
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 9cd34ff75..31eec4d33 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -271,6 +271,7 @@ SOURCES_MLI = \
lvm_utils.mli \
md.mli \
mount.mli \
+ mount_utils.mli \
mountable.mli \
optgroups.mli \
parted.mli \
@@ -301,6 +302,7 @@ SOURCES_ML = \
findfs.ml \
md.ml \
mount.ml \
+ mount_utils.ml \
parted.ml \
listfs.ml \
realpath.ml \
diff --git a/daemon/inspect.ml b/daemon/inspect.ml
index 6d4b17815..ce62c17f2 100644
--- a/daemon/inspect.ml
+++ b/daemon/inspect.ml
@@ -27,7 +27,7 @@ open Inspect_types
let re_primary_partition = PCRE.compile "^/dev/(?:h|s|v)d.[1234]$"
let rec inspect_os () =
- Mount.umount_all ();
+ Mount_utils.umount_all ();
(* Iterate over all detected filesystems. Inspect each one in turn. *)
let fses = Listfs.list_filesystems () in
diff --git a/daemon/inspect_fs.ml b/daemon/inspect_fs.ml
index 02e2060b9..da98946af 100644
--- a/daemon/inspect_fs.ml
+++ b/daemon/inspect_fs.ml
@@ -55,7 +55,7 @@ let rec check_for_filesystem_on mountable vfs_type =
if not mounted then None
else (
let role = check_filesystem mountable in
- Mount.umount_all ();
+ Mount_utils.umount_all ();
role
)
) in
diff --git a/daemon/mount.ml b/daemon/mount.ml
index e42ea1580..4fe85d3b6 100644
--- a/daemon/mount.ml
+++ b/daemon/mount.ml
@@ -60,64 +60,3 @@ let mount_vfs options vfs mountable mountpoint =
let mount = mount_vfs "" ""
let mount_ro = mount_vfs "ro" ""
let mount_options options = mount_vfs options ""
-
-(* Unmount everything mounted under /sysroot.
- *
- * We have to unmount in the correct order, so we sort the paths by
- * longest first to ensure that child paths are unmounted by parent
- * paths.
- *
- * This call is more important than it appears at first, because it
- * is widely used by both test and production code in order to
- * get back to a known state (nothing mounted, everything synchronized).
- *)
-let rec umount_all () =
- (* This is called from internal_autosync and generally as a cleanup
- * function, and since the umount will definitely fail if any
- * handles are open, we may as well close them.
- *)
- (* XXX
- aug_finalize ();
- hivex_finalize ();
- journal_finalize ();
- *)
-
- let sysroot = Sysroot.sysroot () in
- let sysroot_len = String.length sysroot in
-
- let info = read_whole_file "/proc/self/mountinfo" in
- let info = String.nsplit "\n" info in
-
- let mps = ref [] in
- List.iter (
- fun line ->
- let line = String.nsplit " " line in
- (* The field of interest is the 5th field. Whitespace is escaped
- * with octal sequences like \040 (for space).
- * See fs/seq_file.c:mangle_path.
- *)
- if List.length line >= 5 then (
- let mp = List.nth line 4 in
- let mp = proc_unmangle_path mp in
-
- (* Allow a mount directory like "/sysroot" or "/sysroot/..."
*)
- if (sysroot_len > 0 && String.is_prefix mp sysroot) ||
- (String.is_prefix mp sysroot &&
- String.length mp > sysroot_len &&
- mp.[sysroot_len] = '/') then
- List.push_front mp mps
- )
- ) info;
-
- let mps = !mps in
- let mps = List.sort compare_longest_first mps in
-
- (* Unmount them. *)
- List.iter (
- fun mp -> ignore (command "umount" [mp])
- ) mps
-
-and compare_longest_first s1 s2 =
- let n1 = String.length s1 in
- let n2 = String.length s2 in
- n2 - n1
diff --git a/daemon/mount.mli b/daemon/mount.mli
index 96c400190..9fa5b76e7 100644
--- a/daemon/mount.mli
+++ b/daemon/mount.mli
@@ -20,5 +20,3 @@ val mount : Mountable.t -> string -> unit
val mount_ro : Mountable.t -> string -> unit
val mount_options : string -> Mountable.t -> string -> unit
val mount_vfs : string -> string -> Mountable.t -> string -> unit
-
-val umount_all : unit -> unit
diff --git a/daemon/mount_utils.ml b/daemon/mount_utils.ml
new file mode 100644
index 000000000..a53959de3
--- /dev/null
+++ b/daemon/mount_utils.ml
@@ -0,0 +1,83 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2018 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Std_utils
+
+open Mountable
+open Utils
+
+(* Unmount everything mounted under /sysroot.
+ *
+ * We have to unmount in the correct order, so we sort the paths by
+ * longest first to ensure that child paths are unmounted by parent
+ * paths.
+ *
+ * This call is more important than it appears at first, because it
+ * is widely used by both test and production code in order to
+ * get back to a known state (nothing mounted, everything synchronized).
+ *)
+let rec umount_all () =
+ (* This is called from internal_autosync and generally as a cleanup
+ * function, and since the umount will definitely fail if any
+ * handles are open, we may as well close them.
+ *)
+ (* XXX
+ aug_finalize ();
+ hivex_finalize ();
+ journal_finalize ();
+ *)
+
+ let sysroot = Sysroot.sysroot () in
+ let sysroot_len = String.length sysroot in
+
+ let info = read_whole_file "/proc/self/mountinfo" in
+ let info = String.nsplit "\n" info in
+
+ let mps = ref [] in
+ List.iter (
+ fun line ->
+ let line = String.nsplit " " line in
+ (* The field of interest is the 5th field. Whitespace is escaped
+ * with octal sequences like \040 (for space).
+ * See fs/seq_file.c:mangle_path.
+ *)
+ if List.length line >= 5 then (
+ let mp = List.nth line 4 in
+ let mp = proc_unmangle_path mp in
+
+ (* Allow a mount directory like "/sysroot" or "/sysroot/..."
*)
+ if (sysroot_len > 0 && String.is_prefix mp sysroot) ||
+ (String.is_prefix mp sysroot &&
+ String.length mp > sysroot_len &&
+ mp.[sysroot_len] = '/') then
+ List.push_front mp mps
+ )
+ ) info;
+
+ let mps = !mps in
+ let mps = List.sort compare_longest_first mps in
+
+ (* Unmount them. *)
+ List.iter (
+ fun mp -> ignore (command "umount" [mp])
+ ) mps
+
+and compare_longest_first s1 s2 =
+ let n1 = String.length s1 in
+ let n2 = String.length s2 in
+ n2 - n1
diff --git a/daemon/mount_utils.mli b/daemon/mount_utils.mli
new file mode 100644
index 000000000..72421adfa
--- /dev/null
+++ b/daemon/mount_utils.mli
@@ -0,0 +1,19 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2018 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+val umount_all : unit -> unit
--
2.14.3