[Libguestfs] [PATCH v6 18/41] daemon: Reimplement several devsparts APIs in OCaml.

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

The reimplemented APIs are:

* list_devices
* list_partitions
* part_to_dev
* part_to_partnum
* is_whole_device
---
 daemon/Makefile.am        |   2 +
 daemon/daemon.h           |   3 -
 daemon/devsparts.c        | 257 ----------------------------------------------
 daemon/devsparts.ml       | 109 ++++++++++++++++++++
 daemon/devsparts.mli      |  25 +++++
 daemon/guestfsd.c         |  75 --------------
 daemon/utils.ml           |  84 +++++++++++++++
 daemon/utils.mli          |  15 +++
 generator/actions_core.ml |   5 +
 generator/daemon.ml       |  32 +++++-
 10 files changed, 268 insertions(+), 339 deletions(-)

diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index fc99c500f..e616de73b 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -260,6 +260,7 @@ SOURCES_MLI = \
 	blkid.mli \
 	chroot.mli \
 	sysroot.mli \
+	devsparts.mli \
 	file.mli \
 	mountable.mli \
 	utils.mli
@@ -271,6 +272,7 @@ SOURCES_ML = \
 	mountable.ml \
 	chroot.ml \
 	blkid.ml \
+	devsparts.ml \
 	file.ml \
 	callbacks.ml \
 	daemon.ml
diff --git a/daemon/daemon.h b/daemon/daemon.h
index 2d296a6c2..684f9b096 100644
--- a/daemon/daemon.h
+++ b/daemon/daemon.h
@@ -130,9 +130,6 @@ extern void free_stringsbuf (struct stringsbuf *sb);
 extern void sort_strings (char **argv, size_t len);
 extern void free_stringslen (char **argv, size_t len);

-extern void sort_device_names (char **argv, size_t len);
-extern int compare_device_names (const char *a, const char *b);
-
 extern struct stringsbuf split_lines_sb (char *str);
 extern char **split_lines (char *str);

diff --git a/daemon/devsparts.c b/daemon/devsparts.c
index 82467b92f..1aacb8e16 100644
--- a/daemon/devsparts.c
+++ b/daemon/devsparts.c
@@ -33,263 +33,6 @@
 #include "daemon.h"
 #include "actions.h"

