daemon: Reimplement ‘mount’, ‘mount_ro’, ‘mount_options’, ‘mount_vfs’ APIs in OCaml.

Some of the oldest and most core APIs, reimplemented.

This also moves the strange ‘mount_vfs_nochroot’ function into
btrfs.c.

daemon/Makefile.am

@@ -249,6 +249,7 @@ SOURCES_MLI = \
 	file.mli \
 	is.mli \
 	link.mli \
+	mount.mli \
 	mountable.mli \
 	utils.mli
 
@@ -265,6 +266,7 @@ SOURCES_ML = \
 	file.ml \
 	is.ml \
 	link.ml \
+	mount.ml \
 	callbacks.ml \
 	daemon.ml
 

daemon/btrfs.c

@@ -380,6 +380,48 @@ do_btrfs_subvolume_create (const char *dest, const char *qgroupid)
   return 0;
 }
 
+static int
+mount_vfs_nochroot (const char *options, const char *vfstype,
+                    const mountable_t *mountable,
+                    const char *mp, const char *user_mp)
+{
+  CLEANUP_FREE char *options_plus = NULL;
+  const char *device = mountable->device;
+  if (mountable->type == MOUNTABLE_BTRFSVOL) {
+    if (options && strlen (options) > 0) {
+      if (asprintf (&options_plus, "subvol=%s,%s",
+                    mountable->volume, options) == -1) {
+        reply_with_perror ("asprintf");
+        return -1;
+      }
+    }
+    else {
+      if (asprintf (&options_plus, "subvol=%s", mountable->volume) == -1) {
+        reply_with_perror ("asprintf");
+        return -1;
+      }
+    }
+  }
+
+  CLEANUP_FREE char *error = NULL;
+  int r;
+  if (vfstype)
+    r = command (NULL, &error,
+                 "mount", "-o", options_plus ? options_plus : options,
+                 "-t", vfstype, device, mp, NULL);
+  else
+    r = command (NULL, &error,
+                 "mount", "-o", options_plus ? options_plus : options,
+                 device, mp, NULL);
+  if (r == -1) {
+    reply_with_error ("%s on %s (options: '%s'): %s",
+                      device, user_mp, options, error);
+    return -1;
+  }
+
+  return 0;
+}
+
 static char *
 mount (const mountable_t *fs)
 {

daemon/daemon.h

@@ -109,9 +109,6 @@ extern void cleanup_free_stringsbuf (void *ptr);
 #endif
 
 /* mount.c */
-extern int mount_vfs_nochroot (const char *options, const char *vfstype,
-                               const mountable_t *mountable,
-                               const char *mp, const char *user_mp);
 extern int is_root_mounted (void);
 extern int is_device_mounted (const char *device);
 

daemon/mount.c

@@ -108,105 +108,6 @@ is_device_mounted (const char *device)
   return 0;
 }
 
