[Libguestfs] [PATCH v6 34/41] daemon: Reimplement ‘findfs_uuid’ and ‘findfs_label’ APIs in OCaml.

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

---
 daemon/Makefile.am        |  3 +-
 daemon/findfs.c           | 94 -----------------------------------------------
 daemon/findfs.ml          | 56 ++++++++++++++++++++++++++++
 daemon/findfs.mli         | 20 ++++++++++
 daemon/lvm.c              | 31 ++++++++++++++++
 daemon/lvm.ml             |  3 ++
 daemon/lvm.mli            |  8 ++++
 docs/C_SOURCE_FILES       |  1 -
 generator/actions_core.ml |  2 +
 9 files changed, 122 insertions(+), 96 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index a3c486046..15b78d6d8 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -108,7 +108,6 @@ guestfsd_SOURCES = \
 	ext2.c \
 	fallocate.c \
 	file.c \
-	findfs.c \
 	fill.c \
 	find.c \
 	format.c \
@@ -265,6 +264,7 @@ SOURCES_MLI = \
 	devsparts.mli \
 	file.mli \
 	filearch.mli \
+	findfs.mli \
 	is.mli \
 	ldm.mli \
 	link.mli \
@@ -293,6 +293,7 @@ SOURCES_ML = \
 	ldm.ml \
 	link.ml \
 	lvm.ml \
+	findfs.ml \
 	md.ml \
 	mount.ml \
 	parted.ml \
