daemon: Reimplement ‘list_ldm_(volumes|partitions)’ APIs in OCaml.

daemon/Makefile.am

@@ -249,6 +249,7 @@ SOURCES_MLI = \
 	file.mli \
 	filearch.mli \
 	is.mli \
+	ldm.mli \
 	link.mli \
 	mount.mli \
 	mountable.mli \
@@ -269,6 +270,7 @@ SOURCES_ML = \
 	file.ml \
 	filearch.ml \
 	is.ml \
+	ldm.ml \
 	link.ml \
 	mount.ml \
 	parted.ml \

daemon/ldm.c

@@ -23,7 +23,6 @@
 #include <unistd.h>
 #include <sys/types.h>
 #include <sys/stat.h>
-#include <glob.h>
 #include <string.h>
 
 #include <yajl/yajl_tree.h>
@@ -45,87 +44,6 @@ optgroup_ldm_available (void)
   return prog_exists ("ldmtool");
 }
 
-static int
-glob_errfunc (const char *epath, int eerrno)
-{
-  fprintf (stderr, "glob: failure reading %s: %s\n", epath, strerror (eerrno));
-  return 1;
-}
-
-static char **
-get_devices (const char *pattern)
-{
-  CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (ret);
-  glob_t devs;
-  int err;
-  size_t i;
-
-  memset (&devs, 0, sizeof devs);
-
-  err = glob (pattern, GLOB_ERR, glob_errfunc, &devs);
-  if (err == GLOB_NOSPACE) {
-    reply_with_error ("glob: returned GLOB_NOSPACE: "
-                      "rerun with LIBGUESTFS_DEBUG=1");
-    goto error;
-  } else if (err == GLOB_ABORTED) {
-    reply_with_error ("glob: returned GLOB_ABORTED: "
-                      "rerun with LIBGUESTFS_DEBUG=1");
-    goto error;
-  }
-
-  for (i = 0; i < devs.gl_pathc; ++i) {
-    if (add_string (&ret, devs.gl_pathv[i]) == -1)
-      goto error;
-  }
-
-  if (end_stringsbuf (&ret) == -1) goto error;
-
-  globfree (&devs);
-  return take_stringsbuf (&ret);
-
- error:
-  globfree (&devs);
-
-  return NULL;
-}
-
-/* All device mapper devices called /dev/mapper/ldm_vol_*.  XXX We
- * could tighten this up in future if ldmtool had a way to read these
- * names back after they have been created.
- */
-char **
-do_list_ldm_volumes (void)
-{
-  struct stat buf;
-
-  /* If /dev/mapper doesn't exist at all, don't give an error. */
-  if (stat ("/dev/mapper", &buf) == -1) {
-    if (errno == ENOENT)
-      return empty_list ();
-    reply_with_perror ("/dev/mapper");
-    return NULL;
-  }
-
-  return get_devices ("/dev/mapper/ldm_vol_*");
-}
-
-/* Same as above but /dev/mapper/ldm_part_*.  See comment above. */
-char **
-do_list_ldm_partitions (void)
-{
-  struct stat buf;
-
-  /* If /dev/mapper doesn't exist at all, don't give an error. */
-  if (stat ("/dev/mapper", &buf) == -1) {
-    if (errno == ENOENT)
-      return empty_list ();
-    reply_with_perror ("/dev/mapper");
-    return NULL;
-  }
-
-  return get_devices ("/dev/mapper/ldm_part_*");
-}
-
 int
 do_ldmtool_create_all (void)
 {

daemon/ldm.ml

@@ -0,0 +1,44 @@
+(* 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 Utils
+
+(* All device mapper devices are called /dev/mapper/ldm_vol_*
+ * or /dev/mapper/ldm_part_*.
+ *
+ * XXX We could tighten this up in future if ldmtool had a way
+ * to read these names back after they have been created.
+ *)
+let rec list_ldm_volumes () = list "ldm_vol_"
+
+and list_ldm_partitions () = list "ldm_part_"
+
+and list prefix =
+  (* If /dev/mapper doesn't exist at all, don't give an error. *)
+  if not (is_directory "/dev/mapper") then
+    []
+  else (
+    let dir = Sys.readdir "/dev/mapper" in
+    let dir = Array.to_list dir in
+    let dir =
+      List.filter (fun d -> String.is_prefix d prefix) dir in
+    let dir = List.map ((^) "/dev/mapper/") dir in
+    List.sort compare dir
+  )

daemon/ldm.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 list_ldm_volumes : unit -> string list
+val list_ldm_partitions : unit -> string list

generator/actions_core.ml

@@ -8114,6 +8114,7 @@ The capabilities set C<cap> should be passed in text form
   { defaults with
     name = "list_ldm_volumes"; added = (1, 20, 0);
     style = RStringList (RDevice, "devices"), [], [];
+    impl = OCaml "Ldm.list_ldm_volumes";
     optional = Some "ldm";
     shortdesc = "list all Windows dynamic disk volumes";
     longdesc = "\
@@ -8124,6 +8125,7 @@ device names." };
   { defaults with
     name = "list_ldm_partitions"; added = (1, 20, 0);
     style = RStringList (RDevice, "devices"), [], [];
+    impl = OCaml "Ldm.list_ldm_partitions";
     optional = Some "ldm";
     shortdesc = "list all Windows dynamic disk partitions";
     longdesc = "\