-/* The "simple mount" call offers no complex options, you can just
- * mount a device on a mountpoint.  The variations like mount_ro,
- * mount_options and mount_vfs let you set progressively more things.
- *
- * It's tempting to try a direct mount(2) syscall, but that doesn't
- * do any autodetection, so we are better off calling out to
- * /bin/mount.
- */
-
-int
-do_mount_vfs (const char *options, const char *vfstype,
-              const mountable_t *mountable, const char *mountpoint)
-{
-  CLEANUP_FREE char *mp = NULL;
-  struct stat statbuf;
-
-  ABS_PATH (mountpoint, 0, return -1);
-
-  mp = sysroot_path (mountpoint);
-  if (!mp) {
-    reply_with_perror ("malloc");
-    return -1;
-  }
-
-  /* Check the mountpoint exists and is a directory. */
-  if (stat (mp, &statbuf) == -1) {
-    reply_with_perror ("mount: %s", mountpoint);
-    return -1;
-  }
-  if (!S_ISDIR (statbuf.st_mode)) {
-    reply_with_perror ("mount: %s: mount point is not a directory", mountpoint);
-    return -1;
-  }
-
-  return mount_vfs_nochroot (options, vfstype, mountable, mp, mountpoint);
-}
-
-int
-mount_vfs_nochroot (const char *options, const char *vfstype,
-                    const mountable_t *mountable,
-                    const char *mp, const char *user_mp)
-{
-  CLEANUP_FREE char *options_plus = NULL;
-  const char *device = mountable->device;
-  if (mountable->type == MOUNTABLE_BTRFSVOL) {
-    if (options && strlen (options) > 0) {
-      if (asprintf (&options_plus, "subvol=%s,%s",
-                    mountable->volume, options) == -1) {
-        reply_with_perror ("asprintf");
-        return -1;
-      }
-    }
-    
-    else {
-      if (asprintf (&options_plus, "subvol=%s", mountable->volume) == -1) {
-        reply_with_perror ("asprintf");
-        return -1;
-      }
-    }
-  }
-
-  CLEANUP_FREE char *error = NULL;
-  int r;
-  if (vfstype)
-    r = command (NULL, &error,
-                 "mount", "-o", options_plus ? options_plus : options,
-                 "-t", vfstype, device, mp, NULL);
-  else
-    r = command (NULL, &error,
-                 "mount", "-o", options_plus ? options_plus : options,
-                 device, mp, NULL);
-  if (r == -1) {
-    reply_with_error ("%s on %s (options: '%s'): %s",
-                      device, user_mp, options, error);
-    return -1;
-  }
-
-  return 0;
-}
-
-int
-do_mount (const mountable_t *mountable, const char *mountpoint)
-{
-  return do_mount_vfs ("", NULL, mountable, mountpoint);
-}
-
-int
-do_mount_ro (const mountable_t *mountable, const char *mountpoint)
-{
-  return do_mount_vfs ("ro", NULL, mountable, mountpoint);
-}
-
-int
-do_mount_options (const char *options, const mountable_t *mountable,
-                  const char *mountpoint)
-{
-  return do_mount_vfs (options, NULL, mountable, mountpoint);
-}
-
 /* Takes optional arguments, consult optargs_bitmask. */
 int
 do_umount (const char *pathordevice,

daemon/mount.ml

@@ -0,0 +1,62 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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
+
+let mount_vfs options vfs mountable mountpoint =
+  let mp = Sysroot.sysroot_path mountpoint in
+
+  (* Check the mountpoint exists and is a directory. *)
+  if not (is_directory mp) then
+    failwithf "mount: %s: mount point is not a directory" mountpoint;
+
+  let args = ref [] in
+
+  (* -o options *)
+  (match options, mountable.m_type with
+   | (None | Some ""), (MountableDevice | MountablePath) -> ()
+   | Some options, (MountableDevice | MountablePath) ->
+      push_back args "-o";
+      push_back args options
+   | (None | Some ""), MountableBtrfsVol subvol ->
+      push_back args "-o";
+      push_back args ("subvol=" ^ subvol)
+   | Some options, MountableBtrfsVol subvol ->
+      push_back args "-o";
+      push_back args ("subvol=" ^ subvol ^ "," ^ options)
+  );
+
+  (* -t vfs *)
+  (match vfs with
+   | None | Some "" -> ()
+   | Some t ->
+      push_back args "-t";
+      push_back args t
+  );
+
+  push_back args mountable.m_device;
+  push_back args mp;
+
+  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

daemon/mount.mli

@@ -0,0 +1,22 @@
+(* guestfs-inspection
+ * Copyright (C) 2009-2017 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 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

generator/actions_core.ml

@@ -1739,6 +1739,7 @@ let daemon_functions = [
   { defaults with
     name = "mount"; added = (0, 0, 3);
     style = RErr, [String (Mountable, "mountable"); String (PlainString, "mountpoint")], [];
+    impl = OCaml "Mount.mount";
     tests = [
       InitEmpty, Always, TestResultString (
         [["part_disk"; "/dev/sda"; "mbr"];
@@ -2922,6 +2923,7 @@ If set to true, POSIX ACLs are saved in the output tar.
   { defaults with
     name = "mount_ro"; added = (1, 0, 10);
     style = RErr, [String (Mountable, "mountable"); String (PlainString, "mountpoint")], [];
+    impl = OCaml "Mount.mount_ro";
     tests = [
       InitBasicFS, Always, TestLastFail (
         [["umount"; "/"; "false"; "false"];
@@ -2941,6 +2943,7 @@ mounts the filesystem with the read-only (I<-o ro>) flag." };
   { defaults with
     name = "mount_options"; added = (1, 0, 10);
     style = RErr, [String (PlainString, "options"); String (Mountable, "mountable"); String (PlainString, "mountpoint")], [];
+    impl = OCaml "Mount.mount_options";
     shortdesc = "mount a guest disk with mount options";
     longdesc = "\
 This is the same as the C<guestfs_mount> command, but it
@@ -2954,6 +2957,7 @@ the filesystem uses)." };
   { defaults with
     name = "mount_vfs"; added = (1, 0, 10);
     style = RErr, [String (PlainString, "options"); String (PlainString, "vfstype"); String (Mountable, "mountable"); String (PlainString, "mountpoint")], [];
+    impl = OCaml "Mount.mount_vfs";
     shortdesc = "mount a guest disk with mount options and vfstype";
     longdesc = "\
 This is the same as the C<guestfs_mount> command, but it