diff --git a/daemon/findfs.c b/daemon/findfs.c
deleted file mode 100644
index f44137038..000000000
--- a/daemon/findfs.c
+++ /dev/null
@@ -1,94 +0,0 @@
-/* libguestfs - the guestfsd daemon
- * Copyright (C) 2010 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.
- */
-
-#include <config.h>
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <unistd.h>
-
-#include "daemon.h"
-#include "actions.h"
-
-GUESTFSD_EXT_CMD(str_findfs, findfs);
-
-static char *
-findfs (const char *tag, const char *label_or_uuid)
-{
-  char *out;
-  CLEANUP_FREE char *err = NULL;
-  CLEANUP_FREE char *arg = NULL;
-  int r;
-  size_t len;
-
-  /* Kill the cache file, forcing blkid to reread values from the
-   * original filesystems.  In blkid there is a '-p' option which is
-   * supposed to do this, but (a) it doesn't work and (b) that option
-   * is not supported in RHEL 5.
-   */
-  unlink ("/etc/blkid/blkid.tab");
-  unlink ("/run/blkid/blkid.tab");
-
-  if (asprintf (&arg, "%s=%s", tag, label_or_uuid) == -1) {
-    reply_with_perror ("asprintf");
-    return NULL;
-  }
-
-  r = command (&out, &err, str_findfs, arg, NULL);
-  if (r == -1) {
-    reply_with_error ("%s", err);
-    free (out);
-    return NULL;
-  }
-
-  /* Trim trailing \n if present. */
-  len = strlen (out);
-  if (len > 0 && out[len-1] == '\n')
-    out[len-1] = '\0';
-
-  if (STRPREFIX (out, "/dev/mapper/") || STRPREFIX (out,
"/dev/dm-")) {
-    char *canonical;
-    r = lv_canonical (out, &canonical);
-    if (r == -1) {
-      free (out);
-      return NULL;
-    }
-    if (r == 1) {
-      free (out);
-      out = canonical;
-    }
-    /* Ignore the case where r == 0.  /dev/mapper does not correspond
-     * to an LV, so the best we can do is just return it as-is.
-     */
-  }
-
-  return out;                   /* caller frees */
-}
-
-char *
-do_findfs_uuid (const char *uuid)
-{
-  return findfs ("UUID", uuid);
-}
-
-char *
-do_findfs_label (const char *label)
-{
-  return findfs ("LABEL", label);
-}
diff --git a/daemon/findfs.ml b/daemon/findfs.ml
new file mode 100644
index 000000000..8acb72928
--- /dev/null
+++ b/daemon/findfs.ml
@@ -0,0 +1,56 @@
+(* 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 Unix
+
+open Std_utils
+
+open Utils
+
+let rec findfs_uuid uuid +  findfs "UUID" uuid
+and findfs_label label +  findfs "LABEL"label
+
+and findfs tag str +  (* Kill the cache file, forcing blkid to reread values
from the
+   * original filesystems.  In blkid there is a '-p' option which is
+   * supposed to do this, but (a) it doesn't work and (b) that option
+   * is not supported in RHEL 5.
+   *)
+  (try unlink "/etc/blkid/blkid.tab" with Unix_error _ -> ());
+  (try unlink "/run/blkid/blkid.tab" with Unix_error _ -> ());
+
+  let out = command "findfs" [ sprintf "%s=%s" tag str ] in
+
+  (* Trim trailing \n if present. *)
+  let out = String.trim out in
+
+  if String.is_prefix out "/dev/mapper/" ||
+     String.is_prefix out "/dev/dm-" then (
+    match Lvm.lv_canonical out with
+    | None ->
+       (* Ignore the case where 'out' doesn't appear to be an LV.
+        * The best we can do is return the original as-is.
+        *)
+       out
+    | Some out -> out
+  )
+  else
+    out
diff --git a/daemon/findfs.mli b/daemon/findfs.mli
new file mode 100644
index 000000000..acef0395c
--- /dev/null
+++ b/daemon/findfs.mli
@@ -0,0 +1,20 @@
+(* 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 findfs_uuid : string -> string
+val findfs_label : string -> string
diff --git a/daemon/lvm.c b/daemon/lvm.c
index 072bf53b4..268d87416 100644
--- a/daemon/lvm.c
+++ b/daemon/lvm.c
@@ -27,6 +27,11 @@
 #include <sys/stat.h>
 #include <dirent.h>

+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+
 #include "daemon.h"
 #include "c-ctype.h"
 #include "actions.h"
@@ -969,3 +974,29 @@ do_vgchange_uuid_all (void)

   return 0;
 }
+
+/* Allow lv_canonical to be called from OCaml functions in the daemon. */
+extern value guestfs_int_daemon_lv_canonical (value devicev);
+
+value
+guestfs_int_daemon_lv_canonical (value devicev)
+{
+  CAMLparam1 (devicev);
+  CAMLlocal2 (rv, v);
+  int r;
+  CLEANUP_FREE char *rdevice = NULL;
+
+  r = lv_canonical (String_val (devicev), &rdevice);
+  if (r == -1)
+    caml_failwith ("lv_canonical");
+
+  if (r == 0)                   /* Return None. */
+    rv = Val_int (0);
+  else {                        /* Return Some rdevice. */
+    v = caml_copy_string (rdevice);
+    rv = caml_alloc (1, 0);
+    caml_modify (&Field (rv, 0), v);
+  }
+
+  CAMLreturn (rv);
+}
diff --git a/daemon/lvm.ml b/daemon/lvm.ml
index 14f0a8578..8647f3246 100644
--- a/daemon/lvm.ml
+++ b/daemon/lvm.ml
@@ -25,6 +25,9 @@ open Utils
 external available : unit -> bool
"guestfs_int_daemon_optgroup_lvm2_available" "noalloc"

+external lv_canonical : string -> string option +
"guestfs_int_daemon_lv_canonical"
+
 let lvs_has_S_opt = lazy (
   let out = command "lvm" ["lvs"; "--help"] in
   String.find out "-S" >= 0
diff --git a/daemon/lvm.mli b/daemon/lvm.mli
index 1cf61ecfb..f01f1f80c 100644
--- a/daemon/lvm.mli
+++ b/daemon/lvm.mli
@@ -19,3 +19,11 @@
 val available : unit -> bool

 val lvs : unit -> string list
+
+val lv_canonical : string -> string option
+(** This is a binding for the C lv_canonical function used in a
+    few cases.  On error this raises an exception.  There are
+    two possible non-error cases:
+
+    Some lv = conversion was successful, returning the canonical LV
+    None = input path was not an LV, it could not be made canonical *)
diff --git a/docs/C_SOURCE_FILES b/docs/C_SOURCE_FILES
index c01064803..651d294c5 100644
--- a/docs/C_SOURCE_FILES
+++ b/docs/C_SOURCE_FILES
@@ -103,7 +103,6 @@ daemon/fallocate.c
 daemon/file.c
 daemon/fill.c
 daemon/find.c
-daemon/findfs.c
 daemon/format.c
 daemon/fs-min-size.c
 daemon/fsck.c
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index b1e2559e0..0a967f76d 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -5746,6 +5746,7 @@ returns true iff this is the case." };
   { defaults with
     name = "findfs_uuid"; added = (1, 5, 3);
     style = RString (RDevice, "device"), [String (PlainString,
"uuid")], [];
+    impl = OCaml "Findfs.findfs_uuid";
     shortdesc = "find a filesystem by UUID";
     longdesc = "\
 This command searches the filesystems and returns the one
@@ -5757,6 +5758,7 @@ To find the UUID of a filesystem, use
C<guestfs_vfs_uuid>." };
   { defaults with
     name = "findfs_label"; added = (1, 5, 3);
     style = RString (RDevice, "device"), [String (PlainString,
"label")], [];
+    impl = OCaml "Findfs.findfs_label";
     shortdesc = "find a filesystem by label";
     longdesc = "\
 This command searches the filesystems and returns the one
--
2.13.0