Implement device name translation. Remove device name hacks in tests.

[libguestfs.git] / src / generator.ml

diff --git a/src/generator.ml b/src/generator.ml
index 23738bd..c4f2851 100755 (executable)
--- a/src/generator.ml
+++ b/src/generator.ml
@@ -33,6 +33,7 @@
  *)
 
 #load "unix.cma";;
  *)
 
 #load "unix.cma";;

+#load "str.cma";;

 
 open Printf
 
 
 open Printf
 


@@ -115,6 +116,7 @@ type flags =
   | FishAlias of string          (* provide an alias for this cmd in guestfish *)
   | FishAction of string  (* call this function in guestfish *)
   | NotInFish            (* do not export via guestfish *)
   | FishAlias of string          (* provide an alias for this cmd in guestfish *)
   | FishAction of string  (* call this function in guestfish *)
   | NotInFish            (* do not export via guestfish *)

+  | NotInDocs            (* do not add this function to documentation *)

 
 let protocol_limit_warning =
   "Because of the message protocol, there is a transfer limit 
 
 let protocol_limit_warning =
   "Because of the message protocol, there is a transfer limit 


@@ -128,19 +130,41 @@ can easily destroy all your data>."
 (* You can supply zero or as many tests as you want per API call.
  *
  * Note that the test environment has 3 block devices, of size 500MB,
 (* You can supply zero or as many tests as you want per API call.
  *
  * Note that the test environment has 3 block devices, of size 500MB,

- * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc).
+ * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc), and
+ * a fourth squashfs block device with some known files on it (/dev/sdd).
+ *

  * Note for partitioning purposes, the 500MB device has 63 cylinders.
  *
  * Note for partitioning purposes, the 500MB device has 63 cylinders.
  *

+ * The squashfs block device (/dev/sdd) comes from images/test.sqsh.
+ *

  * To be able to run the tests in a reasonable amount of time,
  * the virtual machine and block devices are reused between tests.
  * So don't try testing kill_subprocess :-x
  *
  * To be able to run the tests in a reasonable amount of time,
  * the virtual machine and block devices are reused between tests.
  * So don't try testing kill_subprocess :-x
  *

- * Between each test we umount-all and lvm-remove-all (except InitNone).
+ * Between each test we blockdev-setrw, umount-all, lvm-remove-all.
+ *
+ * If the appliance is running an older Linux kernel (eg. RHEL 5) then
+ * devices are named /dev/hda etc.  To cope with this, the test suite
+ * adds some hairly logic to detect this case, and then automagically
+ * replaces all strings which match "/dev/sd.*" with "/dev/hd.*".
+ * When writing test cases you shouldn't have to worry about this
+ * difference.

  *
  * Don't assume anything about the previous contents of the block
  * devices.  Use 'Init*' to create some initial scenarios.
  *
  * Don't assume anything about the previous contents of the block
  * devices.  Use 'Init*' to create some initial scenarios.

+ *
+ * You can add a prerequisite clause to any individual test.  This
+ * is a run-time check, which, if it fails, causes the test to be
+ * skipped.  Useful if testing a command which might not work on
+ * all variations of libguestfs builds.  A test that has prerequisite
+ * of 'Always' is run unconditionally.
+ *
+ * In addition, packagers can skip individual tests by setting the
+ * environment variables:     eg:
+ *   SKIP_TEST_<CMD>_<NUM>=1  SKIP_TEST_COMMAND_3=1  (skips test #3 of command)
+ *   SKIP_TEST_<CMD>=1        SKIP_TEST_ZEROFREE=1   (skips all zerofree tests)

  *)
  *)

-type tests = (test_init * test) list
+type tests = (test_init * test_prereq * test) list

 and test =
     (* Run the command sequence and just expect nothing to fail. *)
   | TestRun of seq
 and test =
     (* Run the command sequence and just expect nothing to fail. *)
   | TestRun of seq


@@ -153,6 +177,12 @@ and test =
      *)
   | TestOutputList of seq * string list
     (* Run the command sequence and expect the output of the final
      *)
   | TestOutputList of seq * string list
     (* Run the command sequence and expect the output of the final

+     * command to be the list of block devices (could be either
+     * "/dev/sd.." or "/dev/hd.." form - we don't check the 5th
+     * character of each string).
+     *)
+  | TestOutputListOfDevices of seq * string list
+    (* Run the command sequence and expect the output of the final

      * command to be the integer.
      *)
   | TestOutputInt of seq * int
      * command to be the integer.
      *)
   | TestOutputInt of seq * int


@@ -184,6 +214,21 @@ and test_field_compare =
   | CompareFieldsIntEq of string * string
   | CompareFieldsStrEq of string * string
 
   | CompareFieldsIntEq of string * string
   | CompareFieldsStrEq of string * string
 

+(* Test prerequisites. *)
+and test_prereq =
+    (* Test always runs. *)
+  | Always
+    (* Test is currently disabled - eg. it fails, or it tests some
+     * unimplemented feature.
+     *)
+  | Disabled
+    (* 'string' is some C code (a function body) that should return
+     * true or false.  The test will run if the code returns true.
+     *)
+  | If of string
+    (* As for 'If' but the test runs _unless_ the code returns true. *)
+  | Unless 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


@@ -219,7 +264,81 @@ and cmd = string list
  * Apart from that, long descriptions are just perldoc paragraphs.
  *)
 
  * Apart from that, long descriptions are just perldoc paragraphs.
  *)
 

