[Libguestfs] [PATCH v6 35/41] daemon: Reimplement ‘nr_devices’ API in OCaml.

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

---
 daemon/devsparts.c        | 15 ---------------
 daemon/devsparts.ml       |  2 ++
 daemon/devsparts.mli      |  2 ++
 generator/actions_core.ml |  1 +
 4 files changed, 5 insertions(+), 15 deletions(-)

diff --git a/daemon/devsparts.c b/daemon/devsparts.c
index 1aacb8e16..12e779326 100644
--- a/daemon/devsparts.c
+++ b/daemon/devsparts.c
@@ -54,21 +54,6 @@ do_device_index (const char *device)
   return ret;
 }

-int
-do_nr_devices (void)
-{
-  size_t i;
-  CLEANUP_FREE_STRING_LIST char **devices = do_list_devices ();
-
-  if (devices == NULL)
-    return -1;
-
-  for (i = 0; devices[i] != NULL; ++i)
-    ;
-
-  return (int) i;
-}
-
 #define GUESTFSDIR "/dev/disk/guestfs"

 char **
diff --git a/daemon/devsparts.ml b/daemon/devsparts.ml
index e97ff1267..273612516 100644
--- a/daemon/devsparts.ml
+++ b/daemon/devsparts.ml
@@ -85,6 +85,8 @@ and add_partitions dev    let parts = List.filter (fun part
-> String.is_prefix part dev) parts in
   List.map (fun part -> "/dev/" ^ part) parts

+let nr_devices () = List.length (list_devices ())
+
 let part_to_dev part    let dev, part = split_device_partition part in
   if part = 0 then
diff --git a/daemon/devsparts.mli b/daemon/devsparts.mli
index 4dfaa86e6..8be47e752 100644
--- a/daemon/devsparts.mli
+++ b/daemon/devsparts.mli
@@ -19,6 +19,8 @@
 val list_devices : unit -> string list
 val list_partitions : unit -> string list

+val nr_devices : unit -> int
+
 val part_to_dev : string -> string
 val part_to_partnum : string -> int

diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index 0a967f76d..db1411ff8 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -7432,6 +7432,7 @@ See also C<guestfs_list_devices>,
C<guestfs_part_to_dev>." };

   { defaults with
     name = "nr_devices"; added = (1, 19, 15);
+    impl = OCaml "Devsparts.nr_devices";
     style = RInt "nrdisks", [], [];
     tests = [
       InitEmpty, Always, TestResult (
--
2.13.0