-typedef int (*block_dev_func_t) (const char *dev, struct stringsbuf *r);
-
-/* Execute a given function for each discovered block device */
-static char **
-foreach_block_device (block_dev_func_t func, bool return_md)
-{
-  CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (r);
-  DIR *dir;
-  int err = 0;
-  struct dirent *d;
-  int fd;
-
-  dir = opendir ("/sys/block");
-  if (!dir) {
-    reply_with_perror ("opendir: /sys/block");
-    return NULL;
-  }
-
-  for (;;) {
-    errno = 0;
-    d = readdir (dir);
-    if (!d) break;
-
-    if (STREQLEN (d->d_name, "sd", 2) ||
-        STREQLEN (d->d_name, "hd", 2) ||
-        STREQLEN (d->d_name, "ubd", 3) ||
-        STREQLEN (d->d_name, "vd", 2) ||
-        STREQLEN (d->d_name, "sr", 2) ||
-        (return_md &&
-         STREQLEN (d->d_name, "md", 2) && c_isdigit
(d->d_name[2]))) {
-      CLEANUP_FREE char *dev_path = NULL;
-      if (asprintf (&dev_path, "/dev/%s", d->d_name) == -1) {
-        reply_with_perror ("asprintf");
-        closedir (dir);
-        return NULL;
-      }
-
-      /* Ignore the root device. */
-      if (is_root_device (dev_path))
-        continue;
-
-      /* RHBZ#514505: Some versions of qemu <= 0.10 add a
-       * CD-ROM device even though we didn't request it.  Try to
-       * detect this by seeing if the device contains media.
-       */
-      fd = open (dev_path, O_RDONLY|O_CLOEXEC);
-      if (fd == -1) {
-        perror (dev_path);
-        continue;
-      }
-      close (fd);
-
-      /* Call the map function for this device */
-      if ((*func)(d->d_name, &r) != 0) {
-        err = 1;
-        break;
-      }
-    }
-  }
-
-  /* Check readdir didn't fail */
-  if (errno != 0) {
-    reply_with_perror ("readdir: /sys/block");
-    closedir (dir);
-    return NULL;
-  }
-
-  /* Close the directory handle */
-  if (closedir (dir) == -1) {
-    reply_with_perror ("closedir: /sys/block");
-    return NULL;
-  }
-
-  if (err)
-    return NULL;
-
-  /* Sort the devices. */
-  if (r.size > 0)
-    sort_device_names (r.argv, r.size);
-
-  /* NULL terminate the list */
-  if (end_stringsbuf (&r) == -1) {
-    return NULL;
-  }
-
-  return take_stringsbuf (&r);
-}
-
-/* Add a device to the list of devices */
-static int
-add_device (const char *device, struct stringsbuf *r)
-{
-  char *dev_path;
-
-  if (asprintf (&dev_path, "/dev/%s", device) == -1) {
-    reply_with_perror ("asprintf");
-    return -1;
-  }
-
-  if (add_string_nodup (r, dev_path) == -1)
-    return -1;
-
-  return 0;
-}
-
-char **
-do_list_devices (void)
-{
-  /* For backwards compatibility, don't return MD devices in the list
-   * returned by guestfs_list_devices.  This is because most API users
-   * expect that this list is effectively the same as the list of
-   * devices added by guestfs_add_drive.
-   *
-   * Also, MD devices are special devices - unlike the devices exposed
-   * by QEMU, and there is a special API for them,
-   * guestfs_list_md_devices.
-   */
-  return foreach_block_device (add_device, false);
-}
-
-static int
-add_partitions (const char *device, struct stringsbuf *r)
-{
-  CLEANUP_FREE char *devdir = NULL;
-
-  /* Open the device's directory under /sys/block */
-  if (asprintf (&devdir, "/sys/block/%s", device) == -1) {
-    reply_with_perror ("asprintf");
-    return -1;
-  }
-
-  DIR *dir = opendir (devdir);
-  if (!dir) {
-    reply_with_perror ("opendir: %s", devdir);
-    return -1;
-  }
-
-  /* Look in /sys/block/<device>/ for entries starting with
<device>
-   * e.g. /sys/block/sda/sda1
-   */
-  errno = 0;
-  struct dirent *d;
-  while ((d = readdir (dir)) != NULL) {
-    if (STREQLEN (d->d_name, device, strlen (device))) {
-      CLEANUP_FREE char *part = NULL;
-      if (asprintf (&part, "/dev/%s", d->d_name) == -1) {
-        perror ("asprintf");
-        closedir (dir);
-        return -1;
-      }
-
-      if (add_string (r, part) == -1) {
-        closedir (dir);
-        return -1;
-      }
-    }
-  }
-
-  /* Check if readdir failed */
-  if (0 != errno) {
-    reply_with_perror ("readdir: %s", devdir);
-    closedir (dir);
-    return -1;
-  }
-
-  /* Close the directory handle */
-  if (closedir (dir) == -1) {
-    reply_with_perror ("closedir: /sys/block/%s", device);
-    return -1;
-  }
-
-  return 0;
-}
-
-char **
-do_list_partitions (void)
-{
-  return foreach_block_device (add_partitions, true);
-}
-
-char *
-do_part_to_dev (const char *part)
-{
-  int err = 1;
-  size_t n = strlen (part);
-
-  while (n >= 1 && c_isdigit (part[n-1])) {
-    err = 0;
-    n--;
-  }
-
-  if (err) {
-    reply_with_error ("device name is not a partition");
-    return NULL;
-  }
-
-  /* Deal with <device>p<N> partition names such as /dev/md0p1. */
-  if (part[n-1] == 'p')
-    n--;
-
-  char *r = strndup (part, n);
-  if (r == NULL) {
-    reply_with_perror ("strdup");
-    return NULL;
-  }
-
-  return r;
-}
-
-int
-do_part_to_partnum (const char *part)
-{
-  int err = 1;
-  size_t n = strlen (part);
-
-  while (n >= 1 && c_isdigit (part[n-1])) {
-    err = 0;
-    n--;
-  }
-
-  if (err) {
-    reply_with_error ("device name is not a partition");
-    return -1;
-  }
-
-  int r;
-  if (sscanf (&part[n], "%d", &r) != 1) {
-    reply_with_error ("could not parse number");
-    return -1;
-  }
-
-  return r;
-}
-
-int
-do_is_whole_device (const char *device)
-{
-  /* A 'whole' block device will have a symlink to the device in its
-   * /sys/block directory */
-  CLEANUP_FREE char *devpath = NULL;
-  if (asprintf (&devpath, "/sys/block/%s/device",
-                device + strlen ("/dev/")) == -1) {
-    reply_with_perror ("asprintf");
-    return -1;
-  }
-
-  struct stat statbuf;
-  if (stat (devpath, &statbuf) == -1) {
-    if (errno == ENOENT || errno == ENOTDIR) return 0;
-
-    reply_with_perror ("stat");
-    return -1;
-  }
-
-  return 1;
-}
-
 int
 do_device_index (const char *device)
 {
diff --git a/daemon/devsparts.ml b/daemon/devsparts.ml
new file mode 100644
index 000000000..e97ff1267
--- /dev/null
+++ b/daemon/devsparts.ml
@@ -0,0 +1,109 @@
+(* 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 map_block_devices ~return_md f +  let devs = Sys.readdir
"/sys/block" in
+  let devs = Array.to_list devs in
+  let devs = List.filter (
+    fun dev ->
+      String.is_prefix dev "sd" ||
+      String.is_prefix dev "hd" ||
+      String.is_prefix dev "ubd" ||
+      String.is_prefix dev "vd" ||
+      String.is_prefix dev "sr" ||
+      (return_md && String.is_prefix dev "md" &&
+         String.length dev >= 3 && Char.isdigit dev.[2])
+  ) devs in
+
+  (* Ignore the root device. *)
+  let devs +    List.filter (fun dev -> not (is_root_device
("/dev/" ^ dev))) devs in
+
+  (* RHBZ#514505: Some versions of qemu <= 0.10 add a
+   * CD-ROM device even though we didn't request it.  Try to
+   * detect this by seeing if the device contains media.
+   *)
+  let devs +    List.filter (
+      fun dev ->
+        try close (openfile ("/dev/" ^ dev) [O_RDONLY; O_CLOEXEC] 0);
true
+        with _ -> false
+    ) devs in
+
+  (* Call the map function for the devices left in the list. *)
+  List.map f devs
+
+let list_devices () +  (* For backwards compatibility, don't return MD
devices in the list
+   * returned by guestfs_list_devices.  This is because most API users
+   * expect that this list is effectively the same as the list of
+   * devices added by guestfs_add_drive.
+   *
+   * Also, MD devices are special devices - unlike the devices exposed
+   * by QEMU, and there is a special API for them,
+   * guestfs_list_md_devices.
+   *)
+  let devices +    map_block_devices ~return_md:false (fun dev ->
"/dev/" ^ dev) in
+  sort_device_names devices
+
+let rec list_partitions () +  let partitions = map_block_devices
~return_md:true add_partitions in
+  let partitions = List.flatten partitions in
+  sort_device_names partitions
+
+and add_partitions dev +  (* Open the device's directory under /sys/block
*)
+  let parts = Sys.readdir ("/sys/block/" ^ dev) in
+  let parts = Array.to_list parts in
+
+  (* Look in /sys/block/<device>/ for entries starting with
+   * <device>, eg. /sys/block/sda/sda1.
+   *)
+  let parts = List.filter (fun part -> String.is_prefix part dev) parts in
+  List.map (fun part -> "/dev/" ^ part) parts
+
+let part_to_dev part +  let dev, part = split_device_partition part in
+  if part = 0 then
+    failwithf "device name is not a partition";
+  "/dev/" ^ dev
+
+let part_to_partnum part +  let _, part = split_device_partition part in
+  if part = 0 then
+    failwithf "device name is not a partition";
+  part
+
+let is_whole_device device +  (* A 'whole' block device will have a
symlink to the device in its
+   * /sys/block directory
+   *)
+  assert (String.is_prefix device "/dev/");
+  let device = String.sub device 5 (String.length device - 5) in
+  let devpath = sprintf "/sys/block/%s/device" device in
+
+  try ignore (stat devpath); true
+  with Unix_error ((ENOENT|ENOTDIR), _, _) -> false
diff --git a/daemon/devsparts.mli b/daemon/devsparts.mli
new file mode 100644
index 000000000..4dfaa86e6
--- /dev/null
+++ b/daemon/devsparts.mli
@@ -0,0 +1,25 @@
+(* 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_devices : unit -> string list
+val list_partitions : unit -> string list
+
+val part_to_dev : string -> string
+val part_to_partnum : string -> int
+
+val is_whole_device : string -> bool
diff --git a/daemon/guestfsd.c b/daemon/guestfsd.c
index 05337b31c..9704094a6 100644
--- a/daemon/guestfsd.c
+++ b/daemon/guestfsd.c
@@ -630,81 +630,6 @@ free_stringslen (char **argv, size_t len)
 }

 /**
- * Compare device names (including partition numbers if present).
- *
- *
L<https://rwmj.wordpress.com/2011/01/09/how-are-linux-drives-named-beyond-drive-26-devsdz/>
- */
-int
-compare_device_names (const char *a, const char *b)
-{
-  size_t alen, blen;
-  int r;
-  int a_partnum, b_partnum;
-
-  /* Skip /dev/ prefix if present. */
-  if (STRPREFIX (a, "/dev/"))
-    a += 5;
-  if (STRPREFIX (b, "/dev/"))
-    b += 5;
-
-  /* Skip sd/hd/ubd/vd. */
-  alen = strcspn (a, "d");
-  blen = strcspn (b, "d");
-  assert (alen > 0 && alen <= 2);
-  assert (blen > 0 && blen <= 2);
-  a += alen + 1;
-  b += blen + 1;
-
-  /* Get device name part, that is, just 'a', 'ab' etc. */
-  alen = strcspn (a, "0123456789");
-  blen = strcspn (b, "0123456789");
-
-  /* If device name part is longer, it is always greater, eg.
-   * "/dev/sdz" < "/dev/sdaa".
-   */
-  if (alen != blen)
-    return alen - blen;
-
-  /* Device name parts are the same length, so do a regular compare. */
-  r = strncmp (a, b, alen);
-  if (r != 0)
-    return r;
-
-  /* Compare partitions numbers. */
-  a += alen;
-  b += alen;
-
-  /* If no partition numbers, bail -- the devices are the same.  This
-   * can happen in one peculiar case: where you have a mix of devices
-   * with different interfaces (eg. /dev/sda and /dev/vda).
-   * (RHBZ#858128).
-   */
-  if (!*a && !*b)
-    return 0;
-
-  r = sscanf (a, "%d", &a_partnum);
-  assert (r == 1);
-  r = sscanf (b, "%d", &b_partnum);
-  assert (r == 1);
-
-  return a_partnum - b_partnum;
-}
-
-static int
-compare_device_names_vp (const void *vp1, const void *vp2)
-{
-  char * const *p1 = (char * const *) vp1;
-  char * const *p2 = (char * const *) vp2;
-  return compare_device_names (*p1, *p2);
-}
-
-void
-sort_device_names (char **argv, size_t len)
-{
-  qsort (argv, len, sizeof (char *), compare_device_names_vp);
-}
-
-/**
  * Split an output string into a NULL-terminated list of lines,
  * wrapped into a stringsbuf.
  *
diff --git a/daemon/utils.ml b/daemon/utils.ml
index 7630a5534..48f6b9c5c 100644
--- a/daemon/utils.ml
+++ b/daemon/utils.ml
@@ -129,6 +129,90 @@ let is_root_device device                device func arg
(error_message err);
       false

+(* XXX This function is copied from C, but is misconceived.  It
+ * cannot by design work for devices like /dev/md0.  It would be
+ * better if it checked for the existence of devices and partitions
+ * in /sys/block so we know what the kernel thinks is a device or
+ * partition.  The same applies to APIs such as part_to_partnum
+ * and part_to_dev which rely on this function.
+ *)
+let split_device_partition dev +  (* Skip /dev/ prefix if present. *)
+  let dev +    if String.is_prefix dev "/dev/" then
+      String.sub dev 5 (String.length dev - 5)
+    else dev in
+
+  (* Find the partition number (if present). *)
+  let dev, part +    let n = String.length dev in
+    let i = ref n in
+    while !i >= 1 && Char.isdigit dev.[!i-1] do
+      decr i
+    done;
+    let i = !i in
+    if i = n then
+      dev, 0 (* no partition number, whole device *)
+    else
+      String.sub dev 0 i, int_of_string (String.sub dev i (n-i)) in
+
+  (* Deal with device names like /dev/md0p1. *)
+  (* XXX This function is buggy (as was the old C function) when
+   * presented with a whole device like /dev/md0.
+   *)
+  let dev +    let n = String.length dev in
+    if n < 2 || dev.[n-1] <> 'p' || not (Char.isdigit
dev.[n-2]) then
+      dev
+    else (
+      let i = ref (n-1) in
+      while !i >= 0 && Char.isdigit dev.[!i] do
+        decr i;
+      done;
+      let i = !i in
+      String.sub dev 0 i
+    ) in
+
+  dev, part
+
+let rec sort_device_names devs +  List.sort compare_device_names devs
+
+and compare_device_names a b +  (* This takes the device name like
"/dev/sda1" and returns ("sda", 1). *)
+  let dev_a, part_a = split_device_partition a
+  and dev_b, part_b = split_device_partition b in
+
+  (* Skip "sd|hd|ubd..." so that /dev/sda and /dev/vda sort together.
+   * (This is what the old C function did, but it's not clear if it
+   * is still relevant. XXX)
+   *)
+  let skip_prefix dev +    let n = String.length dev in
+    if n >= 2 && dev.[1] = 'd' then
+      String.sub dev 2 (String.length dev - 2)
+    else if n >= 3 && dev.[2] = 'd' then
+      String.sub dev 3 (String.length dev - 3)
+    else
+      dev in
+  let dev_a = skip_prefix dev_a
+  and dev_b = skip_prefix dev_b in
+
+  (* If device name part is longer, it is always greater, eg.
+   * "/dev/sdz" < "/dev/sdaa".
+   *)
+  let r = compare (String.length dev_a) (String.length dev_b) in
+  if r <> 0 then r
+  else (
+    (* Device name parts are the same length, so do a regular compare. *)
+    let r = compare dev_a dev_b in
+    if r <> 0 then r
+    else (
+      (* Device names are identical, so compare partition numbers. *)
+      compare part_a part_b
+    )
+  )
+
 let proc_unmangle_path path    let n = String.length path in
   let b = Buffer.create n in
diff --git a/daemon/utils.mli b/daemon/utils.mli
index 57f703c6c..a1f956be3 100644
--- a/daemon/utils.mli
+++ b/daemon/utils.mli
@@ -41,6 +41,21 @@ val is_root_device_stat : Unix.stats -> bool
 (** As for {!is_root_device} but operates on a statbuf instead of
     a device name. *)

+val split_device_partition : string -> string * int
+(** Split a device name like [/dev/sda1] into a device name and
+    partition number, eg. ["sda", 1].
+
+    The [/dev/] prefix is skipped and removed, if present.
+
+    If the partition number is not present (a whole device), 0 is returned.
+
+    This function splits [/dev/md0p1] to ["md0", 1]. *)
+
+val sort_device_names : string list -> string list
+(** Sort device names correctly so that /dev/sdaa appears after /dev/sdz.
+    This also deals with partition numbers, and works whether or not
+    [/dev/] is present. *)
+
 val proc_unmangle_path : string -> string
 (** Reverse kernel path escaping done in fs/seq_file.c:mangle_path.
     This is inconsistently used for /proc fields. *)
diff --git a/generator/actions_core.ml b/generator/actions_core.ml
index a6eb2c273..94391288f 100644
--- a/generator/actions_core.ml
+++ b/generator/actions_core.ml
@@ -1817,6 +1817,7 @@ is I<not> intended that you try to parse the output
string." };
   { defaults with
     name = "list_devices"; added = (0, 0, 4);
     style = RStringList (RDevice, "devices"), [], [];
+    impl = OCaml "Devsparts.list_devices";
     tests = [
       InitEmpty, Always, TestResult (
         [["list_devices"]],
@@ -1833,6 +1834,7 @@ See also C<guestfs_list_filesystems>." };
   { defaults with
     name = "list_partitions"; added = (0, 0, 4);
     style = RStringList (RDevice, "partitions"), [], [];
+    impl = OCaml "Devsparts.list_partitions";
     tests = [
       InitBasicFS, Always, TestResult (
         [["list_partitions"]],
@@ -6086,6 +6088,7 @@ See also C<guestfs_stat>." };
   { defaults with
     name = "part_to_dev"; added = (1, 5, 15);
     style = RString (RDevice, "device"), [String (Device,
"partition")], [];
+    impl = OCaml "Devsparts.part_to_dev";
     tests = [
       InitPartition, Always, TestResultDevice (
         [["part_to_dev"; "/dev/sda1"]],
"/dev/sda"), [];
@@ -6533,6 +6536,7 @@ as in C<guestfs_compress_out>." };
   { defaults with
     name = "part_to_partnum"; added = (1, 13, 25);
     style = RInt "partnum", [String (Device, "partition")],
[];
+    impl = OCaml "Devsparts.part_to_partnum";
     tests = [
       InitPartition, Always, TestResult (
         [["part_to_partnum"; "/dev/sda1"]], "ret ==
1"), [];
@@ -8480,6 +8484,7 @@ you are better to use C<guestfs_mv> instead."
};
   { defaults with
     name = "is_whole_device"; added = (1, 21, 9);
     style = RBool "flag", [String (Device, "device")], [];
+    impl = OCaml "Devsparts.is_whole_device";
     tests = [
       InitEmpty, Always, TestResultTrue (
         [["is_whole_device"; "/dev/sda"]]), [];
diff --git a/generator/daemon.ml b/generator/daemon.ml
index 121634806..3ffe91537 100644
--- a/generator/daemon.ml
+++ b/generator/daemon.ml
@@ -553,6 +553,26 @@ copy_mountable (const mountable_t *mountable)
   CAMLreturn (r);
 }

+/* Implement RStringList. */
+static char **
+return_string_list (value retv)
+{
+  CLEANUP_FREE_STRINGSBUF DECLARE_STRINGSBUF (ret);
+  value v;
+
+  while (retv != Val_int (0)) {
+    v = Field (retv, 0);
+    if (add_string (&ret, String_val (v)) == -1)
+      return NULL;
+    retv = Field (retv, 1);
+  }
+
+  if (end_stringsbuf (&ret) == -1)
+    return NULL;
+
+  return take_stringsbuf (&ret); /* caller frees */
+}
+
 ";

   List.iter (
@@ -669,12 +689,14 @@ copy_mountable (const mountable_t *mountable)

       (match ret with
        | RErr -> assert false
-       | RInt _ -> assert false
+       | RInt _ ->
+          pr "  CAMLreturnT (int, Int_val (retv));\n"
        | RInt64 _ -> assert false
-       | RBool _ -> assert false
+       | RBool _ ->
+          pr "  CAMLreturnT (int, Bool_val (retv));\n"
        | RConstString _ -> assert false
        | RConstOptString _ -> assert false
-       | RString (RPlainString, _) ->
+       | RString ((RPlainString|RDevice), _) ->
           pr "  char *ret = strdup (String_val (retv));\n";
           pr "  if (ret == NULL) {\n";
           pr "    reply_with_perror (\"strdup\");\n";
@@ -682,7 +704,9 @@ copy_mountable (const mountable_t *mountable)
           pr "  }\n";
           pr "  CAMLreturnT (char *, ret); /* caller frees */\n"
        | RString _ -> assert false
-       | RStringList _ -> assert false
+       | RStringList _ ->
+          pr "  char **ret = return_string_list (retv);\n";
+          pr "  CAMLreturnT (char **, ret); /* caller frees */\n"
        | RStruct _ -> assert false
        | RStructList _ -> assert false
        | RHashtable _ -> assert false
--
2.13.0