tests: modprobe fat instead of ext2 module.
[libguestfs.git] / src / generator.ml
index b76f502..6937021 100755 (executable)
@@ -139,6 +139,7 @@ and argt =
   | Dev_or_Path of string (* /dev device name or Pathname, cannot be NULL *)
   | OptString of string        (* const char *name, may be NULL *)
   | StringList of string(* list of strings (each string cannot be NULL) *)
+  | DeviceList of string(* list of Device names (each cannot be NULL) *)
   | Bool of string     (* boolean *)
   | Int of string      (* int (smallish ints, signed, <= 31 bits) *)
     (* These are treated as filenames (simple string parameters) in
@@ -342,6 +343,19 @@ and cmd = string list
  * Apart from that, long descriptions are just perldoc paragraphs.
  *)
 
+(* Generate a random UUID (used in tests). *)
+let uuidgen () =
+  let chan = Unix.open_process_in "uuidgen" in
+  let uuid = input_line chan in
+  (match Unix.close_process_in chan with
+   | Unix.WEXITED 0 -> ()
+   | Unix.WEXITED _ ->
+       failwith "uuidgen: process exited with non-zero status"
+   | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
+       failwith "uuidgen: process signalled or stopped by signal"
+  );
+  uuid
+
 (* These test functions are used in the language binding tests. *)
 
 let test_all_args = [
@@ -1307,7 +1321,7 @@ This creates an LVM physical volume on the named C<device>,
 where C<device> should usually be a partition name such
 as C</dev/sda1>.");
 
-  ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
+  ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [],
    [InitEmpty, Always, TestOutputList (
       [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
        ["pvcreate"; "/dev/sda1"];
@@ -2077,17 +2091,18 @@ This returns the ext2/3/4 filesystem label of the filesystem on
 C<device>.");
 
   ("set_e2uuid", (RErr, [Device "device"; String "uuid"]), 82, [],
-   [InitBasicFS, Always, TestOutput (
-      [["set_e2uuid"; "/dev/sda1"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"];
-       ["get_e2uuid"; "/dev/sda1"]], "a3a61220-882b-4f61-89f4-cf24dcc7297d");
-    InitBasicFS, Always, TestOutput (
-      [["set_e2uuid"; "/dev/sda1"; "clear"];
-       ["get_e2uuid"; "/dev/sda1"]], "");
-    (* We can't predict what UUIDs will be, so just check the commands run. *)
-    InitBasicFS, Always, TestRun (
-      [["set_e2uuid"; "/dev/sda1"; "random"]]);
-    InitBasicFS, Always, TestRun (
-      [["set_e2uuid"; "/dev/sda1"; "time"]])],
+   (let uuid = uuidgen () in
+    [InitBasicFS, Always, TestOutput (
+       [["set_e2uuid"; "/dev/sda1"; uuid];
+        ["get_e2uuid"; "/dev/sda1"]], uuid);
+     InitBasicFS, Always, TestOutput (
+       [["set_e2uuid"; "/dev/sda1"; "clear"];
+        ["get_e2uuid"; "/dev/sda1"]], "");
+     (* We can't predict what UUIDs will be, so just check the commands run. *)
+     InitBasicFS, Always, TestRun (
+       [["set_e2uuid"; "/dev/sda1"; "random"]]);
+     InitBasicFS, Always, TestRun (
+       [["set_e2uuid"; "/dev/sda1"; "time"]])]),
    "set the ext2/3/4 filesystem UUID",
    "\
 This sets the ext2/3/4 filesystem UUID of the filesystem on
@@ -2805,9 +2820,10 @@ Note that you cannot attach a swap label to a block device
 a limitation of the kernel or swap tools.");
 
   ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [],
-   [InitEmpty, Always, TestRun (
-      [["sfdiskM"; "/dev/sda"; ","];
-       ["mkswap_U"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"; "/dev/sda1"]])],
+   (let uuid = uuidgen () in
+    [InitEmpty, Always, TestRun (
+       [["sfdiskM"; "/dev/sda"; ","];
+        ["mkswap_U"; uuid; "/dev/sda1"]])]),
    "create a swap partition with an explicit UUID",
    "\
 Create a swap partition on C<device> with UUID C<uuid>.");
@@ -2952,7 +2968,7 @@ were rarely if ever used anyway.
 
 See also C<guestfs_sfdisk> and the L<sfdisk(8)> manpage.");
 
-  ("zfile", (RString "description", [String "method"; Pathname "path"]), 140, [DeprecatedBy "file"],
+  ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
    [],
    "determine file type inside a compressed file",
    "\
@@ -3316,10 +3332,11 @@ This command disables the libguestfs appliance swap on
 labeled swap partition.");
 
   ("swapon_uuid", (RErr, [String "uuid"]), 176, [],
-   [InitEmpty, Always, TestRun (
-      [["mkswap_U"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"; "/dev/sdb"];
-       ["swapon_uuid"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"];
-       ["swapoff_uuid"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"]])],
+   (let uuid = uuidgen () in
+    [InitEmpty, Always, TestRun (
+       [["mkswap_U"; uuid; "/dev/sdb"];
+        ["swapon_uuid"; uuid];
+        ["swapoff_uuid"; uuid]])]),
    "enable swap on swap partition by UUID",
    "\
 This command enables swap to a swap partition with the given UUID.
@@ -3459,6 +3476,99 @@ This gets the SELinux security context of the daemon.
 See the documentation about SELINUX in L<guestfs(3)>,
 and C<guestfs_setcon>");
 
+  ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
+   [InitEmpty, Always, TestOutput (
+      [["sfdiskM"; "/dev/sda"; ","];
+       ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
+       ["mount"; "/dev/sda1"; "/"];
+       ["write_file"; "/new"; "new file contents"; "0"];
+       ["cat"; "/new"]], "new file contents")],
+   "make a filesystem with block size",
+   "\
+This call is similar to C<guestfs_mkfs>, but it allows you to
+control the block size of the resulting filesystem.  Supported
+block sizes depend on the filesystem type, but typically they
+are C<1024>, C<2048> or C<4096> only.");
+
+  ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
+   [InitEmpty, Always, TestOutput (
+      [["sfdiskM"; "/dev/sda"; ",100 ,"];
+       ["mke2journal"; "4096"; "/dev/sda1"];
+       ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
+       ["mount"; "/dev/sda2"; "/"];
+       ["write_file"; "/new"; "new file contents"; "0"];
+       ["cat"; "/new"]], "new file contents")],
+   "make ext2/3/4 external journal",
+   "\
+This creates an ext2 external journal on C<device>.  It is equivalent
+to the command:
+
+ mke2fs -O journal_dev -b blocksize device");
+
+  ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
+   [InitEmpty, Always, TestOutput (
+      [["sfdiskM"; "/dev/sda"; ",100 ,"];
+       ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
+       ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
+       ["mount"; "/dev/sda2"; "/"];
+       ["write_file"; "/new"; "new file contents"; "0"];
+       ["cat"; "/new"]], "new file contents")],
+   "make ext2/3/4 external journal with label",
+   "\
+This creates an ext2 external journal on C<device> with label C<label>.");
+
+  ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [],
+   (let uuid = uuidgen () in
+    [InitEmpty, Always, TestOutput (
+       [["sfdiskM"; "/dev/sda"; ",100 ,"];
+        ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
+        ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
+        ["mount"; "/dev/sda2"; "/"];
+        ["write_file"; "/new"; "new file contents"; "0"];
+        ["cat"; "/new"]], "new file contents")]),
+   "make ext2/3/4 external journal with UUID",
+   "\
+This creates an ext2 external journal on C<device> with UUID C<uuid>.");
+
+  ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
+   [],
+   "make ext2/3/4 filesystem with external journal",
+   "\
+This creates an ext2/3/4 filesystem on C<device> with
+an external journal on C<journal>.  It is equivalent
+to the command:
+
+ mke2fs -t fstype -b blocksize -J device=<journal> <device>
+
+See also C<guestfs_mke2journal>.");
+
+  ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
+   [],
+   "make ext2/3/4 filesystem with external journal",
+   "\
+This creates an ext2/3/4 filesystem on C<device> with
+an external journal on the journal labeled C<label>.
+
+See also C<guestfs_mke2journal_L>.");
+
+  ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [],
+   [],
+   "make ext2/3/4 filesystem with external journal",
+   "\
+This creates an ext2/3/4 filesystem on C<device> with
+an external journal on the journal with UUID C<uuid>.
+
+See also C<guestfs_mke2journal_U>.");
+
+  ("modprobe", (RErr, [String "modulename"]), 194, [],
+   [InitNone, Always, TestRun [["modprobe"; "fat"]]],
+   "load a kernel module",
+   "\
+This loads a kernel module in the appliance.
+
+The kernel module must have been whitelisted when libguestfs
+was built (see C<appliance/kmod.whitelist.in> in the source).");
+
 ]
 
 let all_functions = non_daemon_functions @ daemon_functions
@@ -3721,6 +3831,10 @@ let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
     v
   with
     _ -> Hashtbl.create 13
+let pod2text_memo_updated () =
+  let chan = open_out pod2text_memo_filename in
+  output_value chan pod2text_memo;
+  close_out chan
 
 (* Useful functions.
  * Note we don't want to use any external OCaml libraries which
@@ -3841,7 +3955,8 @@ let mapi f xs =
   loop 0 xs
 
 let name_of_argt = function
-  | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | Bool n | Int n
+  | Pathname n | Device n | Dev_or_Path n | String n | OptString n
+  | StringList n | DeviceList n | Bool n | Int n
   | FileIn n | FileOut n -> n
 
 let java_name_of_struct typ =
@@ -3935,7 +4050,36 @@ let check_functions () =
         if n = "i" || n = "n" then
           failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
         if n = "argv" || n = "args" then
-          failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name
+          failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
+
+        (* List Haskell, OCaml and C keywords here.
+         * http://www.haskell.org/haskellwiki/Keywords
+         * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
+         * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
+         * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
+         *   |perl -pe 's/(.+)/"$1";/'|fmt -70
+         * Omitting _-containing words, since they're handled above.
+         * Omitting the OCaml reserved word, "val", is ok,
+         * and saves us from renaming several parameters.
+         *)
+        let reserved = [
+          "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
+          "char"; "class"; "const"; "constraint"; "continue"; "data";
+          "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
+          "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
+          "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
+          "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
+          "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
+          "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
+          "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
+          "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
+          "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
+          "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
+          "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
+          "volatile"; "when"; "where"; "while";
+          ] in
+        if List.mem n reserved then
+          failwithf "%s has param/ret using reserved word %s" name n;
       in
 
       (match fst style with
@@ -4230,7 +4374,7 @@ and generate_xdr () =
              function
              | Pathname n | Device n | Dev_or_Path n | String n -> pr "  string %s<>;\n" n
              | OptString n -> pr "  str *%s;\n" n
-             | StringList n -> pr "  str %s<>;\n" n
+             | StringList n | DeviceList n -> pr "  str %s<>;\n" n
              | Bool n -> pr "  bool %s;\n" n
              | Int n -> pr "  int %s;\n" n
              | FileIn _ | FileOut _ -> ()
@@ -4416,17 +4560,17 @@ and generate_client_actions () =
 #include \"guestfs_protocol.h\"
 
 #define error guestfs_error
-#define perrorf guestfs_perrorf
-#define safe_malloc guestfs_safe_malloc
+//#define perrorf guestfs_perrorf
+//#define safe_malloc guestfs_safe_malloc
 #define safe_realloc guestfs_safe_realloc
-#define safe_strdup guestfs_safe_strdup
+//#define safe_strdup guestfs_safe_strdup
 #define safe_memdup guestfs_safe_memdup
 
 /* Check the return message from a call for validity. */
 static int
 check_reply_header (guestfs_h *g,
                     const struct guestfs_message_header *hdr,
-                    int proc_nr, int serial)
+                    unsigned int proc_nr, unsigned int serial)
 {
   if (hdr->prog != GUESTFS_PROGRAM) {
     error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
@@ -4593,7 +4737,7 @@ check_state (guestfs_h *g, const char *caller)
                  pr "  args.%s = (char *) %s;\n" n n
              | OptString n ->
                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
-             | StringList n ->
+             | StringList n | DeviceList n ->
                  pr "  args.%s.%s_val = (char **) %s;\n" n n n;
                  pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
              | Bool n ->
@@ -4798,7 +4942,7 @@ and generate_daemon_actions () =
              | Pathname n
              | String n -> ()
              | OptString n -> pr "  char *%s;\n" n
-             | StringList n -> pr "  char **%s;\n" n
+             | StringList n | DeviceList n -> pr "  char **%s;\n" n
              | Bool n -> pr "  int %s;\n" n
              | Int n -> pr "  int %s;\n" n
              | FileIn _ | FileOut _ -> ()
@@ -4818,6 +4962,16 @@ and generate_daemon_actions () =
            let pr_args n =
              pr "  char *%s = args.%s;\n" n n
            in
+           let pr_list_handling_code n =
+             pr "  %s = realloc (args.%s.%s_val,\n" n n n;
+             pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
+             pr "  if (%s == NULL) {\n" n;
+             pr "    reply_with_perror (\"realloc\");\n";
+             pr "    goto done;\n";
+             pr "  }\n";
+             pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
+             pr "  args.%s.%s_val = %s;\n" n n n;
+           in
            List.iter (
              function
              | Pathname n ->
@@ -4825,21 +4979,21 @@ and generate_daemon_actions () =
                  pr "  ABS_PATH (%s, goto done);\n" n;
              | Device n ->
                  pr_args n;
-                 pr "  RESOLVE_DEVICE (%s, goto done);" n;
+                 pr "  RESOLVE_DEVICE (%s, goto done);\n" n;
              | Dev_or_Path n ->
                  pr_args n;
-                 pr "  REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);" n;
+                 pr "  REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);\n" n;
              | String n -> pr_args n
              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
              | StringList n ->
-                 pr "  %s = realloc (args.%s.%s_val,\n" n n n;
-                 pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
-                 pr "  if (%s == NULL) {\n" n;
-                 pr "    reply_with_perror (\"realloc\");\n";
-                 pr "    goto done;\n";
+                 pr_list_handling_code n;
+             | DeviceList n ->
+                 pr_list_handling_code n;
+                 pr "  /* Ensure that each is a device,\n";
+                 pr "   * and perform device name translation. */\n";
+                 pr "  { int pvi; for (pvi = 0; physvols[pvi] != NULL; ++pvi)\n";
+                 pr "    RESOLVE_DEVICE (physvols[pvi], goto done);\n";
                  pr "  }\n";
-                 pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
-                 pr "  args.%s.%s_val = %s;\n" n n n;
              | Bool n -> pr "  %s = args.%s;\n" n n
              | Int n -> pr "  %s = args.%s;\n" n n
              | FileIn _ | FileOut _ -> ()
@@ -4847,6 +5001,7 @@ and generate_daemon_actions () =
            pr "\n"
       );
 
+
       (* this is used at least for do_equal *)
       if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
         (* Emit NEED_ROOT just once, even when there are two or
@@ -5160,7 +5315,8 @@ static void print_error (guestfs_h *g, void *data, const char *msg)
     fprintf (stderr, \"%%s\\n\", msg);
 }
 
-static void print_strings (char * const * const argv)
+/* FIXME: nearly identical code appears in fish.c */
+static void print_strings (char *const *argv)
 {
   int argc;
 
@@ -5169,7 +5325,7 @@ static void print_strings (char * const * const argv)
 }
 
 /*
-static void print_table (char * const * const argv)
+static void print_table (char const *const *argv)
 {
   int i;
 
@@ -5749,13 +5905,13 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
         | Int _, _
         | Bool _, _
         | FileIn _, _ | FileOut _, _ -> ()
-        | StringList n, arg ->
+        | StringList n, arg | DeviceList n, arg ->
             let strs = string_split " " arg in
             iteri (
               fun i str ->
                 pr "    const char *%s_%d = \"%s\";\n" n i (c_quote str);
             ) strs;
-            pr "    const char *%s[] = {\n" n;
+            pr "    const char *const %s[] = {\n" n;
             iteri (
               fun i _ -> pr "      %s_%d,\n" n i
             ) strs;
@@ -5797,8 +5953,8 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
             pr ", %s" n
         | FileIn _, arg | FileOut _, arg ->
             pr ", \"%s\"" (c_quote arg)
-        | StringList n, _ ->
-            pr ", %s" n
+        | StringList n, _ | DeviceList n, _ ->
+            pr ", (char **) %s" n
         | Int _, arg ->
             let i =
               try int_of_string arg
@@ -5949,6 +6105,21 @@ and generate_fish_cmds () =
   pr "}\n";
   pr "\n";
 
+  let emit_print_list_function typ =
+    pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
+      typ typ typ;
+    pr "{\n";
+    pr "  int i;\n";
+    pr "\n";
+    pr "  for (i = 0; i < %ss->len; ++i) {\n" typ;
+    pr "    printf (\"[%%d] = {\\n\", i);\n";
+    pr "    print_%s_indent (&%ss->val[i], \"  \");\n" typ typ;
+    pr "    printf (\"}\\n\");\n";
+    pr "  }\n";
+    pr "}\n";
+    pr "\n";
+  in
+
   (* print_* functions *)
   List.iter (
     fun (typ, cols) ->
@@ -6000,25 +6171,29 @@ and generate_fish_cmds () =
       ) cols;
       pr "}\n";
       pr "\n";
-      pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
-      pr "{\n";
-      pr "  print_%s_indent (%s, \"\");\n" typ typ;
-      pr "}\n";
-      pr "\n";
-      pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
-        typ typ typ;
-      pr "{\n";
-      pr "  int i;\n";
-      pr "\n";
-      pr "  for (i = 0; i < %ss->len; ++i) {\n" typ;
-      pr "    printf (\"[%%d] = {\\n\", i);\n";
-      pr "    print_%s_indent (&%ss->val[i], \"  \");\n" typ typ;
-      pr "    printf (\"}\\n\");\n";
-      pr "  }\n";
-      pr "}\n";
-      pr "\n";
   ) structs;
 
+  (* Emit a print_TYPE_list function definition only if that function is used. *)
+  List.iter (
+    function
+    | typ, (RStructListOnly | RStructAndList) ->
+        (* generate the function for typ *)
+        emit_print_list_function typ
+    | typ, _ -> () (* empty *)
+  ) rstructs_used;
+
+  (* Emit a print_TYPE function definition only if that function is used. *)
+  List.iter (
+    function
+    | typ, RStructOnly ->
+        pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
+        pr "{\n";
+        pr "  print_%s_indent (%s, \"\");\n" typ typ;
+        pr "}\n";
+        pr "\n";
+    | typ, _ -> () (* empty *)
+  ) rstructs_used;
+
   (* run_<action> actions *)
   List.iter (
     fun (name, style, _, flags, _, _, _) ->
@@ -6046,7 +6221,7 @@ and generate_fish_cmds () =
         | OptString n
         | FileIn n
         | FileOut n -> pr "  const char *%s;\n" n
-        | StringList n -> pr "  char **%s;\n" n
+        | StringList n | DeviceList n -> pr "  char *const *%s;\n" n
         | Bool n -> pr "  int %s;\n" n
         | Int n -> pr "  int %s;\n" n
       ) (snd style);
@@ -6073,7 +6248,7 @@ and generate_fish_cmds () =
           | FileOut name ->
               pr "  %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
                 name i i
-          | StringList name ->
+          | StringList name | DeviceList name ->
               pr "  %s = parse_string_list (argv[%d]);\n" name i
           | Bool name ->
               pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i
@@ -6298,7 +6473,7 @@ and generate_fish_actions_pod () =
         function
         | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
         | OptString n -> pr " %s" n
-        | StringList n -> pr " '%s ...'" n
+        | StringList n | DeviceList n -> pr " '%s ...'" n
         | Bool _ -> pr " true|false"
         | Int n -> pr " %s" n
         | FileIn n | FileOut n -> pr " (%s|-)" n
@@ -6368,10 +6543,9 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
       | OptString n ->
           next ();
           pr "const char *%s" n
-      | StringList n ->
+      | StringList n | DeviceList n ->
           next ();
-          if not in_daemon then pr "char * const* const %s" n
-          else pr "char **%s" n
+          pr "char *const *%s" n
       | Bool n -> next (); pr "int %s" n
       | Int n -> next (); pr "int %s" n
       | FileIn n
@@ -6635,7 +6809,7 @@ copy_table (char * const * argv)
             pr "  const char *%s =\n" n;
             pr "    %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
               n n
-        | StringList n ->
+        | StringList n | DeviceList n ->
             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
         | Bool n ->
             pr "  int %s = Bool_val (%sv);\n" n n
@@ -6677,7 +6851,7 @@ copy_table (char * const * argv)
 
       List.iter (
         function
-        | StringList n ->
+        | StringList n | DeviceList n ->
             pr "  ocaml_guestfs_free_strings (%s);\n" n;
         | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ | Bool _ | Int _
         | FileIn _ | FileOut _ -> ()
@@ -6765,7 +6939,7 @@ and generate_ocaml_prototype ?(is_external = false) name style =
     function
     | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
     | OptString _ -> pr "string option -> "
-    | StringList _ -> pr "string array -> "
+    | StringList _ | DeviceList _ -> pr "string array -> "
     | Bool _ -> pr "bool -> "
     | Int _ -> pr "int -> "
   ) (snd style);
@@ -6916,7 +7090,7 @@ DESTROY (g)
                * to add 1 to the ST(x) operator.
                *)
               pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
-          | StringList n -> pr "      char **%s;\n" n
+          | StringList n | DeviceList n -> pr "      char **%s;\n" n
           | Bool n -> pr "      int %s;\n" n
           | Int n -> pr "      int %s;\n" n
       ) (snd style);
@@ -6926,7 +7100,7 @@ DESTROY (g)
           function
           | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ | Bool _ | Int _
           | FileIn _ | FileOut _ -> ()
-          | StringList n -> pr "      free (%s);\n" n
+          | StringList n | DeviceList n -> pr "      free (%s);\n" n
         ) (snd style)
       in
 
@@ -7299,7 +7473,7 @@ and generate_perl_prototype name style =
       | Pathname n | Device n | Dev_or_Path n | String n
       | OptString n | Bool n | Int n | FileIn n | FileOut n ->
           pr "$%s" n
-      | StringList n ->
+      | StringList n | DeviceList n ->
           pr "\\@%s" n
   ) (snd style);
   pr ");"
@@ -7309,12 +7483,12 @@ and generate_python_c () =
   generate_header CStyle LGPLv2;
 
   pr "\
+#include <Python.h>
+
 #include <stdio.h>
 #include <stdlib.h>
 #include <assert.h>
 
-#include <Python.h>
-
 #include \"guestfs.h\"
 
 typedef struct {
@@ -7339,11 +7513,11 @@ put_handle (guestfs_h *g)
 }
 
 /* This list should be freed (but not the strings) after use. */
-static const char **
+static char **
 get_string_list (PyObject *obj)
 {
   int i, len;
-  const char **r;
+  char **r;
 
   assert (obj);
 
@@ -7445,6 +7619,21 @@ py_guestfs_close (PyObject *self, PyObject *args)
 
 ";
 
+  let emit_put_list_function typ =
+    pr "static PyObject *\n";
+    pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
+    pr "{\n";
+    pr "  PyObject *list;\n";
+    pr "  int i;\n";
+    pr "\n";
+    pr "  list = PyList_New (%ss->len);\n" typ;
+    pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
+    pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
+    pr "  return list;\n";
+    pr "};\n";
+    pr "\n"
+  in
+
   (* Structures, turned into Python dictionaries. *)
   List.iter (
     fun (typ, cols) ->
@@ -7491,7 +7680,7 @@ py_guestfs_close (PyObject *self, PyObject *args)
               typ name;
             pr "  else {\n";
             pr "    Py_INCREF (Py_None);\n";
-            pr "    PyDict_SetItemString (dict, \"%s\", Py_None);" name;
+            pr "    PyDict_SetItemString (dict, \"%s\", Py_None);\n" name;
             pr "  }\n"
         | name, FChar ->
             pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
@@ -7501,20 +7690,17 @@ py_guestfs_close (PyObject *self, PyObject *args)
       pr "};\n";
       pr "\n";
 
-      pr "static PyObject *\n";
-      pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
-      pr "{\n";
-      pr "  PyObject *list;\n";
-      pr "  int i;\n";
-      pr "\n";
-      pr "  list = PyList_New (%ss->len);\n" typ;
-      pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
-      pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
-      pr "  return list;\n";
-      pr "};\n";
-      pr "\n"
   ) structs;
 
+  (* Emit a put_TYPE_list function definition only if that function is used. *)
+  List.iter (
+    function
+    | typ, (RStructListOnly | RStructAndList) ->
+        (* generate the function for typ *)
+        emit_put_list_function typ
+    | typ, _ -> () (* empty *)
+  ) rstructs_used;
+
   (* Python wrapper functions. *)
   List.iter (
     fun (name, style, _, _, _, _, _) ->
@@ -7547,9 +7733,9 @@ py_guestfs_close (PyObject *self, PyObject *args)
         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
             pr "  const char *%s;\n" n
         | OptString n -> pr "  const char *%s;\n" n
-        | StringList n ->
+        | StringList n | DeviceList n ->
             pr "  PyObject *py_%s;\n" n;
-            pr "  const char **%s;\n" n
+            pr "  char **%s;\n" n
         | Bool n -> pr "  int %s;\n" n
         | Int n -> pr "  int %s;\n" n
       ) (snd style);
@@ -7562,7 +7748,7 @@ py_guestfs_close (PyObject *self, PyObject *args)
         function
         | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
         | OptString _ -> pr "z"
-        | StringList _ -> pr "O"
+        | StringList _ | DeviceList _ -> pr "O"
         | Bool _ -> pr "i" (* XXX Python has booleans? *)
         | Int _ -> pr "i"
       ) (snd style);
@@ -7572,7 +7758,7 @@ py_guestfs_close (PyObject *self, PyObject *args)
         function
         | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
         | OptString n -> pr ", &%s" n
-        | StringList n -> pr ", &py_%s" n
+        | StringList n | DeviceList n -> pr ", &py_%s" n
         | Bool n -> pr ", &%s" n
         | Int n -> pr ", &%s" n
       ) (snd style);
@@ -7585,7 +7771,7 @@ py_guestfs_close (PyObject *self, PyObject *args)
         function
         | Pathname _ | Device _ | Dev_or_Path _ | String _
         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
-        | StringList n ->
+        | StringList n | DeviceList n ->
             pr "  %s = get_string_list (py_%s);\n" n n;
             pr "  if (!%s) return NULL;\n" n
       ) (snd style);
@@ -7600,7 +7786,7 @@ py_guestfs_close (PyObject *self, PyObject *args)
         function
         | Pathname _ | Device _ | Dev_or_Path _ | String _
         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
-        | StringList n ->
+        | StringList n | DeviceList n ->
             pr "  free (%s);\n" n
       ) (snd style);
 
@@ -7828,9 +8014,7 @@ and pod2text ~width name longdesc =
          failwithf "pod2text: process signalled or stopped by signal %d" i
     );
     Hashtbl.add pod2text_memo key lines;
-    let chan = open_out pod2text_memo_filename in
-    output_value chan pod2text_memo;
-    close_out chan;
+    pod2text_memo_updated ();
     lines
 
 (* Generate ruby bindings. *)
@@ -7915,7 +8099,7 @@ static VALUE ruby_guestfs_close (VALUE gv)
             pr "              \"%s\", \"%s\");\n" n name
         | OptString n ->
             pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
-        | StringList n ->
+        | StringList n | DeviceList n ->
             pr "  char **%s;\n" n;
             pr "  Check_Type (%sv, T_ARRAY);\n" n;
             pr "  {\n";
@@ -7961,7 +8145,7 @@ static VALUE ruby_guestfs_close (VALUE gv)
         function
         | Pathname _ | Device _ | Dev_or_Path _ | String _
         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
-        | StringList n ->
+        | StringList n | DeviceList n ->
             pr "  free (%s);\n" n
       ) (snd style);
 
@@ -8277,7 +8461,7 @@ and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
       | FileIn n
       | FileOut n ->
           pr "String %s" n
-      | StringList n ->
+      | StringList n | DeviceList n ->
           pr "String[] %s" n
       | Bool n ->
           pr "boolean %s" n
@@ -8396,7 +8580,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
         | FileIn n
         | FileOut n ->
             pr ", jstring j%s" n
-        | StringList n ->
+        | StringList n | DeviceList n ->
             pr ", jobjectArray j%s" n
         | Bool n ->
             pr ", jboolean j%s" n
@@ -8449,7 +8633,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
         | FileIn n
         | FileOut n ->
             pr "  const char *%s;\n" n
-        | StringList n ->
+        | StringList n | DeviceList n ->
             pr "  int %s_len;\n" n;
             pr "  const char **%s;\n" n
         | Bool n
@@ -8463,7 +8647,10 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
          | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
          | RConstOptString _
          | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
-          List.exists (function StringList _ -> true | _ -> false) (snd style) in
+          List.exists (function
+                       | StringList _ -> true
+                       | DeviceList _ -> true
+                       | _ -> false) (snd style) in
       if needs_i then
         pr "  int i;\n";
 
@@ -8483,7 +8670,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
              * a NULL parameter.
              *)
             pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
-        | StringList n ->
+        | StringList n | DeviceList n ->
             pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
             pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
@@ -8514,7 +8701,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
         | OptString n ->
             pr "  if (j%s)\n" n;
             pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
-        | StringList n ->
+        | StringList n | DeviceList n ->
             pr "  for (i = 0; i < %s_len; ++i) {\n" n;
             pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
               n;
@@ -8783,7 +8970,7 @@ last_error h = do
           | FileOut n
           | Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n
           | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
-          | StringList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
+          | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
           | Bool _ | Int _ -> ()
         ) (snd style);
         (* Convert integer arguments. *)
@@ -8793,7 +8980,7 @@ last_error h = do
             | Bool n -> sprintf "(fromBool %s)" n
             | Int n -> sprintf "(fromIntegral %s)" n
             | FileIn n | FileOut n
-            | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n -> n
+            | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
           ) (snd style) in
         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
           (String.concat " " ("p" :: args));
@@ -8845,7 +9032,7 @@ and generate_haskell_prototype ~handle ?(hs = false) style =
       (match arg with
        | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
-       | StringList _ -> if hs then pr "[String]" else pr "Ptr CString"
+       | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
        | Bool _ -> pr "%s" bool
        | Int _ -> pr "%s" int
        | FileIn _ -> pr "%s" string
@@ -8891,7 +9078,7 @@ and generate_bindtests () =
 #define safe_malloc guestfs_safe_malloc
 
 static void
-print_strings (char * const* const argv)
+print_strings (char *const *argv)
 {
   int argc;
 
@@ -8924,7 +9111,7 @@ print_strings (char * const* const argv)
       | FileIn n
       | FileOut n -> pr "  printf (\"%%s\\n\", %s);\n" n
       | OptString n -> pr "  printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
-      | StringList n -> pr "  print_strings (%s);\n" n
+      | StringList n | DeviceList n -> pr "  print_strings (%s);\n" n
       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
     ) (snd style);