[Libguestfs] [PATCH v9 04/11] daemon: Implement umount_all in OCaml.

Unlike previous ‘daemon: Reimplement ...’ patches, this does not reimplement the umount_all API completely (yet, but this implementation could be completed in future and then replace the C one). However it is necessary to have a version of umount_all which we can call from the OCaml inspection code. --- daemon/mount.ml | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ daemon/mount.mli | 2 ++ 2 files changed, 63 insertions(+) diff --git a/daemon/mount.ml b/daemon/mount.ml index 4bb74fb82..40c81be0e 100644 --- a/daemon/mount.ml +++ b/daemon/mount.ml @@ -60,3 +60,64 @@ let mount_vfs options vfs mountable mountpoint = let mount = mount_vfs None None let mount_ro = mount_vfs (Some "ro") None let mount_options options = mount_vfs (Some options) None + +(* 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 + 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 e43d97c42..abf538521 100644 --- a/daemon/mount.mli +++ b/daemon/mount.mli @@ -20,3 +20,5 @@ 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 option -> string option -> Mountable.t -> string -> unit + +val umount_all : unit -> unit -- 2.13.2