[Libguestfs] [PATCH] daemon: Fix type signature of mount_vfs (RHBZ#1564983).

Reported-by: Yongkui Guo. Fixes commit 82bbd9c8a503661528289589976697d08cb41090. --- daemon/inspect_fs.ml | 6 ++---- daemon/mount.ml | 18 +++++++++--------- daemon/mount.mli | 2 +- 3 files changed, 12 insertions(+), 14 deletions(-) diff --git a/daemon/inspect_fs.ml b/daemon/inspect_fs.ml index 383e3e0a7..02e2060b9 100644 --- a/daemon/inspect_fs.ml +++ b/daemon/inspect_fs.ml @@ -39,14 +39,12 @@ let rec check_for_filesystem_on mountable vfs_type = if vfs_type = "ufs" then ( (* Hack for the *BSDs. *) (* FreeBSD fs is a variant of ufs called ufs2 ... *) try - Mount.mount_vfs (Some "ro,ufstype=ufs2") (Some "ufs") - mountable "/"; + Mount.mount_vfs "ro,ufstype=ufs2" "ufs" mountable "/"; true with _ -> (* while NetBSD and OpenBSD use another variant labeled 44bsd *) try - Mount.mount_vfs (Some "ro,ufstype=44bsd") (Some "ufs") - mountable "/"; + Mount.mount_vfs "ro,ufstype=44bsd" "ufs" mountable "/"; true with _ -> false ) else ( diff --git a/daemon/mount.ml b/daemon/mount.ml index a4e744f7b..e42ea1580 100644 --- a/daemon/mount.ml +++ b/daemon/mount.ml @@ -32,22 +32,22 @@ let mount_vfs options vfs mountable mountpoint = (* -o options *) (match options, mountable.m_type with - | (None | Some ""), (MountableDevice | MountablePath) -> () - | Some options, (MountableDevice | MountablePath) -> + | "", (MountableDevice | MountablePath) -> () + | options, (MountableDevice | MountablePath) -> List.push_back args "-o"; List.push_back args options - | (None | Some ""), MountableBtrfsVol subvol -> + | "", MountableBtrfsVol subvol -> List.push_back args "-o"; List.push_back args ("subvol=" ^ subvol) - | Some options, MountableBtrfsVol subvol -> + | options, MountableBtrfsVol subvol -> List.push_back args "-o"; List.push_back args ("subvol=" ^ subvol ^ "," ^ options) ); (* -t vfs *) (match vfs with - | None | Some "" -> () - | Some t -> + | "" -> () + | t -> List.push_back args "-t"; List.push_back args t ); @@ -57,9 +57,9 @@ let mount_vfs options vfs mountable mountpoint = ignore (command "mount" !args) -let mount = mount_vfs None None -let mount_ro = mount_vfs (Some "ro") None -let mount_options options = mount_vfs (Some options) None +let mount = mount_vfs "" "" +let mount_ro = mount_vfs "ro" "" +let mount_options options = mount_vfs options "" (* Unmount everything mounted under /sysroot. * diff --git a/daemon/mount.mli b/daemon/mount.mli index 553630667..96c400190 100644 --- a/daemon/mount.mli +++ b/daemon/mount.mli @@ -19,6 +19,6 @@ 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 mount_vfs : string -> string -> Mountable.t -> string -> unit val umount_all : unit -> unit -- 2.16.2