[Libguestfs] [PATCH v6 31/41] daemon: Reimplement ‘btrfs_subvolume_list’ and ‘btrfs_subvolume_get_default’ in OCaml.

Richard W.M. Jones
Thu, 15 Jun 2017 17:06:21 -0000

---
 daemon/Makefile.am        |   2 +
 daemon/btrfs.c            | 175 ----------------------------------------------
 daemon/btrfs.ml           | 127 +++++++++++++++++++++++++++++++++
 daemon/btrfs.mli          |  26 +++++++
 generator/actions_core.ml |   2 +
 generator/daemon.ml       |   5 +-
 6 files changed, 160 insertions(+), 177 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 02afabcab..439c71bd3 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -259,6 +259,7 @@ guestfsd_CFLAGS = \
 # https://caml.inria.fr/pub/docs/manual-ocaml/intfc.html
 SOURCES_MLI = \
 	blkid.mli \
+	btrfs.mli \
 	chroot.mli \
 	sysroot.mli \
 	devsparts.mli \
@@ -283,6 +284,7 @@ SOURCES_ML = \
 	mountable.ml \
 	chroot.ml \
 	blkid.ml \
+	btrfs.ml \
 	devsparts.ml \
 	file.ml \
 	filearch.ml \
diff --git a/daemon/btrfs.c b/daemon/btrfs.c
index 4f52b71e8..d9043d53c 100644
--- a/daemon/btrfs.c
+++ b/daemon/btrfs.c
@@ -41,11 +41,6 @@ GUESTFSD_EXT_CMD(str_mount, mount);
 GUESTFSD_EXT_CMD(str_umount, umount);
 GUESTFSD_EXT_CMD(str_btrfsimage, btrfs-image);

-COMPILE_REGEXP (re_btrfs_subvolume_list,
-                "ID\\s+(\\d+).*\\s"
-                "top level\\s+(\\d+).*\\s"
-                "path\\s(.*)",
-                0)
 COMPILE_REGEXP (re_btrfs_balance_status, "Balance on '.*' is
(.*)", 0)

 int
@@ -483,137 +478,6 @@ umount (char *fs_buf, const mountable_t *fs)
   return 0;
 }