-let non_daemon_functions = [
+(* These test functions are used in the language binding tests. *)
+
+let test_all_args = [
+  String "str";
+  OptString "optstr";
+  StringList "strlist";
+  Bool "b";
+  Int "integer";
+  FileIn "filein";
+  FileOut "fileout";
+]
+
+let test_all_rets = [
+  (* except for RErr, which is tested thoroughly elsewhere *)
+  "test0rint",         RInt "valout";
+  "test0rint64",       RInt64 "valout";
+  "test0rbool",        RBool "valout";
+  "test0rconststring", RConstString "valout";
+  "test0rstring",      RString "valout";
+  "test0rstringlist",  RStringList "valout";
+  "test0rintbool",     RIntBool ("valout", "valout");
+  "test0rpvlist",      RPVList "valout";
+  "test0rvglist",      RVGList "valout";
+  "test0rlvlist",      RLVList "valout";
+  "test0rstat",        RStat "valout";
+  "test0rstatvfs",     RStatVFS "valout";
+  "test0rhashtable",   RHashtable "valout";
+]
+
+let test_functions = [
+  ("test0", (RErr, test_all_args), -1, [NotInFish; NotInDocs],
+   [],
+   "internal test function - do not use",
+   "\
+This is an internal test function which is used to test whether
+the automatically generated bindings can handle every possible
+parameter type correctly.
+
+It echos the contents of each parameter to stdout.
+
+You probably don't want to call this function.");
+] @ List.flatten (
+  List.map (
+    fun (name, ret) ->
+      [(name, (ret, [String "val"]), -1, [NotInFish; NotInDocs],
+       [],
+       "internal test function - do not use",
+       "\
+This is an internal test function which is used to test whether
+the automatically generated bindings can handle every possible
+return type correctly.
+
+It converts string C<val> to the return type.
+
+You probably don't want to call this function.");
+       (name ^ "err", (ret, []), -1, [NotInFish; NotInDocs],
+       [],
+       "internal test function - do not use",
+       "\
+This is an internal test function which is used to test whether
+the automatically generated bindings can handle every possible
+return type correctly.
+
+This function always returns an error.
+
+You probably don't want to call this function.")]
+  ) test_all_rets
+)
+
+(* non_daemon_functions are any functions which don't get processed
+ * in the daemon, eg. functions for setting and getting local
+ * configuration values.
+ *)
+
+let non_daemon_functions = test_functions @ [

   ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
    [],
    "launch the qemu subprocess",
   ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
    [],
    "launch the qemu subprocess",


@@ -261,7 +380,12 @@ for whatever operations you want to perform (ie. read access if you
 just want to read the image or write access if you want to modify the
 image).
 
 just want to read the image or write access if you want to modify the
 image).
 

-This is equivalent to the qemu parameter C<-drive file=filename>.");
+This is equivalent to the qemu parameter C<-drive file=filename>.
+
+Note that this call checks for the existence of C<filename>.  This
+stops you from specifying other types of drive which are supported
+by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
+the general C<guestfs_config> call instead.");

 
   ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
    [],
 
   ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
    [],


@@ -269,7 +393,33 @@ This is equivalent to the qemu parameter C<-drive file=filename>.");
    "\
 This function adds a virtual CD-ROM disk image to the guest.
 
    "\
 This function adds a virtual CD-ROM disk image to the guest.
 

-This is equivalent to the qemu parameter C<-cdrom filename>.");
+This is equivalent to the qemu parameter C<-cdrom filename>.
+
+Note that this call checks for the existence of C<filename>.  This
+stops you from specifying other types of drive which are supported
+by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
+the general C<guestfs_config> call instead.");
+
+  ("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"],
+   [],
+   "add a drive in snapshot mode (read-only)",
+   "\
+This adds a drive in snapshot mode, making it effectively
+read-only.
+
+Note that writes to the device are allowed, and will be seen for
+the duration of the guestfs handle, but they are written
+to a temporary file which is discarded as soon as the guestfs
+handle is closed.  We don't currently have any method to enable
+changes to be committed, although qemu can support this.
+
+This is equivalent to the qemu parameter
+C<-drive file=filename,snapshot=on>.
+
+Note that this call checks for the existence of C<filename>.  This
+stops you from specifying other types of drive which are supported
+by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
+the general C<guestfs_config> call instead.");

 
   ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
    [],
 
   ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
    [],


@@ -296,9 +446,6 @@ configure script.
 You can also override this by setting the C<LIBGUESTFS_QEMU>
 environment variable.
 
 You can also override this by setting the C<LIBGUESTFS_QEMU>
 environment variable.
 

-The string C<qemu> is stashed in the libguestfs handle, so the caller
-must make sure it remains valid for the lifetime of the handle.
-

 Setting C<qemu> to C<NULL> restores the default qemu binary.");
 
   ("get_qemu", (RConstString "qemu", []), -1, [],
 Setting C<qemu> to C<NULL> restores the default qemu binary.");
 
   ("get_qemu", (RConstString "qemu", []), -1, [],


@@ -319,9 +466,6 @@ Set the path that libguestfs searches for kernel and initrd.img.
 The default is C<$libdir/guestfs> unless overridden by setting
 C<LIBGUESTFS_PATH> environment variable.
 
 The default is C<$libdir/guestfs> unless overridden by setting
 C<LIBGUESTFS_PATH> environment variable.
 

-The string C<path> is stashed in the libguestfs handle, so the caller
-must make sure it remains valid for the lifetime of the handle.
-

 Setting C<path> to C<NULL> restores the default path.");
 
   ("get_path", (RConstString "path", []), -1, [],
 Setting C<path> to C<NULL> restores the default path.");
 
   ("get_path", (RConstString "path", []), -1, [],


@@ -333,13 +477,39 @@ Return the current search path.
 This is always non-NULL.  If it wasn't set already, then this will
 return the default path.");
 
 This is always non-NULL.  If it wasn't set already, then this will
 return the default path.");
 

+  ("set_append", (RErr, [String "append"]), -1, [FishAlias "append"],
+   [],
+   "add options to kernel command line",
+   "\
+This function is used to add additional options to the
+guest kernel command line.
+
+The default is C<NULL> unless overridden by setting
+C<LIBGUESTFS_APPEND> environment variable.
+
+Setting C<append> to C<NULL> means I<no> additional options
+are passed (libguestfs always adds a few of its own).");
+
+  ("get_append", (RConstString "append", []), -1, [],
+   [],
+   "get the additional kernel options",
+   "\
+Return the additional kernel options which are added to the
+guest kernel command line.
+
+If C<NULL> then no options are added.");
+

   ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
    [],
    "set autosync mode",
    "\
 If C<autosync> is true, this enables autosync.  Libguestfs will make a
   ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
    [],
    "set autosync mode",
    "\
 If C<autosync> is true, this enables autosync.  Libguestfs will make a

-best effort attempt to run C<guestfs_sync> when the handle is closed
-(also if the program exits without closing handles).");
+best effort attempt to run C<guestfs_umount_all> followed by
+C<guestfs_sync> when the handle is closed
+(also if the program exits without closing handles).
+
+This is disabled by default (except in guestfish where it is
+enabled by default).");

 
   ("get_autosync", (RBool "autosync", []), -1, [],
    [],
 
   ("get_autosync", (RBool "autosync", []), -1, [],
    [],


@@ -425,11 +595,25 @@ actions using the low-level API.
 
 For more information on states, see L<guestfs(3)>.");
 
 
 For more information on states, see L<guestfs(3)>.");
 

+  ("end_busy", (RErr, []), -1, [NotInFish],
+   [],
+   "leave the busy state",
+   "\
+This sets the state to C<READY>, or if in C<CONFIG> then it leaves the
+state as is.  This is only used when implementing
+actions using the low-level API.
+
+For more information on states, see L<guestfs(3)>.");
+

 ]
 
 ]
 

+(* daemon_functions are any functions which cause some action
+ * to take place in the daemon.
+ *)
+

 let daemon_functions = [
   ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
 let daemon_functions = [
   ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],

-   [InitEmpty, TestOutput (
+   [InitEmpty, Always, TestOutput (

       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
        ["mkfs"; "ext2"; "/dev/sda1"];
        ["mount"; "/dev/sda1"; "/"];
       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
        ["mkfs"; "ext2"; "/dev/sda1"];
        ["mount"; "/dev/sda1"; "/"];


@@ -455,7 +639,7 @@ The filesystem options C<sync> and C<noatime> are set with this
 call, in order to improve reliability.");
 
   ("sync", (RErr, []), 2, [],
 call, in order to improve reliability.");
 
   ("sync", (RErr, []), 2, [],

-   [ InitEmpty, TestRun [["sync"]]],
+   [ InitEmpty, Always, TestRun [["sync"]]],

    "sync disks, writes are flushed through to the disk image",
    "\
 This syncs the disk, so that any writes are flushed through to the
    "sync disks, writes are flushed through to the disk image",
    "\
 This syncs the disk, so that any writes are flushed through to the


@@ -465,7 +649,7 @@ You should always call this if you have modified a disk image, before
 closing the handle.");
 
   ("touch", (RErr, [String "path"]), 3, [],
 closing the handle.");
 
   ("touch", (RErr, [String "path"]), 3, [],

-   [InitBasicFS, TestOutputTrue (
+   [InitBasicFS, Always, TestOutputTrue (

       [["touch"; "/new"];
        ["exists"; "/new"]])],
    "update file timestamps or create a new file",
       [["touch"; "/new"];
        ["exists"; "/new"]])],
    "update file timestamps or create a new file",


@@ -475,7 +659,7 @@ update the timestamps on a file, or, if the file does not exist,
 to create a new zero-length file.");
 
   ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
 to create a new zero-length file.");
 
   ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],

-   [InitBasicFS, TestOutput (
+   [InitBasicFS, Always, TestOutput (

       [["write_file"; "/new"; "new file contents"; "0"];
        ["cat"; "/new"]], "new file contents")],
    "list the contents of a file",
       [["write_file"; "/new"; "new file contents"; "0"];
        ["cat"; "/new"]], "new file contents")],
    "list the contents of a file",


@@ -500,7 +684,7 @@ This command is mostly useful for interactive sessions.  It
 is I<not> intended that you try to parse the output string.");
 
   ("ls", (RStringList "listing", [String "directory"]), 6, [],
 is I<not> intended that you try to parse the output string.");
 
   ("ls", (RStringList "listing", [String "directory"]), 6, [],

-   [InitBasicFS, TestOutputList (
+   [InitBasicFS, Always, TestOutputList (

       [["touch"; "/new"];
        ["touch"; "/newer"];
        ["touch"; "/newest"];
       [["touch"; "/new"];
        ["touch"; "/newer"];
        ["touch"; "/newest"];


@@ -515,8 +699,8 @@ This command is mostly useful for interactive sessions.  Programs
 should probably use C<guestfs_readdir> instead.");
 
   ("list_devices", (RStringList "devices", []), 7, [],
 should probably use C<guestfs_readdir> instead.");
 
   ("list_devices", (RStringList "devices", []), 7, [],

-   [InitEmpty, TestOutputList (
-      [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
+   [InitEmpty, Always, TestOutputListOfDevices (
+      [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],

    "list the block devices",
    "\
 List all the block devices.
    "list the block devices",
    "\
 List all the block devices.


@@ -524,9 +708,9 @@ List all the block devices.
 The full block device names are returned, eg. C</dev/sda>");
 
   ("list_partitions", (RStringList "partitions", []), 8, [],
 The full block device names are returned, eg. C</dev/sda>");
 
   ("list_partitions", (RStringList "partitions", []), 8, [],

-   [InitBasicFS, TestOutputList (
+   [InitBasicFS, Always, TestOutputListOfDevices (

       [["list_partitions"]], ["/dev/sda1"]);
       [["list_partitions"]], ["/dev/sda1"]);

-    InitEmpty, TestOutputList (
+    InitEmpty, Always, TestOutputListOfDevices (

       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
        ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
    "list the partitions",
       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
        ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
    "list the partitions",


@@ -539,9 +723,9 @@ This does not return logical volumes.  For that you will need to
 call C<guestfs_lvs>.");
 
   ("pvs", (RStringList "physvols", []), 9, [],
 call C<guestfs_lvs>.");
 
   ("pvs", (RStringList "physvols", []), 9, [],

-   [InitBasicFSonLVM, TestOutputList (
+   [InitBasicFSonLVM, Always, TestOutputListOfDevices (

       [["pvs"]], ["/dev/sda1"]);
       [["pvs"]], ["/dev/sda1"]);

-    InitEmpty, TestOutputList (
+    InitEmpty, Always, TestOutputListOfDevices (

       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
        ["pvcreate"; "/dev/sda1"];
        ["pvcreate"; "/dev/sda2"];
       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
        ["pvcreate"; "/dev/sda1"];
        ["pvcreate"; "/dev/sda2"];


@@ -558,9 +742,9 @@ PVs (eg. C</dev/sda2>).
 See also C<guestfs_pvs_full>.");
 
   ("vgs", (RStringList "volgroups", []), 10, [],
 See also C<guestfs_pvs_full>.");
 
   ("vgs", (RStringList "volgroups", []), 10, [],

-   [InitBasicFSonLVM, TestOutputList (
+   [InitBasicFSonLVM, Always, TestOutputList (

       [["vgs"]], ["VG"]);
       [["vgs"]], ["VG"]);

-    InitEmpty, TestOutputList (
+    InitEmpty, Always, TestOutputList (

       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
        ["pvcreate"; "/dev/sda1"];
        ["pvcreate"; "/dev/sda2"];
       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
        ["pvcreate"; "/dev/sda1"];
        ["pvcreate"; "/dev/sda2"];


@@ -579,9 +763,9 @@ detected (eg. C<VolGroup00>).
 See also C<guestfs_vgs_full>.");
 
   ("lvs", (RStringList "logvols", []), 11, [],
 See also C<guestfs_vgs_full>.");
 
   ("lvs", (RStringList "logvols", []), 11, [],

-   [InitBasicFSonLVM, TestOutputList (
+   [InitBasicFSonLVM, Always, TestOutputList (

       [["lvs"]], ["/dev/VG/LV"]);
       [["lvs"]], ["/dev/VG/LV"]);

-    InitEmpty, TestOutputList (
+    InitEmpty, Always, TestOutputList (

       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
        ["pvcreate"; "/dev/sda1"];
        ["pvcreate"; "/dev/sda2"];
       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
        ["pvcreate"; "/dev/sda1"];
        ["pvcreate"; "/dev/sda2"];


@@ -624,10 +808,10 @@ List all the logical volumes detected.  This is the equivalent
 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
 
   ("read_lines", (RStringList "lines", [String "path"]), 15, [],
 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
 
   ("read_lines", (RStringList "lines", [String "path"]), 15, [],

-   [InitBasicFS, TestOutputList (
+   [InitBasicFS, Always, TestOutputList (

       [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
        ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
       [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
        ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);

-    InitBasicFS, TestOutputList (
+    InitBasicFS, Always, TestOutputList (

       [["write_file"; "/new"; ""; "0"];
        ["read_lines"; "/new"]], [])],
    "read file as lines",
       [["write_file"; "/new"; ""; "0"];
        ["read_lines"; "/new"]], [])],
    "read file as lines",


@@ -802,12 +986,12 @@ This is just a shortcut for listing C<guestfs_aug_match>
 C<path/*> and sorting the resulting nodes into alphabetical order.");
 
   ("rm", (RErr, [String "path"]), 29, [],
 C<path/*> and sorting the resulting nodes into alphabetical order.");
 
   ("rm", (RErr, [String "path"]), 29, [],

-   [InitBasicFS, TestRun
+   [InitBasicFS, Always, TestRun

       [["touch"; "/new"];
        ["rm"; "/new"]];
       [["touch"; "/new"];
        ["rm"; "/new"]];

-    InitBasicFS, TestLastFail
+    InitBasicFS, Always, TestLastFail

       [["rm"; "/new"]];
       [["rm"; "/new"]];

-    InitBasicFS, TestLastFail
+    InitBasicFS, Always, TestLastFail

       [["mkdir"; "/new"];
        ["rm"; "/new"]]],
    "remove a file",
       [["mkdir"; "/new"];
        ["rm"; "/new"]]],
    "remove a file",


@@ -815,12 +999,12 @@ C<path/*> and sorting the resulting nodes into alphabetical order.");
 Remove the single file C<path>.");
 
   ("rmdir", (RErr, [String "path"]), 30, [],
 Remove the single file C<path>.");
 
   ("rmdir", (RErr, [String "path"]), 30, [],

-   [InitBasicFS, TestRun
+   [InitBasicFS, Always, TestRun

       [["mkdir"; "/new"];
        ["rmdir"; "/new"]];
       [["mkdir"; "/new"];
        ["rmdir"; "/new"]];

-    InitBasicFS, TestLastFail
+    InitBasicFS, Always, TestLastFail

       [["rmdir"; "/new"]];
       [["rmdir"; "/new"]];

-    InitBasicFS, TestLastFail
+    InitBasicFS, Always, TestLastFail

       [["touch"; "/new"];
        ["rmdir"; "/new"]]],
    "remove a directory",
       [["touch"; "/new"];
        ["rmdir"; "/new"]]],
    "remove a directory",


@@ -828,7 +1012,7 @@ Remove the single file C<path>.");
 Remove the single directory C<path>.");
 
   ("rm_rf", (RErr, [String "path"]), 31, [],
 Remove the single directory C<path>.");
 
   ("rm_rf", (RErr, [String "path"]), 31, [],

-   [InitBasicFS, TestOutputFalse
+   [InitBasicFS, Always, TestOutputFalse

       [["mkdir"; "/new"];
        ["mkdir"; "/new/foo"];
        ["touch"; "/new/foo/bar"];
       [["mkdir"; "/new"];
        ["mkdir"; "/new/foo"];
        ["touch"; "/new/foo/bar"];


@@ -841,25 +1025,32 @@ contents if its a directory.  This is like the C<rm -rf> shell
 command.");
 
   ("mkdir", (RErr, [String "path"]), 32, [],
 command.");
 
   ("mkdir", (RErr, [String "path"]), 32, [],

-   [InitBasicFS, TestOutputTrue
+   [InitBasicFS, Always, TestOutputTrue

       [["mkdir"; "/new"];
        ["is_dir"; "/new"]];
       [["mkdir"; "/new"];
        ["is_dir"; "/new"]];

-    InitBasicFS, TestLastFail
+    InitBasicFS, Always, TestLastFail

       [["mkdir"; "/new/foo/bar"]]],
    "create a directory",
    "\
 Create a directory named C<path>.");
 
   ("mkdir_p", (RErr, [String "path"]), 33, [],
       [["mkdir"; "/new/foo/bar"]]],
    "create a directory",
    "\
 Create a directory named C<path>.");
 
   ("mkdir_p", (RErr, [String "path"]), 33, [],

-   [InitBasicFS, TestOutputTrue
+   [InitBasicFS, Always, TestOutputTrue

       [["mkdir_p"; "/new/foo/bar"];
        ["is_dir"; "/new/foo/bar"]];
       [["mkdir_p"; "/new/foo/bar"];
        ["is_dir"; "/new/foo/bar"]];

-    InitBasicFS, TestOutputTrue
+    InitBasicFS, Always, TestOutputTrue

       [["mkdir_p"; "/new/foo/bar"];
        ["is_dir"; "/new/foo"]];
       [["mkdir_p"; "/new/foo/bar"];
        ["is_dir"; "/new/foo"]];

-    InitBasicFS, TestOutputTrue
+    InitBasicFS, Always, TestOutputTrue

       [["mkdir_p"; "/new/foo/bar"];
       [["mkdir_p"; "/new/foo/bar"];

-       ["is_dir"; "/new"]]],
+       ["is_dir"; "/new"]];
+    (* Regression tests for RHBZ#503133: *)
+    InitBasicFS, Always, TestRun
+      [["mkdir"; "/new"];
+       ["mkdir_p"; "/new"]];
+    InitBasicFS, Always, TestLastFail
+      [["touch"; "/new"];
+       ["mkdir_p"; "/new"]]],

    "create a directory and parents",
    "\
 Create a directory named C<path>, creating any parent directories
    "create a directory and parents",
    "\
 Create a directory named C<path>, creating any parent directories


@@ -883,10 +1074,10 @@ names, you will need to locate and parse the password file
 yourself (Augeas support makes this relatively easy).");
 
   ("exists", (RBool "existsflag", [String "path"]), 36, [],
 yourself (Augeas support makes this relatively easy).");
 
   ("exists", (RBool "existsflag", [String "path"]), 36, [],

-   [InitBasicFS, TestOutputTrue (
+   [InitBasicFS, Always, TestOutputTrue (

       [["touch"; "/new"];
        ["exists"; "/new"]]);
       [["touch"; "/new"];
        ["exists"; "/new"]]);

-    InitBasicFS, TestOutputTrue (
+    InitBasicFS, Always, TestOutputTrue (

       [["mkdir"; "/new"];
        ["exists"; "/new"]])],
    "test if file or directory exists",
       [["mkdir"; "/new"];
        ["exists"; "/new"]])],
    "test if file or directory exists",


@@ -897,10 +1088,10 @@ This returns C<true> if and only if there is a file, directory
 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
 
   ("is_file", (RBool "fileflag", [String "path"]), 37, [],
 See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
 
   ("is_file", (RBool "fileflag", [String "path"]), 37, [],

-   [InitBasicFS, TestOutputTrue (
+   [InitBasicFS, Always, TestOutputTrue (

       [["touch"; "/new"];
        ["is_file"; "/new"]]);
       [["touch"; "/new"];
        ["is_file"; "/new"]]);

-    InitBasicFS, TestOutputFalse (
+    InitBasicFS, Always, TestOutputFalse (

       [["mkdir"; "/new"];
        ["is_file"; "/new"]])],
    "test if file exists",
       [["mkdir"; "/new"];
        ["is_file"; "/new"]])],
    "test if file exists",


@@ -912,10 +1103,10 @@ other objects like directories.
 See also C<guestfs_stat>.");
 
   ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
 See also C<guestfs_stat>.");
 
   ("is_dir", (RBool "dirflag", [String "path"]), 38, [],

-   [InitBasicFS, TestOutputFalse (
+   [InitBasicFS, Always, TestOutputFalse (

       [["touch"; "/new"];
        ["is_dir"; "/new"]]);
       [["touch"; "/new"];
        ["is_dir"; "/new"]]);

-    InitBasicFS, TestOutputTrue (
+    InitBasicFS, Always, TestOutputTrue (

       [["mkdir"; "/new"];
        ["is_dir"; "/new"]])],
    "test if file exists",
       [["mkdir"; "/new"];
        ["is_dir"; "/new"]])],
    "test if file exists",


@@ -927,7 +1118,7 @@ other objects like files.
 See also C<guestfs_stat>.");
 
   ("pvcreate", (RErr, [String "device"]), 39, [],
 See also C<guestfs_stat>.");
 
   ("pvcreate", (RErr, [String "device"]), 39, [],

-   [InitEmpty, TestOutputList (
+   [InitEmpty, Always, TestOutputListOfDevices (

       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
        ["pvcreate"; "/dev/sda1"];
        ["pvcreate"; "/dev/sda2"];
       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
        ["pvcreate"; "/dev/sda1"];
        ["pvcreate"; "/dev/sda2"];


@@ -940,7 +1131,7 @@ where C<device> should usually be a partition name such
 as C</dev/sda1>.");
 
   ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
 as C</dev/sda1>.");
 
   ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],

-   [InitEmpty, TestOutputList (
+   [InitEmpty, Always, TestOutputList (

       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
        ["pvcreate"; "/dev/sda1"];
        ["pvcreate"; "/dev/sda2"];
       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
        ["pvcreate"; "/dev/sda1"];
        ["pvcreate"; "/dev/sda2"];


@@ -954,7 +1145,7 @@ This creates an LVM volume group called C<volgroup>
 from the non-empty list of physical volumes C<physvols>.");
 
   ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
 from the non-empty list of physical volumes C<physvols>.");
 
   ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],

-   [InitEmpty, TestOutputList (
+   [InitEmpty, Always, TestOutputList (

       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
        ["pvcreate"; "/dev/sda1"];
        ["pvcreate"; "/dev/sda2"];
       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
        ["pvcreate"; "/dev/sda1"];
        ["pvcreate"; "/dev/sda2"];


@@ -975,7 +1166,7 @@ This creates an LVM volume group called C<logvol>
 on the volume group C<volgroup>, with C<size> megabytes.");
 
   ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
 on the volume group C<volgroup>, with C<size> megabytes.");
 
   ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],

-   [InitEmpty, TestOutput (
+   [InitEmpty, Always, TestOutput (

       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
        ["mkfs"; "ext2"; "/dev/sda1"];
        ["mount"; "/dev/sda1"; "/"];
       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
        ["mkfs"; "ext2"; "/dev/sda1"];
        ["mount"; "/dev/sda1"; "/"];


@@ -984,7 +1175,7 @@ on the volume group C<volgroup>, with C<size> megabytes.");
    "make a filesystem",
    "\
 This creates a filesystem on C<device> (usually a partition
    "make a filesystem",
    "\
 This creates a filesystem on C<device> (usually a partition

-of LVM logical volume).  The filesystem type is C<fstype>, for
+or LVM logical volume).  The filesystem type is C<fstype>, for

 example C<ext3>.");
 
   ("sfdisk", (RErr, [String "device";
 example C<ext3>.");
 
   ("sfdisk", (RErr, [String "device";


@@ -1011,25 +1202,27 @@ information refer to the L<sfdisk(8)> manpage.
 
 To create a single partition occupying the whole disk, you would
 pass C<lines> as a single element list, when the single element being
 
 To create a single partition occupying the whole disk, you would
 pass C<lines> as a single element list, when the single element being

-the string C<,> (comma).");
+the string C<,> (comma).
+
+See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>");

 
   ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
 
   ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],

-   [InitBasicFS, TestOutput (
+   [InitBasicFS, Always, TestOutput (

       [["write_file"; "/new"; "new file contents"; "0"];
        ["cat"; "/new"]], "new file contents");
       [["write_file"; "/new"; "new file contents"; "0"];
        ["cat"; "/new"]], "new file contents");

-    InitBasicFS, TestOutput (
+    InitBasicFS, Always, TestOutput (

       [["write_file"; "/new"; "\nnew file contents\n"; "0"];
        ["cat"; "/new"]], "\nnew file contents\n");
       [["write_file"; "/new"; "\nnew file contents\n"; "0"];
        ["cat"; "/new"]], "\nnew file contents\n");

-    InitBasicFS, TestOutput (
+    InitBasicFS, Always, TestOutput (

       [["write_file"; "/new"; "\n\n"; "0"];
        ["cat"; "/new"]], "\n\n");
       [["write_file"; "/new"; "\n\n"; "0"];
        ["cat"; "/new"]], "\n\n");

-    InitBasicFS, TestOutput (
+    InitBasicFS, Always, TestOutput (

       [["write_file"; "/new"; ""; "0"];
        ["cat"; "/new"]], "");
       [["write_file"; "/new"; ""; "0"];
        ["cat"; "/new"]], "");

-    InitBasicFS, TestOutput (
+    InitBasicFS, Always, TestOutput (

       [["write_file"; "/new"; "\n\n\n"; "0"];
        ["cat"; "/new"]], "\n\n\n");
       [["write_file"; "/new"; "\n\n\n"; "0"];
        ["cat"; "/new"]], "\n\n\n");

-    InitBasicFS, TestOutput (
+    InitBasicFS, Always, TestOutput (

       [["write_file"; "/new"; "\n"; "0"];
        ["cat"; "/new"]], "\n")],
    "create a file",
       [["write_file"; "/new"; "\n"; "0"];
        ["cat"; "/new"]], "\n")],
    "create a file",


@@ -1040,15 +1233,20 @@ with length C<size>.
 
 As a special case, if C<size> is C<0>
 then the length is calculated using C<strlen> (so in this case
 
 As a special case, if C<size> is C<0>
 then the length is calculated using C<strlen> (so in this case

-the content cannot contain embedded ASCII NULs).");
+the content cannot contain embedded ASCII NULs).
+
+I<NB.> Owing to a bug, writing content containing ASCII NUL
+characters does I<not> work, even if the length is specified.
+We hope to resolve this bug in a future version.  In the meantime
+use C<guestfs_upload>.");

 
   ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
 
   ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],

-   [InitEmpty, TestOutputList (
+   [InitEmpty, Always, TestOutputListOfDevices (

       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
        ["mkfs"; "ext2"; "/dev/sda1"];
        ["mount"; "/dev/sda1"; "/"];
        ["mounts"]], ["/dev/sda1"]);
       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
        ["mkfs"; "ext2"; "/dev/sda1"];
        ["mount"; "/dev/sda1"; "/"];
        ["mounts"]], ["/dev/sda1"]);

-    InitEmpty, TestOutputList (
+    InitEmpty, Always, TestOutputList (

       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
        ["mkfs"; "ext2"; "/dev/sda1"];
        ["mount"; "/dev/sda1"; "/"];
       [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
        ["mkfs"; "ext2"; "/dev/sda1"];
        ["mount"; "/dev/sda1"; "/"];


@@ -1061,7 +1259,7 @@ specified either by its mountpoint (path) or the device which
 contains the filesystem.");
 
   ("mounts", (RStringList "devices", []), 46, [],
 contains the filesystem.");
 
   ("mounts", (RStringList "devices", []), 46, [],

-   [InitBasicFS, TestOutputList (
+   [InitBasicFS, Always, TestOutputListOfDevices (

       [["mounts"]], ["/dev/sda1"])],
    "show mounted filesystems",
    "\
       [["mounts"]], ["/dev/sda1"])],
    "show mounted filesystems",
    "\


@@ -1071,8 +1269,22 @@ the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
 Some internal mounts are not shown.");
 
   ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
 Some internal mounts are not shown.");
 
   ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],

-   [InitBasicFS, TestOutputList (
+   [InitBasicFS, Always, TestOutputList (

       [["umount_all"];
       [["umount_all"];

+       ["mounts"]], []);
+    (* check that umount_all can unmount nested mounts correctly: *)
+    InitEmpty, Always, TestOutputList (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
+       ["mkfs"; "ext2"; "/dev/sda1"];
+       ["mkfs"; "ext2"; "/dev/sda2"];
+       ["mkfs"; "ext2"; "/dev/sda3"];
+       ["mount"; "/dev/sda1"; "/"];
+       ["mkdir"; "/mp1"];
+       ["mount"; "/dev/sda2"; "/mp1"];
+       ["mkdir"; "/mp1/mp2"];
+       ["mount"; "/dev/sda3"; "/mp1/mp2"];
+       ["mkdir"; "/mp1/mp2/mp3"];
+       ["umount_all"];

        ["mounts"]], [])],
    "unmount all filesystems",
    "\
        ["mounts"]], [])],
    "unmount all filesystems",
    "\


@@ -1088,13 +1300,13 @@ This command removes all LVM logical volumes, volume groups
 and physical volumes.");
 
   ("file", (RString "description", [String "path"]), 49, [],
 and physical volumes.");
 
   ("file", (RString "description", [String "path"]), 49, [],

-   [InitBasicFS, TestOutput (
+   [InitBasicFS, Always, TestOutput (

       [["touch"; "/new"];
        ["file"; "/new"]], "empty");
       [["touch"; "/new"];
        ["file"; "/new"]], "empty");

-    InitBasicFS, TestOutput (
+    InitBasicFS, Always, TestOutput (

       [["write_file"; "/new"; "some content\n"; "0"];
        ["file"; "/new"]], "ASCII text");
       [["write_file"; "/new"; "some content\n"; "0"];
        ["file"; "/new"]], "ASCII text");

-    InitBasicFS, TestLastFail (
+    InitBasicFS, Always, TestLastFail (

       [["file"; "/nofile"]])],
    "determine file type",
    "\
       [["file"; "/nofile"]])],
    "determine file type",
    "\


@@ -1106,8 +1318,55 @@ The exact command which runs is C<file -bsL path>.  Note in
 particular that the filename is not prepended to the output
 (the C<-b> option).");
 
 particular that the filename is not prepended to the output
 (the C<-b> option).");
 

-  ("command", (RString "output", [StringList "arguments"]), 50, [],
-   [], (* XXX how to test? *)
+  ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
+   [InitBasicFS, Always, TestOutput (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command"; "/test-command 1"]], "Result1");
+    InitBasicFS, Always, TestOutput (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command"; "/test-command 2"]], "Result2\n");
+    InitBasicFS, Always, TestOutput (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command"; "/test-command 3"]], "\nResult3");
+    InitBasicFS, Always, TestOutput (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command"; "/test-command 4"]], "\nResult4\n");
+    InitBasicFS, Always, TestOutput (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command"; "/test-command 5"]], "\nResult5\n\n");
+    InitBasicFS, Always, TestOutput (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command"; "/test-command 6"]], "\n\nResult6\n\n");
+    InitBasicFS, Always, TestOutput (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command"; "/test-command 7"]], "");
+    InitBasicFS, Always, TestOutput (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command"; "/test-command 8"]], "\n");
+    InitBasicFS, Always, TestOutput (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command"; "/test-command 9"]], "\n\n");
+    InitBasicFS, Always, TestOutput (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
+    InitBasicFS, Always, TestOutput (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
+    InitBasicFS, Always, TestLastFail (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command"; "/test-command"]])],

    "run a command from the guest filesystem",
    "\
 This call runs a command from the guest filesystem.  The
    "run a command from the guest filesystem",
    "\
 This call runs a command from the guest filesystem.  The


@@ -1120,6 +1379,13 @@ The first element is the name of the program to run.
 Subsequent elements are parameters.  The list must be
 non-empty (ie. must contain a program name).
 
 Subsequent elements are parameters.  The list must be
 non-empty (ie. must contain a program name).
 

+The return value is anything printed to I<stdout> by
+the command.
+
+If the command returns a non-zero exit status, then
+this function returns an error message.  The error message
+string is the content of I<stderr> from the command.
+

 The C<$PATH> environment variable will contain at least
 C</usr/bin> and C</bin>.  If you require a program from
 another location, you should provide the full path in the
 The C<$PATH> environment variable will contain at least
 C</usr/bin> and C</bin>.  If you require a program from
 another location, you should provide the full path in the


@@ -1131,15 +1397,58 @@ correct places.  It is the caller's responsibility to ensure
 all filesystems that are needed are mounted at the right
 locations.");
 
 all filesystems that are needed are mounted at the right
 locations.");
 

-  ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [],
-   [], (* XXX how to test? *)
+  ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
+   [InitBasicFS, Always, TestOutputList (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command_lines"; "/test-command 1"]], ["Result1"]);
+    InitBasicFS, Always, TestOutputList (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command_lines"; "/test-command 2"]], ["Result2"]);
+    InitBasicFS, Always, TestOutputList (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command_lines"; "/test-command 3"]], ["";"Result3"]);
+    InitBasicFS, Always, TestOutputList (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command_lines"; "/test-command 4"]], ["";"Result4"]);
+    InitBasicFS, Always, TestOutputList (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
+    InitBasicFS, Always, TestOutputList (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
+    InitBasicFS, Always, TestOutputList (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command_lines"; "/test-command 7"]], []);
+    InitBasicFS, Always, TestOutputList (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command_lines"; "/test-command 8"]], [""]);
+    InitBasicFS, Always, TestOutputList (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command_lines"; "/test-command 9"]], ["";""]);
+    InitBasicFS, Always, TestOutputList (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
+    InitBasicFS, Always, TestOutputList (
+      [["upload"; "test-command"; "/test-command"];
+       ["chmod"; "493"; "/test-command"];
+       ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],

    "run a command, returning lines",
    "\
 This is the same as C<guestfs_command>, but splits the
 result into a list of lines.");
 
   ("stat", (RStat "statbuf", [String "path"]), 52, [],
    "run a command, returning lines",
    "\
 This is the same as C<guestfs_command>, but splits the
 result into a list of lines.");
 
   ("stat", (RStat "statbuf", [String "path"]), 52, [],

-   [InitBasicFS, TestOutputStruct (
+   [InitBasicFS, Always, TestOutputStruct (

       [["touch"; "/new"];
        ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
    "get file information",
       [["touch"; "/new"];
        ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
    "get file information",


@@ -1149,7 +1458,7 @@ Returns file information for the given C<path>.
 This is the same as the C<stat(2)> system call.");
 
   ("lstat", (RStat "statbuf", [String "path"]), 53, [],
 This is the same as the C<stat(2)> system call.");
 
   ("lstat", (RStat "statbuf", [String "path"]), 53, [],

-   [InitBasicFS, TestOutputStruct (
+   [InitBasicFS, Always, TestOutputStruct (

       [["touch"; "/new"];
        ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
    "get file information for a symbolic link",
       [["touch"; "/new"];
        ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
    "get file information for a symbolic link",


@@ -1163,7 +1472,7 @@ refers to.
 This is the same as the C<lstat(2)> system call.");
 
   ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
 This is the same as the C<lstat(2)> system call.");
 
   ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],

-   [InitBasicFS, TestOutputStruct (
+   [InitBasicFS, Always, TestOutputStruct (

       [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
                           CompareWithInt ("blocks", 490020);
                           CompareWithInt ("bsize", 1024)])],
       [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
                           CompareWithInt ("blocks", 490020);
                           CompareWithInt ("bsize", 1024)])],


@@ -1177,10 +1486,10 @@ This is the same as the C<statvfs(2)> system call.");
 
   ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
    [], (* XXX test *)
 
   ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
    [], (* XXX test *)

-   "get ext2/ext3 superblock details",
+   "get ext2/ext3/ext4 superblock details",

    "\
    "\

-This returns the contents of the ext2 or ext3 filesystem superblock
-on C<device>.
+This returns the contents of the ext2, ext3 or ext4 filesystem
+superblock on C<device>.

 
 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
 manpage for more details.  The list of fields returned isn't
 
 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
 manpage for more details.  The list of fields returned isn't


@@ -1188,7 +1497,7 @@ clearly defined, and depends on both the version of C<tune2fs>
 that libguestfs was built against, and the filesystem itself.");
 
   ("blockdev_setro", (RErr, [String "device"]), 56, [],
 that libguestfs was built against, and the filesystem itself.");
 
   ("blockdev_setro", (RErr, [String "device"]), 56, [],

-   [InitEmpty, TestOutputTrue (
+   [InitEmpty, Always, TestOutputTrue (

       [["blockdev_setro"; "/dev/sda"];
        ["blockdev_getro"; "/dev/sda"]])],
    "set block device to read-only",
       [["blockdev_setro"; "/dev/sda"];
        ["blockdev_getro"; "/dev/sda"]])],
    "set block device to read-only",


@@ -1198,7 +1507,7 @@ Sets the block device named C<device> to read-only.
 This uses the L<blockdev(8)> command.");
 
   ("blockdev_setrw", (RErr, [String "device"]), 57, [],
 This uses the L<blockdev(8)> command.");
 
   ("blockdev_setrw", (RErr, [String "device"]), 57, [],

-   [InitEmpty, TestOutputFalse (
+   [InitEmpty, Always, TestOutputFalse (

       [["blockdev_setrw"; "/dev/sda"];
        ["blockdev_getro"; "/dev/sda"]])],
    "set block device to read-write",
       [["blockdev_setrw"; "/dev/sda"];
        ["blockdev_getro"; "/dev/sda"]])],
    "set block device to read-write",


@@ -1208,7 +1517,7 @@ Sets the block device named C<device> to read-write.
 This uses the L<blockdev(8)> command.");
 
   ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
 This uses the L<blockdev(8)> command.");
 
   ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],

-   [InitEmpty, TestOutputTrue (
+   [InitEmpty, Always, TestOutputTrue (

       [["blockdev_setro"; "/dev/sda"];
        ["blockdev_getro"; "/dev/sda"]])],
    "is block device set to read-only",
       [["blockdev_setro"; "/dev/sda"];
        ["blockdev_getro"; "/dev/sda"]])],
    "is block device set to read-only",


@@ -1219,7 +1528,7 @@ Returns a boolean indicating if the block device is read-only
 This uses the L<blockdev(8)> command.");
 
   ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
 This uses the L<blockdev(8)> command.");
 
   ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],

-   [InitEmpty, TestOutputInt (
+   [InitEmpty, Always, TestOutputInt (

       [["blockdev_getss"; "/dev/sda"]], 512)],
    "get sectorsize of block device",
    "\
       [["blockdev_getss"; "/dev/sda"]], 512)],
    "get sectorsize of block device",
    "\


@@ -1232,7 +1541,7 @@ for that).
 This uses the L<blockdev(8)> command.");
 
   ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
 This uses the L<blockdev(8)> command.");
 
   ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],

-   [InitEmpty, TestOutputInt (
+   [InitEmpty, Always, TestOutputInt (

       [["blockdev_getbsz"; "/dev/sda"]], 4096)],
    "get blocksize of block device",
    "\
       [["blockdev_getbsz"; "/dev/sda"]], 4096)],
    "get blocksize of block device",
    "\


@@ -1255,7 +1564,7 @@ I<filesystem block size>).
 This uses the L<blockdev(8)> command.");
 
   ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
 This uses the L<blockdev(8)> command.");
 
   ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],

-   [InitEmpty, TestOutputInt (
+   [InitEmpty, Always, TestOutputInt (

       [["blockdev_getsz"; "/dev/sda"]], 1024000)],
    "get total size of device in 512-byte sectors",
    "\
       [["blockdev_getsz"; "/dev/sda"]], 1024000)],
    "get total size of device in 512-byte sectors",
    "\


@@ -1269,7 +1578,7 @@ useful I<size in bytes>.
 This uses the L<blockdev(8)> command.");
 
   ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
 This uses the L<blockdev(8)> command.");
 
   ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],

-   [InitEmpty, TestOutputInt (
+   [InitEmpty, Always, TestOutputInt (

       [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
    "get total size of device in bytes",
    "\
       [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
    "get total size of device in bytes",
    "\


@@ -1280,7 +1589,7 @@ See also C<guestfs_blockdev_getsz>.
 This uses the L<blockdev(8)> command.");
 
   ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
 This uses the L<blockdev(8)> command.");
 
   ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],

-   [InitEmpty, TestRun
+   [InitEmpty, Always, TestRun

       [["blockdev_flushbufs"; "/dev/sda"]]],
    "flush device buffers",
    "\
       [["blockdev_flushbufs"; "/dev/sda"]]],
    "flush device buffers",
    "\


@@ -1290,7 +1599,7 @@ with C<device>.
 This uses the L<blockdev(8)> command.");
 
   ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
 This uses the L<blockdev(8)> command.");
 
   ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],

-   [InitEmpty, TestRun
+   [InitEmpty, Always, TestRun

       [["blockdev_rereadpt"; "/dev/sda"]]],
    "reread partition table",
    "\
       [["blockdev_rereadpt"; "/dev/sda"]]],
    "reread partition table",
    "\


@@ -1299,9 +1608,9 @@ Reread the partition table on C<device>.
 This uses the L<blockdev(8)> command.");
 
   ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
 This uses the L<blockdev(8)> command.");
 
   ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],

-   [InitBasicFS, TestOutput (
+   [InitBasicFS, Always, TestOutput (

       (* Pick a file from cwd which isn't likely to change. *)
       (* Pick a file from cwd which isn't likely to change. *)

-    [["upload"; "COPYING.LIB"; "/COPYING.LIB"];
+    [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];

      ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
    "upload a file from the local machine",
    "\
      ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
    "upload a file from the local machine",
    "\


@@ -1313,9 +1622,9 @@ C<filename> can also be a named pipe.
 See also C<guestfs_download>.");
 
   ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
 See also C<guestfs_download>.");
 
   ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],

-   [InitBasicFS, TestOutput (
+   [InitBasicFS, Always, TestOutput (

       (* Pick a file from cwd which isn't likely to change. *)
       (* Pick a file from cwd which isn't likely to change. *)

-    [["upload"; "COPYING.LIB"; "/COPYING.LIB"];
+    [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];

      ["download"; "/COPYING.LIB"; "testdownload.tmp"];
      ["upload"; "testdownload.tmp"; "/upload"];
      ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
      ["download"; "/COPYING.LIB"; "testdownload.tmp"];
      ["upload"; "testdownload.tmp"; "/upload"];
      ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")],


@@ -1329,29 +1638,32 @@ C<filename> can also be a named pipe.
 See also C<guestfs_upload>, C<guestfs_cat>.");
 
   ("checksum", (RString "checksum", [String "csumtype"; String "path"]), 68, [],
 See also C<guestfs_upload>, C<guestfs_cat>.");
 
   ("checksum", (RString "checksum", [String "csumtype"; String "path"]), 68, [],

-   [InitBasicFS, TestOutput (
+   [InitBasicFS, Always, TestOutput (

       [["write_file"; "/new"; "test\n"; "0"];
        ["checksum"; "crc"; "/new"]], "935282863");
       [["write_file"; "/new"; "test\n"; "0"];
        ["checksum"; "crc"; "/new"]], "935282863");

-    InitBasicFS, TestLastFail (
+    InitBasicFS, Always, TestLastFail (

       [["checksum"; "crc"; "/new"]]);
       [["checksum"; "crc"; "/new"]]);

-    InitBasicFS, TestOutput (
+    InitBasicFS, Always, TestOutput (

       [["write_file"; "/new"; "test\n"; "0"];
        ["checksum"; "md5"; "/new"]], "d8e8fca2dc0f896fd7cb4cb0031ba249");
       [["write_file"; "/new"; "test\n"; "0"];
        ["checksum"; "md5"; "/new"]], "d8e8fca2dc0f896fd7cb4cb0031ba249");

-    InitBasicFS, TestOutput (
+    InitBasicFS, Always, TestOutput (

       [["write_file"; "/new"; "test\n"; "0"];
        ["checksum"; "sha1"; "/new"]], "4e1243bd22c66e76c2ba9eddc1f91394e57f9f83");
       [["write_file"; "/new"; "test\n"; "0"];
        ["checksum"; "sha1"; "/new"]], "4e1243bd22c66e76c2ba9eddc1f91394e57f9f83");

-    InitBasicFS, TestOutput (
+    InitBasicFS, Always, TestOutput (

       [["write_file"; "/new"; "test\n"; "0"];
        ["checksum"; "sha224"; "/new"]], "52f1bf093f4b7588726035c176c0cdb4376cfea53819f1395ac9e6ec");
       [["write_file"; "/new"; "test\n"; "0"];
        ["checksum"; "sha224"; "/new"]], "52f1bf093f4b7588726035c176c0cdb4376cfea53819f1395ac9e6ec");

-    InitBasicFS, TestOutput (
+    InitBasicFS, Always, TestOutput (

       [["write_file"; "/new"; "test\n"; "0"];
        ["checksum"; "sha256"; "/new"]], "f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93b7605022da52e6ccc26fd2");
       [["write_file"; "/new"; "test\n"; "0"];
        ["checksum"; "sha256"; "/new"]], "f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93b7605022da52e6ccc26fd2");

-    InitBasicFS, TestOutput (
+    InitBasicFS, Always, TestOutput (

       [["write_file"; "/new"; "test\n"; "0"];
        ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d");
       [["write_file"; "/new"; "test\n"; "0"];
        ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d");

-    InitBasicFS, TestOutput (
+    InitBasicFS, Always, TestOutput (

       [["write_file"; "/new"; "test\n"; "0"];
       [["write_file"; "/new"; "test\n"; "0"];

-       ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123")],
+       ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123");
+    InitBasicFS, Always, TestOutput (
+      [["mount"; "/dev/sdd"; "/"];
+       ["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c")],

    "compute MD5, SHAx or CRC checksum of file",
    "\
 This call computes the MD5, SHAx or CRC checksum of the
    "compute MD5, SHAx or CRC checksum of file",
    "\
 This call computes the MD5, SHAx or CRC checksum of the


@@ -1396,8 +1708,8 @@ Compute the SHA512 hash (using the C<sha512sum> program).
 The checksum is returned as a printable string.");
 
   ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
 The checksum is returned as a printable string.");
 
   ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],

-   [InitBasicFS, TestOutput (
-      [["tar_in"; "images/helloworld.tar"; "/"];
+   [InitBasicFS, Always, TestOutput (
+      [["tar_in"; "../images/helloworld.tar"; "/"];

        ["cat"; "/hello"]], "hello\n")],
    "unpack tarfile to directory",
    "\
        ["cat"; "/hello"]], "hello\n")],
    "unpack tarfile to directory",
    "\


@@ -1416,8 +1728,8 @@ it to local file C<tarfile>.
 To download a compressed tarball, use C<guestfs_tgz_out>.");
 
   ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
 To download a compressed tarball, use C<guestfs_tgz_out>.");
 
   ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],

-   [InitBasicFS, TestOutput (
-      [["tgz_in"; "images/helloworld.tar.gz"; "/"];
+   [InitBasicFS, Always, TestOutput (
+      [["tgz_in"; "../images/helloworld.tar.gz"; "/"];

        ["cat"; "/hello"]], "hello\n")],
    "unpack compressed tarball to directory",
    "\
        ["cat"; "/hello"]], "hello\n")],
    "unpack compressed tarball to directory",
    "\


@@ -1435,6 +1747,606 @@ it to local file C<tarball>.
 
 To download an uncompressed tarball, use C<guestfs_tar_out>.");
 
 
 To download an uncompressed tarball, use C<guestfs_tar_out>.");
 

+  ("mount_ro", (RErr, [String "device"; String "mountpoint"]), 73, [],
+   [InitBasicFS, Always, TestLastFail (
+      [["umount"; "/"];
+       ["mount_ro"; "/dev/sda1"; "/"];
+       ["touch"; "/new"]]);
+    InitBasicFS, Always, TestOutput (
+      [["write_file"; "/new"; "data"; "0"];
+       ["umount"; "/"];
+       ["mount_ro"; "/dev/sda1"; "/"];
+       ["cat"; "/new"]], "data")],
+   "mount a guest disk, read-only",
+   "\
+This is the same as the C<guestfs_mount> command, but it
+mounts the filesystem with the read-only (I<-o ro>) flag.");
+
+  ("mount_options", (RErr, [String "options"; String "device"; String "mountpoint"]), 74, [],
+   [],
+   "mount a guest disk with mount options",
+   "\
+This is the same as the C<guestfs_mount> command, but it
+allows you to set the mount options as for the
+L<mount(8)> I<-o> flag.");
+
+  ("mount_vfs", (RErr, [String "options"; String "vfstype"; String "device"; String "mountpoint"]), 75, [],
+   [],
+   "mount a guest disk with mount options and vfstype",
+   "\
+This is the same as the C<guestfs_mount> command, but it
+allows you to set both the mount options and the vfstype
+as for the L<mount(8)> I<-o> and I<-t> flags.");
+
+  ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
+   [],
+   "debugging and internals",
+   "\
+The C<guestfs_debug> command exposes some internals of
+C<guestfsd> (the guestfs daemon) that runs inside the
+qemu subprocess.
+
+There is no comprehensive help for this command.  You have
+to look at the file C<daemon/debug.c> in the libguestfs source
+to find out what you can do.");
+
+  ("lvremove", (RErr, [String "device"]), 77, [],
+   [InitEmpty, Always, TestOutputList (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+       ["pvcreate"; "/dev/sda1"];
+       ["vgcreate"; "VG"; "/dev/sda1"];
+       ["lvcreate"; "LV1"; "VG"; "50"];
+       ["lvcreate"; "LV2"; "VG"; "50"];
+       ["lvremove"; "/dev/VG/LV1"];
+       ["lvs"]], ["/dev/VG/LV2"]);
+    InitEmpty, Always, TestOutputList (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+       ["pvcreate"; "/dev/sda1"];
+       ["vgcreate"; "VG"; "/dev/sda1"];
+       ["lvcreate"; "LV1"; "VG"; "50"];
+       ["lvcreate"; "LV2"; "VG"; "50"];
+       ["lvremove"; "/dev/VG"];
+       ["lvs"]], []);
+    InitEmpty, Always, TestOutputList (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+       ["pvcreate"; "/dev/sda1"];
+       ["vgcreate"; "VG"; "/dev/sda1"];
+       ["lvcreate"; "LV1"; "VG"; "50"];
+       ["lvcreate"; "LV2"; "VG"; "50"];
+       ["lvremove"; "/dev/VG"];
+       ["vgs"]], ["VG"])],
+   "remove an LVM logical volume",
+   "\
+Remove an LVM logical volume C<device>, where C<device> is
+the path to the LV, such as C</dev/VG/LV>.
+
+You can also remove all LVs in a volume group by specifying
+the VG name, C</dev/VG>.");
+
+  ("vgremove", (RErr, [String "vgname"]), 78, [],
+   [InitEmpty, Always, TestOutputList (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+       ["pvcreate"; "/dev/sda1"];
+       ["vgcreate"; "VG"; "/dev/sda1"];
+       ["lvcreate"; "LV1"; "VG"; "50"];
+       ["lvcreate"; "LV2"; "VG"; "50"];
+       ["vgremove"; "VG"];
+       ["lvs"]], []);
+    InitEmpty, Always, TestOutputList (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+       ["pvcreate"; "/dev/sda1"];
+       ["vgcreate"; "VG"; "/dev/sda1"];
+       ["lvcreate"; "LV1"; "VG"; "50"];
+       ["lvcreate"; "LV2"; "VG"; "50"];
+       ["vgremove"; "VG"];
+       ["vgs"]], [])],
+   "remove an LVM volume group",
+   "\
+Remove an LVM volume group C<vgname>, (for example C<VG>).
+
+This also forcibly removes all logical volumes in the volume
+group (if any).");
+
+  ("pvremove", (RErr, [String "device"]), 79, [],
+   [InitEmpty, Always, TestOutputListOfDevices (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+       ["pvcreate"; "/dev/sda1"];
+       ["vgcreate"; "VG"; "/dev/sda1"];
+       ["lvcreate"; "LV1"; "VG"; "50"];
+       ["lvcreate"; "LV2"; "VG"; "50"];
+       ["vgremove"; "VG"];
+       ["pvremove"; "/dev/sda1"];
+       ["lvs"]], []);
+    InitEmpty, Always, TestOutputListOfDevices (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+       ["pvcreate"; "/dev/sda1"];
+       ["vgcreate"; "VG"; "/dev/sda1"];
+       ["lvcreate"; "LV1"; "VG"; "50"];
+       ["lvcreate"; "LV2"; "VG"; "50"];
+       ["vgremove"; "VG"];
+       ["pvremove"; "/dev/sda1"];
+       ["vgs"]], []);
+    InitEmpty, Always, TestOutputListOfDevices (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+       ["pvcreate"; "/dev/sda1"];
+       ["vgcreate"; "VG"; "/dev/sda1"];
+       ["lvcreate"; "LV1"; "VG"; "50"];
+       ["lvcreate"; "LV2"; "VG"; "50"];
+       ["vgremove"; "VG"];
+       ["pvremove"; "/dev/sda1"];
+       ["pvs"]], [])],
+   "remove an LVM physical volume",
+   "\
+This wipes a physical volume C<device> so that LVM will no longer
+recognise it.
+
+The implementation uses the C<pvremove> command which refuses to
+wipe physical volumes that contain any volume groups, so you have
+to remove those first.");
+
+  ("set_e2label", (RErr, [String "device"; String "label"]), 80, [],
+   [InitBasicFS, Always, TestOutput (
+      [["set_e2label"; "/dev/sda1"; "testlabel"];
+       ["get_e2label"; "/dev/sda1"]], "testlabel")],
+   "set the ext2/3/4 filesystem label",
+   "\
+This sets the ext2/3/4 filesystem label of the filesystem on
+C<device> to C<label>.  Filesystem labels are limited to
+16 characters.
+
+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", [String "device"]), 81, [],
+   [],
+   "get the ext2/3/4 filesystem label",
+   "\
+This returns the ext2/3/4 filesystem label of the filesystem on
+C<device>.");
+
+  ("set_e2uuid", (RErr, [String "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"]])],
+   "set the ext2/3/4 filesystem UUID",
+   "\
+This sets the ext2/3/4 filesystem UUID of the filesystem on
+C<device> to C<uuid>.  The format of the UUID and alternatives
+such as C<clear>, C<random> and C<time> are described in the
+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.");
+
+  ("get_e2uuid", (RString "uuid", [String "device"]), 83, [],
+   [],
+   "get the ext2/3/4 filesystem UUID",
+   "\
+This returns the ext2/3/4 filesystem UUID of the filesystem on
+C<device>.");
+
+  ("fsck", (RInt "status", [String "fstype"; String "device"]), 84, [],
+   [InitBasicFS, Always, TestOutputInt (
+      [["umount"; "/dev/sda1"];
+       ["fsck"; "ext2"; "/dev/sda1"]], 0);
+    InitBasicFS, Always, TestOutputInt (
+      [["umount"; "/dev/sda1"];
+       ["zero"; "/dev/sda1"];
+       ["fsck"; "ext2"; "/dev/sda1"]], 8)],
+   "run the filesystem checker",
+   "\
+This runs the filesystem checker (fsck) on C<device> which
+should have filesystem type C<fstype>.
+
+The returned integer is the status.  See L<fsck(8)> for the
+list of status codes from C<fsck>.
+
+Notes:
+
+=over 4
+
+=item *
+
+Multiple status codes can be summed together.
+
+=item *
+
+A non-zero return code can mean \"success\", for example if
+errors have been corrected on the filesystem.
+
+=item *
+
+Checking or repairing NTFS volumes is not supported
+(by linux-ntfs).
+
+=back
+
+This command is entirely equivalent to running C<fsck -a -t fstype device>.");
+
+  ("zero", (RErr, [String "device"]), 85, [],
+   [InitBasicFS, Always, TestOutput (
+      [["umount"; "/dev/sda1"];
+       ["zero"; "/dev/sda1"];
+       ["file"; "/dev/sda1"]], "data")],
+   "write zeroes to the device",
+   "\
+This command writes zeroes over the first few blocks of C<device>.
+
+How many blocks are zeroed isn't specified (but it's I<not> enough
+to securely wipe the device).  It should be sufficient to remove
+any partition tables, filesystem superblocks and so on.");
+
+  ("grub_install", (RErr, [String "root"; String "device"]), 86, [],
+   [InitBasicFS, Always, TestOutputTrue (
+      [["grub_install"; "/"; "/dev/sda1"];
+       ["is_dir"; "/boot"]])],
+   "install GRUB",
+   "\
+This command installs GRUB (the Grand Unified Bootloader) on
+C<device>, with the root directory being C<root>.");
+
+  ("cp", (RErr, [String "src"; String "dest"]), 87, [],
+   [InitBasicFS, Always, TestOutput (
+      [["write_file"; "/old"; "file content"; "0"];
+       ["cp"; "/old"; "/new"];
+       ["cat"; "/new"]], "file content");
+    InitBasicFS, Always, TestOutputTrue (
+      [["write_file"; "/old"; "file content"; "0"];
+       ["cp"; "/old"; "/new"];
+       ["is_file"; "/old"]]);
+    InitBasicFS, Always, TestOutput (
+      [["write_file"; "/old"; "file content"; "0"];
+       ["mkdir"; "/dir"];
+       ["cp"; "/old"; "/dir/new"];
+       ["cat"; "/dir/new"]], "file content")],
+   "copy a file",
+   "\
+This copies a file from C<src> to C<dest> where C<dest> is
+either a destination filename or destination directory.");
+
+  ("cp_a", (RErr, [String "src"; String "dest"]), 88, [],
+   [InitBasicFS, Always, TestOutput (
+      [["mkdir"; "/olddir"];
+       ["mkdir"; "/newdir"];
+       ["write_file"; "/olddir/file"; "file content"; "0"];
+       ["cp_a"; "/olddir"; "/newdir"];
+       ["cat"; "/newdir/olddir/file"]], "file content")],
+   "copy a file or directory recursively",
+   "\
+This copies a file or directory from C<src> to C<dest>
+recursively using the C<cp -a> command.");
+
+  ("mv", (RErr, [String "src"; String "dest"]), 89, [],
+   [InitBasicFS, Always, TestOutput (
+      [["write_file"; "/old"; "file content"; "0"];
+       ["mv"; "/old"; "/new"];
+       ["cat"; "/new"]], "file content");
+    InitBasicFS, Always, TestOutputFalse (
+      [["write_file"; "/old"; "file content"; "0"];
+       ["mv"; "/old"; "/new"];
+       ["is_file"; "/old"]])],
+   "move a file",
+   "\
+This moves a file from C<src> to C<dest> where C<dest> is
+either a destination filename or destination directory.");
+
+  ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
+   [InitEmpty, Always, TestRun (
+      [["drop_caches"; "3"]])],
+   "drop kernel page cache, dentries and inodes",
+   "\
+This instructs the guest kernel to drop its page cache,
+and/or dentries and inode caches.  The parameter C<whattodrop>
+tells the kernel what precisely to drop, see
+L<http://linux-mm.org/Drop_Caches>
+
+Setting C<whattodrop> to 3 should drop everything.
+
+This automatically calls L<sync(2)> before the operation,
+so that the maximum guest memory is freed.");
+
+  ("dmesg", (RString "kmsgs", []), 91, [],
+   [InitEmpty, Always, TestRun (
+      [["dmesg"]])],
+   "return kernel messages",
+   "\
+This returns the kernel messages (C<dmesg> output) from
+the guest kernel.  This is sometimes useful for extended
+debugging of problems.
+
+Another way to get the same information is to enable
+verbose messages with C<guestfs_set_verbose> or by setting
+the environment variable C<LIBGUESTFS_DEBUG=1> before
+running the program.");
+
+  ("ping_daemon", (RErr, []), 92, [],
+   [InitEmpty, Always, TestRun (
+      [["ping_daemon"]])],
+   "ping the guest daemon",
+   "\
+This is a test probe into the guestfs daemon running inside
+the qemu subprocess.  Calling this function checks that the
+daemon responds to the ping message, without affecting the daemon
+or attached block device(s) in any other way.");
+
+  ("equal", (RBool "equality", [String "file1"; String "file2"]), 93, [],
+   [InitBasicFS, Always, TestOutputTrue (
+      [["write_file"; "/file1"; "contents of a file"; "0"];
+       ["cp"; "/file1"; "/file2"];
+       ["equal"; "/file1"; "/file2"]]);
+    InitBasicFS, Always, TestOutputFalse (
+      [["write_file"; "/file1"; "contents of a file"; "0"];
+       ["write_file"; "/file2"; "contents of another file"; "0"];
+       ["equal"; "/file1"; "/file2"]]);
+    InitBasicFS, Always, TestLastFail (
+      [["equal"; "/file1"; "/file2"]])],
+   "test if two files have equal contents",
+   "\
+This compares the two files C<file1> and C<file2> and returns
+true if their content is exactly equal, or false otherwise.
+
+The external L<cmp(1)> program is used for the comparison.");
+
+  ("strings", (RStringList "stringsout", [String "path"]), 94, [ProtocolLimitWarning],
+   [InitBasicFS, Always, TestOutputList (
+      [["write_file"; "/new"; "hello\nworld\n"; "0"];
+       ["strings"; "/new"]], ["hello"; "world"]);
+    InitBasicFS, Always, TestOutputList (
+      [["touch"; "/new"];
+       ["strings"; "/new"]], [])],
+   "print the printable strings in a file",
+   "\
+This runs the L<strings(1)> command on a file and returns
+the list of printable strings found.");
+
+  ("strings_e", (RStringList "stringsout", [String "encoding"; String "path"]), 95, [ProtocolLimitWarning],
+   [InitBasicFS, Always, TestOutputList (
+      [["write_file"; "/new"; "hello\nworld\n"; "0"];
+       ["strings_e"; "b"; "/new"]], []);
+    InitBasicFS, Disabled, TestOutputList (
+      [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
+       ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
+   "print the printable strings in a file",
+   "\
+This is like the C<guestfs_strings> command, but allows you to
+specify the encoding.
+
+See the L<strings(1)> manpage for the full list of encodings.
+
+Commonly useful encodings are C<l> (lower case L) which will
+show strings inside Windows/x86 files.
+
+The returned strings are transcoded to UTF-8.");
+
+  ("hexdump", (RString "dump", [String "path"]), 96, [ProtocolLimitWarning],
+   [InitBasicFS, Always, TestOutput (
+      [["write_file"; "/new"; "hello\nworld\n"; "12"];
+       ["hexdump"; "/new"]], "00000000  68 65 6c 6c 6f 0a 77 6f  72 6c 64 0a              |hello.world.|\n0000000c\n")],
+   "dump a file in hexadecimal",
+   "\
+This runs C<hexdump -C> on the given C<path>.  The result is
+the human-readable, canonical hex dump of the file.");
+
+  ("zerofree", (RErr, [String "device"]), 97, [],
+   [InitNone, Always, TestOutput (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+       ["mkfs"; "ext3"; "/dev/sda1"];
+       ["mount"; "/dev/sda1"; "/"];
+       ["write_file"; "/new"; "test file"; "0"];
+       ["umount"; "/dev/sda1"];
+       ["zerofree"; "/dev/sda1"];
+       ["mount"; "/dev/sda1"; "/"];
+       ["cat"; "/new"]], "test file")],
+   "zero unused inodes and disk blocks on ext2/3 filesystem",
+   "\
+This runs the I<zerofree> program on C<device>.  This program
+claims to zero unused inodes and disk blocks on an ext2/3
+filesystem, thus making it possible to compress the filesystem
+more effectively.
+
+You should B<not> run this program if the filesystem is
+mounted.
+
+It is possible that using this program can damage the filesystem
+or data on the filesystem.");
+
+  ("pvresize", (RErr, [String "device"]), 98, [],
+   [],
+   "resize an LVM physical volume",
+   "\
+This resizes (expands or shrinks) an existing LVM physical
+volume to match the new size of the underlying device.");
+
+  ("sfdisk_N", (RErr, [String "device"; Int "n";
+                      Int "cyls"; Int "heads"; Int "sectors";
+                      String "line"]), 99, [DangerWillRobinson],
+   [],
+   "modify a single partition on a block device",
+   "\
+This runs L<sfdisk(8)> option to modify just the single
+partition C<n> (note: C<n> counts from 1).
+
+For other parameters, see C<guestfs_sfdisk>.  You should usually
+pass C<0> for the cyls/heads/sectors parameters.");
+
+  ("sfdisk_l", (RString "partitions", [String "device"]), 100, [],
+   [],
+   "display the partition table",
+   "\
+This displays the partition table on C<device>, in the
+human-readable output of the L<sfdisk(8)> command.  It is
+not intended to be parsed.");
+
+  ("sfdisk_kernel_geometry", (RString "partitions", [String "device"]), 101, [],
+   [],
+   "display the kernel geometry",
+   "\
+This displays the kernel's idea of the geometry of C<device>.
+
+The result is in human-readable format, and not designed to
+be parsed.");
+
+  ("sfdisk_disk_geometry", (RString "partitions", [String "device"]), 102, [],
+   [],
+   "display the disk geometry from the partition table",
+   "\
+This displays the disk geometry of C<device> read from the
+partition table.  Especially in the case where the underlying
+block device has been resized, this can be different from the
+kernel's idea of the geometry (see C<guestfs_sfdisk_kernel_geometry>).
+
+The result is in human-readable format, and not designed to
+be parsed.");
+
+  ("vg_activate_all", (RErr, [Bool "activate"]), 103, [],
+   [],
+   "activate or deactivate all volume groups",
+   "\
+This command activates or (if C<activate> is false) deactivates
+all logical volumes in all volume groups.
+If activated, then they are made known to the
+kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
+then those devices disappear.
+
+This command is the same as running C<vgchange -a y|n>");
+
+  ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [],
+   [],
+   "activate or deactivate some volume groups",
+   "\
+This command activates or (if C<activate> is false) deactivates
+all logical volumes in the listed volume groups C<volgroups>.
+If activated, then they are made known to the
+kernel, ie. they appear as C</dev/mapper> devices.  If deactivated,
+then those devices disappear.
+
+This command is the same as running C<vgchange -a y|n volgroups...>
+
+Note that if C<volgroups> is an empty list then B<all> volume groups
+are activated or deactivated.");
+
+  ("lvresize", (RErr, [String "device"; Int "mbytes"]), 105, [],
+   [InitNone, Always, TestOutput (
+    [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+     ["pvcreate"; "/dev/sda1"];
+     ["vgcreate"; "VG"; "/dev/sda1"];
+     ["lvcreate"; "LV"; "VG"; "10"];
+     ["mkfs"; "ext2"; "/dev/VG/LV"];
+     ["mount"; "/dev/VG/LV"; "/"];
+     ["write_file"; "/new"; "test content"; "0"];
+     ["umount"; "/"];
+     ["lvresize"; "/dev/VG/LV"; "20"];
+     ["e2fsck_f"; "/dev/VG/LV"];
+     ["resize2fs"; "/dev/VG/LV"];
+     ["mount"; "/dev/VG/LV"; "/"];
+     ["cat"; "/new"]], "test content")],
+   "resize an LVM logical volume",
+   "\
+This resizes (expands or shrinks) an existing LVM logical
+volume to C<mbytes>.  When reducing, data in the reduced part
+is lost.");
+
+  ("resize2fs", (RErr, [String "device"]), 106, [],
+   [], (* lvresize tests this *)
+   "resize an ext2/ext3 filesystem",
+   "\
+This resizes an ext2 or ext3 filesystem to match the size of
+the underlying device.
+
+I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
+on the C<device> before calling this command.  For unknown reasons
+C<resize2fs> sometimes gives an error about this and sometimes not.
+In any case, it is always safe to call C<guestfs_e2fsck_f> before
+calling this function.");
+
+  ("find", (RStringList "names", [String "directory"]), 107, [],
+   [InitBasicFS, Always, TestOutputList (
+      [["find"; "/"]], ["lost+found"]);
+    InitBasicFS, Always, TestOutputList (
+      [["touch"; "/a"];
+       ["mkdir"; "/b"];
+       ["touch"; "/b/c"];
+       ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]);
+    InitBasicFS, Always, TestOutputList (
+      [["mkdir_p"; "/a/b/c"];
+       ["touch"; "/a/b/c/d"];
+       ["find"; "/a/b/"]], ["c"; "c/d"])],
+   "find all files and directories",
+   "\
+This command lists out all files and directories, recursively,
+starting at C<directory>.  It is essentially equivalent to
+running the shell command C<find directory -print> but some
+post-processing happens on the output, described below.
+
+This returns a list of strings I<without any prefix>.  Thus
+if the directory structure was:
+
+ /tmp/a
+ /tmp/b
+ /tmp/c/d
+
+then the returned list from C<guestfs_find> C</tmp> would be
+4 elements:
+
+ a
+ b
+ c
+ c/d
+
+If C<directory> is not a directory, then this command returns
+an error.
+
+The returned list is sorted.");
+
+  ("e2fsck_f", (RErr, [String "device"]), 108, [],
+   [], (* lvresize tests this *)
+   "check an ext2/ext3 filesystem",
+   "\
+This runs C<e2fsck -p -f device>, ie. runs the ext2/ext3
+filesystem checker on C<device>, noninteractively (C<-p>),
+even if the filesystem appears to be clean (C<-f>).
+
+This command is only needed because of C<guestfs_resize2fs>
+(q.v.).  Normally you should use C<guestfs_fsck>.");
+
+  ("sleep", (RErr, [Int "secs"]), 109, [],
+   [InitNone, Always, TestRun (
+    [["sleep"; "1"]])],
+   "sleep for some seconds",
+   "\
+Sleep for C<secs> seconds.");
+
+  ("ntfs_3g_probe", (RInt "status", [Bool "rw"; String "device"]), 110, [],
+   [InitNone, Always, TestOutputInt (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+       ["mkfs"; "ntfs"; "/dev/sda1"];
+       ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0);
+    InitNone, Always, TestOutputInt (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+       ["mkfs"; "ext2"; "/dev/sda1"];
+       ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)],
+   "probe NTFS volume",
+   "\
+This command runs the L<ntfs-3g.probe(8)> command which probes
+an NTFS C<device> for mountability.  (Not all NTFS volumes can
+be mounted read-write, and some cannot be mounted at all).
+
+C<rw> is a boolean flag.  Set it to true if you want to test
+if the volume can be mounted read-write.  Set it to false if
+you want to test if the volume can be mounted read-only.
+
+The return value is an integer which C<0> if the operation
+would succeed, or some non-zero value documented in the
+L<ntfs-3g.probe(8)> manual page.");
+

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


@@ -1542,6 +2454,14 @@ let statvfs_cols = [
   "namemax", `Int;
 ]
 
   "namemax", `Int;
 ]
 

+(* Used for testing language bindings. *)
+type callt =
+  | CallString of string
+  | CallOptString of string option
+  | CallStringList of string list
+  | CallInt of int
+  | CallBool of bool
+

 (* Useful functions.
  * Note we don't want to use any external OCaml libraries which
  * makes this a bit harder than it should be.
 (* Useful functions.
  * Note we don't want to use any external OCaml libraries which
  * makes this a bit harder than it should be.


@@ -1625,6 +2545,13 @@ let rec string_split sep str =
     s' :: string_split sep s''
   )
 
     s' :: string_split sep s''
   )
 

+let files_equal n1 n2 =
+  let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
+  match Sys.command cmd with
+  | 0 -> true
+  | 1 -> false
+  | i -> failwithf "%s: failed with error code %d" cmd i
+

 let rec find_map f = function
   | [] -> raise Not_found
   | x :: xs ->
 let rec find_map f = function
   | [] -> raise Not_found
   | x :: xs ->


@@ -1652,6 +2579,7 @@ let name_of_argt = function
 
 let seq_of_test = function
   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
 
 let seq_of_test = function
   | TestRun s | TestOutput (s, _) | TestOutputList (s, _)

+  | TestOutputListOfDevices (s, _)

   | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
   | TestOutputLength (s, _) | TestOutputStruct (s, _)
   | TestLastFail s -> s
   | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
   | TestOutputLength (s, _) | TestOutputStruct (s, _)
   | TestLastFail s -> s


@@ -1676,8 +2604,10 @@ let check_functions () =
     fun (name, _, _, _, _, _, _) ->
       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
        failwithf "function name %s does not need 'guestfs' prefix" name;
     fun (name, _, _, _, _, _, _) ->
       if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
        failwithf "function name %s does not need 'guestfs' prefix" name;

-      if contains_uppercase name then
-       failwithf "function name %s should not contain uppercase chars" name;
+      if name = "" then
+       failwithf "function name is empty";
+      if name.[0] < 'a' || name.[0] > 'z' then
+       failwithf "function name %s must start with lowercase a-z" name;

       if String.contains name '-' then
        failwithf "function name %s should not contain '-', use '_' instead."
          name
       if String.contains name '-' then
        failwithf "function name %s should not contain '-', use '_' instead."
          name


@@ -1694,9 +2624,13 @@ let check_functions () =
          failwithf "%s param/ret %s should not contain '-' or '_'"
            name n;
        if n = "value" then
          failwithf "%s param/ret %s should not contain '-' or '_'"
            name n;
        if n = "value" then

-         failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" n;
+         failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" name;
+       if n = "int" || n = "char" || n = "short" || n = "long" then
+         failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
+       if n = "i" then
+         failwithf "%s has a param/ret called 'i', which will cause some conflicts in the generated code" name;

        if n = "argv" || n = "args" then
        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" n
+         failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name

       in
 
       (match fst style with
       in
 
       (match fst style with


@@ -1769,7 +2703,7 @@ let check_functions () =
     | name, _, _, _, tests, _, _ ->
        let funcs =
          List.map (
     | name, _, _, _, tests, _, _ ->
        let funcs =
          List.map (

-           fun (_, test) ->
+           fun (_, _, test) ->

              match seq_of_test test with
              | [] ->
                  failwithf "%s has a test containing an empty sequence" name
              match seq_of_test test with
              | [] ->
                  failwithf "%s has a test containing an empty sequence" name


@@ -1788,14 +2722,15 @@ let chan = ref stdout
 let pr fs = ksprintf (output_string !chan) fs
 
 (* Generate a header block in a number of standard styles. *)
 let pr fs = ksprintf (output_string !chan) fs
 
 (* Generate a header block in a number of standard styles. *)

-type comment_style = CStyle | HashStyle | OCamlStyle
+type comment_style = CStyle | HashStyle | OCamlStyle | HaskellStyle

 type license = GPLv2 | LGPLv2
 
 let generate_header comment license =
   let c = match comment with
     | CStyle ->     pr "/* "; " *"
     | HashStyle ->  pr "# ";  "#"
 type license = GPLv2 | LGPLv2
 
 let generate_header comment license =
   let c = match comment with
     | CStyle ->     pr "/* "; " *"
     | HashStyle ->  pr "# ";  "#"

-    | OCamlStyle -> pr "(* "; " *" in
+    | OCamlStyle -> pr "(* "; " *"
+    | HaskellStyle -> pr "{- "; "  " in

   pr "libguestfs generated file\n";
   pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
   pr "libguestfs generated file\n";
   pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
   pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;


@@ -1837,6 +2772,7 @@ let generate_header comment license =
    | CStyle -> pr " */\n"
    | HashStyle -> ()
    | OCamlStyle -> pr " *)\n"
    | CStyle -> pr " */\n"
    | HashStyle -> ()
    | OCamlStyle -> pr " *)\n"

+   | HaskellStyle -> pr "-}\n"

   );
   pr "\n"
 
   );
   pr "\n"
 


@@ -1846,71 +2782,73 @@ let generate_header comment license =
 let rec generate_actions_pod () =
   List.iter (
     fun (shortname, style, _, flags, _, _, longdesc) ->
 let rec generate_actions_pod () =
   List.iter (
     fun (shortname, style, _, flags, _, _, longdesc) ->

-      let name = "guestfs_" ^ shortname in
-      pr "=head2 %s\n\n" name;
-      pr " ";
-      generate_prototype ~extern:false ~handle:"handle" name style;
-      pr "\n\n";
-      pr "%s\n\n" longdesc;
-      (match fst style with
-       | RErr ->
-          pr "This function returns 0 on success or -1 on error.\n\n"
-       | RInt _ ->
-          pr "On error this function returns -1.\n\n"
-       | RInt64 _ ->
-          pr "On error this function returns -1.\n\n"
-       | RBool _ ->
-          pr "This function returns a C truth value on success or -1 on error.\n\n"
-       | RConstString _ ->
-          pr "This function returns a string, or NULL on error.
+      if not (List.mem NotInDocs flags) then (
+       let name = "guestfs_" ^ shortname in
+       pr "=head2 %s\n\n" name;
+       pr " ";
+       generate_prototype ~extern:false ~handle:"handle" name style;
+       pr "\n\n";
+       pr "%s\n\n" longdesc;
+       (match fst style with
+        | RErr ->
+            pr "This function returns 0 on success or -1 on error.\n\n"
+        | RInt _ ->
+            pr "On error this function returns -1.\n\n"
+        | RInt64 _ ->
+            pr "On error this function returns -1.\n\n"
+        | RBool _ ->
+            pr "This function returns a C truth value on success or -1 on error.\n\n"
+        | RConstString _ ->
+            pr "This function returns a string, or NULL on error.

 The string is owned by the guest handle and must I<not> be freed.\n\n"
 The string is owned by the guest handle and must I<not> be freed.\n\n"

-       | RString _ ->
-          pr "This function returns a string, or NULL on error.
+        | RString _ ->
+            pr "This function returns a string, or NULL on error.

 I<The caller must free the returned string after use>.\n\n"
 I<The caller must free the returned string after use>.\n\n"

-       | RStringList _ ->
-          pr "This function returns a NULL-terminated array of strings
+        | RStringList _ ->
+            pr "This function returns a NULL-terminated array of strings

 (like L<environ(3)>), or NULL if there was an error.
 I<The caller must free the strings and the array after use>.\n\n"
 (like L<environ(3)>), or NULL if there was an error.
 I<The caller must free the strings and the array after use>.\n\n"

-       | RIntBool _ ->
-          pr "This function returns a C<struct guestfs_int_bool *>,
+        | RIntBool _ ->
+            pr "This function returns a C<struct guestfs_int_bool *>,

 or NULL if there was an error.
 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
 or NULL if there was an error.
 I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"

-       | RPVList _ ->
-          pr "This function returns a C<struct guestfs_lvm_pv_list *>
+        | RPVList _ ->
+            pr "This function returns a C<struct guestfs_lvm_pv_list *>

 (see E<lt>guestfs-structs.hE<gt>),
 or NULL if there was an error.
 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
 (see E<lt>guestfs-structs.hE<gt>),
 or NULL if there was an error.
 I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"

-       | RVGList _ ->
-          pr "This function returns a C<struct guestfs_lvm_vg_list *>
+        | RVGList _ ->
+            pr "This function returns a C<struct guestfs_lvm_vg_list *>

 (see E<lt>guestfs-structs.hE<gt>),
 or NULL if there was an error.
 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
 (see E<lt>guestfs-structs.hE<gt>),
 or NULL if there was an error.
 I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"

-       | RLVList _ ->
-          pr "This function returns a C<struct guestfs_lvm_lv_list *>
+        | RLVList _ ->
+            pr "This function returns a C<struct guestfs_lvm_lv_list *>

 (see E<lt>guestfs-structs.hE<gt>),
 or NULL if there was an error.
 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
 (see E<lt>guestfs-structs.hE<gt>),
 or NULL if there was an error.
 I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"

-       | RStat _ ->
-          pr "This function returns a C<struct guestfs_stat *>
+        | RStat _ ->
+            pr "This function returns a C<struct guestfs_stat *>

 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
 or NULL if there was an error.
 I<The caller must call C<free> after use>.\n\n"
 (see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
 or NULL if there was an error.
 I<The caller must call C<free> after use>.\n\n"

-       | RStatVFS _ ->
-          pr "This function returns a C<struct guestfs_statvfs *>
+        | RStatVFS _ ->
+            pr "This function returns a C<struct guestfs_statvfs *>

 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
 or NULL if there was an error.
 I<The caller must call C<free> after use>.\n\n"
 (see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
 or NULL if there was an error.
 I<The caller must call C<free> after use>.\n\n"

-       | RHashtable _ ->
-          pr "This function returns a NULL-terminated array of
+        | RHashtable _ ->
+            pr "This function returns a NULL-terminated array of

 strings, or NULL if there was an error.
 The array of strings will always have length C<2n+1>, where
 C<n> keys and values alternate, followed by the trailing NULL entry.
 I<The caller must free the strings and the array after use>.\n\n"
 strings, or NULL if there was an error.
 The array of strings will always have length C<2n+1>, where
 C<n> keys and values alternate, followed by the trailing NULL entry.
 I<The caller must free the strings and the array after use>.\n\n"

-      );
-      if List.mem ProtocolLimitWarning flags then
-       pr "%s\n\n" protocol_limit_warning;
-      if List.mem DangerWillRobinson flags then
-       pr "%s\n\n" danger_will_robinson;
+       );
+       if List.mem ProtocolLimitWarning flags then
+         pr "%s\n\n" protocol_limit_warning;
+       if List.mem DangerWillRobinson flags then
+         pr "%s\n\n" danger_will_robinson
+      )

   ) all_functions_sorted
 
 and generate_structs_pod () =
   ) all_functions_sorted
 
 and generate_structs_pod () =


@@ -2281,8 +3219,7 @@ check_state (guestfs_h *g, const char *caller)
       pr "struct %s_ctx {\n" shortname;
       pr "  /* This flag is set by the callbacks, so we know we've done\n";
       pr "   * the callbacks as expected, and in the right sequence.\n";
       pr "struct %s_ctx {\n" shortname;
       pr "  /* This flag is set by the callbacks, so we know we've done\n";
       pr "   * the callbacks as expected, and in the right sequence.\n";

-      pr "   * 0 = not called, 1 = send called,\n";
-      pr "   * 1001 = reply called.\n";
+      pr "   * 0 = not called, 1 = reply_cb called.\n";

       pr "   */\n";
       pr "  int cb_sequence;\n";
       pr "  struct guestfs_message_header hdr;\n";
       pr "   */\n";
       pr "  int cb_sequence;\n";
       pr "  struct guestfs_message_header hdr;\n";


@@ -2308,6 +3245,13 @@ check_state (guestfs_h *g, const char *caller)
       pr "  guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
       pr "  struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
       pr "\n";
       pr "  guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
       pr "  struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
       pr "\n";

+      pr "  /* This should definitely not happen. */\n";
+      pr "  if (ctx->cb_sequence != 0) {\n";
+      pr "    ctx->cb_sequence = 9999;\n";
+      pr "    error (g, \"%%s: internal error: reply callback called twice\", \"%s\");\n" name;
+      pr "    return;\n";
+      pr "  }\n";
+      pr "\n";

       pr "  ml->main_loop_quit (ml, g);\n";
       pr "\n";
       pr "  if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
       pr "  ml->main_loop_quit (ml, g);\n";
       pr "\n";
       pr "  if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";


@@ -2340,7 +3284,7 @@ check_state (guestfs_h *g, const char *caller)
       );
 
       pr " done:\n";
       );
 
       pr " done:\n";

-      pr "  ctx->cb_sequence = 1001;\n";
+      pr "  ctx->cb_sequence = 1;\n";

       pr "}\n\n";
 
       (* Generate the action stub. *)
       pr "}\n\n";
 
       (* Generate the action stub. *)


@@ -2402,7 +3346,7 @@ check_state (guestfs_h *g, const char *caller)
             name;
       );
       pr "  if (serial == -1) {\n";
             name;
       );
       pr "  if (serial == -1) {\n";

-      pr "    guestfs_set_ready (g);\n";
+      pr "    guestfs_end_busy (g);\n";

       pr "    return %s;\n" error_code;
       pr "  }\n";
       pr "\n";
       pr "    return %s;\n" error_code;
       pr "  }\n";
       pr "\n";


@@ -2417,7 +3361,7 @@ check_state (guestfs_h *g, const char *caller)
            pr "\n";
            pr "    r = guestfs__send_file_sync (g, %s);\n" n;
            pr "    if (r == -1) {\n";
            pr "\n";
            pr "    r = guestfs__send_file_sync (g, %s);\n" n;
            pr "    if (r == -1) {\n";

-           pr "      guestfs_set_ready (g);\n";
+           pr "      guestfs_end_busy (g);\n";

            pr "      return %s;\n" error_code;
            pr "    }\n";
            pr "    if (r == -2) /* daemon cancelled */\n";
            pr "      return %s;\n" error_code;
            pr "    }\n";
            pr "    if (r == -2) /* daemon cancelled */\n";


@@ -2435,23 +3379,24 @@ check_state (guestfs_h *g, const char *caller)
       pr "  guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
       pr "  (void) ml->main_loop_run (ml, g);\n";
       pr "  guestfs_set_reply_callback (g, NULL, NULL);\n";
       pr "  guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
       pr "  (void) ml->main_loop_run (ml, g);\n";
       pr "  guestfs_set_reply_callback (g, NULL, NULL);\n";

-      pr "  if (ctx.cb_sequence != 1001) {\n";
+      pr "  if (ctx.cb_sequence != 1) {\n";

       pr "    error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
       pr "    error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;

-      pr "    guestfs_set_ready (g);\n";
+      pr "    guestfs_end_busy (g);\n";

       pr "    return %s;\n" error_code;
       pr "  }\n";
       pr "\n";
 
       pr "  if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
        (String.uppercase shortname);
       pr "    return %s;\n" error_code;
       pr "  }\n";
       pr "\n";
 
       pr "  if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
        (String.uppercase shortname);

-      pr "    guestfs_set_ready (g);\n";
+      pr "    guestfs_end_busy (g);\n";

       pr "    return %s;\n" error_code;
       pr "  }\n";
       pr "\n";
 
       pr "  if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
       pr "    error (g, \"%%s\", ctx.err.error_message);\n";
       pr "    return %s;\n" error_code;
       pr "  }\n";
       pr "\n";
 
       pr "  if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
       pr "    error (g, \"%%s\", ctx.err.error_message);\n";

-      pr "    guestfs_set_ready (g);\n";
+      pr "    free (ctx.err.error_message);\n";
+      pr "    guestfs_end_busy (g);\n";

       pr "    return %s;\n" error_code;
       pr "  }\n";
       pr "\n";
       pr "    return %s;\n" error_code;
       pr "  }\n";
       pr "\n";


@@ -2461,14 +3406,14 @@ check_state (guestfs_h *g, const char *caller)
        function
        | FileOut n ->
            pr "  if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
        function
        | FileOut n ->
            pr "  if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;

-           pr "    guestfs_set_ready (g);\n";
+           pr "    guestfs_end_busy (g);\n";

            pr "    return %s;\n" error_code;
            pr "  }\n";
            pr "\n";
        | _ -> ()
       ) (snd style);
 
            pr "    return %s;\n" error_code;
            pr "  }\n";
            pr "\n";
        | _ -> ()
       ) (snd style);
 

-      pr "  guestfs_set_ready (g);\n";
+      pr "  guestfs_end_busy (g);\n";

 
       (match fst style with
        | RErr -> pr "  return 0;\n"
 
       (match fst style with
        | RErr -> pr "  return 0;\n"


@@ -2516,7 +3461,7 @@ and generate_daemon_actions_h () =
 and generate_daemon_actions () =
   generate_header CStyle GPLv2;
 
 and generate_daemon_actions () =
   generate_header CStyle GPLv2;
 

-  pr "#define _GNU_SOURCE // for strchrnul\n";
+  pr "#include <config.h>\n";

   pr "\n";
   pr "#include <stdio.h>\n";
   pr "#include <stdlib.h>\n";
   pr "\n";
   pr "#include <stdio.h>\n";
   pr "#include <stdlib.h>\n";


@@ -2558,8 +3503,12 @@ and generate_daemon_actions () =
           pr "  struct guestfs_%s_args args;\n" name;
           List.iter (
             function
           pr "  struct guestfs_%s_args args;\n" name;
           List.iter (
             function

+              (* Note we allow the string to be writable, in order to
+               * allow device name translation.  This is safe because
+               * we can modify the string (passed from RPC).
+               *)

             | String n
             | String n

-            | OptString n -> pr "  const char *%s;\n" n
+            | OptString n -> pr "  char *%s;\n" n

             | StringList n -> pr "  char **%s;\n" n
             | Bool n -> pr "  int %s;\n" n
             | Int n -> pr "  int %s;\n" n
             | StringList n -> pr "  char **%s;\n" n
             | Bool n -> pr "  int %s;\n" n
             | Int n -> pr "  int %s;\n" n


@@ -2582,9 +3531,14 @@ and generate_daemon_actions () =
             | String n -> pr "  %s = args.%s;\n" n n
             | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
             | StringList n ->
             | String n -> pr "  %s = args.%s;\n" n n
             | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
             | StringList n ->

-                pr "  args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
-                pr "  args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
-                pr "  %s = args.%s.%s_val;\n" n n 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;

             | Bool n -> pr "  %s = args.%s;\n" n n
             | Int n -> pr "  %s = args.%s;\n" n n
             | FileIn _ | FileOut _ -> ()
             | Bool n -> pr "  %s = args.%s;\n" n n
             | Int n -> pr "  %s = args.%s;\n" n n
             | FileIn _ | FileOut _ -> ()


@@ -2921,7 +3875,6 @@ int main (int argc, char *argv[])
 {
   char c = 0;
   int failed = 0;
 {
   char c = 0;
   int failed = 0;

-  const char *srcdir;

   const char *filename;
   int fd;
   int nr_tests, test_num = 0;
   const char *filename;
   int fd;
   int nr_tests, test_num = 0;


@@ -2936,10 +3889,7 @@ int main (int argc, char *argv[])
 
   guestfs_set_error_handler (g, print_error, NULL);
 
 
   guestfs_set_error_handler (g, print_error, NULL);
 

-  srcdir = getenv (\"srcdir\");
-  if (!srcdir) srcdir = \".\";
-  chdir (srcdir);
-  guestfs_set_path (g, \".\");
+  guestfs_set_path (g, \"../appliance\");

 
   filename = \"test1.img\";
   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
 
   filename = \"test1.img\";
   fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);


@@ -3025,6 +3975,11 @@ int main (int argc, char *argv[])
     exit (1);
   }
 
     exit (1);
   }
 

+  if (guestfs_add_drive_ro (g, \"../images/test.sqsh\") == -1) {
+    printf (\"guestfs_add_drive_ro ../images/test.sqsh FAILED\\n\");
+    exit (1);
+  }
+

   if (guestfs_launch (g) == -1) {
     printf (\"guestfs_launch FAILED\\n\");
     exit (1);
   if (guestfs_launch (g) == -1) {
     printf (\"guestfs_launch FAILED\\n\");
     exit (1);


@@ -3064,32 +4019,93 @@ int main (int argc, char *argv[])
   pr "  exit (0);\n";
   pr "}\n"
 
   pr "  exit (0);\n";
   pr "}\n"
 

-and generate_one_test name i (init, test) =
+and generate_one_test name i (init, prereq, test) =

   let test_name = sprintf "test_%s_%d" name i in
 
   let test_name = sprintf "test_%s_%d" name i in
 

-  pr "static int %s (void)\n" test_name;
-  pr "{\n";
+  pr "\
+static int %s_skip (void)
+{
+  const char *str;
+
+  str = getenv (\"SKIP_%s\");
+  if (str && strcmp (str, \"1\") == 0) return 1;
+  str = getenv (\"SKIP_TEST_%s\");
+  if (str && strcmp (str, \"1\") == 0) return 1;
+  return 0;
+}
+
+" test_name (String.uppercase test_name) (String.uppercase name);
+
+  (match prereq with
+   | Disabled | Always -> ()
+   | If code | Unless code ->
+       pr "static int %s_prereq (void)\n" test_name;
+       pr "{\n";
+       pr "  %s\n" code;
+       pr "}\n";
+       pr "\n";
+  );
+
+  pr "\
+static int %s (void)
+{
+  if (%s_skip ()) {
+    printf (\"%%s skipped (reason: SKIP_TEST_* variable set)\\n\", \"%s\");
+    return 0;
+  }
+
+" test_name test_name test_name;
+
+  (match prereq with
+   | Disabled ->
+       pr "  printf (\"%%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
+   | If _ ->
+       pr "  if (! %s_prereq ()) {\n" test_name;
+       pr "    printf (\"%%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
+       pr "    return 0;\n";
+       pr "  }\n";
+       pr "\n";
+       generate_one_test_body name i test_name init test;
+   | Unless _ ->
+       pr "  if (%s_prereq ()) {\n" test_name;
+       pr "    printf (\"%%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
+       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
+  );
+
+  pr "  return 0;\n";
+  pr "}\n";
+  pr "\n";
+  test_name

 
 

+and generate_one_test_body name i test_name init test =

   (match init with
   (match init with

-   | InitNone -> ()
+   | InitNone

    | InitEmpty ->
    | InitEmpty ->

-       pr "  /* InitEmpty for %s (%d) */\n" name i;
+       pr "  /* InitNone|InitEmpty for %s */\n" test_name;

        List.iter (generate_test_command_call test_name)
        List.iter (generate_test_command_call test_name)

-        [["umount_all"];
+        [["blockdev_setrw"; "/dev/sda"];
+         ["umount_all"];

          ["lvm_remove_all"]]
    | InitBasicFS ->
          ["lvm_remove_all"]]
    | InitBasicFS ->

-       pr "  /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
+       pr "  /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;

        List.iter (generate_test_command_call test_name)
        List.iter (generate_test_command_call test_name)

-        [["umount_all"];
+        [["blockdev_setrw"; "/dev/sda"];
+         ["umount_all"];

          ["lvm_remove_all"];
          ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
          ["mkfs"; "ext2"; "/dev/sda1"];
          ["mount"; "/dev/sda1"; "/"]]
    | InitBasicFSonLVM ->
          ["lvm_remove_all"];
          ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
          ["mkfs"; "ext2"; "/dev/sda1"];
          ["mount"; "/dev/sda1"; "/"]]
    | InitBasicFSonLVM ->

-       pr "  /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
-        name i;
+       pr "  /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
+        test_name;

        List.iter (generate_test_command_call test_name)
        List.iter (generate_test_command_call test_name)

-        [["umount_all"];
+        [["blockdev_setrw"; "/dev/sda"];
+         ["umount_all"];

          ["lvm_remove_all"];
          ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
          ["pvcreate"; "/dev/sda1"];
          ["lvm_remove_all"];
          ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
          ["pvcreate"; "/dev/sda1"];


@@ -3108,153 +4124,180 @@ and generate_one_test name i (init, test) =
        List.rev (List.tl seq), List.hd seq
   in
 
        List.rev (List.tl seq), List.hd seq
   in
 

-  (match test with
-   | TestRun seq ->
-       pr "  /* TestRun for %s (%d) */\n" name i;
-       List.iter (generate_test_command_call test_name) seq
-   | TestOutput (seq, expected) ->
-       pr "  /* TestOutput for %s (%d) */\n" name i;
-       let seq, last = get_seq_last seq in
-       let test () =
-        pr "    if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
-        pr "      fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
-        pr "      return -1;\n";
-        pr "    }\n"
-       in
-       List.iter (generate_test_command_call test_name) seq;
-       generate_test_command_call ~test test_name last
-   | TestOutputList (seq, expected) ->
-       pr "  /* TestOutputList for %s (%d) */\n" name i;
-       let seq, last = get_seq_last seq in
-       let test () =
-        iteri (
-          fun i str ->
-            pr "    if (!r[%d]) {\n" i;
-            pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
-            pr "      print_strings (r);\n";
-            pr "      return -1;\n";
-            pr "    }\n";
-            pr "    if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
-            pr "      fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
-            pr "      return -1;\n";
-            pr "    }\n"
-        ) expected;
-        pr "    if (r[%d] != NULL) {\n" (List.length expected);
-        pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
-          test_name;
-        pr "      print_strings (r);\n";
-        pr "      return -1;\n";
-        pr "    }\n"
-       in
-       List.iter (generate_test_command_call test_name) seq;
-       generate_test_command_call ~test test_name last
-   | TestOutputInt (seq, expected) ->
-       pr "  /* TestOutputInt for %s (%d) */\n" name i;
-       let seq, last = get_seq_last seq in
-       let test () =
-        pr "    if (r != %d) {\n" expected;
-        pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
-          test_name expected;
-        pr "               (int) r);\n";
-        pr "      return -1;\n";
-        pr "    }\n"
-       in
-       List.iter (generate_test_command_call test_name) seq;
-       generate_test_command_call ~test test_name last
-   | TestOutputTrue seq ->
-       pr "  /* TestOutputTrue for %s (%d) */\n" name i;
-       let seq, last = get_seq_last seq in
-       let test () =
-        pr "    if (!r) {\n";
-        pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
-          test_name;
-        pr "      return -1;\n";
-        pr "    }\n"
-       in
-       List.iter (generate_test_command_call test_name) seq;
-       generate_test_command_call ~test test_name last
-   | TestOutputFalse seq ->
-       pr "  /* TestOutputFalse for %s (%d) */\n" name i;
-       let seq, last = get_seq_last seq in
-       let test () =
-        pr "    if (r) {\n";
-        pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
-          test_name;
-        pr "      return -1;\n";
-        pr "    }\n"
-       in
-       List.iter (generate_test_command_call test_name) seq;
-       generate_test_command_call ~test test_name last
-   | TestOutputLength (seq, expected) ->
-       pr "  /* TestOutputLength for %s (%d) */\n" name i;
-       let seq, last = get_seq_last seq in
-       let test () =
-        pr "    int j;\n";
-        pr "    for (j = 0; j < %d; ++j)\n" expected;
-        pr "      if (r[j] == NULL) {\n";
-        pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
-          test_name;
-        pr "        print_strings (r);\n";
-        pr "        return -1;\n";
-        pr "      }\n";
-        pr "    if (r[j] != NULL) {\n";
-        pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
-          test_name;
-        pr "      print_strings (r);\n";
-        pr "      return -1;\n";
-        pr "    }\n"
-       in
-       List.iter (generate_test_command_call test_name) seq;
-       generate_test_command_call ~test test_name last
-   | TestOutputStruct (seq, checks) ->
-       pr "  /* TestOutputStruct for %s (%d) */\n" name i;
-       let seq, last = get_seq_last seq in
-       let test () =
-        List.iter (
-          function
-          | CompareWithInt (field, expected) ->
-              pr "    if (r->%s != %d) {\n" field expected;
-              pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
-                test_name field expected;
-              pr "               (int) r->%s);\n" field;
-              pr "      return -1;\n";
-              pr "    }\n"
-          | CompareWithString (field, expected) ->
-              pr "    if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
-              pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
-                test_name field expected;
-              pr "               r->%s);\n" field;
-              pr "      return -1;\n";
-              pr "    }\n"
-          | CompareFieldsIntEq (field1, field2) ->
-              pr "    if (r->%s != r->%s) {\n" field1 field2;
-              pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
-                test_name field1 field2;
-              pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
-              pr "      return -1;\n";
-              pr "    }\n"
-          | CompareFieldsStrEq (field1, field2) ->
-              pr "    if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
-              pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
-                test_name field1 field2;
-              pr "               r->%s, r->%s);\n" field1 field2;
-              pr "      return -1;\n";
-              pr "    }\n"
-        ) checks
-       in
-       List.iter (generate_test_command_call test_name) seq;
-       generate_test_command_call ~test test_name last
-   | TestLastFail seq ->
-       pr "  /* TestLastFail for %s (%d) */\n" name i;
-       let seq, last = get_seq_last seq in
-       List.iter (generate_test_command_call test_name) seq;
-       generate_test_command_call test_name ~expect_error:true last
-  );
-
-  pr "  return 0;\n";
-  pr "}\n";
-  pr "\n";
-  test_name
+  match test with
+  | TestRun seq ->
+      pr "  /* TestRun for %s (%d) */\n" name i;
+      List.iter (generate_test_command_call test_name) seq
+  | TestOutput (seq, expected) ->
+      pr "  /* TestOutput for %s (%d) */\n" name i;
+      pr "  char expected[] = \"%s\";\n" (c_quote expected);
+      let seq, last = get_seq_last seq in
+      let test () =
+       pr "    if (strcmp (r, expected) != 0) {\n";
+       pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
+       pr "      return -1;\n";
+       pr "    }\n"
+      in
+      List.iter (generate_test_command_call test_name) seq;
+      generate_test_command_call ~test test_name last
+  | TestOutputList (seq, expected) ->
+      pr "  /* TestOutputList for %s (%d) */\n" name i;
+      let seq, last = get_seq_last seq in
+      let test () =
+       iteri (
+         fun i str ->
+           pr "    if (!r[%d]) {\n" i;
+           pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
+           pr "      print_strings (r);\n";
+           pr "      return -1;\n";
+           pr "    }\n";
+            pr "    {\n";
+            pr "      char expected[] = \"%s\";\n" (c_quote str);
+           pr "      if (strcmp (r[%d], expected) != 0) {\n" i;
+           pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
+           pr "        return -1;\n";
+           pr "      }\n";
+           pr "    }\n"
+       ) expected;
+       pr "    if (r[%d] != NULL) {\n" (List.length expected);
+       pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
+         test_name;
+       pr "      print_strings (r);\n";
+       pr "      return -1;\n";
+       pr "    }\n"
+      in
+      List.iter (generate_test_command_call test_name) seq;
+      generate_test_command_call ~test test_name last
+  | TestOutputListOfDevices (seq, expected) ->
+      pr "  /* TestOutputListOfDevices for %s (%d) */\n" name i;
+      let seq, last = get_seq_last seq in
+      let test () =
+       iteri (
+         fun i str ->
+           pr "    if (!r[%d]) {\n" i;
+           pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
+           pr "      print_strings (r);\n";
+           pr "      return -1;\n";
+           pr "    }\n";
+            pr "    {\n";
+            pr "      char expected[] = \"%s\";\n" (c_quote str);
+           pr "      r[%d][5] = 's';\n" i;
+           pr "      if (strcmp (r[%d], expected) != 0) {\n" i;
+           pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
+           pr "        return -1;\n";
+           pr "      }\n";
+           pr "    }\n"
+       ) expected;
+       pr "    if (r[%d] != NULL) {\n" (List.length expected);
+       pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
+         test_name;
+       pr "      print_strings (r);\n";
+       pr "      return -1;\n";
+       pr "    }\n"
+      in
+      List.iter (generate_test_command_call test_name) seq;
+      generate_test_command_call ~test test_name last
+  | TestOutputInt (seq, expected) ->
+      pr "  /* TestOutputInt for %s (%d) */\n" name i;
+      let seq, last = get_seq_last seq in
+      let test () =
+       pr "    if (r != %d) {\n" expected;
+       pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
+         test_name expected;
+       pr "               (int) r);\n";
+       pr "      return -1;\n";
+       pr "    }\n"
+      in
+      List.iter (generate_test_command_call test_name) seq;
+      generate_test_command_call ~test test_name last
+  | TestOutputTrue seq ->
+      pr "  /* TestOutputTrue for %s (%d) */\n" name i;
+      let seq, last = get_seq_last seq in
+      let test () =
+       pr "    if (!r) {\n";
+       pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
+         test_name;
+       pr "      return -1;\n";
+       pr "    }\n"
+      in
+      List.iter (generate_test_command_call test_name) seq;
+      generate_test_command_call ~test test_name last
+  | TestOutputFalse seq ->
+      pr "  /* TestOutputFalse for %s (%d) */\n" name i;
+      let seq, last = get_seq_last seq in
+      let test () =
+       pr "    if (r) {\n";
+       pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
+         test_name;
+       pr "      return -1;\n";
+       pr "    }\n"
+      in
+      List.iter (generate_test_command_call test_name) seq;
+      generate_test_command_call ~test test_name last
+  | TestOutputLength (seq, expected) ->
+      pr "  /* TestOutputLength for %s (%d) */\n" name i;
+      let seq, last = get_seq_last seq in
+      let test () =
+       pr "    int j;\n";
+       pr "    for (j = 0; j < %d; ++j)\n" expected;
+       pr "      if (r[j] == NULL) {\n";
+       pr "        fprintf (stderr, \"%s: short list returned\\n\");\n"
+         test_name;
+       pr "        print_strings (r);\n";
+       pr "        return -1;\n";
+       pr "      }\n";
+       pr "    if (r[j] != NULL) {\n";
+       pr "      fprintf (stderr, \"%s: long list returned\\n\");\n"
+         test_name;
+       pr "      print_strings (r);\n";
+       pr "      return -1;\n";
+       pr "    }\n"
+      in
+      List.iter (generate_test_command_call test_name) seq;
+      generate_test_command_call ~test test_name last
+  | TestOutputStruct (seq, checks) ->
+      pr "  /* TestOutputStruct for %s (%d) */\n" name i;
+      let seq, last = get_seq_last seq in
+      let test () =
+       List.iter (
+         function
+         | CompareWithInt (field, expected) ->
+             pr "    if (r->%s != %d) {\n" field expected;
+             pr "      fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
+               test_name field expected;
+             pr "               (int) r->%s);\n" field;
+             pr "      return -1;\n";
+             pr "    }\n"
+         | CompareWithString (field, expected) ->
+             pr "    if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
+             pr "      fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
+               test_name field expected;
+             pr "               r->%s);\n" field;
+             pr "      return -1;\n";
+             pr "    }\n"
+         | CompareFieldsIntEq (field1, field2) ->
+             pr "    if (r->%s != r->%s) {\n" field1 field2;
+             pr "      fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
+               test_name field1 field2;
+             pr "               (int) r->%s, (int) r->%s);\n" field1 field2;
+             pr "      return -1;\n";
+             pr "    }\n"
+         | CompareFieldsStrEq (field1, field2) ->
+             pr "    if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
+             pr "      fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
+               test_name field1 field2;
+             pr "               r->%s, r->%s);\n" field1 field2;
+             pr "      return -1;\n";
+             pr "    }\n"
+       ) checks
+      in
+      List.iter (generate_test_command_call test_name) seq;
+      generate_test_command_call ~test test_name last
+  | TestLastFail seq ->
+      pr "  /* TestLastFail for %s (%d) */\n" name i;
+      let seq, last = get_seq_last seq in
+      List.iter (generate_test_command_call test_name) seq;
+      generate_test_command_call test_name ~expect_error:true last

 
 (* Generate the code to run a command, leaving the result in 'r'.
  * If you expect to get an error then you should set expect_error:true.
 
 (* Generate the code to run a command, leaving the result in 'r'.
  * If you expect to get an error then you should set expect_error:true.


@@ -3280,16 +4323,22 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
 
       List.iter (
        function
 
       List.iter (
        function

-       | String _, _
-       | OptString _, _
+       | OptString n, "NULL" -> ()
+       | String n, arg
+       | OptString n, arg ->
+           pr "    char %s[] = \"%s\";\n" n (c_quote arg);

        | Int _, _
        | Int _, _

-       | Bool _, _ -> ()
+       | Bool _, _

        | FileIn _, _ | FileOut _, _ -> ()
        | StringList n, arg ->
        | FileIn _, _ | FileOut _, _ -> ()
        | StringList n, arg ->

-           pr "    char *%s[] = {\n" n;

            let strs = string_split " " arg in
            let strs = string_split " " arg in

-           List.iter (
-             fun str -> pr "      \"%s\",\n" (c_quote str)
+           iteri (
+             fun i str ->
+                pr "    char %s_%d[] = \"%s\";\n" n i (c_quote str);
+           ) strs;
+           pr "    char *%s[] = {\n" n;
+           iteri (
+             fun i _ -> pr "      %s_%d,\n" n i

            ) strs;
            pr "      NULL\n";
            pr "    };\n";
            ) strs;
            pr "      NULL\n";
            pr "    };\n";


@@ -3324,11 +4373,12 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
       (* Generate the parameters. *)
       List.iter (
        function
       (* Generate the parameters. *)
       List.iter (
        function

-       | String _, arg
+       | OptString _, "NULL" -> pr ", NULL"
+       | String n, _
+       | OptString n, _ ->
+            pr ", %s" n

        | FileIn _, arg | FileOut _, arg ->
            pr ", \"%s\"" (c_quote arg)
        | FileIn _, arg | FileOut _, arg ->
            pr ", \"%s\"" (c_quote arg)

-       | OptString _, arg ->
-           if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)

        | StringList n, _ ->
            pr ", %s" n
        | Int _, arg ->
        | StringList n, _ ->
            pr ", %s" n
        | Int _, arg ->


@@ -3379,6 +4429,7 @@ and c_quote str =
   let str = replace_str str "\r" "\\r" in
   let str = replace_str str "\n" "\\n" in
   let str = replace_str str "\t" "\\t" in
   let str = replace_str str "\r" "\\r" in
   let str = replace_str str "\n" "\\n" in
   let str = replace_str str "\t" "\\t" in

+  let str = replace_str str "\000" "\\0" in

   str
 
 (* Generate a lot of different functions for guestfish. *)
   str
 
 (* Generate a lot of different functions for guestfish. *)


@@ -3714,10 +4765,13 @@ and generate_fish_completion () =
 
 #ifdef HAVE_LIBREADLINE
 
 
 #ifdef HAVE_LIBREADLINE
 

-static const char *commands[] = {
+static const char *const commands[] = {
+  BUILTIN_COMMANDS_FOR_COMPLETION,

 ";
 
 ";
 

-  (* Get the commands and sort them, including the aliases. *)
+  (* Get the commands, including the aliases.  They don't need to be
+   * sorted - the generator() function just does a dumb linear search.
+   *)

   let commands =
     List.map (
       fun (name, _, _, flags, _, _, _) ->
   let commands =
     List.map (
       fun (name, _, _, flags, _, _, _) ->


@@ -3729,7 +4783,6 @@ static const char *commands[] = {
        if name <> alias then [name2; alias] else [name2]
     ) all_functions in
   let commands = List.flatten commands in
        if name <> alias then [name2; alias] else [name2]
     ) all_functions in
   let commands = List.flatten commands in

-  let commands = List.sort compare commands in

 
   List.iter (pr "  \"%s\",\n") commands;
 
 
   List.iter (pr "  \"%s\",\n") commands;
 


@@ -3775,12 +4828,23 @@ char **do_completion (const char *text, int start, int end)
 and generate_fish_actions_pod () =
   let all_functions_sorted =
     List.filter (
 and generate_fish_actions_pod () =
   let all_functions_sorted =
     List.filter (

-      fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
+      fun (_, _, _, flags, _, _, _) ->
+       not (List.mem NotInFish flags || List.mem NotInDocs flags)

     ) all_functions_sorted in
 
     ) all_functions_sorted in
 

+  let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
+

   List.iter (
     fun (name, style, _, flags, _, _, longdesc) ->
   List.iter (
     fun (name, style, _, flags, _, _, longdesc) ->

-      let longdesc = replace_str longdesc "C<guestfs_" "C<" in
+      let longdesc =
+       Str.global_substitute rex (
+         fun s ->
+           let sub =
+             try Str.matched_group 1 s
+             with Not_found ->
+               failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
+           "C<" ^ replace_char sub '_' '-' ^ ">"
+       ) longdesc in

       let name = replace_char name '_' '-' in
       let alias =
        try find_map (function FishAlias n -> Some n | _ -> None) flags
       let name = replace_char name '_' '-' in
       let alias =
        try find_map (function FishAlias n -> Some n | _ -> None) flags


@@ -3868,8 +4932,14 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
     List.iter (
       function
       | String n
     List.iter (
       function
       | String n

-      | OptString n -> next (); pr "const char *%s" n
-      | StringList n -> next (); pr "char * const* const %s" n
+      | OptString n ->
+         next ();
+         if not in_daemon then pr "const char *%s" n
+         else pr "char *%s" n
+      | StringList n ->
+         next ();
+         if not in_daemon then pr "char * const* const %s" n
+         else pr "char **%s" n

       | Bool n -> next (); pr "int %s" n
       | Int n -> next (); pr "int %s" n
       | FileIn n
       | Bool n -> next (); pr "int %s" n
       | Int n -> next (); pr "int %s" n
       | FileIn n


@@ -4106,6 +5176,8 @@ copy_table (char * const * argv)
       pr "{\n";
 
       (match params with
       pr "{\n";
 
       (match params with

+       | [p1; p2; p3; p4; p5] ->
+          pr "  CAMLparam5 (%s);\n" (String.concat ", " params)

        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
           pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
           pr "  CAMLxparam%d (%s);\n"
        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
           pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
           pr "  CAMLxparam%d (%s);\n"


@@ -4132,7 +5204,7 @@ copy_table (char * const * argv)
            pr "    %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
              n n
        | StringList n ->
            pr "    %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
              n n
        | StringList n ->

-           pr "  char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
+           pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n

        | Bool n ->
            pr "  int %s = Bool_val (%sv);\n" n n
        | Int n ->
        | Bool n ->
            pr "  int %s = Bool_val (%sv);\n" n n
        | Int n ->


@@ -4354,12 +5426,13 @@ XS_unpack_charPtrPtr (SV *arg) {
   AV *av;
   I32 i;
 
   AV *av;
   I32 i;
 

-  if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
+  if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)

     croak (\"array reference expected\");
     croak (\"array reference expected\");

-  }

 
   av = (AV *)SvRV (arg);
 
   av = (AV *)SvRV (arg);

-  ret = (char **)malloc (av_len (av) + 1 + 1);
+  ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
+  if (!ret)
+    croak (\"malloc failed\");

 
   for (i = 0; i <= av_len (av); i++) {
     SV **elem = av_fetch (av, i, 0);
 
   for (i = 0; i <= av_len (av); i++) {
     SV **elem = av_fetch (av, i, 0);


@@ -4377,6 +5450,8 @@ XS_unpack_charPtrPtr (SV *arg) {
 
 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
 
 
 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
 

+PROTOTYPES: ENABLE
+

 guestfs_h *
 _create ()
    CODE:
 guestfs_h *
 _create ()
    CODE:


@@ -4416,13 +5491,19 @@ DESTROY (g)
       generate_call_args ~handle:"g" (snd style);
       pr "\n";
       pr "      guestfs_h *g;\n";
       generate_call_args ~handle:"g" (snd style);
       pr "\n";
       pr "      guestfs_h *g;\n";

-      List.iter (
-       function
-       | String n | FileIn n | FileOut n -> pr "      char *%s;\n" n
-       | OptString n -> pr "      char *%s;\n" n
-       | StringList n -> pr "      char **%s;\n" n
-       | Bool n -> pr "      int %s;\n" n
-       | Int n -> pr "      int %s;\n" n
+      iteri (
+       fun i ->
+         function
+         | String n | FileIn n | FileOut n -> pr "      char *%s;\n" n
+         | OptString n ->
+             (* http://www.perlmonks.org/?node_id=554277
+              * Note that the implicit handle argument means we have
+              * 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
+         | Bool n -> pr "      int %s;\n" n
+         | Int n -> pr "      int %s;\n" n

       ) (snd style);
 
       let do_cleanups () =
       ) (snd style);
 
       let do_cleanups () =


@@ -4688,15 +5769,17 @@ sub new {
    *)
   List.iter (
     fun (name, style, _, flags, _, _, longdesc) ->
    *)
   List.iter (
     fun (name, style, _, flags, _, _, longdesc) ->

-      let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
-      pr "=item ";
-      generate_perl_prototype name style;
-      pr "\n\n";
-      pr "%s\n\n" longdesc;
-      if List.mem ProtocolLimitWarning flags then
-       pr "%s\n\n" protocol_limit_warning;
-      if List.mem DangerWillRobinson flags then
-       pr "%s\n\n" danger_will_robinson
+      if not (List.mem NotInDocs flags) then (
+       let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
+       pr "=item ";
+       generate_perl_prototype name style;
+       pr "\n\n";
+       pr "%s\n\n" longdesc;
+       if List.mem ProtocolLimitWarning flags then
+         pr "%s\n\n" protocol_limit_warning;
+       if List.mem DangerWillRobinson flags then
+         pr "%s\n\n" danger_will_robinson
+      )

   ) all_functions_sorted;
 
   (* End of file. *)
   ) all_functions_sorted;
 
   (* End of file. *)


@@ -5199,43 +6282,45 @@ class GuestFS:
 
   List.iter (
     fun (name, style, _, flags, _, _, longdesc) ->
 
   List.iter (
     fun (name, style, _, flags, _, _, longdesc) ->

-      let doc = replace_str longdesc "C<guestfs_" "C<g." in
-      let doc =
-        match fst style with
-       | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
-       | RString _ -> doc
-       | RStringList _ ->
-           doc ^ "\n\nThis function returns a list of strings."
-       | RIntBool _ ->
-           doc ^ "\n\nThis function returns a tuple (int, bool).\n"
-       | RPVList _ ->
-           doc ^ "\n\nThis function returns a list of PVs.  Each PV is represented as a dictionary."
-       | RVGList _ ->
-           doc ^ "\n\nThis function returns a list of VGs.  Each VG is represented as a dictionary."
-       | RLVList _ ->
-           doc ^ "\n\nThis function returns a list of LVs.  Each LV is represented as a dictionary."
-       | RStat _ ->
-           doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure."
-       | RStatVFS _ ->
-           doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure."
-       | RHashtable _ ->
-           doc ^ "\n\nThis function returns a dictionary." in
-      let doc =
-       if List.mem ProtocolLimitWarning flags then
-         doc ^ "\n\n" ^ protocol_limit_warning
-       else doc in
-      let doc =
-       if List.mem DangerWillRobinson flags then
-         doc ^ "\n\n" ^ danger_will_robinson
-       else doc in
-      let doc = pod2text ~width:60 name doc in
-      let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
-      let doc = String.concat "\n        " doc in
-

       pr "    def %s " name;
       generate_call_args ~handle:"self" (snd style);
       pr ":\n";
       pr "    def %s " name;
       generate_call_args ~handle:"self" (snd style);
       pr ":\n";

-      pr "        u\"\"\"%s\"\"\"\n" doc;
+
+      if not (List.mem NotInDocs flags) then (
+       let doc = replace_str longdesc "C<guestfs_" "C<g." in
+       let doc =
+          match fst style with
+         | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
+         | RString _ -> doc
+         | RStringList _ ->
+             doc ^ "\n\nThis function returns a list of strings."
+         | RIntBool _ ->
+             doc ^ "\n\nThis function returns a tuple (int, bool).\n"
+         | RPVList _ ->
+             doc ^ "\n\nThis function returns a list of PVs.  Each PV is represented as a dictionary."
+         | RVGList _ ->
+             doc ^ "\n\nThis function returns a list of VGs.  Each VG is represented as a dictionary."
+         | RLVList _ ->
+             doc ^ "\n\nThis function returns a list of LVs.  Each LV is represented as a dictionary."
+         | RStat _ ->
+             doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure."
+         | RStatVFS _ ->
+             doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure."
+         | RHashtable _ ->
+             doc ^ "\n\nThis function returns a dictionary." in
+       let doc =
+         if List.mem ProtocolLimitWarning flags then
+           doc ^ "\n\n" ^ protocol_limit_warning
+         else doc in
+       let doc =
+         if List.mem DangerWillRobinson flags then
+           doc ^ "\n\n" ^ danger_will_robinson
+         else doc in
+       let doc = pod2text ~width:60 name doc in
+       let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
+       let doc = String.concat "\n        " doc in
+       pr "        u\"\"\"%s\"\"\"\n" doc;
+      );

       pr "        return libguestfsmod.%s " name;
       generate_call_args ~handle:"self._o" (snd style);
       pr "\n";
       pr "        return libguestfsmod.%s " name;
       generate_call_args ~handle:"self._o" (snd style);
       pr "\n";


@@ -5286,6 +6371,11 @@ and generate_ruby_c () =
 
 #include \"extconf.h\"
 
 
 #include \"extconf.h\"
 

+/* For Ruby < 1.9 */
+#ifndef RARRAY_LEN
+#define RARRAY_LEN(r) (RARRAY((r))->len)
+#endif
+

 static VALUE m_guestfs;                        /* guestfs module */
 static VALUE c_guestfs;                        /* guestfs_h handle */
 static VALUE e_Error;                  /* used for all errors */
 static VALUE m_guestfs;                        /* guestfs module */
 static VALUE c_guestfs;                        /* guestfs_h handle */
 static VALUE e_Error;                  /* used for all errors */


@@ -5347,19 +6437,22 @@ static VALUE ruby_guestfs_close (VALUE gv)
            pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
            pr "              \"%s\", \"%s\");\n" n name
        | OptString n ->
            pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
            pr "              \"%s\", \"%s\");\n" n name
        | OptString n ->

-           pr "  const char *%s = StringValueCStr (%sv);\n" n n
+           pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n

        | StringList n ->
            pr "  char **%s;" n;
            pr "  {\n";
            pr "    int i, len;\n";
            pr "    len = RARRAY_LEN (%sv);\n" n;
        | StringList n ->
            pr "  char **%s;" n;
            pr "  {\n";
            pr "    int i, len;\n";
            pr "    len = RARRAY_LEN (%sv);\n" n;

-           pr "    %s = malloc (sizeof (char *) * (len+1));\n" n;
+           pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
+             n;

            pr "    for (i = 0; i < len; ++i) {\n";
            pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
            pr "      %s[i] = StringValueCStr (v);\n" n;
            pr "    }\n";
            pr "    for (i = 0; i < len; ++i) {\n";
            pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
            pr "      %s[i] = StringValueCStr (v);\n" n;
            pr "    }\n";

+           pr "    %s[len] = NULL;\n" n;

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

-       | Bool n
+       | Bool n ->
+           pr "  int %s = RTEST (%sv);\n" n n

        | Int n ->
            pr "  int %s = NUM2INT (%sv);\n" n n
       ) (snd style);
        | Int n ->
            pr "  int %s = NUM2INT (%sv);\n" n n
       ) (snd style);


@@ -5579,25 +6672,32 @@ public class GuestFS {
 
   List.iter (
     fun (name, style, _, flags, _, shortdesc, longdesc) ->
 
   List.iter (
     fun (name, style, _, flags, _, shortdesc, longdesc) ->

-      let doc = replace_str longdesc "C<guestfs_" "C<g." in
-      let doc =
-       if List.mem ProtocolLimitWarning flags then
-         doc ^ "\n\n" ^ protocol_limit_warning
-       else doc in
-      let doc =
-       if List.mem DangerWillRobinson flags then
-         doc ^ "\n\n" ^ danger_will_robinson
-       else doc in
-      let doc = pod2text ~width:60 name doc in
-      let doc = String.concat "\n   * " doc in
-
-      pr "  /**\n";
-      pr "   * %s\n" shortdesc;
-      pr "   *\n";
-      pr "   * %s\n" doc;
-      pr "   * @throws LibGuestFSException\n";
-      pr "   */\n";
-      pr "  ";
+      if not (List.mem NotInDocs flags); then (
+       let doc = replace_str longdesc "C<guestfs_" "C<g." in
+       let doc =
+         if List.mem ProtocolLimitWarning flags then
+           doc ^ "\n\n" ^ protocol_limit_warning
+         else doc in
+       let doc =
+         if List.mem DangerWillRobinson flags then
+           doc ^ "\n\n" ^ danger_will_robinson
+         else doc in
+       let doc = pod2text ~width:60 name doc in
+       let doc = List.map (            (* RHBZ#501883 *)
+         function
+         | "" -> "<p>"
+         | nonempty -> nonempty
+       ) doc in
+       let doc = String.concat "\n   * " doc in
+
+       pr "  /**\n";
+       pr "   * %s\n" shortdesc;
+       pr "   * <p>\n";
+       pr "   * %s\n" doc;
+       pr "   * @throws LibGuestFSException\n";
+       pr "   */\n";
+       pr "  ";
+      );

       generate_java_prototype ~public:true ~semicolon:false name style;
       pr "\n";
       pr "  {\n";
       generate_java_prototype ~public:true ~semicolon:false name style;
       pr "\n";
       pr "  {\n";


@@ -5736,14 +6836,14 @@ Java_com_redhat_et_libguestfs_GuestFS__1create
     return 0;
   }
   guestfs_set_error_handler (g, NULL, NULL);
     return 0;
   }
   guestfs_set_error_handler (g, NULL, NULL);

-  return (jlong) g;
+  return (jlong) (long) g;

 }
 
 JNIEXPORT void JNICALL
 Java_com_redhat_et_libguestfs_GuestFS__1close
   (JNIEnv *env, jobject obj, jlong jg)
 {
 }
 
 JNIEXPORT void JNICALL
 Java_com_redhat_et_libguestfs_GuestFS__1close
   (JNIEnv *env, jobject obj, jlong jg)
 {

-  guestfs_h *g = (guestfs_h *) jg;
+  guestfs_h *g = (guestfs_h *) (long) jg;

   guestfs_close (g);
 }
 
   guestfs_close (g);
 }
 


@@ -5784,7 +6884,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
       ) (snd style);
       pr ")\n";
       pr "{\n";
       ) (snd style);
       pr ")\n";
       pr "{\n";

-      pr "  guestfs_h *g = (guestfs_h *) jg;\n";
+      pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";

       let error_code, no_ret =
        match fst style with
        | RErr -> pr "  int r;\n"; "-1", ""
       let error_code, no_ret =
        match fst style with
        | RErr -> pr "  int r;\n"; "-1", ""


@@ -5853,7 +6953,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
       let needs_i =
        (match fst style with
         | RStringList _ | RPVList _ | RVGList _ | RLVList _ -> true
       let needs_i =
        (match fst style with
         | RStringList _ | RPVList _ | RVGList _ | RLVList _ -> true

-        | RErr _ | RBool _ | RInt _ | RInt64 _ | RConstString _
+        | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _

         | RString _ | RIntBool _ | RStat _ | RStatVFS _
         | RHashtable _ -> false) ||
        List.exists (function StringList _ -> true | _ -> false) (snd style) in
         | RString _ | RIntBool _ | RStat _ | RStatVFS _
         | RHashtable _ -> false) ||
        List.exists (function StringList _ -> true | _ -> false) (snd style) in


@@ -5866,13 +6966,17 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
       List.iter (
        function
        | String n
       List.iter (
        function
        | String n

-       | OptString n

        | FileIn n
        | FileOut n ->
            pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
        | FileIn n
        | FileOut n ->
            pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n

+       | OptString n ->
+           (* This is completely undocumented, but Java null becomes
+            * a NULL parameter.
+            *)
+           pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n

        | StringList n ->
            pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
        | StringList n ->
            pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;

-           pr "  %s = malloc (sizeof (char *) * (%s_len+1));\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;
            pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
              n;
            pr "  for (i = 0; i < %s_len; ++i) {\n" n;
            pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
              n;


@@ -5893,10 +6997,12 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
       List.iter (
        function
        | String n
       List.iter (
        function
        | String n

-       | OptString n

        | FileIn n
        | FileOut n ->
            pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
        | FileIn n
        | FileOut n ->
            pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n

+       | OptString n ->
+           pr "  if (j%s)\n" n;
+           pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n

        | StringList n ->
            pr "  for (i = 0; i < %s_len; ++i) {\n" n;
            pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
        | StringList n ->
            pr "  for (i = 0; i < %s_len; ++i) {\n" n;
            pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"


@@ -6016,14 +7122,620 @@ and generate_java_lvm_return typ jtyp cols =
   pr "  guestfs_free_lvm_%s_list (r);\n" typ;
   pr "  return jr;\n"
 
   pr "  guestfs_free_lvm_%s_list (r);\n" typ;
   pr "  return jr;\n"
 

+and generate_haskell_hs () =
+  generate_header HaskellStyle LGPLv2;
+
+  (* XXX We only know how to generate partial FFI for Haskell
+   * at the moment.  Please help out!
+   *)
+  let can_generate style =
+    let check_no_bad_args =
+      List.for_all (function Bool _ | Int _ -> false | _ -> true)
+    in
+    match style with
+    | RErr, args -> check_no_bad_args args
+    | RBool _, _
+    | RInt _, _
+    | RInt64 _, _
+    | RConstString _, _
+    | RString _, _
+    | RStringList _, _
+    | RIntBool _, _
+    | RPVList _, _
+    | RVGList _, _
+    | RLVList _, _
+    | RStat _, _
+    | RStatVFS _, _
+    | RHashtable _, _ -> false in
+
+  pr "\
+{-# INCLUDE <guestfs.h> #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Guestfs (
+  create";
+
+  (* List out the names of the actions we want to export. *)
+  List.iter (
+    fun (name, style, _, _, _, _, _) ->
+      if can_generate style then pr ",\n  %s" name
+  ) all_functions;
+
+  pr "
+  ) where
+import Foreign
+import Foreign.C
+import IO
+import Control.Exception
+import Data.Typeable
+
+data GuestfsS = GuestfsS            -- represents the opaque C struct
+type GuestfsP = Ptr GuestfsS        -- guestfs_h *
+type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
+
+-- XXX define properly later XXX
+data PV = PV
+data VG = VG
+data LV = LV
+data IntBool = IntBool
+data Stat = Stat
+data StatVFS = StatVFS
+data Hashtable = Hashtable
+
+foreign import ccall unsafe \"guestfs_create\" c_create
+  :: IO GuestfsP
+foreign import ccall unsafe \"&guestfs_close\" c_close
+  :: FunPtr (GuestfsP -> IO ())
+foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
+  :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
+
+create :: IO GuestfsH
+create = do
+  p <- c_create
+  c_set_error_handler p nullPtr nullPtr
+  h <- newForeignPtr c_close p
+  return h
+
+foreign import ccall unsafe \"guestfs_last_error\" c_last_error
+  :: GuestfsP -> IO CString
+
+-- last_error :: GuestfsH -> IO (Maybe String)
+-- last_error h = do
+--   str <- withForeignPtr h (\\p -> c_last_error p)
+--   maybePeek peekCString str
+
+last_error :: GuestfsH -> IO (String)
+last_error h = do
+  str <- withForeignPtr h (\\p -> c_last_error p)
+  if (str == nullPtr)
+    then return \"no error\"
+    else peekCString str
+
+";
+
+  (* Generate wrappers for each foreign function. *)
+  List.iter (
+    fun (name, style, _, _, _, _, _) ->
+      if can_generate style then (
+       pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
+       pr "  :: ";
+       generate_haskell_prototype ~handle:"GuestfsP" style;
+       pr "\n";
+       pr "\n";
+       pr "%s :: " name;
+       generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
+       pr "\n";
+       pr "%s %s = do\n" name
+         (String.concat " " ("h" :: List.map name_of_argt (snd style)));
+       pr "  r <- ";
+       List.iter (
+         function
+         | FileIn n
+         | FileOut 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
+         | Bool n ->
+             (* XXX this doesn't work *)
+             pr "      let\n";
+             pr "        %s = case %s of\n" n n;
+             pr "          False -> 0\n";
+             pr "          True -> 1\n";
+             pr "      in fromIntegral %s $ \\%s ->\n" n n
+         | Int n -> pr "fromIntegral %s $ \\%s -> " n n
+       ) (snd style);
+       pr "withForeignPtr h (\\p -> c_%s %s)\n" name
+         (String.concat " " ("p" :: List.map name_of_argt (snd style)));
+       (match fst style with
+        | RErr | RInt _ | RInt64 _ | RBool _ ->
+            pr "  if (r == -1)\n";
+            pr "    then do\n";
+            pr "      err <- last_error h\n";
+            pr "      fail err\n";
+        | RConstString _ | RString _ | RStringList _ | RIntBool _
+        | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _
+        | RHashtable _ ->
+            pr "  if (r == nullPtr)\n";
+            pr "    then do\n";
+            pr "      err <- last_error h\n";
+            pr "      fail err\n";
+       );
+       (match fst style with
+        | RErr ->
+            pr "    else return ()\n"
+        | RInt _ ->
+            pr "    else return (fromIntegral r)\n"
+        | RInt64 _ ->
+            pr "    else return (fromIntegral r)\n"
+        | RBool _ ->
+            pr "    else return (toBool r)\n"
+        | RConstString _
+        | RString _
+        | RStringList _
+        | RIntBool _
+        | RPVList _
+        | RVGList _
+        | RLVList _
+        | RStat _
+        | RStatVFS _
+        | RHashtable _ ->
+            pr "    else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
+       );
+       pr "\n";
+      )
+  ) all_functions
+
+and generate_haskell_prototype ~handle ?(hs = false) style =
+  pr "%s -> " handle;
+  let string = if hs then "String" else "CString" in
+  let int = if hs then "Int" else "CInt" in
+  let bool = if hs then "Bool" else "CInt" in
+  let int64 = if hs then "Integer" else "Int64" in
+  List.iter (
+    fun arg ->
+      (match arg with
+       | String _ -> pr "%s" string
+       | OptString _ -> if hs then pr "Maybe String" else pr "CString"
+       | StringList _ -> if hs then pr "[String]" else pr "Ptr CString"
+       | Bool _ -> pr "%s" bool
+       | Int _ -> pr "%s" int
+       | FileIn _ -> pr "%s" string
+       | FileOut _ -> pr "%s" string
+      );
+      pr " -> ";
+  ) (snd style);
+  pr "IO (";
+  (match fst style with
+   | RErr -> if not hs then pr "CInt"
+   | RInt _ -> pr "%s" int
+   | RInt64 _ -> pr "%s" int64
+   | RBool _ -> pr "%s" bool
+   | RConstString _ -> pr "%s" string
+   | RString _ -> pr "%s" string
+   | RStringList _ -> pr "[%s]" string
+   | RIntBool _ -> pr "IntBool"
+   | RPVList _ -> pr "[PV]"
+   | RVGList _ -> pr "[VG]"
+   | RLVList _ -> pr "[LV]"
+   | RStat _ -> pr "Stat"
+   | RStatVFS _ -> pr "StatVFS"
+   | RHashtable _ -> pr "Hashtable"
+  );
+  pr ")"
+
+and generate_bindtests () =
+  generate_header CStyle LGPLv2;
+
+  pr "\
+#include <stdio.h>
+#include <stdlib.h>
+#include <inttypes.h>
+#include <string.h>
+
+#include \"guestfs.h\"
+#include \"guestfs_protocol.h\"
+
+#define error guestfs_error
+
+static void
+print_strings (char * const* const argv)
+{
+  int argc;
+
+  printf (\"[\");
+  for (argc = 0; argv[argc] != NULL; ++argc) {
+    if (argc > 0) printf (\", \");
+    printf (\"\\\"%%s\\\"\", argv[argc]);
+  }
+  printf (\"]\\n\");
+}
+
+/* The test0 function prints its parameters to stdout. */
+";
+
+  let test0, tests =
+    match test_functions with
+    | [] -> assert false
+    | test0 :: tests -> test0, tests in
+
+  let () =
+    let (name, style, _, _, _, _, _) = test0 in
+    generate_prototype ~extern:false ~semicolon:false ~newline:true
+      ~handle:"g" ~prefix:"guestfs_" name style;
+    pr "{\n";
+    List.iter (
+      function
+      | String n
+      | 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
+      | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
+      | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
+    ) (snd style);
+    pr "  /* Java changes stdout line buffering so we need this: */\n";
+    pr "  fflush (stdout);\n";
+    pr "  return 0;\n";
+    pr "}\n";
+    pr "\n" in
+
+  List.iter (
+    fun (name, style, _, _, _, _, _) ->
+      if String.sub name (String.length name - 3) 3 <> "err" then (
+       pr "/* Test normal return. */\n";
+       generate_prototype ~extern:false ~semicolon:false ~newline:true
+         ~handle:"g" ~prefix:"guestfs_" name style;
+       pr "{\n";
+       (match fst style with
+        | RErr ->
+            pr "  return 0;\n"
+        | RInt _ ->
+            pr "  int r;\n";
+            pr "  sscanf (val, \"%%d\", &r);\n";
+            pr "  return r;\n"
+        | RInt64 _ ->
+            pr "  int64_t r;\n";
+            pr "  sscanf (val, \"%%\" SCNi64, &r);\n";
+            pr "  return r;\n"
+        | RBool _ ->
+            pr "  return strcmp (val, \"true\") == 0;\n"
+        | RConstString _ ->
+            (* Can't return the input string here.  Return a static
+             * string so we ensure we get a segfault if the caller
+             * tries to free it.
+             *)
+            pr "  return \"static string\";\n"
+        | RString _ ->
+            pr "  return strdup (val);\n"
+        | RStringList _ ->
+            pr "  char **strs;\n";
+            pr "  int n, i;\n";
+            pr "  sscanf (val, \"%%d\", &n);\n";
+            pr "  strs = malloc ((n+1) * sizeof (char *));\n";
+            pr "  for (i = 0; i < n; ++i) {\n";
+            pr "    strs[i] = malloc (16);\n";
+            pr "    snprintf (strs[i], 16, \"%%d\", i);\n";
+            pr "  }\n";
+            pr "  strs[n] = NULL;\n";
+            pr "  return strs;\n"
+        | RIntBool _ ->
+            pr "  struct guestfs_int_bool *r;\n";
+            pr "  r = malloc (sizeof (struct guestfs_int_bool));\n";
+            pr "  sscanf (val, \"%%\" SCNi32, &r->i);\n";
+            pr "  r->b = 0;\n";
+            pr "  return r;\n"
+        | RPVList _ ->
+            pr "  struct guestfs_lvm_pv_list *r;\n";
+            pr "  int i;\n";
+            pr "  r = malloc (sizeof (struct guestfs_lvm_pv_list));\n";
+            pr "  sscanf (val, \"%%d\", &r->len);\n";
+            pr "  r->val = calloc (r->len, sizeof (struct guestfs_lvm_pv));\n";
+            pr "  for (i = 0; i < r->len; ++i) {\n";
+            pr "    r->val[i].pv_name = malloc (16);\n";
+            pr "    snprintf (r->val[i].pv_name, 16, \"%%d\", i);\n";
+            pr "  }\n";
+            pr "  return r;\n"
+        | RVGList _ ->
+            pr "  struct guestfs_lvm_vg_list *r;\n";
+            pr "  int i;\n";
+            pr "  r = malloc (sizeof (struct guestfs_lvm_vg_list));\n";
+            pr "  sscanf (val, \"%%d\", &r->len);\n";
+            pr "  r->val = calloc (r->len, sizeof (struct guestfs_lvm_vg));\n";
+            pr "  for (i = 0; i < r->len; ++i) {\n";
+            pr "    r->val[i].vg_name = malloc (16);\n";
+            pr "    snprintf (r->val[i].vg_name, 16, \"%%d\", i);\n";
+            pr "  }\n";
+            pr "  return r;\n"
+        | RLVList _ ->
+            pr "  struct guestfs_lvm_lv_list *r;\n";
+            pr "  int i;\n";
+            pr "  r = malloc (sizeof (struct guestfs_lvm_lv_list));\n";
+            pr "  sscanf (val, \"%%d\", &r->len);\n";
+            pr "  r->val = calloc (r->len, sizeof (struct guestfs_lvm_lv));\n";
+            pr "  for (i = 0; i < r->len; ++i) {\n";
+            pr "    r->val[i].lv_name = malloc (16);\n";
+            pr "    snprintf (r->val[i].lv_name, 16, \"%%d\", i);\n";
+            pr "  }\n";
+            pr "  return r;\n"
+        | RStat _ ->
+            pr "  struct guestfs_stat *r;\n";
+            pr "  r = calloc (1, sizeof (*r));\n";
+            pr "  sscanf (val, \"%%\" SCNi64, &r->dev);\n";
+            pr "  return r;\n"
+        | RStatVFS _ ->
+            pr "  struct guestfs_statvfs *r;\n";
+            pr "  r = calloc (1, sizeof (*r));\n";
+            pr "  sscanf (val, \"%%\" SCNi64, &r->bsize);\n";
+            pr "  return r;\n"
+        | RHashtable _ ->
+            pr "  char **strs;\n";
+            pr "  int n, i;\n";
+            pr "  sscanf (val, \"%%d\", &n);\n";
+            pr "  strs = malloc ((n*2+1) * sizeof (char *));\n";
+            pr "  for (i = 0; i < n; ++i) {\n";
+            pr "    strs[i*2] = malloc (16);\n";
+            pr "    strs[i*2+1] = malloc (16);\n";
+            pr "    snprintf (strs[i*2], 16, \"%%d\", i);\n";
+            pr "    snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
+            pr "  }\n";
+            pr "  strs[n*2] = NULL;\n";
+            pr "  return strs;\n"
+       );
+       pr "}\n";
+       pr "\n"
+      ) else (
+       pr "/* Test error return. */\n";
+       generate_prototype ~extern:false ~semicolon:false ~newline:true
+         ~handle:"g" ~prefix:"guestfs_" name style;
+       pr "{\n";
+       pr "  error (g, \"error\");\n";
+       (match fst style with
+        | RErr | RInt _ | RInt64 _ | RBool _ ->
+            pr "  return -1;\n"
+        | RConstString _
+        | RString _ | RStringList _ | RIntBool _
+        | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _
+        | RHashtable _ ->
+            pr "  return NULL;\n"
+       );
+       pr "}\n";
+       pr "\n"
+      )
+  ) tests
+
+and generate_ocaml_bindtests () =
+  generate_header OCamlStyle GPLv2;
+
+  pr "\
+let () =
+  let g = Guestfs.create () in
+";
+
+  let mkargs args =
+    String.concat " " (
+      List.map (
+       function
+       | CallString s -> "\"" ^ s ^ "\""
+       | CallOptString None -> "None"
+       | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
+       | CallStringList xs ->
+           "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
+       | CallInt i when i >= 0 -> string_of_int i
+       | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
+       | CallBool b -> string_of_bool b
+      ) args
+    )
+  in
+
+  generate_lang_bindtests (
+    fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
+  );
+
+  pr "print_endline \"EOF\"\n"
+
+and generate_perl_bindtests () =
+  pr "#!/usr/bin/perl -w\n";
+  generate_header HashStyle GPLv2;
+
+  pr "\
+use strict;
+
+use Sys::Guestfs;
+
+my $g = Sys::Guestfs->new ();
+";
+
+  let mkargs args =
+    String.concat ", " (
+      List.map (
+       function
+       | CallString s -> "\"" ^ s ^ "\""
+       | CallOptString None -> "undef"
+       | CallOptString (Some s) -> sprintf "\"%s\"" s
+       | CallStringList xs ->
+           "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
+       | CallInt i -> string_of_int i
+       | CallBool b -> if b then "1" else "0"
+      ) args
+    )
+  in
+
+  generate_lang_bindtests (
+    fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
+  );
+
+  pr "print \"EOF\\n\"\n"
+
+and generate_python_bindtests () =
+  generate_header HashStyle GPLv2;
+
+  pr "\
+import guestfs
+
+g = guestfs.GuestFS ()
+";
+
+  let mkargs args =
+    String.concat ", " (
+      List.map (
+       function
+       | CallString s -> "\"" ^ s ^ "\""
+       | CallOptString None -> "None"
+       | CallOptString (Some s) -> sprintf "\"%s\"" s
+       | CallStringList xs ->
+           "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
+       | CallInt i -> string_of_int i
+       | CallBool b -> if b then "1" else "0"
+      ) args
+    )
+  in
+
+  generate_lang_bindtests (
+    fun f args -> pr "g.%s (%s)\n" f (mkargs args)
+  );
+
+  pr "print \"EOF\"\n"
+
+and generate_ruby_bindtests () =
+  generate_header HashStyle GPLv2;
+
+  pr "\
+require 'guestfs'
+
+g = Guestfs::create()
+";
+
+  let mkargs args =
+    String.concat ", " (
+      List.map (
+       function
+       | CallString s -> "\"" ^ s ^ "\""
+       | CallOptString None -> "nil"
+       | CallOptString (Some s) -> sprintf "\"%s\"" s
+       | CallStringList xs ->
+           "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
+       | CallInt i -> string_of_int i
+       | CallBool b -> string_of_bool b
+      ) args
+    )
+  in
+
+  generate_lang_bindtests (
+    fun f args -> pr "g.%s(%s)\n" f (mkargs args)
+  );
+
+  pr "print \"EOF\\n\"\n"
+
+and generate_java_bindtests () =
+  generate_header CStyle GPLv2;
+
+  pr "\
+import com.redhat.et.libguestfs.*;
+
+public class Bindtests {
+    public static void main (String[] argv)
+    {
+        try {
+            GuestFS g = new GuestFS ();
+";
+
+  let mkargs args =
+    String.concat ", " (
+      List.map (
+       function
+       | CallString s -> "\"" ^ s ^ "\""
+       | CallOptString None -> "null"
+       | CallOptString (Some s) -> sprintf "\"%s\"" s
+       | CallStringList xs ->
+           "new String[]{" ^
+             String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
+       | CallInt i -> string_of_int i
+       | CallBool b -> string_of_bool b
+      ) args
+    )
+  in
+
+  generate_lang_bindtests (
+    fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
+  );
+
+  pr "
+            System.out.println (\"EOF\");
+        }
+        catch (Exception exn) {
+            System.err.println (exn);
+            System.exit (1);
+        }
+    }
+}
+"
+
+and generate_haskell_bindtests () =
+  () (* XXX Haskell bindings need to be fleshed out. *)
+
+(* Language-independent bindings tests - we do it this way to
+ * ensure there is parity in testing bindings across all languages.
+ *)
+and generate_lang_bindtests call =
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList []; CallBool false;
+               CallInt 0; CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString None;
+               CallStringList []; CallBool false;
+               CallInt 0; CallString "123"; CallString "456"];
+  call "test0" [CallString ""; CallOptString (Some "def");
+               CallStringList []; CallBool false;
+               CallInt 0; CallString "123"; CallString "456"];
+  call "test0" [CallString ""; CallOptString (Some "");
+               CallStringList []; CallBool false;
+               CallInt 0; CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"]; CallBool false;
+               CallInt 0; CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"; "2"]; CallBool false;
+               CallInt 0; CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"]; CallBool true;
+               CallInt 0; CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"]; CallBool false;
+               CallInt (-1); CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"]; CallBool false;
+               CallInt (-2); CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"]; CallBool false;
+               CallInt 1; CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"]; CallBool false;
+               CallInt 2; CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"]; CallBool false;
+               CallInt 4095; CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"]; CallBool false;
+               CallInt 0; CallString ""; CallString ""]
+
+  (* XXX Add here tests of the return and error functions. *)
+

 let output_to filename =
   let filename_new = filename ^ ".new" in
   chan := open_out filename_new;
   let close () =
     close_out !chan;
     chan := stdout;
 let output_to filename =
   let filename_new = filename ^ ".new" in
   chan := open_out filename_new;
   let close () =
     close_out !chan;
     chan := stdout;

-    Unix.rename filename_new filename;
-    printf "written %s\n%!" filename;
+
+    (* Is the new file different from the current file? *)
+    if Sys.file_exists filename && files_equal filename filename_new then
+      Unix.unlink filename_new         (* same, so skip it *)
+    else (
+      (* different, overwrite old one *)
+      (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ());
+      Unix.rename filename_new filename;
+      Unix.chmod filename 0o444;
+      printf "written %s\n%!" filename;
+    )

   in
   close
 
   in
   close
 


@@ -6064,10 +7776,14 @@ Run it from the top source directory using the command
   generate_daemon_actions ();
   close ();
 
   generate_daemon_actions ();
   close ();
 

-  let close = output_to "tests.c" in
+  let close = output_to "capitests/tests.c" in

   generate_tests ();
   close ();
 
   generate_tests ();
   close ();
 

+  let close = output_to "src/guestfs-bindtests.c" in
+  generate_bindtests ();
+  close ();
+

   let close = output_to "fish/cmds.c" in
   generate_fish_cmds ();
   close ();
   let close = output_to "fish/cmds.c" in
   generate_fish_cmds ();
   close ();


@@ -6100,6 +7816,10 @@ Run it from the top source directory using the command
   generate_ocaml_c ();
   close ();
 
   generate_ocaml_c ();
   close ();
 

+  let close = output_to "ocaml/bindtests.ml" in
+  generate_ocaml_bindtests ();
+  close ();
+

   let close = output_to "perl/Guestfs.xs" in
   generate_perl_xs ();
   close ();
   let close = output_to "perl/Guestfs.xs" in
   generate_perl_xs ();
   close ();


@@ -6108,6 +7828,10 @@ Run it from the top source directory using the command
   generate_perl_pm ();
   close ();
 
   generate_perl_pm ();
   close ();
 

+  let close = output_to "perl/bindtests.pl" in
+  generate_perl_bindtests ();
+  close ();
+

   let close = output_to "python/guestfs-py.c" in
   generate_python_c ();
   close ();
   let close = output_to "python/guestfs-py.c" in
   generate_python_c ();
   close ();


@@ -6116,10 +7840,18 @@ Run it from the top source directory using the command
   generate_python_py ();
   close ();
 
   generate_python_py ();
   close ();
 

+  let close = output_to "python/bindtests.py" in
+  generate_python_bindtests ();
+  close ();
+

   let close = output_to "ruby/ext/guestfs/_guestfs.c" in
   generate_ruby_c ();
   close ();
 
   let close = output_to "ruby/ext/guestfs/_guestfs.c" in
   generate_ruby_c ();
   close ();
 

+  let close = output_to "ruby/bindtests.rb" in
+  generate_ruby_bindtests ();
+  close ();
+

   let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in
   generate_java_java ();
   close ();
   let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in
   generate_java_java ();
   close ();


@@ -6147,3 +7879,15 @@ Run it from the top source directory using the command
   let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in
   generate_java_c ();
   close ();
   let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in
   generate_java_c ();
   close ();

+
+  let close = output_to "java/Bindtests.java" in
+  generate_java_bindtests ();
+  close ();
+
+  let close = output_to "haskell/Guestfs.hs" in
+  generate_haskell_hs ();
+  close ();
+
+  let close = output_to "haskell/bindtests.hs" in
+  generate_haskell_bindtests ();
+  close ();