Make tmp directory world readable (RHBZ#610880).

[libguestfs.git] / src / generator.ml

diff --git a/src/generator.ml b/src/generator.ml
index c6a1262..d640343 100755 (executable)
--- a/src/generator.ml
+++ b/src/generator.ml
@@ -309,6 +309,9 @@ and test_prereq =
     (* As for 'If' but the test runs _unless_ the code returns true. *)
   | Unless of string
 
     (* As for 'If' but the test runs _unless_ the code returns true. *)
   | Unless of string
 

+    (* Run the test only if 'string' is available in the daemon. *)
+  | IfAvailable of string
+

 (* Some initial scenarios for testing. *)
 and test_init =
     (* Do nothing, block devices could contain random stuff including
 (* Some initial scenarios for testing. *)
 and test_init =
     (* Do nothing, block devices could contain random stuff including


@@ -989,7 +992,10 @@ closing the handle.");
    "\
 Touch acts like the L<touch(1)> command.  It can be used to
 update the timestamps on a file, or, if the file does not exist,
    "\
 Touch acts like the L<touch(1)> command.  It can be used to
 update the timestamps on a file, or, if the file does not exist,

-to create a new zero-length file.");
+to create a new zero-length file.
+
+This command only works on regular files, and will fail on other
+file types such as directories, symbolic links, block special etc.");

 
   ("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
    [InitISOFS, Always, TestOutput (
 
   ("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
    [InitISOFS, Always, TestOutput (


@@ -1543,7 +1549,9 @@ See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>,
 C<guestfs_part_init>");
 
   ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning; DeprecatedBy "write"],
 C<guestfs_part_init>");
 
   ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning; DeprecatedBy "write"],

-   [],
+   (* Regression test for RHBZ#597135. *)
+   [InitBasicFS, Always, TestLastFail
+      [["write_file"; "/new"; "abc"; "10000"]]],

    "create a file",
    "\
 This call creates a file called C<path>.  The contents of the
    "create a file",
    "\
 This call creates a file called C<path>.  The contents of the


@@ -1624,19 +1632,32 @@ and physical volumes.");
     InitISOFS, Always, TestOutput (
       [["file"; "/known-1"]], "ASCII text");
     InitISOFS, Always, TestLastFail (
     InitISOFS, Always, TestOutput (
       [["file"; "/known-1"]], "ASCII text");
     InitISOFS, Always, TestLastFail (

-      [["file"; "/notexists"]])],
+      [["file"; "/notexists"]]);
+    InitISOFS, Always, TestOutput (
+      [["file"; "/abssymlink"]], "symbolic link");
+    InitISOFS, Always, TestOutput (
+      [["file"; "/directory"]], "directory")],

    "determine file type",
    "\
 This call uses the standard L<file(1)> command to determine
    "determine file type",
    "\
 This call uses the standard L<file(1)> command to determine

-the type or contents of the file.  This also works on devices,
-for example to find out whether a partition contains a filesystem.
+the type or contents of the file.

 
 This call will also transparently look inside various types
 of compressed file.
 
 
 This call will also transparently look inside various types
 of compressed file.
 

-The exact command which runs is C<file -zbsL path>.  Note in
+The exact command which runs is C<file -zb path>.  Note in

 particular that the filename is not prepended to the output
 particular that the filename is not prepended to the output

-(the C<-b> option).");
+(the C<-b> option).
+
+This command can also be used on C</dev/> devices
+(and partitions, LV names).  You can for example use this
+to determine if a device contains a filesystem, although
+it's usually better to use C<guestfs_vfs_type>.
+
+If the C<path> does not begin with C</dev/> then
+this command only works for the content of regular files.
+For other file types (directory, symbolic link etc) it
+will just return the string C<directory> etc.");

 
   ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
    [InitBasicFS, Always, TestOutput (
 
   ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
    [InitBasicFS, Always, TestOutput (


@@ -2222,7 +2243,7 @@ C<device> to C<label>.  Filesystem labels are limited to
 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
 to return the existing label on a filesystem.");
 
 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
 to return the existing label on a filesystem.");
 

-  ("get_e2label", (RString "label", [Device "device"]), 81, [],
+  ("get_e2label", (RString "label", [Device "device"]), 81, [DeprecatedBy "vfs_label"],

    [],
    "get the ext2/3/4 filesystem label",
    "\
    [],
    "get the ext2/3/4 filesystem label",
    "\


@@ -2252,8 +2273,13 @@ L<tune2fs(8)> manpage.
 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
 to return the existing UUID of a filesystem.");
 
 You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
 to return the existing UUID of a filesystem.");
 

-  ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [],
-   [],
+  ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [DeprecatedBy "vfs_uuid"],
+   (* Regression test for RHBZ#597112. *)
+   (let uuid = uuidgen () in
+    [InitBasicFS, Always, TestOutput (
+       [["mke2journal"; "1024"; "/dev/sdb"];
+        ["set_e2uuid"; "/dev/sdb"; uuid];
+        ["get_e2uuid"; "/dev/sdb"]], uuid)]),

    "get the ext2/3/4 filesystem UUID",
    "\
 This returns the ext2/3/4 filesystem UUID of the filesystem on
    "get the ext2/3/4 filesystem UUID",
    "\
 This returns the ext2/3/4 filesystem UUID of the filesystem on


@@ -2313,16 +2339,30 @@ any partition tables, filesystem superblocks and so on.
 See also: C<guestfs_zero_device>, C<guestfs_scrub_device>.");
 
   ("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
 See also: C<guestfs_zero_device>, C<guestfs_scrub_device>.");
 
   ("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],

-   (* Test disabled because grub-install incompatible with virtio-blk driver.
-    * See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760
+   (* See:
+    * https://bugzilla.redhat.com/show_bug.cgi?id=484986
+    * https://bugzilla.redhat.com/show_bug.cgi?id=479760

     *)
     *)

-   [InitBasicFS, Disabled, TestOutputTrue (
-      [["grub_install"; "/"; "/dev/sda1"];
+   [InitBasicFS, Always, TestOutputTrue (
+      [["mkdir_p"; "/boot/grub"];
+       ["write"; "/boot/grub/device.map"; "(hd0) /dev/vda"];
+       ["grub_install"; "/"; "/dev/vda"];

        ["is_dir"; "/boot"]])],
    "install GRUB",
    "\
 This command installs GRUB (the Grand Unified Bootloader) on
        ["is_dir"; "/boot"]])],
    "install GRUB",
    "\
 This command installs GRUB (the Grand Unified Bootloader) on

-C<device>, with the root directory being C<root>.");
+C<device>, with the root directory being C<root>.
+
+Note: If grub-install reports the error
+\"No suitable drive was found in the generated device map.\"
+it may be that you need to create a C</boot/grub/device.map>
+file first that contains the mapping between grub device names
+and Linux device names.  It is usually sufficient to create
+a file containing:
+
+ (hd0) /dev/vda
+
+replacing C</dev/vda> with the name of the installation device.");

 
   ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
    [InitBasicFS, Always, TestOutput (
 
   ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
    [InitBasicFS, Always, TestOutput (


@@ -2634,9 +2674,9 @@ is lost.");
 
   ("resize2fs", (RErr, [Device "device"]), 106, [],
    [], (* lvresize tests this *)
 
   ("resize2fs", (RErr, [Device "device"]), 106, [],
    [], (* lvresize tests this *)

-   "resize an ext2/ext3 filesystem",
+   "resize an ext2, ext3 or ext4 filesystem",

    "\
    "\

-This resizes an ext2 or ext3 filesystem to match the size of
+This resizes an ext2, ext3 or ext4 filesystem to match the size of

 the underlying device.
 
 I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
 the underlying device.
 
 I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>


@@ -3708,13 +3748,28 @@ and C<guestfs_setcon>");
        ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
        ["mount_options"; ""; "/dev/sda1"; "/"];
        ["write"; "/new"; "new file contents"];
        ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
        ["mount_options"; ""; "/dev/sda1"; "/"];
        ["write"; "/new"; "new file contents"];

-       ["cat"; "/new"]], "new file contents")],
+       ["cat"; "/new"]], "new file contents");
+    InitEmpty, Always, TestRun (
+      [["part_disk"; "/dev/sda"; "mbr"];
+       ["mkfs_b"; "vfat"; "32768"; "/dev/sda1"]]);
+    InitEmpty, Always, TestLastFail (
+      [["part_disk"; "/dev/sda"; "mbr"];
+       ["mkfs_b"; "vfat"; "32769"; "/dev/sda1"]]);
+    InitEmpty, Always, TestLastFail (
+      [["part_disk"; "/dev/sda"; "mbr"];
+       ["mkfs_b"; "vfat"; "33280"; "/dev/sda1"]]);
+    InitEmpty, IfAvailable "ntfsprogs", TestRun (
+      [["part_disk"; "/dev/sda"; "mbr"];
+       ["mkfs_b"; "ntfs"; "32768"; "/dev/sda1"]])],

    "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
    "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.");
+are C<1024>, C<2048> or C<4096> only.
+
+For VFAT and NTFS the C<blocksize> parameter is treated as
+the requested cluster size.");

 
   ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
    [InitEmpty, Always, TestOutput (
 
   ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
    [InitEmpty, Always, TestOutput (


@@ -3904,12 +3959,13 @@ See also C<guestfs_realpath>.");
       [["vfs_type"; "/dev/sda1"]], "ext2")],
    "get the Linux VFS type corresponding to a mounted device",
    "\
       [["vfs_type"; "/dev/sda1"]], "ext2")],
    "get the Linux VFS type corresponding to a mounted device",
    "\

-This command gets the block device type corresponding to
-a mounted device called C<device>.
+This command gets the filesystem type corresponding to
+the filesystem on C<device>.

 
 

-Usually the result is the name of the Linux VFS module that
-is used to mount this device (probably determined automatically
-if you used the C<guestfs_mount> call).");
+For most filesystems, the result is the name of the Linux
+VFS module which would be used to mount this filesystem
+if you mounted it without specifying the filesystem type.
+For example a string such as C<ext3> or C<ntfs>.");

 
   ("truncate", (RErr, [Pathname "path"]), 199, [],
    [InitBasicFS, Always, TestOutputStruct (
 
   ("truncate", (RErr, [Pathname "path"]), 199, [],
    [InitBasicFS, Always, TestOutputStruct (


@@ -4700,7 +4756,7 @@ See also C<guestfs_pread>.");
 
   ("resize2fs_size", (RErr, [Device "device"; Int64 "size"]), 248, [],
    [],
 
   ("resize2fs_size", (RErr, [Device "device"; Int64 "size"]), 248, [],
    [],

-   "resize an ext2/ext3 filesystem (with size)",
+   "resize an ext2, ext3 or ext4 filesystem (with size)",

    "\
 This command is the same as C<guestfs_resize2fs> except that it
 allows you to specify the new size (in bytes) explicitly.");
    "\
 This command is the same as C<guestfs_resize2fs> except that it
 allows you to specify the new size (in bytes) explicitly.");


@@ -4753,6 +4809,29 @@ Do not confuse this with the guestfish-specific
 C<alloc> and C<sparse> commands which create
 a file in the host and attach it as a device.");
 
 C<alloc> and C<sparse> commands which create
 a file in the host and attach it as a device.");
 

+  ("vfs_label", (RString "label", [Device "device"]), 253, [],
+   [InitBasicFS, Always, TestOutput (
+       [["set_e2label"; "/dev/sda1"; "LTEST"];
+        ["vfs_label"; "/dev/sda1"]], "LTEST")],
+   "get the filesystem label",
+   "\
+This returns the filesystem label of the filesystem on
+C<device>.
+
+If the filesystem is unlabeled, this returns the empty string.");
+
+  ("vfs_uuid", (RString "uuid", [Device "device"]), 254, [],
+   (let uuid = uuidgen () in
+    [InitBasicFS, Always, TestOutput (
+       [["set_e2uuid"; "/dev/sda1"; uuid];
+        ["vfs_uuid"; "/dev/sda1"]], uuid)]),
+   "get the filesystem UUID",
+   "\
+This returns the filesystem UUID of the filesystem on
+C<device>.
+
+If the filesystem does not have a UUID, this returns the empty string.");
+

 ]
 
 let all_functions = non_daemon_functions @ daemon_functions
 ]
 
 let all_functions = non_daemon_functions @ daemon_functions


@@ -6258,6 +6337,7 @@ and generate_linker_script () =
     "guestfs_get_error_handler";
     "guestfs_get_out_of_memory_handler";
     "guestfs_last_error";
     "guestfs_get_error_handler";
     "guestfs_get_out_of_memory_handler";
     "guestfs_last_error";

+    "guestfs_set_close_callback";

     "guestfs_set_error_handler";
     "guestfs_set_launch_done_callback";
     "guestfs_set_log_message_callback";
     "guestfs_set_error_handler";
     "guestfs_set_launch_done_callback";
     "guestfs_set_log_message_callback";


@@ -6269,6 +6349,8 @@ and generate_linker_script () =
      *)
     "guestfs_safe_calloc";
     "guestfs_safe_malloc";
      *)
     "guestfs_safe_calloc";
     "guestfs_safe_malloc";

+    "guestfs_safe_strdup";
+    "guestfs_safe_memdup";

   ] in
   let functions =
     List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
   ] in
   let functions =
     List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)


@@ -6793,6 +6875,26 @@ static void print_table (char const *const *argv)
 }
 */
 
 }
 */
 

+static int
+is_available (const char *group)
+{
+  const char *groups[] = { group, NULL };
+  int r;
+
+  suppress_error = 1;
+  r = guestfs_available (g, (char **) groups);
+  suppress_error = 0;
+
+  return r == 0;
+}
+
+static void
+incr (guestfs_h *g, void *iv)
+{
+  int *i = (int *) iv;
+  (*i)++;
+}
+

 ";
 
   (* Generate a list of commands which are not tested anywhere. *)
 ";
 
   (* Generate a list of commands which are not tested anywhere. *)


@@ -6804,7 +6906,7 @@ static void print_table (char const *const *argv)
     fun (_, _, _, _, tests, _, _) ->
       let tests = filter_map (
         function
     fun (_, _, _, _, tests, _, _) ->
       let tests = filter_map (
         function

-        | (_, (Always|If _|Unless _), test) -> Some test
+        | (_, (Always|If _|Unless _|IfAvailable _), test) -> Some test

         | (_, Disabled, _) -> None
       ) tests in
       let seq = List.concat (List.map seq_of_test tests) in
         | (_, Disabled, _) -> None
       ) tests in
       let seq = List.concat (List.map seq_of_test tests) in


@@ -6974,11 +7076,22 @@ int main (int argc, char *argv[])
   ) test_names;
   pr "\n";
 
   ) test_names;
   pr "\n";
 

-  pr "  guestfs_close (g);\n";
-  pr "  unlink (\"test1.img\");\n";
-  pr "  unlink (\"test2.img\");\n";
-  pr "  unlink (\"test3.img\");\n";
-  pr "\n";
+  pr "  /* Check close callback is called. */
+  int close_sentinel = 1;
+  guestfs_set_close_callback (g, incr, &close_sentinel);
+
+  guestfs_close (g);
+
+  if (close_sentinel != 2) {
+    fprintf (stderr, \"close callback was not called\\n\");
+    exit (EXIT_FAILURE);
+  }
+
+  unlink (\"test1.img\");
+  unlink (\"test2.img\");
+  unlink (\"test3.img\");
+
+";

 
   pr "  if (n_failed > 0) {\n";
   pr "    printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
 
   pr "  if (n_failed > 0) {\n";
   pr "    printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";


@@ -7010,7 +7123,7 @@ static int %s_skip (void)
 " test_name name (String.uppercase test_name) (String.uppercase name);
 
   (match prereq with
 " test_name name (String.uppercase test_name) (String.uppercase name);
 
   (match prereq with

-   | Disabled | Always -> ()
+   | Disabled | Always | IfAvailable _ -> ()

    | If code | Unless code ->
        pr "static int %s_prereq (void)\n" test_name;
        pr "{\n";
    | If code | Unless code ->
        pr "static int %s_prereq (void)\n" test_name;
        pr "{\n";


@@ -7035,16 +7148,9 @@ static int %s (void)
   List.iter (
     function
     | Optional group ->
   List.iter (
     function
     | Optional group ->

-        pr "  {\n";
-        pr "    const char *groups[] = { \"%s\", NULL };\n" group;
-        pr "    int r;\n";
-        pr "    suppress_error = 1;\n";
-        pr "    r = guestfs_available (g, (char **) groups);\n";
-        pr "    suppress_error = 0;\n";
-        pr "    if (r == -1) {\n";
-        pr "      printf (\"        %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", groups[0]);\n" test_name;
-        pr "      return 0;\n";
-        pr "    }\n";
+        pr "  if (!is_available (\"%s\")) {\n" group;
+        pr "    printf (\"        %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", \"%s\");\n" test_name group;
+        pr "    return 0;\n";

         pr "  }\n";
     | _ -> ()
   ) flags;
         pr "  }\n";
     | _ -> ()
   ) flags;


@@ -7066,6 +7172,13 @@ static int %s (void)
        pr "  }\n";
        pr "\n";
        generate_one_test_body name i test_name init test;
        pr "  }\n";
        pr "\n";
        generate_one_test_body name i test_name init test;

+   | IfAvailable group ->
+       pr "  if (!is_available (\"%s\")) {\n" group;
+       pr "    printf (\"        %%s skipped (reason: %%s not available)\\n\", \"%s\", \"%s\");\n" test_name group;
+       pr "    return 0;\n";
+       pr "  }\n";
+       pr "\n";
+       generate_one_test_body name i test_name init test;

    | Always ->
        generate_one_test_body name i test_name init test
   );
    | Always ->
        generate_one_test_body name i test_name init test
   );


@@ -7544,7 +7657,7 @@ and generate_fish_cmds () =
   pr "\n";
 
   (* display_command function, which implements guestfish -h cmd *)
   pr "\n";
 
   (* display_command function, which implements guestfish -h cmd *)

-  pr "void display_command (const char *cmd)\n";
+  pr "int display_command (const char *cmd)\n";

   pr "{\n";
   List.iter (
     fun (name, style, _, flags, _, shortdesc, longdesc) ->
   pr "{\n";
   List.iter (
     fun (name, style, _, flags, _, shortdesc, longdesc) ->


@@ -7592,15 +7705,17 @@ and generate_fish_cmds () =
         pr " || STRCASEEQ (cmd, \"%s\")" name2;
       if name <> alias then
         pr " || STRCASEEQ (cmd, \"%s\")" alias;
         pr " || STRCASEEQ (cmd, \"%s\")" name2;
       if name <> alias then
         pr " || STRCASEEQ (cmd, \"%s\")" alias;

-      pr ")\n";
+      pr ") {\n";

       pr "    pod2text (\"%s\", _(\"%s\"), %S);\n"
         name2 shortdesc
         ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
          "=head1 DESCRIPTION\n\n" ^
          longdesc ^ warnings ^ describe_alias);
       pr "    pod2text (\"%s\", _(\"%s\"), %S);\n"
         name2 shortdesc
         ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
          "=head1 DESCRIPTION\n\n" ^
          longdesc ^ warnings ^ describe_alias);

+      pr "    return 0;\n";
+      pr "  }\n";

       pr "  else\n"
   ) all_functions;
       pr "  else\n"
   ) all_functions;

-  pr "    display_builtin_command (cmd);\n";
+  pr "    return display_builtin_command (cmd);\n";

   pr "}\n";
   pr "\n";
 
   pr "}\n";
   pr "\n";
 


@@ -8282,7 +8397,7 @@ and generate_ocaml_c () =
 #include <caml/mlvalues.h>
 #include <caml/signals.h>
 
 #include <caml/mlvalues.h>
 #include <caml/signals.h>
 

-#include <guestfs.h>
+#include \"guestfs.h\"

 
 #include \"guestfs_c.h\"
 
 
 #include \"guestfs_c.h\"
 


@@ -8450,14 +8565,15 @@ copy_table (char * const * argv)
         | String n
         | FileIn n
         | FileOut n ->
         | String n
         | FileIn n
         | FileOut n ->

-            pr "  const char *%s = String_val (%sv);\n" n n
+            (* Copy strings in case the GC moves them: RHBZ#604691 *)
+            pr "  char *%s = guestfs_safe_strdup (g, String_val (%sv));\n" n n

         | OptString n ->
         | OptString n ->

-            pr "  const char *%s =\n" n;
-            pr "    %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
-              n n
+            pr "  char *%s =\n" n;
+            pr "    %sv != Val_int (0) ?" n;
+            pr "      guestfs_safe_strdup (g, String_val (Field (%sv, 0))) : NULL;\n" n

         | BufferIn n ->
         | BufferIn n ->

-            pr "  const char *%s = String_val (%sv);\n" n n;
-            pr "  size_t %s_size = caml_string_length (%sv);\n" n n
+            pr "  size_t %s_size = caml_string_length (%sv);\n" n n;
+            pr "  char *%s = guestfs_safe_memdup (g, String_val (%sv), %s_size);\n" n n n

         | StringList n | DeviceList n ->
             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
         | Bool n ->
         | StringList n | DeviceList n ->
             pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
         | Bool n ->


@@ -8500,13 +8616,15 @@ copy_table (char * const * argv)
       pr ";\n";
       pr "  caml_leave_blocking_section ();\n";
 
       pr ";\n";
       pr "  caml_leave_blocking_section ();\n";
 

+      (* Free strings if we copied them above. *)

       List.iter (
         function
       List.iter (
         function

+        | Pathname n | Device n | Dev_or_Path n | String n | OptString n
+        | FileIn n | FileOut n | BufferIn n ->
+            pr "  free (%s);\n" n

         | StringList n | DeviceList n ->
             pr "  ocaml_guestfs_free_strings (%s);\n" n;
         | StringList n | DeviceList n ->
             pr "  ocaml_guestfs_free_strings (%s);\n" n;

-        | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
-        | Bool _ | Int _ | Int64 _
-        | FileIn _ | FileOut _ | BufferIn _ -> ()
+        | Bool _ | Int _ | Int64 _ -> ()

       ) (snd style);
 
       pr "  if (r == %s)\n" error_code;
       ) (snd style);
 
       pr "  if (r == %s)\n" error_code;


@@ -8708,10 +8826,30 @@ _create ()
       RETVAL
 
 void
       RETVAL
 
 void

-DESTROY (g)
+DESTROY (sv)
+      SV *sv;
+ PPCODE:
+      /* For the 'g' argument above we do the conversion explicitly and
+       * don't rely on the typemap, because if the handle has been
+       * explicitly closed we don't want the typemap conversion to
+       * display an error.
+       */
+      HV *hv = (HV *) SvRV (sv);
+      SV **svp = hv_fetch (hv, \"_g\", 2, 0);
+      if (svp != NULL) {
+        guestfs_h *g = (guestfs_h *) SvIV (*svp);
+        assert (g != NULL);
+        guestfs_close (g);
+      }
+
+void
+close (g)

       guestfs_h *g;
  PPCODE:
       guestfs_close (g);
       guestfs_h *g;
  PPCODE:
       guestfs_close (g);

+      /* Avoid double-free in DESTROY method. */
+      HV *hv = (HV *) SvRV (ST(0));
+      (void) hv_delete (hv, \"_g\", 2, G_DISCARD);

 
 ";
 
 
 ";
 


@@ -9066,11 +9204,28 @@ sub new {
   my $proto = shift;
   my $class = ref ($proto) || $proto;
 
   my $proto = shift;
   my $class = ref ($proto) || $proto;
 

-  my $self = Sys::Guestfs::_create ();
+  my $g = Sys::Guestfs::_create ();
+  my $self = { _g => $g };

   bless $self, $class;
   return $self;
 }
 
   bless $self, $class;
   return $self;
 }
 

+=item $h->close ();
+
+Explicitly close the guestfs handle.
+
+B<Note:> You should not usually call this function.  The handle will
+be closed implicitly when its reference count goes to zero (eg.
+when it goes out of scope or the program ends).  This call is
+only required in some exceptional cases, such as where the program
+may contain cached references to the handle 'somewhere' and you
+really have to have the close happen right away.  After calling
+C<close> the program must not call any method (including C<close>)
+on the handle (but the implicit call to C<DESTROY> that happens
+when the final reference is cleaned up is OK).
+
+=cut
+

 " max_proc_nr;
 
   (* Actions.  We only need to print documentation for these as
 " max_proc_nr;
 
   (* Actions.  We only need to print documentation for these as