-guestfs_int_btrfssubvolume_list *
-do_btrfs_subvolume_list (const mountable_t *fs)
-{
-  CLEANUP_FREE_STRING_LIST char **lines = NULL;
-  size_t i = 0;
-  const size_t MAX_ARGS = 64;
-  const char *argv[MAX_ARGS];
-
-  /* Execute 'btrfs subvolume list <fs>', and split the output
into lines */
-  {
-    char *fs_buf = mount (fs);
-
-    if (!fs_buf)
-      return NULL;
-
-    ADD_ARG (argv, i, str_btrfs);
-    ADD_ARG (argv, i, "subvolume");
-    ADD_ARG (argv, i, "list");
-    ADD_ARG (argv, i, fs_buf);
-    ADD_ARG (argv, i, NULL);
-
-    CLEANUP_FREE char *out = NULL, *errout = NULL;
-    int r = commandv (&out, &errout, argv);
-
-    if (umount (fs_buf, fs) != 0)
-      return NULL;
-
-    if (r == -1) {
-      CLEANUP_FREE char *fs_desc = mountable_to_string (fs);
-      if (fs_desc == NULL) {
-        fprintf (stderr, "malloc: %m");
-      }
-      reply_with_error ("%s: %s", fs_desc ? fs_desc :
"malloc", errout);
-      return NULL;
-    }
-
-    lines = split_lines (out);
-    if (!lines) return NULL;
-  }
-
-  /* Output is:
-   *
-   * ID 256 gen 30 top level 5 path test1
-   * ID 257 gen 30 top level 5 path dir/test2
-   * ID 258 gen 30 top level 5 path test3
-   *
-   * "ID <n>" is the subvolume ID.
-   * "gen <n>" is the generation when the root was created or
last
-   * updated.
-   * "top level <n>" is the top level subvolume ID.
-   * "path <str>" is the subvolume path, relative to the top of
the
-   * filesystem.
-   *
-   * Note that the order that each of the above is fixed, but
-   * different versions of btrfs may display different sets of data.
-   * Specifically, older versions of btrfs do not display gen.
-   */
-
-  guestfs_int_btrfssubvolume_list *ret = NULL;
-
-  const size_t nr_subvolumes = guestfs_int_count_strings (lines);
-
-  ret = malloc (sizeof *ret);
-  if (!ret) {
-    reply_with_perror ("malloc");
-    return NULL;
-  }
-
-  ret->guestfs_int_btrfssubvolume_list_len = nr_subvolumes;
-  ret->guestfs_int_btrfssubvolume_list_val -    calloc (nr_subvolumes,
sizeof (struct guestfs_int_btrfssubvolume));
-  if (ret->guestfs_int_btrfssubvolume_list_val == NULL) {
-    reply_with_perror ("calloc");
-    goto error;
-  }
-
-  for (i = 0; i < nr_subvolumes; ++i) {
-    /* To avoid allocations, reuse the 'line' buffer to store the
-     * path.  Thus we don't need to free 'line', since it will be
-     * freed by the calling (XDR) code.
-     */
-    char *line = lines[i];
-#define N_MATCHES 4
-    int ovector[N_MATCHES * 3];
-
-    if (pcre_exec (re_btrfs_subvolume_list, NULL, line, strlen (line), 0, 0,
-                   ovector, N_MATCHES * 3) < 0)
-#undef N_MATCHES
-      {
-      unexpected_output:
-	reply_with_error ("unexpected output from 'btrfs subvolume list'
command: %s", line);
-	goto error;
-      }
-
-    struct guestfs_int_btrfssubvolume *this -
&ret->guestfs_int_btrfssubvolume_list_val[i];
-
-#if __WORDSIZE == 64
-#define XSTRTOU64 xstrtoul
-#else
-#define XSTRTOU64 xstrtoull
-#endif
-
-    if (XSTRTOU64 (line + ovector[2], NULL, 10,
-                   &this->btrfssubvolume_id, NULL) != LONGINT_OK)
-      goto unexpected_output;
-    if (XSTRTOU64 (line + ovector[4], NULL, 10,
-                   &this->btrfssubvolume_top_level_id, NULL) !=
LONGINT_OK)
-      goto unexpected_output;
-
-#undef XSTRTOU64
-
-    this->btrfssubvolume_path -      strndup (line + ovector[6], ovector[7]
- ovector[6]);
-    if (this->btrfssubvolume_path == NULL)
-      goto error;
-  }
-
-  return ret;
-
- error:
-  if (ret->guestfs_int_btrfssubvolume_list_val) {
-    for (i = 0; i < nr_subvolumes; ++i)
-      free
(ret->guestfs_int_btrfssubvolume_list_val[i].btrfssubvolume_path);
-    free (ret->guestfs_int_btrfssubvolume_list_val);
-  }
-  free (ret);
-
-  return NULL;
-}
-
 int
 do_btrfs_subvolume_set_default (int64_t id, const char *fs)
 {
@@ -649,45 +513,6 @@ do_btrfs_subvolume_set_default (int64_t id, const char *fs)
   return 0;
 }

-int64_t
-do_btrfs_subvolume_get_default (const mountable_t *fs)
-{
-  const size_t MAX_ARGS = 64;
-  const char *argv[MAX_ARGS];
-  size_t i = 0;
-  char *fs_buf = NULL;
-  CLEANUP_FREE char *err = NULL;
-  CLEANUP_FREE char *out = NULL;
-  int r;
-  int64_t ret = -1;
-
-  fs_buf = mount (fs);
-  if (fs_buf == NULL)
-    goto error;
-
-  ADD_ARG (argv, i, str_btrfs);
-  ADD_ARG (argv, i, "subvolume");
-  ADD_ARG (argv, i, "get-default");
-  ADD_ARG (argv, i, fs_buf);
-  ADD_ARG (argv, i, NULL);
-
-  r = commandv (&out, &err, argv);
-  if (r == -1) {
-    reply_with_error ("%s: %s", fs_buf, err);
-    goto error;
-  }
-  if (sscanf (out, "ID %" SCNi64, &ret) != 1) {
-    reply_with_error ("%s: could not parse subvolume id: %s",
argv[0], out);
-    ret = -1;
-    goto error;
-  }
-
- error:
-  if (fs_buf && umount (fs_buf, fs) != 0)
-    return -1;
-  return ret;
-}
-
 int
 do_btrfs_filesystem_sync (const char *fs)
 {
diff --git a/daemon/btrfs.ml b/daemon/btrfs.ml
new file mode 100644
index 000000000..554212ccf
--- /dev/null
+++ b/daemon/btrfs.ml
@@ -0,0 +1,127 @@
+(* 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 Printf
+open Scanf
+open Unix
+
+open Std_utils
+
+open Mountable
+open Utils
+
+include Structs
+
+(* In order to examine subvolumes, quota and other things, the btrfs
+ * filesystem has to be mounted.  However we're passed a mountable
+ * in these cases, so we must mount the filesystem.  But we cannot
+ * mount it under the sysroot, as something else might be mounted
+ * there so this function mounts the filesystem on a temporary
+ * directory and ensures it is always unmounted afterwards.
+ *)
+let with_mounted mountable f +  let tmpdir = sprintf "/tmp/%s"
(String.random8 ()) in
+  (* This is the cleanup function which is called to unmount and
+   * remove the temporary directory.  This is called on error and
+   * ordinary exit paths.
+   *)
+  let finally () +    ignore (Sys.command (sprintf "umount %s" (quote
tmpdir)));
+    rmdir tmpdir
+  in
+
+  match mountable.m_type with
+  | MountablePath ->
+     (* This corner-case happens for Mountable_or_Path parameters, where
+      * a path was supplied by the caller.  The path (the m_device
+      * field) is relative to the sysroot.
+      *)
+     f (Sysroot.sysroot () // mountable.m_device)
+
+  | MountableDevice ->
+     protect ~finally ~f:(
+       fun () ->
+         mkdir tmpdir 0o700;
+         ignore (command "mount" [mountable.m_device; tmpdir]);
+         f tmpdir
+     )
+
+  | MountableBtrfsVol subvol ->
+     protect ~finally ~f:(
+       fun () ->
+         mkdir tmpdir 0o700;
+         ignore (command "mount" ["-o"; "subvol="
^ subvol (* XXX quoting? *);
+                                  mountable.m_device; tmpdir]);
+         f tmpdir
+     )
+
+let re_btrfs_subvolume_list +  Str.regexp ("ID[ \t]+\\([0-9]+\\).*[
\t]" ^
+              "top level[ \t]+\\([0-9]+\\).*[ \t]" ^
+              "path[ \t]+\\(.*\\)")
+
+let btrfs_subvolume_list mountable +  (* Execute 'btrfs subvolume list
<fs>', and split the output into lines *)
+  let lines +    with_mounted mountable (
+      fun mp -> command "btrfs" ["subvolume";
"list"; mp]
+    ) in
+  let lines = String.nsplit "\n" lines in
+
+  (* Output is:
+   *
+   * ID 256 gen 30 top level 5 path test1
+   * ID 257 gen 30 top level 5 path dir/test2
+   * ID 258 gen 30 top level 5 path test3
+   *
+   * "ID <n>" is the subvolume ID.
+   * "gen <n>" is the generation when the root was created or
last
+   * updated.
+   * "top level <n>" is the top level subvolume ID.
+   * "path <str>" is the subvolume path, relative to the top of
the
+   * filesystem.
+   *
+   * Note that the order that each of the above is fixed, but
+   * different versions of btrfs may display different sets of data.
+   * Specifically, older versions of btrfs do not display gen.
+   *)
+  filter_map (
+    fun line ->
+      if line = "" then None
+      else if Str.string_match re_btrfs_subvolume_list line 0 then (
+        let id = Int64.of_string (Str.matched_group 1 line)
+        and top_level_id = Int64.of_string (Str.matched_group 2 line)
+        and path = Str.matched_group 3 line in
+
+        Some {
+          btrfssubvolume_id = id;
+          btrfssubvolume_top_level_id = top_level_id;
+          btrfssubvolume_path = path
+        }
+      )
+      else
+        failwithf "unexpected output from 'btrfs subvolume list'
command: %s"
+                  line
+  ) lines
+
+let btrfs_subvolume_get_default mountable +  let out +    with_mounted
mountable (
+      fun mp -> command "btrfs" ["subvolume";
"get-default"; mp]
+    ) in
+  sscanf out "ID %Ld" identity
diff --git a/daemon/btrfs.mli b/daemon/btrfs.mli
new file mode 100644
index 000000000..55a38e42d
--- /dev/null
+++ b/daemon/btrfs.mli
@@ -0,0 +1,26 @@
+(* 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.
+ *)
+
+type btrfssubvolume = {
+  btrfssubvolume_id : int64;
+  btrfssubvolume_top_level_id : int64;
+  btrfssubvolume_path : string;
+}
+
+val btrfs_subvolume_list : Mountable.t -> btrfssubvolume list
+val btrfs_subvolume_get_default : Mountable.t -> int64
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index 140ba6c1b..bd3c21d3b 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -7304,6 +7304,7 @@ created subvolume will be added to." };
   { defaults with
     name = "btrfs_subvolume_list"; added = (1, 17, 35);
     style = RStructList ("subvolumes", "btrfssubvolume"),
[String (Mountable_or_Path, "fs")], [];
+    impl = OCaml "Btrfs.btrfs_subvolume_list";
     optional = Some "btrfs"; camel_name =
"BTRFSSubvolumeList";
     test_excuse = "tested in tests/btrfs";
     shortdesc = "list btrfs snapshots and subvolumes";
@@ -8783,6 +8784,7 @@ This uses the L<blockdev(8)> command." };
   { defaults with
     name = "btrfs_subvolume_get_default"; added = (1, 29, 17);
     style = RInt64 "id", [String (Mountable_or_Path,
"fs")], [];
+    impl = OCaml "Btrfs.btrfs_subvolume_get_default";
     optional = Some "btrfs"; camel_name =
"BTRFSSubvolumeGetDefault";
     tests = [
       InitPartition, Always, TestResult (
diff --git a/generator/daemon.ml b/generator/daemon.ml
index 8cac5ccb1..83994e9d3 100644
--- a/generator/daemon.ml
+++ b/generator/daemon.ml
@@ -758,7 +758,7 @@ return_string_list (value retv)
            | Int64 n -> pr "caml_copy_int64 (%s)" n
            | String ((PlainString|Device|Pathname|Dev_or_Path), n) ->
               pr "caml_copy_string (%s)" n
-           | String (Mountable, n) ->
+           | String ((Mountable|Mountable_or_Path), n) ->
               pr "copy_mountable (%s)" n
            | String _ -> assert false
            | OptString _ -> assert false
@@ -797,7 +797,8 @@ return_string_list (value retv)
           pr "  CAMLreturnT (int, 0);\n"
        | RInt _ ->
           pr "  CAMLreturnT (int, Int_val (retv));\n"
-       | RInt64 _ -> assert false
+       | RInt64 _ ->
+          pr "  CAMLreturnT (int, Int64_val (retv));\n"
        | RBool _ ->
           pr "  CAMLreturnT (int, Bool_val (retv));\n"
        | RConstString _ -> assert false
--
2.13.0