Added file(1) command.

[libguestfs.git] / src / generator.ml

diff --git a/src/generator.ml b/src/generator.ml
index 98faa0f..c9da57e 100755 (executable)
--- a/src/generator.ml
+++ b/src/generator.ml
@@ -15,11 +15,21 @@
  * You should have received a copy of the GNU General Public License
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  * You should have received a copy of the GNU General Public License
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

+ *)
+
+(* This script generates a large amount of code and documentation for
+ * all the daemon actions.

  *
  *

- * This script generates a large amount of code and documentation for
- * all the daemon actions.  To add a new action there are only two
- * files you need to change, this one to describe the interface, and
+ * To add a new action there are only two files you need to change,
+ * this one to describe the interface (see the big table below), and

  * daemon/<somefile>.c to write the implementation.
  * daemon/<somefile>.c to write the implementation.

+ *
+ * After editing this file, run it (./src/generator.ml) to regenerate
+ * all the output files.
+ *
+ * IMPORTANT: This script should NOT print any warnings.  If it prints
+ * warnings, you should treat them as errors.
+ * [Need to add -warn-error to ocaml command line]

  *)
 
 #load "unix.cma";;
  *)
 
 #load "unix.cma";;


@@ -28,28 +38,140 @@ open Printf
 
 type style = ret * args
 and ret =
 
 type style = ret * args
 and ret =

-    (* "Err" as a return value means an int used as a simple error
+    (* "RErr" as a return value means an int used as a simple error

      * indication, ie. 0 or -1.
      *)
      * indication, ie. 0 or -1.
      *)

-  | Err
-    (* "RString" and "RStringList" require special treatment because
-     * the caller must free them.
+  | RErr
+    (* "RInt" as a return value means an int which is -1 for error
+     * or any value >= 0 on success.

      *)
      *)

+  | RInt of string
+    (* "RBool" is a bool return value which can be true/false or
+     * -1 for error.
+     *)
+  | RBool of string
+    (* "RConstString" is a string that refers to a constant value.
+     * Try to avoid using this.  In particular you cannot use this
+     * for values returned from the daemon, because there is no
+     * thread-safe way to return them in the C API.
+     *)
+  | RConstString of string
+    (* "RString" and "RStringList" are caller-frees. *)

   | RString of string
   | RStringList of string
   | RString of string
   | RStringList of string

+    (* Some limited tuples are possible: *)
+  | RIntBool of string * string

     (* LVM PVs, VGs and LVs. *)
   | RPVList of string
   | RVGList of string
   | RLVList of string
     (* LVM PVs, VGs and LVs. *)
   | RPVList of string
   | RVGList of string
   | RLVList of string

-and args =
-    (* 0 arguments, 1 argument, etc. The guestfs_h param is implicit. *)
-  | P0
-  | P1 of argt
-  | P2 of argt * argt
+and args = argt list   (* Function parameters, guestfs handle is implicit. *)
+
+    (* Note in future we should allow a "variable args" parameter as
+     * the final parameter, to allow commands like
+     *   chmod mode file [file(s)...]
+     * This is not implemented yet, but many commands (such as chmod)
+     * are currently defined with the argument order keeping this future
+     * possibility in mind.
+     *)

 and argt =
   | String of string   (* const char *name, cannot be NULL *)
 and argt =
   | String of string   (* const char *name, cannot be NULL *)

+  | OptString of string        (* const char *name, may be NULL *)
+  | StringList of string(* list of strings (each string cannot be NULL) *)
+  | Bool of string     (* boolean *)
+  | Int of string      (* int (smallish ints, signed, <= 31 bits) *)
+
+type flags =
+  | ProtocolLimitWarning  (* display warning about protocol size limits *)
+  | DangerWillRobinson   (* flags particularly dangerous commands *)
+  | 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 *)
+
+let protocol_limit_warning =
+  "Because of the message protocol, there is a transfer limit 
+of somewhere between 2MB and 4MB.  To transfer large files you should use
+FTP."
+
+let danger_will_robinson =
+  "B<This command is dangerous.  Without careful use you
+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,
+ * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc).
+ * Note for partitioning purposes, the 500MB device has 63 cylinders.
+ *
+ * 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.
+ *
+ * Don't assume anything about the previous contents of the block
+ * devices.  Use 'Init*' to create some initial scenarios.
+ *)
+type tests = (test_init * test) list
+and test =
+    (* Run the command sequence and just expect nothing to fail. *)
+  | TestRun of seq
+    (* Run the command sequence and expect the output of the final
+     * command to be the string.
+     *)
+  | TestOutput of seq * string
+    (* Run the command sequence and expect the output of the final
+     * command to be the list of strings.
+     *)
+  | TestOutputList of seq * string list
+    (* Run the command sequence and expect the output of the final
+     * command to be the integer.
+     *)
+  | TestOutputInt of seq * int
+    (* Run the command sequence and expect the output of the final
+     * command to be a true value (!= 0 or != NULL).
+     *)
+  | TestOutputTrue of seq
+    (* Run the command sequence and expect the output of the final
+     * command to be a false value (== 0 or == NULL, but not an error).
+     *)
+  | TestOutputFalse of seq
+    (* Run the command sequence and expect the output of the final
+     * command to be a list of the given length (but don't care about
+     * content).
+     *)
+  | TestOutputLength of seq * int
+    (* Run the command sequence and expect the final command (only)
+     * to fail.
+     *)
+  | TestLastFail of seq
+
+(* Some initial scenarios for testing. *)
+and test_init =
+    (* Do nothing, block devices could contain random stuff including
+     * LVM PVs, and some filesystems might be mounted.  This is usually
+     * a bad idea.
+     *)
+  | InitNone
+    (* Block devices are empty and no filesystems are mounted. *)
+  | InitEmpty
+    (* /dev/sda contains a single partition /dev/sda1, which is formatted
+     * as ext2, empty [except for lost+found] and mounted on /.
+     * /dev/sdb and /dev/sdc may have random content.
+     * No LVM.
+     *)
+  | InitBasicFS
+    (* /dev/sda:
+     *   /dev/sda1 (is a PV):
+     *     /dev/VG/LV (size 8MB):
+     *       formatted as ext2, empty [except for lost+found], mounted on /
+     * /dev/sdb and /dev/sdc may have random content.
+     *)
+  | InitBasicFSonLVM

 
 

-type flags = ProtocolLimitWarning
+(* Sequence of commands for testing. *)
+and seq = cmd list
+and cmd = string list

 
 (* Note about long descriptions: When referring to another
  * action, use the format C<guestfs_other> (ie. the full name of
 
 (* Note about long descriptions: When referring to another
  * action, use the format C<guestfs_other> (ie. the full name of


@@ -59,8 +181,132 @@ type flags = ProtocolLimitWarning
  * Apart from that, long descriptions are just perldoc paragraphs.
  *)
 
  * Apart from that, long descriptions are just perldoc paragraphs.
  *)
 

-let functions = [
-  ("mount", (Err, P2 (String "device", String "mountpoint")), 1, [],
+let non_daemon_functions = [
+  ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
+   [],
+   "launch the qemu subprocess",
+   "\
+Internally libguestfs is implemented by running a virtual machine
+using L<qemu(1)>.
+
+You should call this after configuring the handle
+(eg. adding drives) but before performing any actions.");
+
+  ("wait_ready", (RErr, []), -1, [NotInFish],
+   [],
+   "wait until the qemu subprocess launches",
+   "\
+Internally libguestfs is implemented by running a virtual machine
+using L<qemu(1)>.
+
+You should call this after C<guestfs_launch> to wait for the launch
+to complete.");
+
+  ("kill_subprocess", (RErr, []), -1, [],
+   [],
+   "kill the qemu subprocess",
+   "\
+This kills the qemu subprocess.  You should never need to call this.");
+
+  ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
+   [],
+   "add an image to examine or modify",
+   "\
+This function adds a virtual machine disk image C<filename> to the
+guest.  The first time you call this function, the disk appears as IDE
+disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
+so on.
+
+You don't necessarily need to be root when using libguestfs.  However
+you obviously do need sufficient permissions to access the filename
+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).
+
+This is equivalent to the qemu parameter C<-drive file=filename>.");
+
+  ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
+   [],
+   "add a CD-ROM disk image to examine",
+   "\
+This function adds a virtual CD-ROM disk image to the guest.
+
+This is equivalent to the qemu parameter C<-cdrom filename>.");
+
+  ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
+   [],
+   "add qemu parameters",
+   "\
+This can be used to add arbitrary qemu command line parameters
+of the form C<-param value>.  Actually it's not quite arbitrary - we
+prevent you from setting some parameters which would interfere with
+parameters that we use.
+
+The first character of C<param> string must be a C<-> (dash).
+
+C<value> can be NULL.");
+
+  ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
+   [],
+   "set the search path",
+   "\
+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 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, [],
+   [],
+   "get the search path",
+   "\
+Return the current search path.
+
+This is always non-NULL.  If it wasn't set already, then this will
+return the default path.");
+
+  ("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).");
+
+  ("get_autosync", (RBool "autosync", []), -1, [],
+   [],
+   "get autosync mode",
+   "\
+Get the autosync flag.");
+
+  ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
+   [],
+   "set verbose mode",
+   "\
+If C<verbose> is true, this turns on verbose messages (to C<stderr>).
+
+Verbose messages are disabled unless the environment variable
+C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
+
+  ("get_verbose", (RBool "verbose", []), -1, [],
+   [],
+   "get verbose mode",
+   "\
+This returns the verbose messages flag.")
+]
+
+let daemon_functions = [
+  ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
+   [InitEmpty, TestOutput (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+       ["mkfs"; "ext2"; "/dev/sda1"];
+       ["mount"; "/dev/sda1"; "/"];
+       ["write_file"; "/new"; "new file contents"; "0"];
+       ["cat"; "/new"]], "new file contents")],

    "mount a guest disk at a position in the filesystem",
    "\
 Mount a guest disk at a position in the filesystem.  Block devices
    "mount a guest disk at a position in the filesystem",
    "\
 Mount a guest disk at a position in the filesystem.  Block devices


@@ -80,7 +326,8 @@ on the underlying device.
 The filesystem options C<sync> and C<noatime> are set with this
 call, in order to improve reliability.");
 
 The filesystem options C<sync> and C<noatime> are set with this
 call, in order to improve reliability.");
 

-  ("sync", (Err, P0), 2, [],
+  ("sync", (RErr, []), 2, [],
+   [ InitEmpty, 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


@@ -89,14 +336,20 @@ underlying disk image.
 You should always call this if you have modified a disk image, before
 closing the handle.");
 
 You should always call this if you have modified a disk image, before
 closing the handle.");
 

-  ("touch", (Err, P1 (String "path")), 3, [],
+  ("touch", (RErr, [String "path"]), 3, [],
+   [InitBasicFS, TestOutputTrue (
+      [["touch"; "/new"];
+       ["exists"; "/new"]])],

    "update file timestamps or create a new file",
    "\
 Touch acts like the L<touch(1)> command.  It can be used to
 update the timestamps on a file, or, if the file does not exist,
 to create a new zero-length file.");
 
    "update file timestamps or create a new file",
    "\
 Touch acts like the L<touch(1)> command.  It can be used to
 update the timestamps on a file, or, if the file does not exist,
 to create a new zero-length file.");
 

-  ("cat", (RString "content", P1 (String "path")), 4, [ProtocolLimitWarning],
+  ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
+   [InitBasicFS, TestOutput (
+      [["write_file"; "/new"; "new file contents"; "0"];
+       ["cat"; "/new"]], "new file contents")],

    "list the contents of a file",
    "\
 Return the contents of the file named C<path>.
    "list the contents of a file",
    "\
 Return the contents of the file named C<path>.


@@ -106,7 +359,10 @@ Note that this function cannot correctly handle binary files
 as end of string).  For those you need to use the C<guestfs_read_file>
 function which has a more complex interface.");
 
 as end of string).  For those you need to use the C<guestfs_read_file>
 function which has a more complex interface.");
 

-  ("ll", (RString "listing", P1 (String "directory")), 5, [],
+  ("ll", (RString "listing", [String "directory"]), 5, [],
+   [], (* XXX Tricky to test because it depends on the exact format
+       * of the 'ls -l' command, which changes between F10 and F11.
+       *)

    "list the files in a directory (long format)",
    "\
 List the files in C<directory> (relative to the root directory,
    "list the files in a directory (long format)",
    "\
 List the files in C<directory> (relative to the root directory,


@@ -115,7 +371,12 @@ there is no cwd) in the format of 'ls -la'.
 This command is mostly useful for interactive sessions.  It
 is I<not> intended that you try to parse the output string.");
 
 This command is mostly useful for interactive sessions.  It
 is I<not> intended that you try to parse the output string.");
 

-  ("ls", (RStringList "listing", P1 (String "directory")), 6, [],
+  ("ls", (RStringList "listing", [String "directory"]), 6, [],
+   [InitBasicFS, TestOutputList (
+      [["touch"; "/new"];
+       ["touch"; "/newer"];
+       ["touch"; "/newest"];
+       ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],

    "list the files in a directory",
    "\
 List the files in C<directory> (relative to the root directory,
    "list the files in a directory",
    "\
 List the files in C<directory> (relative to the root directory,


@@ -125,14 +386,21 @@ hidden files are shown.
 This command is mostly useful for interactive sessions.  Programs
 should probably use C<guestfs_readdir> instead.");
 
 This command is mostly useful for interactive sessions.  Programs
 should probably use C<guestfs_readdir> instead.");
 

-  ("list_devices", (RStringList "devices", P0), 7, [],
+  ("list_devices", (RStringList "devices", []), 7, [],
+   [InitEmpty, TestOutputList (
+      [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],

    "list the block devices",
    "\
 List all the block devices.
 
 The full block device names are returned, eg. C</dev/sda>");
 
    "list the block devices",
    "\
 List all the block devices.
 
 The full block device names are returned, eg. C</dev/sda>");
 

-  ("list_partitions", (RStringList "partitions", P0), 8, [],
+  ("list_partitions", (RStringList "partitions", []), 8, [],
+   [InitBasicFS, TestOutputList (
+      [["list_partitions"]], ["/dev/sda1"]);
+    InitEmpty, TestOutputList (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
+       ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],

    "list the partitions",
    "\
 List all the partitions detected on all block devices.
    "list the partitions",
    "\
 List all the partitions detected on all block devices.


@@ -142,7 +410,15 @@ The full partition device names are returned, eg. C</dev/sda1>
 This does not return logical volumes.  For that you will need to
 call C<guestfs_lvs>.");
 
 This does not return logical volumes.  For that you will need to
 call C<guestfs_lvs>.");
 

-  ("pvs", (RStringList "physvols", P0), 9, [],
+  ("pvs", (RStringList "physvols", []), 9, [],
+   [InitBasicFSonLVM, TestOutputList (
+      [["pvs"]], ["/dev/sda1"]);
+    InitEmpty, TestOutputList (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
+       ["pvcreate"; "/dev/sda1"];
+       ["pvcreate"; "/dev/sda2"];
+       ["pvcreate"; "/dev/sda3"];
+       ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],

    "list the LVM physical volumes (PVs)",
    "\
 List all the physical volumes detected.  This is the equivalent
    "list the LVM physical volumes (PVs)",
    "\
 List all the physical volumes detected.  This is the equivalent


@@ -153,7 +429,17 @@ PVs (eg. C</dev/sda2>).
 
 See also C<guestfs_pvs_full>.");
 
 
 See also C<guestfs_pvs_full>.");
 

-  ("vgs", (RStringList "volgroups", P0), 10, [],
+  ("vgs", (RStringList "volgroups", []), 10, [],
+   [InitBasicFSonLVM, TestOutputList (
+      [["vgs"]], ["VG"]);
+    InitEmpty, TestOutputList (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
+       ["pvcreate"; "/dev/sda1"];
+       ["pvcreate"; "/dev/sda2"];
+       ["pvcreate"; "/dev/sda3"];
+       ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
+       ["vgcreate"; "VG2"; "/dev/sda3"];
+       ["vgs"]], ["VG1"; "VG2"])],

    "list the LVM volume groups (VGs)",
    "\
 List all the volumes groups detected.  This is the equivalent
    "list the LVM volume groups (VGs)",
    "\
 List all the volumes groups detected.  This is the equivalent


@@ -164,7 +450,20 @@ detected (eg. C<VolGroup00>).
 
 See also C<guestfs_vgs_full>.");
 
 
 See also C<guestfs_vgs_full>.");
 

-  ("lvs", (RStringList "logvols", P0), 11, [],
+  ("lvs", (RStringList "logvols", []), 11, [],
+   [InitBasicFSonLVM, TestOutputList (
+      [["lvs"]], ["/dev/VG/LV"]);
+    InitEmpty, TestOutputList (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
+       ["pvcreate"; "/dev/sda1"];
+       ["pvcreate"; "/dev/sda2"];
+       ["pvcreate"; "/dev/sda3"];
+       ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
+       ["vgcreate"; "VG2"; "/dev/sda3"];
+       ["lvcreate"; "LV1"; "VG1"; "50"];
+       ["lvcreate"; "LV2"; "VG1"; "50"];
+       ["lvcreate"; "LV3"; "VG2"; "50"];
+       ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],

    "list the LVM logical volumes (LVs)",
    "\
 List all the logical volumes detected.  This is the equivalent
    "list the LVM logical volumes (LVs)",
    "\
 List all the logical volumes detected.  This is the equivalent


@@ -175,25 +474,512 @@ This returns a list of the logical volume device names
 
 See also C<guestfs_lvs_full>.");
 
 
 See also C<guestfs_lvs_full>.");
 

-  ("pvs_full", (RPVList "physvols", P0), 12, [],
+  ("pvs_full", (RPVList "physvols", []), 12, [],
+   [InitBasicFSonLVM, TestOutputLength (
+      [["pvs"]], 1)],

    "list the LVM physical volumes (PVs)",
    "\
 List all the physical volumes detected.  This is the equivalent
 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
 
    "list the LVM physical volumes (PVs)",
    "\
 List all the physical volumes detected.  This is the equivalent
 of the L<pvs(8)> command.  The \"full\" version includes all fields.");
 

-  ("vgs_full", (RVGList "volgroups", P0), 13, [],
+  ("vgs_full", (RVGList "volgroups", []), 13, [],
+   [InitBasicFSonLVM, TestOutputLength (
+      [["pvs"]], 1)],

    "list the LVM volume groups (VGs)",
    "\
 List all the volumes groups detected.  This is the equivalent
 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
 
    "list the LVM volume groups (VGs)",
    "\
 List all the volumes groups detected.  This is the equivalent
 of the L<vgs(8)> command.  The \"full\" version includes all fields.");
 

-  ("lvs_full", (RLVList "logvols", P0), 14, [],
+  ("lvs_full", (RLVList "logvols", []), 14, [],
+   [InitBasicFSonLVM, TestOutputLength (
+      [["pvs"]], 1)],

    "list the LVM logical volumes (LVs)",
    "\
 List all the logical volumes detected.  This is the equivalent
 of the L<lvs(8)> command.  The \"full\" version includes all fields.");
    "list the LVM logical volumes (LVs)",
    "\
 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, [],
+   [InitBasicFS, TestOutputList (
+      [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
+       ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
+    InitBasicFS, TestOutputList (
+      [["write_file"; "/new"; ""; "0"];
+       ["read_lines"; "/new"]], [])],
+   "read file as lines",
+   "\
+Return the contents of the file named C<path>.
+
+The file contents are returned as a list of lines.  Trailing
+C<LF> and C<CRLF> character sequences are I<not> returned.
+
+Note that this function cannot correctly handle binary files
+(specifically, files containing C<\\0> character which is treated
+as end of line).  For those you need to use the C<guestfs_read_file>
+function which has a more complex interface.");
+
+  ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
+   [], (* XXX Augeas code needs tests. *)
+   "create a new Augeas handle",
+   "\
+Create a new Augeas handle for editing configuration files.
+If there was any previous Augeas handle associated with this
+guestfs session, then it is closed.
+
+You must call this before using any other C<guestfs_aug_*>
+commands.
+
+C<root> is the filesystem root.  C<root> must not be NULL,
+use C</> instead.
+
+The flags are the same as the flags defined in
+E<lt>augeas.hE<gt>, the logical I<or> of the following
+integers:
+
+=over 4
+
+=item C<AUG_SAVE_BACKUP> = 1
+
+Keep the original file with a C<.augsave> extension.
+
+=item C<AUG_SAVE_NEWFILE> = 2
+
+Save changes into a file with extension C<.augnew>, and
+do not overwrite original.  Overrides C<AUG_SAVE_BACKUP>.
+
+=item C<AUG_TYPE_CHECK> = 4
+
+Typecheck lenses (can be expensive).
+
+=item C<AUG_NO_STDINC> = 8
+
+Do not use standard load path for modules.
+
+=item C<AUG_SAVE_NOOP> = 16
+
+Make save a no-op, just record what would have been changed.
+
+=item C<AUG_NO_LOAD> = 32
+
+Do not load the tree in C<guestfs_aug_init>.
+
+=back
+
+To close the handle, you can call C<guestfs_aug_close>.
+
+To find out more about Augeas, see L<http://augeas.net/>.");
+
+  ("aug_close", (RErr, []), 26, [],
+   [], (* XXX Augeas code needs tests. *)
+   "close the current Augeas handle",
+   "\
+Close the current Augeas handle and free up any resources
+used by it.  After calling this, you have to call
+C<guestfs_aug_init> again before you can use any other
+Augeas functions.");
+
+  ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
+   [], (* XXX Augeas code needs tests. *)
+   "define an Augeas variable",
+   "\
+Defines an Augeas variable C<name> whose value is the result
+of evaluating C<expr>.  If C<expr> is NULL, then C<name> is
+undefined.
+
+On success this returns the number of nodes in C<expr>, or
+C<0> if C<expr> evaluates to something which is not a nodeset.");
+
+  ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
+   [], (* XXX Augeas code needs tests. *)
+   "define an Augeas node",
+   "\
+Defines a variable C<name> whose value is the result of
+evaluating C<expr>.
+
+If C<expr> evaluates to an empty nodeset, a node is created,
+equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
+C<name> will be the nodeset containing that single node.
+
+On success this returns a pair containing the
+number of nodes in the nodeset, and a boolean flag
+if a node was created.");
+
+  ("aug_get", (RString "val", [String "path"]), 19, [],
+   [], (* XXX Augeas code needs tests. *)
+   "look up the value of an Augeas path",
+   "\
+Look up the value associated with C<path>.  If C<path>
+matches exactly one node, the C<value> is returned.");
+
+  ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
+   [], (* XXX Augeas code needs tests. *)
+   "set Augeas path to value",
+   "\
+Set the value associated with C<path> to C<value>.");
+
+  ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
+   [], (* XXX Augeas code needs tests. *)
+   "insert a sibling Augeas node",
+   "\
+Create a new sibling C<label> for C<path>, inserting it into
+the tree before or after C<path> (depending on the boolean
+flag C<before>).
+
+C<path> must match exactly one existing node in the tree, and
+C<label> must be a label, ie. not contain C</>, C<*> or end
+with a bracketed index C<[N]>.");
+
+  ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
+   [], (* XXX Augeas code needs tests. *)
+   "remove an Augeas path",
+   "\
+Remove C<path> and all of its children.
+
+On success this returns the number of entries which were removed.");
+
+  ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
+   [], (* XXX Augeas code needs tests. *)
+   "move Augeas node",
+   "\
+Move the node C<src> to C<dest>.  C<src> must match exactly
+one node.  C<dest> is overwritten if it exists.");
+
+  ("aug_match", (RStringList "matches", [String "path"]), 24, [],
+   [], (* XXX Augeas code needs tests. *)
+   "return Augeas nodes which match path",
+   "\
+Returns a list of paths which match the path expression C<path>.
+The returned paths are sufficiently qualified so that they match
+exactly one node in the current tree.");
+
+  ("aug_save", (RErr, []), 25, [],
+   [], (* XXX Augeas code needs tests. *)
+   "write all pending Augeas changes to disk",
+   "\
+This writes all pending changes to disk.
+
+The flags which were passed to C<guestfs_aug_init> affect exactly
+how files are saved.");
+
+  ("aug_load", (RErr, []), 27, [],
+   [], (* XXX Augeas code needs tests. *)
+   "load files into the tree",
+   "\
+Load files into the tree.
+
+See C<aug_load> in the Augeas documentation for the full gory
+details.");
+
+  ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
+   [], (* XXX Augeas code needs tests. *)
+   "list Augeas nodes under a path",
+   "\
+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, [],
+   [InitBasicFS, TestRun
+      [["touch"; "/new"];
+       ["rm"; "/new"]];
+    InitBasicFS, TestLastFail
+      [["rm"; "/new"]];
+    InitBasicFS, TestLastFail
+      [["mkdir"; "/new"];
+       ["rm"; "/new"]]],
+   "remove a file",
+   "\
+Remove the single file C<path>.");
+
+  ("rmdir", (RErr, [String "path"]), 30, [],
+   [InitBasicFS, TestRun
+      [["mkdir"; "/new"];
+       ["rmdir"; "/new"]];
+    InitBasicFS, TestLastFail
+      [["rmdir"; "/new"]];
+    InitBasicFS, TestLastFail
+      [["touch"; "/new"];
+       ["rmdir"; "/new"]]],
+   "remove a directory",
+   "\
+Remove the single directory C<path>.");
+
+  ("rm_rf", (RErr, [String "path"]), 31, [],
+   [InitBasicFS, TestOutputFalse
+      [["mkdir"; "/new"];
+       ["mkdir"; "/new/foo"];
+       ["touch"; "/new/foo/bar"];
+       ["rm_rf"; "/new"];
+       ["exists"; "/new"]]],
+   "remove a file or directory recursively",
+   "\
+Remove the file or directory C<path>, recursively removing the
+contents if its a directory.  This is like the C<rm -rf> shell
+command.");
+
+  ("mkdir", (RErr, [String "path"]), 32, [],
+   [InitBasicFS, TestOutputTrue
+      [["mkdir"; "/new"];
+       ["is_dir"; "/new"]];
+    InitBasicFS, TestLastFail
+      [["mkdir"; "/new/foo/bar"]]],
+   "create a directory",
+   "\
+Create a directory named C<path>.");
+
+  ("mkdir_p", (RErr, [String "path"]), 33, [],
+   [InitBasicFS, TestOutputTrue
+      [["mkdir_p"; "/new/foo/bar"];
+       ["is_dir"; "/new/foo/bar"]];
+    InitBasicFS, TestOutputTrue
+      [["mkdir_p"; "/new/foo/bar"];
+       ["is_dir"; "/new/foo"]];
+    InitBasicFS, TestOutputTrue
+      [["mkdir_p"; "/new/foo/bar"];
+       ["is_dir"; "/new"]]],
+   "create a directory and parents",
+   "\
+Create a directory named C<path>, creating any parent directories
+as necessary.  This is like the C<mkdir -p> shell command.");
+
+  ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
+   [], (* XXX Need stat command to test *)
+   "change file mode",
+   "\
+Change the mode (permissions) of C<path> to C<mode>.  Only
+numeric modes are supported.");
+
+  ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
+   [], (* XXX Need stat command to test *)
+   "change file owner and group",
+   "\
+Change the file owner to C<owner> and group to C<group>.
+
+Only numeric uid and gid are supported.  If you want to use
+names, you will need to locate and parse the password file
+yourself (Augeas support makes this relatively easy).");
+
+  ("exists", (RBool "existsflag", [String "path"]), 36, [],
+   [InitBasicFS, TestOutputTrue (
+      [["touch"; "/new"];
+       ["exists"; "/new"]]);
+    InitBasicFS, TestOutputTrue (
+      [["mkdir"; "/new"];
+       ["exists"; "/new"]])],
+   "test if file or directory exists",
+   "\
+This returns C<true> if and only if there is a file, directory
+(or anything) with the given C<path> name.
+
+See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
+
+  ("is_file", (RBool "fileflag", [String "path"]), 37, [],
+   [InitBasicFS, TestOutputTrue (
+      [["touch"; "/new"];
+       ["is_file"; "/new"]]);
+    InitBasicFS, TestOutputFalse (
+      [["mkdir"; "/new"];
+       ["is_file"; "/new"]])],
+   "test if file exists",
+   "\
+This returns C<true> if and only if there is a file
+with the given C<path> name.  Note that it returns false for
+other objects like directories.
+
+See also C<guestfs_stat>.");
+
+  ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
+   [InitBasicFS, TestOutputFalse (
+      [["touch"; "/new"];
+       ["is_dir"; "/new"]]);
+    InitBasicFS, TestOutputTrue (
+      [["mkdir"; "/new"];
+       ["is_dir"; "/new"]])],
+   "test if file exists",
+   "\
+This returns C<true> if and only if there is a directory
+with the given C<path> name.  Note that it returns false for
+other objects like files.
+
+See also C<guestfs_stat>.");
+
+  ("pvcreate", (RErr, [String "device"]), 39, [],
+   [InitEmpty, TestOutputList (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
+       ["pvcreate"; "/dev/sda1"];
+       ["pvcreate"; "/dev/sda2"];
+       ["pvcreate"; "/dev/sda3"];
+       ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
+   "create an LVM physical volume",
+   "\
+This creates an LVM physical volume on the named C<device>,
+where C<device> should usually be a partition name such
+as C</dev/sda1>.");
+
+  ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
+   [InitEmpty, TestOutputList (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
+       ["pvcreate"; "/dev/sda1"];
+       ["pvcreate"; "/dev/sda2"];
+       ["pvcreate"; "/dev/sda3"];
+       ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
+       ["vgcreate"; "VG2"; "/dev/sda3"];
+       ["vgs"]], ["VG1"; "VG2"])],
+   "create an LVM volume group",
+   "\
+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, [],
+   [InitEmpty, TestOutputList (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
+       ["pvcreate"; "/dev/sda1"];
+       ["pvcreate"; "/dev/sda2"];
+       ["pvcreate"; "/dev/sda3"];
+       ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
+       ["vgcreate"; "VG2"; "/dev/sda3"];
+       ["lvcreate"; "LV1"; "VG1"; "50"];
+       ["lvcreate"; "LV2"; "VG1"; "50"];
+       ["lvcreate"; "LV3"; "VG2"; "50"];
+       ["lvcreate"; "LV4"; "VG2"; "50"];
+       ["lvcreate"; "LV5"; "VG2"; "50"];
+       ["lvs"]],
+      ["/dev/VG1/LV1"; "/dev/VG1/LV2";
+       "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
+   "create an LVM volume group",
+   "\
+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, [],
+   [InitEmpty, TestOutput (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+       ["mkfs"; "ext2"; "/dev/sda1"];
+       ["mount"; "/dev/sda1"; "/"];
+       ["write_file"; "/new"; "new file contents"; "0"];
+       ["cat"; "/new"]], "new file contents")],
+   "make a filesystem",
+   "\
+This creates a filesystem on C<device> (usually a partition
+of LVM logical volume).  The filesystem type is C<fstype>, for
+example C<ext3>.");
+
+  ("sfdisk", (RErr, [String "device";
+                    Int "cyls"; Int "heads"; Int "sectors";
+                    StringList "lines"]), 43, [DangerWillRobinson],
+   [],
+   "create partitions on a block device",
+   "\
+This is a direct interface to the L<sfdisk(8)> program for creating
+partitions on block devices.
+
+C<device> should be a block device, for example C</dev/sda>.
+
+C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
+and sectors on the device, which are passed directly to sfdisk as
+the I<-C>, I<-H> and I<-S> parameters.  If you pass C<0> for any
+of these, then the corresponding parameter is omitted.  Usually for
+'large' disks, you can just pass C<0> for these, but for small
+(floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
+out the right geometry and you will need to tell it.
+
+C<lines> is a list of lines that we feed to C<sfdisk>.  For more
+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
+the string C<,> (comma).");
+
+  ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
+   [InitEmpty, TestOutput (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+       ["mkfs"; "ext2"; "/dev/sda1"];
+       ["mount"; "/dev/sda1"; "/"];
+       ["write_file"; "/new"; "new file contents"; "0"];
+       ["cat"; "/new"]], "new file contents")],
+   "create a file",
+   "\
+This call creates a file called C<path>.  The contents of the
+file is the string C<content> (which can contain any 8 bit data),
+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
+the content cannot contain embedded ASCII NULs).");
+
+  ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
+   [InitEmpty, TestOutputList (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+       ["mkfs"; "ext2"; "/dev/sda1"];
+       ["mount"; "/dev/sda1"; "/"];
+       ["mounts"]], ["/dev/sda1"]);
+    InitEmpty, TestOutputList (
+      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+       ["mkfs"; "ext2"; "/dev/sda1"];
+       ["mount"; "/dev/sda1"; "/"];
+       ["umount"; "/"];
+       ["mounts"]], [])],
+   "unmount a filesystem",
+   "\
+This unmounts the given filesystem.  The filesystem may be
+specified either by its mountpoint (path) or the device which
+contains the filesystem.");
+
+  ("mounts", (RStringList "devices", []), 46, [],
+   [InitBasicFS, TestOutputList (
+      [["mounts"]], ["/dev/sda1"])],
+   "show mounted filesystems",
+   "\
+This returns the list of currently mounted filesystems.  It returns
+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"],
+   [InitBasicFS, TestOutputList (
+      [["umount_all"];
+       ["mounts"]], [])],
+   "unmount all filesystems",
+   "\
+This unmounts all mounted filesystems.
+
+Some internal mounts are not unmounted by this call.");
+
+  ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
+   [],
+   "remove all LVM LVs, VGs and PVs",
+   "\
+This command removes all LVM logical volumes, volume groups
+and physical volumes.");
+
+  ("file", (RString "description", [String "path"]), 49, [],
+   [InitBasicFS, TestOutput (
+      [["touch"; "/new"];
+       ["file"; "/new"]], "empty");
+    InitBasicFS, TestOutput (
+      [["write_file"; "/new"; "some content\n"; "0"];
+       ["file"; "/new"]], "ASCII text");
+    InitBasicFS, TestLastFail (
+      [["file"; "/nofile"]])],
+   "determine file type",
+   "\
+This call uses the standard L<file(1)> command to determine
+the type or contents of the file.  This also works on devices,
+for example to find out whether a partition contains a filesystem.
+
+The 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).");
+

 ]
 
 ]
 

+let all_functions = non_daemon_functions @ daemon_functions
+
+(* In some places we want the functions to be displayed sorted
+ * alphabetically, so this is useful:
+ *)
+let all_functions_sorted =
+  List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
+              compare n1 n2) all_functions
+

 (* Column names and types from LVM PVs/VGs/LVs. *)
 let pv_cols = [
   "pv_name", `String;
 (* Column names and types from LVM PVs/VGs/LVs. *)
 let pv_cols = [
   "pv_name", `String;


@@ -257,12 +1043,6 @@ let lv_cols = [
   "modules", `String;
 ]
 
   "modules", `String;
 ]
 

-(* In some places we want the functions to be displayed sorted
- * alphabetically, so this is useful:
- *)
-let sorted_functions =
-  List.sort (fun (n1,_,_,_,_,_) (n2,_,_,_,_,_) -> compare n1 n2) functions
-

 (* 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.


@@ -310,40 +1090,127 @@ let rec replace_str s s1 s2 =
     s' ^ s2 ^ replace_str s'' s1 s2
   )
 
     s' ^ s2 ^ replace_str s'' s1 s2
   )
 

-(* 'pr' prints to the current output file. *)
-let chan = ref stdout
-let pr fs = ksprintf (output_string !chan) fs
+let rec string_split sep str =
+  let len = String.length str in
+  let seplen = String.length sep in
+  let i = find str sep in
+  if i = -1 then [str]
+  else (
+    let s' = String.sub str 0 i in
+    let s'' = String.sub str (i+seplen) (len-i-seplen) in
+    s' :: string_split sep s''
+  )

 
 

-let iter_args f = function
-  | P0 -> ()
-  | P1 arg1 -> f arg1
-  | P2 (arg1, arg2) -> f arg1; f arg2
+let rec find_map f = function
+  | [] -> raise Not_found
+  | x :: xs ->
+      match f x with
+      | Some y -> y
+      | None -> find_map f xs

 
 

-let iteri_args f = function
-  | P0 -> ()
-  | P1 arg1 -> f 0 arg1
-  | P2 (arg1, arg2) -> f 0 arg1; f 1 arg2
+let iteri f xs =
+  let rec loop i = function
+    | [] -> ()
+    | x :: xs -> f i x; loop (i+1) xs
+  in
+  loop 0 xs

 
 

-let map_args f = function
-  | P0 -> []
-  | P1 arg1 -> [f arg1]
-  | P2 (arg1, arg2) -> [f arg1; f arg2]
+let mapi f xs =
+  let rec loop i = function
+    | [] -> []
+    | x :: xs -> let r = f i x in r :: loop (i+1) xs
+  in
+  loop 0 xs

 
 

-let nr_args = function | P0 -> 0 | P1 _ -> 1 | P2 _ -> 2
+let name_of_argt = function
+  | String n | OptString n | StringList n | Bool n | Int n -> n

 
 (* Check function names etc. for consistency. *)
 let check_functions () =
 
 (* Check function names etc. for consistency. *)
 let check_functions () =

+  let contains_uppercase str =
+    let len = String.length str in
+    let rec loop i =
+      if i >= len then false
+      else (
+       let c = str.[i] in
+       if c >= 'A' && c <= 'Z' then true
+       else loop (i+1)
+      )
+    in
+    loop 0
+  in
+
+  (* Check function names. *)

   List.iter (
   List.iter (

-    fun (name, _, _, _, _, longdesc) ->
+    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 String.contains name '-' then
       if String.contains name '-' then

-       failwithf "Function name '%s' should not contain '-', use '_' instead."
-         name;
+       failwithf "function name %s should not contain '-', use '_' instead."
+         name
+  ) all_functions;
+
+  (* Check function parameter/return names. *)
+  List.iter (
+    fun (name, style, _, _, _, _, _) ->
+      let check_arg_ret_name n =
+       if contains_uppercase n then
+         failwithf "%s param/ret %s should not contain uppercase chars"
+           name n;
+       if String.contains n '-' || String.contains n '_' 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
+      in
+
+      (match fst style with
+       | RErr -> ()
+       | RInt n | RBool n | RConstString n | RString n
+       | RStringList n | RPVList n | RVGList n | RLVList n ->
+          check_arg_ret_name n
+       | RIntBool (n,m) ->
+          check_arg_ret_name n;
+          check_arg_ret_name m
+      );
+      List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
+  ) all_functions;
+
+  (* Check short descriptions. *)
+  List.iter (
+    fun (name, _, _, _, _, shortdesc, _) ->
+      if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
+       failwithf "short description of %s should begin with lowercase." name;
+      let c = shortdesc.[String.length shortdesc-1] in
+      if c = '\n' || c = '.' then
+       failwithf "short description of %s should not end with . or \\n." name
+  ) all_functions;
+
+  (* Check long dscriptions. *)
+  List.iter (
+    fun (name, _, _, _, _, _, longdesc) ->

       if longdesc.[String.length longdesc-1] = '\n' then
       if longdesc.[String.length longdesc-1] = '\n' then

-       failwithf "Long description of %s should not end with \\n." name
-  ) functions;
+       failwithf "long description of %s should not end with \\n." name
+  ) all_functions;
+
+  (* Check proc_nrs. *)
+  List.iter (
+    fun (name, _, proc_nr, _, _, _, _) ->
+      if proc_nr <= 0 then
+       failwithf "daemon function %s should have proc_nr > 0" name
+  ) daemon_functions;
+
+  List.iter (
+    fun (name, _, proc_nr, _, _, _, _) ->
+      if proc_nr <> -1 then
+       failwithf "non-daemon function %s should have proc_nr -1" name
+  ) non_daemon_functions;

 
   let proc_nrs =
 
   let proc_nrs =

-    List.map (fun (name, _, proc_nr, _, _, _) -> name, proc_nr) functions in
+    List.map (fun (name, _, proc_nr, _, _, _, _) -> name, proc_nr)
+      daemon_functions in

   let proc_nrs =
     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
   let rec loop = function
   let proc_nrs =
     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
   let rec loop = function


@@ -352,16 +1219,20 @@ let check_functions () =
     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
        loop rest
     | (name1,nr1) :: (name2,nr2) :: _ ->
     | (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
        loop rest
     | (name1,nr1) :: (name2,nr2) :: _ ->

-       failwithf "'%s' and '%s' have conflicting procedure numbers (%d, %d)"
+       failwithf "%s and %s have conflicting procedure numbers (%d, %d)"

          name1 name2 nr1 nr2
   in
   loop proc_nrs
 
          name1 name2 nr1 nr2
   in
   loop proc_nrs
 

+(* 'pr' prints to the current output file. *)
+let chan = ref stdout
+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 license = GPLv2 | LGPLv2
 
 type comment_style = CStyle | HashStyle | OCamlStyle
 type license = GPLv2 | LGPLv2
 

-(* Generate a header block in a number of standard styles. *)
-let rec generate_header comment license =
+let generate_header comment license =

   let c = match comment with
     | CStyle ->     pr "/* "; " *"
     | HashStyle ->  pr "# ";  "#"
   let c = match comment with
     | CStyle ->     pr "/* "; " *"
     | HashStyle ->  pr "# ";  "#"


@@ -410,10 +1281,12 @@ let rec generate_header comment license =
   );
   pr "\n"
 
   );
   pr "\n"
 

+(* Start of main code generation functions below this line. *)
+

 (* Generate the pod documentation for the C API. *)
 (* Generate the pod documentation for the C API. *)

-and generate_actions_pod () =
+let rec generate_actions_pod () =

   List.iter (
   List.iter (

-    fun (shortname, style, _, flags, _, longdesc) ->
+    fun (shortname, style, _, flags, _, _, longdesc) ->

       let name = "guestfs_" ^ shortname in
       pr "=head2 %s\n\n" name;
       pr " ";
       let name = "guestfs_" ^ shortname in
       pr "=head2 %s\n\n" name;
       pr " ";


@@ -421,8 +1294,15 @@ and generate_actions_pod () =
       pr "\n\n";
       pr "%s\n\n" longdesc;
       (match fst style with
       pr "\n\n";
       pr "%s\n\n" longdesc;
       (match fst style with

-       | Err ->
+       | RErr ->

           pr "This function returns 0 on success or -1 on error.\n\n"
           pr "This function returns 0 on success or -1 on error.\n\n"

+       | RInt _ ->
+          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"

        | RString _ ->
           pr "This function returns a string or NULL on error.
 I<The caller must free the returned string after use>.\n\n"
        | RString _ ->
           pr "This function returns a string or NULL on error.
 I<The caller must free the returned string after use>.\n\n"


@@ -430,21 +1310,24 @@ I<The caller must free the returned string after use>.\n\n"
           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"
           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"

+       | RIntBool _ ->
+          pr "This function returns a C<struct guestfs_int_bool *>.
+I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"

        | RPVList _ ->
        | RPVList _ ->

-          pr "This function returns a C<struct guestfs_lvm_pv_list>.
-I<The caller must call C<guestfs_free_lvm_pv_list> after use.>.\n\n"
+          pr "This function returns a C<struct guestfs_lvm_pv_list *>.
+I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"

        | RVGList _ ->
        | RVGList _ ->

-          pr "This function returns a C<struct guestfs_lvm_vg_list>.
-I<The caller must call C<guestfs_free_lvm_vg_list> after use.>.\n\n"
+          pr "This function returns a C<struct guestfs_lvm_vg_list *>.
+I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"

        | RLVList _ ->
        | RLVList _ ->

-          pr "This function returns a C<struct guestfs_lvm_lv_list>.
-I<The caller must call C<guestfs_free_lvm_lv_list> after use.>.\n\n"
+          pr "This function returns a C<struct guestfs_lvm_lv_list *>.
+I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"

       );
       if List.mem ProtocolLimitWarning flags then
       );
       if List.mem ProtocolLimitWarning flags then

-       pr "Because of the message protocol, there is a transfer limit 
-of somewhere between 2MB and 4MB.  To transfer large files you should use
-FTP.\n\n";
-  ) sorted_functions
+       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 () =
   (* LVM structs documentation. *)
 
 and generate_structs_pod () =
   (* LVM structs documentation. *)


@@ -477,8 +1360,9 @@ and generate_structs_pod () =
   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
 
 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
 
 (* Generate the protocol (XDR) file, 'guestfs_protocol.x' and

- * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.  We
- * have to use an underscore instead of a dash because otherwise
+ * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
+ *
+ * We have to use an underscore instead of a dash because otherwise

  * rpcgen generates incorrect code.
  *
  * This header is NOT exported to clients, but see also generate_structs_h.
  * rpcgen generates incorrect code.
  *
  * This header is NOT exported to clients, but see also generate_structs_h.


@@ -509,21 +1393,35 @@ and generate_xdr () =
   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
 
   List.iter (
   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
 
   List.iter (

-    fun (shortname, style, _, _, _, _) ->
+    fun (shortname, style, _, _, _, _, _) ->

       let name = "guestfs_" ^ shortname in
       let name = "guestfs_" ^ shortname in

-      pr "/* %s */\n\n" name;
+

       (match snd style with
       (match snd style with

-       | P0 -> ()
+       | [] -> ()

        | args ->
           pr "struct %s_args {\n" name;
        | args ->
           pr "struct %s_args {\n" name;

-          iter_args (
+          List.iter (

             function
             function

-            | String name -> pr "  string %s<>;\n" name
+            | String n -> pr "  string %s<>;\n" n
+            | OptString n -> pr "  str *%s;\n" n
+            | StringList n -> pr "  str %s<>;\n" n
+            | Bool n -> pr "  bool %s;\n" n
+            | Int n -> pr "  int %s;\n" n

           ) args;
           pr "};\n\n"
       );
       (match fst style with
           ) args;
           pr "};\n\n"
       );
       (match fst style with

-       | Err -> () 
+       | RErr -> ()
+       | RInt n ->
+          pr "struct %s_ret {\n" name;
+          pr "  int %s;\n" n;
+          pr "};\n\n"
+       | RBool n ->
+          pr "struct %s_ret {\n" name;
+          pr "  bool %s;\n" n;
+          pr "};\n\n"
+       | RConstString _ ->
+          failwithf "RConstString cannot be returned from a daemon function"

        | RString n ->
           pr "struct %s_ret {\n" name;
           pr "  string %s<>;\n" n;
        | RString n ->
           pr "struct %s_ret {\n" name;
           pr "  string %s<>;\n" n;


@@ -532,6 +1430,11 @@ and generate_xdr () =
           pr "struct %s_ret {\n" name;
           pr "  str %s<>;\n" n;
           pr "};\n\n"
           pr "struct %s_ret {\n" name;
           pr "  str %s<>;\n" n;
           pr "};\n\n"

+       | RIntBool (n,m) ->
+          pr "struct %s_ret {\n" name;
+          pr "  int %s;\n" n;
+          pr "  bool %s;\n" m;
+          pr "};\n\n"

        | RPVList n ->
           pr "struct %s_ret {\n" name;
           pr "  guestfs_lvm_int_pv_list %s;\n" n;
        | RPVList n ->
           pr "struct %s_ret {\n" name;
           pr "  guestfs_lvm_int_pv_list %s;\n" n;


@@ -545,14 +1448,14 @@ and generate_xdr () =
           pr "  guestfs_lvm_int_lv_list %s;\n" n;
           pr "};\n\n"
       );
           pr "  guestfs_lvm_int_lv_list %s;\n" n;
           pr "};\n\n"
       );

-  ) functions;
+  ) daemon_functions;

 
   (* Table of procedure numbers. *)
   pr "enum guestfs_procedure {\n";
   List.iter (
 
   (* Table of procedure numbers. *)
   pr "enum guestfs_procedure {\n";
   List.iter (

-    fun (shortname, _, proc_nr, _, _, _) ->
+    fun (shortname, _, proc_nr, _, _, _, _) ->

       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr

-  ) functions;
+  ) daemon_functions;

   pr "  GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
   pr "};\n";
   pr "\n";
   pr "  GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
   pr "};\n";
   pr "\n";


@@ -615,6 +1518,13 @@ and generate_structs_h () =
    * must be identical to what rpcgen / the RFC defines.
    *)
 
    * must be identical to what rpcgen / the RFC defines.
    *)
 

+  (* guestfs_int_bool structure. *)
+  pr "struct guestfs_int_bool {\n";
+  pr "  int32_t i;\n";
+  pr "  int32_t b;\n";
+  pr "};\n";
+  pr "\n";
+

   (* LVM public structures. *)
   List.iter (
     function
   (* LVM public structures. *)
   List.iter (
     function


@@ -641,11 +1551,11 @@ and generate_structs_h () =
 and generate_actions_h () =
   generate_header CStyle LGPLv2;
   List.iter (
 and generate_actions_h () =
   generate_header CStyle LGPLv2;
   List.iter (

-    fun (shortname, style, _, _, _, _) ->
+    fun (shortname, style, _, _, _, _, _) ->

       let name = "guestfs_" ^ shortname in
       generate_prototype ~single_line:true ~newline:true ~handle:"handle"
        name style
       let name = "guestfs_" ^ shortname in
       generate_prototype ~single_line:true ~newline:true ~handle:"handle"
        name style

-  ) functions
+  ) all_functions

 
 (* Generate the client-side dispatch stubs. *)
 and generate_client_actions () =
 
 (* Generate the client-side dispatch stubs. *)
 and generate_client_actions () =


@@ -653,7 +1563,7 @@ and generate_client_actions () =
 
   (* Client-side stubs for each function. *)
   List.iter (
 
   (* Client-side stubs for each function. *)
   List.iter (

-    fun (shortname, style, _, _, _, _) ->
+    fun (shortname, style, _, _, _, _, _) ->

       let name = "guestfs_" ^ shortname in
 
       (* Generate the return value struct. *)
       let name = "guestfs_" ^ shortname in
 
       (* Generate the return value struct. *)


@@ -662,8 +1572,13 @@ and generate_client_actions () =
       pr "  struct guestfs_message_header hdr;\n";
       pr "  struct guestfs_message_error err;\n";
       (match fst style with
       pr "  struct guestfs_message_header hdr;\n";
       pr "  struct guestfs_message_error err;\n";
       (match fst style with

-       | Err -> ()
-       | RString _ | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
+       | RErr -> ()
+       | RConstString _ ->
+          failwithf "RConstString cannot be returned from a daemon function"
+       | RInt _
+       | RBool _ | RString _ | RStringList _
+       | RIntBool _
+       | RPVList _ | RVGList _ | RLVList _ ->

           pr "  struct %s_ret ret;\n" name
       );
       pr "};\n\n";
           pr "  struct %s_ret ret;\n" name
       );
       pr "};\n\n";


@@ -686,8 +1601,13 @@ and generate_client_actions () =
       pr "  }\n";
 
       (match fst style with
       pr "  }\n";
 
       (match fst style with

-       | Err -> ()
-       | RString _ | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
+       | RErr -> ()
+       | RConstString _ ->
+          failwithf "RConstString cannot be returned from a daemon function"
+       | RInt _
+       | RBool _ | RString _ | RStringList _
+       | RIntBool _
+       | RPVList _ | RVGList _ | RLVList _ ->

            pr "  if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
            pr "    error (g, \"%s: failed to parse reply\");\n" name;
            pr "    return;\n";
            pr "  if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
            pr "    error (g, \"%s: failed to parse reply\");\n" name;
            pr "    return;\n";


@@ -705,14 +1625,17 @@ and generate_client_actions () =
 
       let error_code =
        match fst style with
 
       let error_code =
        match fst style with

-       | Err -> "-1"
-       | RString _ | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
+       | RErr | RInt _ | RBool _ -> "-1"
+       | RConstString _ ->
+           failwithf "RConstString cannot be returned from a daemon function"
+       | RString _ | RStringList _ | RIntBool _
+       | RPVList _ | RVGList _ | RLVList _ ->

            "NULL" in
 
       pr "{\n";
 
       (match snd style with
            "NULL" in
 
       pr "{\n";
 
       (match snd style with

-       | P0 -> ()
+       | [] -> ()

        | _ -> pr "  struct %s_args args;\n" name
       );
 
        | _ -> pr "  struct %s_args args;\n" name
       );
 


@@ -730,13 +1653,23 @@ and generate_client_actions () =
       pr "\n";
 
       (match snd style with
       pr "\n";
 
       (match snd style with

-       | P0 ->
+       | [] ->

           pr "  serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
             (String.uppercase shortname)
        | args ->
           pr "  serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
             (String.uppercase shortname)
        | args ->

-          iter_args (
+          List.iter (

             function
             function

-            | String name -> pr "  args.%s = (char *) %s;\n" name name
+            | String n ->
+                pr "  args.%s = (char *) %s;\n" n n
+            | OptString n ->
+                pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
+            | StringList n ->
+                pr "  args.%s.%s_val = (char **) %s;\n" n n n;
+                pr "  for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
+            | Bool n ->
+                pr "  args.%s = %s;\n" n n
+            | Int n ->
+                pr "  args.%s = %s;\n" n n

           ) args;
           pr "  serial = dispatch (g, GUESTFS_PROC_%s,\n"
             (String.uppercase shortname);
           ) args;
           pr "  serial = dispatch (g, GUESTFS_PROC_%s,\n"
             (String.uppercase shortname);


@@ -771,7 +1704,11 @@ and generate_client_actions () =
       pr "\n";
 
       (match fst style with
       pr "\n";
 
       (match fst style with

-       | Err -> pr "  return 0;\n"
+       | RErr -> pr "  return 0;\n"
+       | RInt n
+       | RBool n -> pr "  return rv.ret.%s;\n" n
+       | RConstString _ ->
+          failwithf "RConstString cannot be returned from a daemon function"

        | RString n ->
           pr "  return rv.ret.%s; /* caller will free */\n" n
        | RStringList n ->
        | RString n ->
           pr "  return rv.ret.%s; /* caller will free */\n" n
        | RStringList n ->


@@ -782,6 +1719,9 @@ and generate_client_actions () =
             n n;
           pr "  rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
           pr "  return rv.ret.%s.%s_val;\n" n n
             n n;
           pr "  rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
           pr "  return rv.ret.%s.%s_val;\n" n n

+       | RIntBool _ ->
+          pr "  /* caller with free this */\n";
+          pr "  return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n"

        | RPVList n ->
           pr "  /* caller will free this */\n";
           pr "  return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
        | RPVList n ->
           pr "  /* caller will free this */\n";
           pr "  return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n


@@ -794,7 +1734,7 @@ and generate_client_actions () =
       );
 
       pr "}\n\n"
       );
 
       pr "}\n\n"

-  ) functions
+  ) daemon_functions

 
 (* Generate daemon/actions.h. *)
 and generate_daemon_actions_h () =
 
 (* Generate daemon/actions.h. *)
 and generate_daemon_actions_h () =


@@ -804,10 +1744,11 @@ and generate_daemon_actions_h () =
   pr "\n";
 
   List.iter (
   pr "\n";
 
   List.iter (

-    fun (name, style, _, _, _, _) ->
-      generate_prototype
-       ~single_line:true ~newline:true ~in_daemon:true ("do_" ^ name) style;
-  ) functions
+    fun (name, style, _, _, _, _, _) ->
+       generate_prototype
+         ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
+         name style;
+  ) daemon_functions

 
 (* Generate the server-side stubs. *)
 and generate_daemon_actions () =
 
 (* Generate the server-side stubs. *)
 and generate_daemon_actions () =


@@ -829,42 +1770,57 @@ and generate_daemon_actions () =
   pr "\n";
 
   List.iter (
   pr "\n";
 
   List.iter (

-    fun (name, style, _, _, _, _) ->
+    fun (name, style, _, _, _, _, _) ->

       (* Generate server-side stubs. *)
       pr "static void %s_stub (XDR *xdr_in)\n" name;
       pr "{\n";
       let error_code =
        match fst style with
       (* Generate server-side stubs. *)
       pr "static void %s_stub (XDR *xdr_in)\n" name;
       pr "{\n";
       let error_code =
        match fst style with

-       | Err -> pr "  int r;\n"; "-1"
+       | RErr | RInt _ -> pr "  int r;\n"; "-1"
+       | RBool _ -> pr "  int r;\n"; "-1"
+       | RConstString _ ->
+           failwithf "RConstString cannot be returned from a daemon function"

        | RString _ -> pr "  char *r;\n"; "NULL"
        | RStringList _ -> pr "  char **r;\n"; "NULL"
        | RString _ -> pr "  char *r;\n"; "NULL"
        | RStringList _ -> pr "  char **r;\n"; "NULL"

+       | RIntBool _ -> pr "  guestfs_%s_ret *r;\n" name; "NULL"

        | RPVList _ -> pr "  guestfs_lvm_int_pv_list *r;\n"; "NULL"
        | RVGList _ -> pr "  guestfs_lvm_int_vg_list *r;\n"; "NULL"
        | RLVList _ -> pr "  guestfs_lvm_int_lv_list *r;\n"; "NULL" in
 
       (match snd style with
        | RPVList _ -> pr "  guestfs_lvm_int_pv_list *r;\n"; "NULL"
        | RVGList _ -> pr "  guestfs_lvm_int_vg_list *r;\n"; "NULL"
        | RLVList _ -> pr "  guestfs_lvm_int_lv_list *r;\n"; "NULL" in
 
       (match snd style with

-       | P0 -> ()
+       | [] -> ()

        | args ->
           pr "  struct guestfs_%s_args args;\n" name;
        | args ->
           pr "  struct guestfs_%s_args args;\n" name;

-          iter_args (
+          List.iter (

             function
             function

-            | String name -> pr "  const char *%s;\n" name
+            | String n
+            | OptString n -> pr "  const 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

           ) args
       );
       pr "\n";
 
       (match snd style with
           ) args
       );
       pr "\n";
 
       (match snd style with

-       | P0 -> ()
+       | [] -> ()

        | args ->
           pr "  memset (&args, 0, sizeof args);\n";
           pr "\n";
           pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
        | args ->
           pr "  memset (&args, 0, sizeof args);\n";
           pr "\n";
           pr "  if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;

-          pr "    reply_with_error (\"%s: daemon failed to decode procedure arguments\");\n" name;
+          pr "    reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;

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

-          iter_args (
+          List.iter (

             function
             function

-            | String name -> pr "  %s = args.%s;\n" name name
+            | 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
+            | Bool n -> pr "  %s = args.%s;\n" n n
+            | Int n -> pr "  %s = args.%s;\n" n n

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


@@ -874,12 +1830,22 @@ and generate_daemon_actions () =
       pr ";\n";
 
       pr "  if (r == %s)\n" error_code;
       pr ";\n";
 
       pr "  if (r == %s)\n" error_code;

-      pr "    /* do_%s has already called reply_with_error, so just return */\n" name;
-      pr "    return;\n";
+      pr "    /* do_%s has already called reply_with_error */\n" name;
+      pr "    goto done;\n";

       pr "\n";
 
       (match fst style with
       pr "\n";
 
       (match fst style with

-       | Err -> pr "  reply (NULL, NULL);\n"
+       | RErr -> pr "  reply (NULL, NULL);\n"
+       | RInt n ->
+          pr "  struct guestfs_%s_ret ret;\n" name;
+          pr "  ret.%s = r;\n" n;
+          pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
+       | RBool n ->
+          pr "  struct guestfs_%s_ret ret;\n" name;
+          pr "  ret.%s = r;\n" n;
+          pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
+       | RConstString _ ->
+          failwithf "RConstString cannot be returned from a daemon function"

        | RString n ->
           pr "  struct guestfs_%s_ret ret;\n" name;
           pr "  ret.%s = r;\n" n;
        | RString n ->
           pr "  struct guestfs_%s_ret ret;\n" name;
           pr "  ret.%s = r;\n" n;


@@ -891,25 +1857,38 @@ and generate_daemon_actions () =
           pr "  ret.%s.%s_val = r;\n" n n;
           pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
           pr "  free_strings (r);\n"
           pr "  ret.%s.%s_val = r;\n" n n;
           pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
           pr "  free_strings (r);\n"

+       | RIntBool _ ->
+          pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
+          pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name

        | RPVList n ->
           pr "  struct guestfs_%s_ret ret;\n" name;
           pr "  ret.%s = *r;\n" n;
        | RPVList n ->
           pr "  struct guestfs_%s_ret ret;\n" name;
           pr "  ret.%s = *r;\n" n;

-          pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
+          pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;

           pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
        | RVGList n ->
           pr "  struct guestfs_%s_ret ret;\n" name;
           pr "  ret.%s = *r;\n" n;
           pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
        | RVGList n ->
           pr "  struct guestfs_%s_ret ret;\n" name;
           pr "  ret.%s = *r;\n" n;

-          pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
+          pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;

           pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
        | RLVList n ->
           pr "  struct guestfs_%s_ret ret;\n" name;
           pr "  ret.%s = *r;\n" n;
           pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
        | RLVList n ->
           pr "  struct guestfs_%s_ret ret;\n" name;
           pr "  ret.%s = *r;\n" n;

-          pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
+          pr "  reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;

           pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
       );
 
           pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
       );
 

+      (* Free the args. *)
+      (match snd style with
+       | [] ->
+          pr "done: ;\n";
+       | _ ->
+          pr "done:\n";
+          pr "  xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
+            name
+      );
+

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

-  ) functions;
+  ) daemon_functions;

 
   (* Dispatch function. *)
   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
 
   (* Dispatch function. *)
   pr "void dispatch_incoming_message (XDR *xdr_in)\n";


@@ -917,11 +1896,11 @@ and generate_daemon_actions () =
   pr "  switch (proc_nr) {\n";
 
   List.iter (
   pr "  switch (proc_nr) {\n";
 
   List.iter (

-    fun (name, style, _, _, _, _) ->
-      pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
-      pr "      %s_stub (xdr_in);\n" name;
-      pr "      break;\n"
-  ) functions;
+    fun (name, style, _, _, _, _, _) ->
+       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
+       pr "      %s_stub (xdr_in);\n" name;
+       pr "      break;\n"
+  ) daemon_functions;

 
   pr "    default:\n";
   pr "      reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
 
   pr "    default:\n";
   pr "      reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";


@@ -1094,70 +2073,550 @@ and generate_daemon_actions () =
 
   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
 
 
   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
 

-(* Generate a lot of different functions for guestfish. *)
-and generate_fish_cmds () =
+(* Generate the tests. *)
+and generate_tests () =

   generate_header CStyle GPLv2;
 
   generate_header CStyle GPLv2;
 

-  pr "#include <stdio.h>\n";
-  pr "#include <stdlib.h>\n";
-  pr "#include <string.h>\n";
-  pr "#include <inttypes.h>\n";
-  pr "\n";
-  pr "#include <guestfs.h>\n";
-  pr "#include \"fish.h\"\n";
-  pr "\n";
+  pr "\
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+#include <sys/types.h>
+#include <fcntl.h>

 
 

-  (* list_commands function, which implements guestfish -h *)
-  pr "void list_commands (void)\n";
-  pr "{\n";
-  pr "  printf (\"    %%-16s     %%s\\n\", \"Command\", \"Description\");\n";
-  pr "  list_builtin_commands ();\n";
-  List.iter (
-    fun (name, _, _, _, shortdesc, _) ->
-      let name = replace_char name '_' '-' in
-      pr "  printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
-       name shortdesc
-  ) sorted_functions;
-  pr "  printf (\"    Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
-  pr "}\n";
-  pr "\n";
+#include \"guestfs.h\"

 
 

-  (* display_command function, which implements guestfish -h cmd *)
+static guestfs_h *g;
+static int suppress_error = 0;
+
+static void print_error (guestfs_h *g, void *data, const char *msg)
+{
+  if (!suppress_error)
+    fprintf (stderr, \"%%s\\n\", msg);
+}
+
+static void print_strings (char * const * const argv)
+{
+  int argc;
+
+  for (argc = 0; argv[argc] != NULL; ++argc)
+    printf (\"\\t%%s\\n\", argv[argc]);
+}
+
+";
+
+  let test_names =
+    List.map (
+      fun (name, _, _, _, tests, _, _) ->
+       mapi (generate_one_test name) tests
+    ) all_functions in
+  let test_names = List.concat test_names in
+  let nr_tests = List.length test_names in
+
+  pr "\
+int main (int argc, char *argv[])
+{
+  char c = 0;
+  int failed = 0;
+  const char *srcdir;
+  int fd;
+  char buf[256];
+
+  g = guestfs_create ();
+  if (g == NULL) {
+    printf (\"guestfs_create FAILED\\n\");
+    exit (1);
+  }
+
+  guestfs_set_error_handler (g, print_error, NULL);
+
+  srcdir = getenv (\"srcdir\");
+  if (!srcdir) srcdir = \".\";
+  guestfs_set_path (g, srcdir);
+
+  snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);
+  fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
+  if (fd == -1) {
+    perror (buf);
+    exit (1);
+  }
+  if (lseek (fd, %d, SEEK_SET) == -1) {
+    perror (\"lseek\");
+    close (fd);
+    unlink (buf);
+    exit (1);
+  }
+  if (write (fd, &c, 1) == -1) {
+    perror (\"write\");
+    close (fd);
+    unlink (buf);
+    exit (1);
+  }
+  if (close (fd) == -1) {
+    perror (buf);
+    unlink (buf);
+    exit (1);
+  }
+  if (guestfs_add_drive (g, buf) == -1) {
+    printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
+    exit (1);
+  }
+
+  snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);
+  fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
+  if (fd == -1) {
+    perror (buf);
+    exit (1);
+  }
+  if (lseek (fd, %d, SEEK_SET) == -1) {
+    perror (\"lseek\");
+    close (fd);
+    unlink (buf);
+    exit (1);
+  }
+  if (write (fd, &c, 1) == -1) {
+    perror (\"write\");
+    close (fd);
+    unlink (buf);
+    exit (1);
+  }
+  if (close (fd) == -1) {
+    perror (buf);
+    unlink (buf);
+    exit (1);
+  }
+  if (guestfs_add_drive (g, buf) == -1) {
+    printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
+    exit (1);
+  }
+
+  snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);
+  fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
+  if (fd == -1) {
+    perror (buf);
+    exit (1);
+  }
+  if (lseek (fd, %d, SEEK_SET) == -1) {
+    perror (\"lseek\");
+    close (fd);
+    unlink (buf);
+    exit (1);
+  }
+  if (write (fd, &c, 1) == -1) {
+    perror (\"write\");
+    close (fd);
+    unlink (buf);
+    exit (1);
+  }
+  if (close (fd) == -1) {
+    perror (buf);
+    unlink (buf);
+    exit (1);
+  }
+  if (guestfs_add_drive (g, buf) == -1) {
+    printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
+    exit (1);
+  }
+
+  if (guestfs_launch (g) == -1) {
+    printf (\"guestfs_launch FAILED\\n\");
+    exit (1);
+  }
+  if (guestfs_wait_ready (g) == -1) {
+    printf (\"guestfs_wait_ready FAILED\\n\");
+    exit (1);
+  }
+
+" (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024);
+
+  iteri (
+    fun i test_name ->
+      pr "  printf (\"%3d/%3d %s\\n\");\n" (i+1) nr_tests test_name;
+      pr "  if (%s () == -1) {\n" test_name;
+      pr "    printf (\"%s FAILED\\n\");\n" test_name;
+      pr "    failed++;\n";
+      pr "  }\n";
+  ) test_names;
+  pr "\n";
+
+  pr "  guestfs_close (g);\n";
+  pr "  snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n";
+  pr "  unlink (buf);\n";
+  pr "  snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n";
+  pr "  unlink (buf);\n";
+  pr "  snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n";
+  pr "  unlink (buf);\n";
+  pr "\n";
+
+  pr "  if (failed > 0) {\n";
+  pr "    printf (\"***** %%d / %d tests FAILED *****\\n\", failed);\n"
+    nr_tests;
+  pr "    exit (1);\n";
+  pr "  }\n";
+  pr "\n";
+
+  pr "  exit (0);\n";
+  pr "}\n"
+
+and generate_one_test name i (init, test) =
+  let test_name = sprintf "test_%s_%d" name i in
+
+  pr "static int %s (void)\n" test_name;
+  pr "{\n";
+
+  (match init with
+   | InitNone -> ()
+   | InitEmpty ->
+       pr "  /* InitEmpty for %s (%d) */\n" name i;
+       List.iter (generate_test_command_call test_name)
+        [["umount_all"];
+         ["lvm_remove_all"]]
+   | InitBasicFS ->
+       pr "  /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
+       List.iter (generate_test_command_call test_name)
+        [["umount_all"];
+         ["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;
+       List.iter (generate_test_command_call test_name)
+        [["umount_all"];
+         ["lvm_remove_all"];
+         ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+         ["pvcreate"; "/dev/sda1"];
+         ["vgcreate"; "VG"; "/dev/sda1"];
+         ["lvcreate"; "LV"; "VG"; "8"];
+         ["mkfs"; "ext2"; "/dev/VG/LV"];
+         ["mount"; "/dev/VG/LV"; "/"]]
+  );
+
+  let get_seq_last = function
+    | [] ->
+       failwithf "%s: you cannot use [] (empty list) when expecting a command"
+         test_name
+    | seq ->
+       let seq = List.rev 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\", r);\n"
+          test_name 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
+   | 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
+   | 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
+
+(* 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.
+ *)
+and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
+  match cmd with
+  | [] -> assert false
+  | name :: args ->
+      (* Look up the command to find out what args/ret it has. *)
+      let style =
+       try
+         let _, style, _, _, _, _, _ =
+           List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
+         style
+       with Not_found ->
+         failwithf "%s: in test, command %s was not found" test_name name in
+
+      if List.length (snd style) <> List.length args then
+       failwithf "%s: in test, wrong number of args given to %s"
+         test_name name;
+
+      pr "  {\n";
+
+      List.iter (
+       function
+       | String _, _
+       | OptString _, _
+       | Int _, _
+       | Bool _, _ -> ()
+       | StringList n, arg ->
+           pr "    char *%s[] = {\n" n;
+           let strs = string_split " " arg in
+           List.iter (
+             fun str -> pr "      \"%s\",\n" (c_quote str)
+           ) strs;
+           pr "      NULL\n";
+           pr "    };\n";
+      ) (List.combine (snd style) args);
+
+      let error_code =
+       match fst style with
+       | RErr | RInt _ | RBool _ -> pr "    int r;\n"; "-1"
+       | RConstString _ -> pr "    const char *r;\n"; "NULL"
+       | RString _ -> pr "    char *r;\n"; "NULL"
+       | RStringList _ ->
+           pr "    char **r;\n";
+           pr "    int i;\n";
+           "NULL"
+       | RIntBool _ ->
+           pr "    struct guestfs_int_bool *r;\n";
+           "NULL"
+       | RPVList _ ->
+           pr "    struct guestfs_lvm_pv_list *r;\n";
+           "NULL"
+       | RVGList _ ->
+           pr "    struct guestfs_lvm_vg_list *r;\n";
+           "NULL"
+       | RLVList _ ->
+           pr "    struct guestfs_lvm_lv_list *r;\n";
+           "NULL" in
+
+      pr "    suppress_error = %d;\n" (if expect_error then 1 else 0);
+      pr "    r = guestfs_%s (g" name;
+
+      (* Generate the parameters. *)
+      List.iter (
+       function
+       | String _, 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 ->
+           let i =
+             try int_of_string arg
+             with Failure "int_of_string" ->
+               failwithf "%s: expecting an int, but got '%s'" test_name arg in
+           pr ", %d" i
+       | Bool _, arg ->
+           let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
+      ) (List.combine (snd style) args);
+
+      pr ");\n";
+      if not expect_error then
+       pr "    if (r == %s)\n" error_code
+      else
+       pr "    if (r != %s)\n" error_code;
+      pr "      return -1;\n";
+
+      (* Insert the test code. *)
+      (match test with
+       | None -> ()
+       | Some f -> f ()
+      );
+
+      (match fst style with
+       | RErr | RInt _ | RBool _ | RConstString _ -> ()
+       | RString _ -> pr "    free (r);\n"
+       | RStringList _ ->
+          pr "    for (i = 0; r[i] != NULL; ++i)\n";
+          pr "      free (r[i]);\n";
+          pr "    free (r);\n"
+       | RIntBool _ ->
+          pr "    guestfs_free_int_bool (r);\n"
+       | RPVList _ ->
+          pr "    guestfs_free_lvm_pv_list (r);\n"
+       | RVGList _ ->
+          pr "    guestfs_free_lvm_vg_list (r);\n"
+       | RLVList _ ->
+          pr "    guestfs_free_lvm_lv_list (r);\n"
+      );
+
+      pr "  }\n"
+
+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
+  str
+
+(* Generate a lot of different functions for guestfish. *)
+and generate_fish_cmds () =
+  generate_header CStyle GPLv2;
+
+  let all_functions =
+    List.filter (
+      fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
+    ) all_functions in
+  let all_functions_sorted =
+    List.filter (
+      fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
+    ) all_functions_sorted in
+
+  pr "#include <stdio.h>\n";
+  pr "#include <stdlib.h>\n";
+  pr "#include <string.h>\n";
+  pr "#include <inttypes.h>\n";
+  pr "\n";
+  pr "#include <guestfs.h>\n";
+  pr "#include \"fish.h\"\n";
+  pr "\n";
+
+  (* list_commands function, which implements guestfish -h *)
+  pr "void list_commands (void)\n";
+  pr "{\n";
+  pr "  printf (\"    %%-16s     %%s\\n\", \"Command\", \"Description\");\n";
+  pr "  list_builtin_commands ();\n";
+  List.iter (
+    fun (name, _, _, flags, _, shortdesc, _) ->
+      let name = replace_char name '_' '-' in
+      pr "  printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
+       name shortdesc
+  ) all_functions_sorted;
+  pr "  printf (\"    Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
+  pr "}\n";
+  pr "\n";
+
+  (* display_command function, which implements guestfish -h cmd *)

   pr "void display_command (const char *cmd)\n";
   pr "{\n";
   List.iter (
   pr "void display_command (const char *cmd)\n";
   pr "{\n";
   List.iter (

-    fun (name, style, _, flags, shortdesc, longdesc) ->
+    fun (name, style, _, flags, _, shortdesc, longdesc) ->

       let name2 = replace_char name '_' '-' in
       let name2 = replace_char name '_' '-' in

+      let alias =
+       try find_map (function FishAlias n -> Some n | _ -> None) flags
+       with Not_found -> name in

       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
       let synopsis =
        match snd style with
       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
       let synopsis =
        match snd style with

-       | P0 -> name2
+       | [] -> name2

        | args ->
            sprintf "%s <%s>"
        | args ->
            sprintf "%s <%s>"

-             name2 (
-               String.concat "> <" (
-                 map_args (function
-                           | String n -> n) args
-               )
-             ) in
+             name2 (String.concat "> <" (List.map name_of_argt args)) in

 
       let warnings =
        if List.mem ProtocolLimitWarning flags then
 
       let warnings =
        if List.mem ProtocolLimitWarning flags then

-         "\n\nBecause of the message protocol, there is a transfer limit 
-of somewhere between 2MB and 4MB.  To transfer large files you should use
-FTP."
+         ("\n\n" ^ protocol_limit_warning)
+       else "" in
+
+      (* For DangerWillRobinson commands, we should probably have
+       * guestfish prompt before allowing you to use them (especially
+       * in interactive mode). XXX
+       *)
+      let warnings =
+       warnings ^
+         if List.mem DangerWillRobinson flags then
+           ("\n\n" ^ danger_will_robinson)
+         else "" in
+
+      let describe_alias =
+       if name <> alias then
+         sprintf "\n\nYou can use '%s' as an alias for this command." alias

        else "" in
 
       pr "  if (";
       pr "strcasecmp (cmd, \"%s\") == 0" name;
       if name <> name2 then
        pr " || strcasecmp (cmd, \"%s\") == 0" name2;
        else "" in
 
       pr "  if (";
       pr "strcasecmp (cmd, \"%s\") == 0" name;
       if name <> name2 then
        pr " || strcasecmp (cmd, \"%s\") == 0" name2;

+      if name <> alias then
+       pr " || strcasecmp (cmd, \"%s\") == 0" alias;

       pr ")\n";
       pr "    pod2text (\"%s - %s\", %S);\n"
        name2 shortdesc
       pr ")\n";
       pr "    pod2text (\"%s - %s\", %S);\n"
        name2 shortdesc

-       (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings);
+       (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);

       pr "  else\n"
       pr "  else\n"

-  ) functions;
+  ) all_functions;

   pr "    display_builtin_command (cmd);\n";
   pr "}\n";
   pr "\n";
   pr "    display_builtin_command (cmd);\n";
   pr "}\n";
   pr "\n";


@@ -1203,47 +2662,79 @@ FTP."
 
   (* run_<action> actions *)
   List.iter (
 
   (* run_<action> actions *)
   List.iter (

-    fun (name, style, _, _, _, _) ->
+    fun (name, style, _, flags, _, _, _) ->

       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
       pr "{\n";
       (match fst style with
       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
       pr "{\n";
       (match fst style with

-       | Err -> pr "  int r;\n"
+       | RErr
+       | RInt _
+       | RBool _ -> pr "  int r;\n"
+       | RConstString _ -> pr "  const char *r;\n"

        | RString _ -> pr "  char *r;\n"
        | RStringList _ -> pr "  char **r;\n"
        | RString _ -> pr "  char *r;\n"
        | RStringList _ -> pr "  char **r;\n"

+       | RIntBool _ -> pr "  struct guestfs_int_bool *r;\n"

        | RPVList _ -> pr "  struct guestfs_lvm_pv_list *r;\n"
        | RVGList _ -> pr "  struct guestfs_lvm_vg_list *r;\n"
        | RLVList _ -> pr "  struct guestfs_lvm_lv_list *r;\n"
       );
        | RPVList _ -> pr "  struct guestfs_lvm_pv_list *r;\n"
        | RVGList _ -> pr "  struct guestfs_lvm_vg_list *r;\n"
        | RLVList _ -> pr "  struct guestfs_lvm_lv_list *r;\n"
       );

-      iter_args (
+      List.iter (

        function
        function

-       | String name -> pr "  const char *%s;\n" name
+       | String n
+       | OptString n -> pr "  const 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

       ) (snd style);
 
       (* Check and convert parameters. *)
       ) (snd style);
 
       (* Check and convert parameters. *)

-      let argc_expected = nr_args (snd style) in
+      let argc_expected = List.length (snd style) in

       pr "  if (argc != %d) {\n" argc_expected;
       pr "    fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
        argc_expected;
       pr "    fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
       pr "    return -1;\n";
       pr "  }\n";
       pr "  if (argc != %d) {\n" argc_expected;
       pr "    fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
        argc_expected;
       pr "    fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
       pr "    return -1;\n";
       pr "  }\n";

-      iteri_args (
+      iteri (

        fun i ->
          function
          | String name -> pr "  %s = argv[%d];\n" name i
        fun i ->
          function
          | String name -> pr "  %s = argv[%d];\n" name i

+         | OptString name ->
+             pr "  %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
+               name i i
+         | StringList name ->
+             pr "  %s = parse_string_list (argv[%d]);\n" name i
+         | Bool name ->
+             pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i
+         | Int name ->
+             pr "  %s = atoi (argv[%d]);\n" name i

       ) (snd style);
 
       (* Call C API function. *)
       ) (snd style);
 
       (* Call C API function. *)

-      pr "  r = guestfs_%s " name;
+      let fn =
+       try find_map (function FishAction n -> Some n | _ -> None) flags
+       with Not_found -> sprintf "guestfs_%s" name in
+      pr "  r = %s " fn;

       generate_call_args ~handle:"g" style;
       pr ";\n";
 
       (* Check return value for errors and display command results. *)
       (match fst style with
       generate_call_args ~handle:"g" style;
       pr ";\n";
 
       (* Check return value for errors and display command results. *)
       (match fst style with

-       | Err -> pr "  return r;\n"
+       | RErr -> pr "  return r;\n"
+       | RInt _ ->
+          pr "  if (r == -1) return -1;\n";
+          pr "  if (r) printf (\"%%d\\n\", r);\n";
+          pr "  return 0;\n"
+       | RBool _ ->
+          pr "  if (r == -1) return -1;\n";
+          pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
+          pr "  return 0;\n"
+       | RConstString _ ->
+          pr "  if (r == NULL) return -1;\n";
+          pr "  printf (\"%%s\\n\", r);\n";
+          pr "  return 0;\n"

        | RString _ ->
           pr "  if (r == NULL) return -1;\n";
        | RString _ ->
           pr "  if (r == NULL) return -1;\n";

-          pr "  printf (\"%%s\", r);\n";
+          pr "  printf (\"%%s\\n\", r);\n";

           pr "  free (r);\n";
           pr "  return 0;\n"
        | RStringList _ ->
           pr "  free (r);\n";
           pr "  return 0;\n"
        | RStringList _ ->


@@ -1251,6 +2742,12 @@ FTP."
           pr "  print_strings (r);\n";
           pr "  free_strings (r);\n";
           pr "  return 0;\n"
           pr "  print_strings (r);\n";
           pr "  free_strings (r);\n";
           pr "  return 0;\n"

+       | RIntBool _ ->
+          pr "  if (r == NULL) return -1;\n";
+          pr "  printf (\"%%d, %%s\\n\", r->i,\n";
+          pr "    r->b ? \"true\" : \"false\");\n";
+          pr "  guestfs_free_int_bool (r);\n";
+          pr "  return 0;\n"

        | RPVList _ ->
           pr "  if (r == NULL) return -1;\n";
           pr "  print_pv_list (r);\n";
        | RPVList _ ->
           pr "  if (r == NULL) return -1;\n";
           pr "  print_pv_list (r);\n";


@@ -1269,22 +2766,27 @@ FTP."
       );
       pr "}\n";
       pr "\n"
       );
       pr "}\n";
       pr "\n"

-  ) functions;
+  ) all_functions;

 
   (* run_action function *)
   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
   pr "{\n";
   List.iter (
 
   (* run_action function *)
   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
   pr "{\n";
   List.iter (

-    fun (name, _, _, _, _, _) ->
+    fun (name, _, _, flags, _, _, _) ->

       let name2 = replace_char name '_' '-' in
       let name2 = replace_char name '_' '-' in

+      let alias =
+       try find_map (function FishAlias n -> Some n | _ -> None) flags
+       with Not_found -> name in

       pr "  if (";
       pr "strcasecmp (cmd, \"%s\") == 0" name;
       if name <> name2 then
        pr " || strcasecmp (cmd, \"%s\") == 0" name2;
       pr "  if (";
       pr "strcasecmp (cmd, \"%s\") == 0" name;
       if name <> name2 then
        pr " || strcasecmp (cmd, \"%s\") == 0" name2;

+      if name <> alias then
+       pr " || strcasecmp (cmd, \"%s\") == 0" alias;

       pr ")\n";
       pr "    return run_%s (cmd, argc, argv);\n" name;
       pr "  else\n";
       pr ")\n";
       pr "    return run_%s (cmd, argc, argv);\n" name;
       pr "  else\n";

-  ) functions;
+  ) all_functions;

   pr "    {\n";
   pr "      fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
   pr "      return -1;\n";
   pr "    {\n";
   pr "      fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
   pr "      return -1;\n";


@@ -1295,31 +2797,61 @@ FTP."
 
 (* Generate the POD documentation for guestfish. *)
 and generate_fish_actions_pod () =
 
 (* Generate the POD documentation for guestfish. *)
 and generate_fish_actions_pod () =

+  let all_functions_sorted =
+    List.filter (
+      fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
+    ) all_functions_sorted in
+

   List.iter (
   List.iter (

-    fun (name, style, _, _, _, longdesc) ->
+    fun (name, style, _, flags, _, _, longdesc) ->

       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
       let name = replace_char name '_' '-' in
       let longdesc = replace_str longdesc "C<guestfs_" "C<" in
       let name = replace_char name '_' '-' in

-      pr "=head2 %s\n\n" name;
+      let alias =
+       try find_map (function FishAlias n -> Some n | _ -> None) flags
+       with Not_found -> name in
+
+      pr "=head2 %s" name;
+      if name <> alias then
+       pr " | %s" alias;
+      pr "\n";
+      pr "\n";

       pr " %s" name;
       pr " %s" name;

-      iter_args (
+      List.iter (

        function
        | String n -> pr " %s" n
        function
        | String n -> pr " %s" n

+       | OptString n -> pr " %s" n
+       | StringList n -> pr " %s,..." n
+       | Bool _ -> pr " true|false"
+       | Int n -> pr " %s" n

       ) (snd style);
       pr "\n";
       pr "\n";
       ) (snd style);
       pr "\n";
       pr "\n";

-      pr "%s\n\n" longdesc
-  ) sorted_functions
+      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

 
 (* Generate a C function prototype. *)
 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
 
 (* Generate a C function prototype. *)
 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
     ?(single_line = false) ?(newline = false) ?(in_daemon = false)

+    ?(prefix = "")

     ?handle name style =
   if extern then pr "extern ";
   if static then pr "static ";
   (match fst style with
     ?handle name style =
   if extern then pr "extern ";
   if static then pr "static ";
   (match fst style with

-   | Err -> pr "int "
+   | RErr -> pr "int "
+   | RInt _ -> pr "int "
+   | RBool _ -> pr "int "
+   | RConstString _ -> pr "const char *"

    | RString _ -> pr "char *"
    | RStringList _ -> pr "char **"
    | RString _ -> pr "char *"
    | RStringList _ -> pr "char **"

+   | RIntBool _ ->
+       if not in_daemon then pr "struct guestfs_int_bool *"
+       else pr "guestfs_%s_ret *" name

    | RPVList _ ->
        if not in_daemon then pr "struct guestfs_lvm_pv_list *"
        else pr "guestfs_lvm_int_pv_list *"
    | RPVList _ ->
        if not in_daemon then pr "struct guestfs_lvm_pv_list *"
        else pr "guestfs_lvm_int_pv_list *"


@@ -1330,22 +2862,30 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
        if not in_daemon then pr "struct guestfs_lvm_lv_list *"
        else pr "guestfs_lvm_int_lv_list *"
   );
        if not in_daemon then pr "struct guestfs_lvm_lv_list *"
        else pr "guestfs_lvm_int_lv_list *"
   );

-  pr "%s (" name;
-  let comma = ref false in
-  (match handle with
-   | None -> ()
-   | Some handle -> pr "guestfs_h *%s" handle; comma := true
-  );
-  let next () =
-    if !comma then (
-      if single_line then pr ", " else pr ",\n\t\t"
+  pr "%s%s (" prefix name;
+  if handle = None && List.length (snd style) = 0 then
+    pr "void"
+  else (
+    let comma = ref false in
+    (match handle with
+     | None -> ()
+     | Some handle -> pr "guestfs_h *%s" handle; comma := true

     );
     );

-    comma := true
-  in
-  iter_args (
-    function
-    | String name -> next (); pr "const char *%s" name
-  ) (snd style);
+    let next () =
+      if !comma then (
+       if single_line then pr ", " else pr ",\n\t\t"
+      );
+      comma := true
+    in
+    List.iter (
+      function
+      | String n -> next (); pr "const char *%s" n
+      | OptString n -> next (); pr "const char *%s" n
+      | StringList n -> next (); pr "char * const* const %s" n
+      | Bool n -> next (); pr "int %s" n
+      | Int n -> next (); pr "int %s" n
+    ) (snd style);
+  );

   pr ")";
   if semicolon then pr ";";
   if newline then pr "\n"
   pr ")";
   if semicolon then pr ";";
   if newline then pr "\n"


@@ -1358,12 +2898,16 @@ and generate_call_args ?handle style =
    | None -> ()
    | Some handle -> pr "%s" handle; comma := true
   );
    | None -> ()
    | Some handle -> pr "%s" handle; comma := true
   );

-  iter_args (
+  List.iter (

     fun arg ->
       if !comma then pr ", ";
       comma := true;
       match arg with
     fun arg ->
       if !comma then pr ", ";
       comma := true;
       match arg with

-      | String name -> pr "%s" name
+      | String n
+      | OptString n
+      | StringList n
+      | Bool n
+      | Int n -> pr "%s" n

   ) (snd style);
   pr ")"
 
   ) (snd style);
   pr ")"
 


@@ -1389,31 +2933,16 @@ val close : t -> unit
     unreferenced, but callers can also call this in order to
     provide predictable cleanup. *)
 
     unreferenced, but callers can also call this in order to
     provide predictable cleanup. *)
 

-val launch : t -> unit
-val wait_ready : t -> unit
-val kill_subprocess : t -> unit
-
-val add_drive : t -> string -> unit
-val add_cdrom : t -> string -> unit
-val config : t -> string -> string option -> unit
-
-val set_path : t -> string option -> unit
-val get_path : t -> string
-val set_autosync : t -> bool -> unit
-val get_autosync : t -> bool
-val set_verbose : t -> bool -> unit
-val get_verbose : t -> bool
-

 ";
   generate_ocaml_lvm_structure_decls ();
 
   (* The actions. *)
   List.iter (
 ";
   generate_ocaml_lvm_structure_decls ();
 
   (* The actions. *)
   List.iter (

-    fun (name, style, _, _, shortdesc, _) ->
+    fun (name, style, _, _, _, shortdesc, _) ->

       generate_ocaml_prototype name style;
       pr "(** %s *)\n" shortdesc;
       pr "\n"
       generate_ocaml_prototype name style;
       pr "(** %s *)\n" shortdesc;
       pr "\n"

-  ) sorted_functions
+  ) all_functions

 
 (* Generate the OCaml bindings implementation. *)
 and generate_ocaml_ml () =
 
 (* Generate the OCaml bindings implementation. *)
 and generate_ocaml_ml () =


@@ -1423,28 +2952,20 @@ and generate_ocaml_ml () =
 type t
 exception Error of string
 external create : unit -> t = \"ocaml_guestfs_create\"
 type t
 exception Error of string
 external create : unit -> t = \"ocaml_guestfs_create\"

-external close : t -> unit = \"ocaml_guestfs_create\"
-external launch : t -> unit = \"ocaml_guestfs_launch\"
-external wait_ready : t -> unit = \"ocaml_guestfs_wait_ready\"
-external kill_subprocess : t -> unit = \"ocaml_guestfs_kill_subprocess\"
-external add_drive : t -> string -> unit = \"ocaml_guestfs_add_drive\"
-external add_cdrom : t -> string -> unit = \"ocaml_guestfs_add_cdrom\"
-external config : t -> string -> string option -> unit = \"ocaml_guestfs_config\"
-external set_path : t -> string option -> unit = \"ocaml_guestfs_set_path\"
-external get_path : t -> string = \"ocaml_guestfs_get_path\"
-external set_autosync : t -> bool -> unit = \"ocaml_guestfs_set_autosync\"
-external get_autosync : t -> bool = \"ocaml_guestfs_get_autosync\"
-external set_verbose : t -> bool -> unit = \"ocaml_guestfs_set_verbose\"
-external get_verbose : t -> bool = \"ocaml_guestfs_get_verbose\"
+external close : t -> unit = \"ocaml_guestfs_close\"
+
+let () =
+  Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")

 
 ";
 
 ";

+

   generate_ocaml_lvm_structure_decls ();
 
   (* The actions. *)
   List.iter (
   generate_ocaml_lvm_structure_decls ();
 
   (* The actions. *)
   List.iter (

-    fun (name, style, _, _, shortdesc, _) ->
+    fun (name, style, _, _, _, shortdesc, _) ->

       generate_ocaml_prototype ~is_external:true name style;
       generate_ocaml_prototype ~is_external:true name style;

-  ) sorted_functions
+  ) all_functions

 
 (* Generate the OCaml bindings C implementation. *)
 and generate_ocaml_c () =
 
 (* Generate the OCaml bindings C implementation. *)
 and generate_ocaml_c () =


@@ -1452,8 +2973,7 @@ and generate_ocaml_c () =
 
   pr "#include <stdio.h>\n";
   pr "#include <stdlib.h>\n";
 
   pr "#include <stdio.h>\n";
   pr "#include <stdlib.h>\n";

-  pr "\n";
-  pr "#include <guestfs.h>\n";
+  pr "#include <string.h>\n";

   pr "\n";
   pr "#include <caml/config.h>\n";
   pr "#include <caml/alloc.h>\n";
   pr "\n";
   pr "#include <caml/config.h>\n";
   pr "#include <caml/alloc.h>\n";


@@ -1461,21 +2981,203 @@ and generate_ocaml_c () =
   pr "#include <caml/fail.h>\n";
   pr "#include <caml/memory.h>\n";
   pr "#include <caml/mlvalues.h>\n";
   pr "#include <caml/fail.h>\n";
   pr "#include <caml/memory.h>\n";
   pr "#include <caml/mlvalues.h>\n";

+  pr "#include <caml/signals.h>\n";
+  pr "\n";
+  pr "#include <guestfs.h>\n";

   pr "\n";
   pr "#include \"guestfs_c.h\"\n";
   pr "\n";
 
   pr "\n";
   pr "#include \"guestfs_c.h\"\n";
   pr "\n";
 

+  (* LVM struct copy functions. *)
+  List.iter (
+    fun (typ, cols) ->
+      let has_optpercent_col =
+       List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
+
+      pr "static CAMLprim value\n";
+      pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
+      pr "{\n";
+      pr "  CAMLparam0 ();\n";
+      if has_optpercent_col then
+       pr "  CAMLlocal3 (rv, v, v2);\n"
+      else
+       pr "  CAMLlocal2 (rv, v);\n";
+      pr "\n";
+      pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
+      iteri (
+       fun i col ->
+         (match col with
+          | name, `String ->
+              pr "  v = caml_copy_string (%s->%s);\n" typ name
+          | name, `UUID ->
+              pr "  v = caml_alloc_string (32);\n";
+              pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
+          | name, `Bytes
+          | name, `Int ->
+              pr "  v = caml_copy_int64 (%s->%s);\n" typ name
+          | name, `OptPercent ->
+              pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
+              pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
+              pr "    v = caml_alloc (1, 0);\n";
+              pr "    Store_field (v, 0, v2);\n";
+              pr "  } else /* None */\n";
+              pr "    v = Val_int (0);\n";
+         );
+         pr "  Store_field (rv, %d, v);\n" i
+      ) cols;
+      pr "  CAMLreturn (rv);\n";
+      pr "}\n";
+      pr "\n";
+
+      pr "static CAMLprim value\n";
+      pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
+       typ typ typ;
+      pr "{\n";
+      pr "  CAMLparam0 ();\n";
+      pr "  CAMLlocal2 (rv, v);\n";
+      pr "  int i;\n";
+      pr "\n";
+      pr "  if (%ss->len == 0)\n" typ;
+      pr "    CAMLreturn (Atom (0));\n";
+      pr "  else {\n";
+      pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
+      pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
+      pr "      v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
+      pr "      caml_modify (&Field (rv, i), v);\n";
+      pr "    }\n";
+      pr "    CAMLreturn (rv);\n";
+      pr "  }\n";
+      pr "}\n";
+      pr "\n";
+  ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
+

   List.iter (
   List.iter (

-    fun (name, style, _, _, _, _) ->
+    fun (name, style, _, _, _, _, _) ->
+      let params =
+       "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
+

       pr "CAMLprim value\n";
       pr "CAMLprim value\n";

-      pr "ocaml_guestfs_%s (value hv /* XXX */)\n" name;
+      pr "ocaml_guestfs_%s (value %s" name (List.hd params);
+      List.iter (pr ", value %s") (List.tl params);
+      pr ")\n";

       pr "{\n";
       pr "{\n";

-      pr "  CAMLparam1 (hv); /* XXX */\n";
-      pr "/* XXX write something here */\n";
-      pr "  CAMLreturn (Val_unit); /* XXX */\n";
+
+      (match params with
+       | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
+          pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
+          pr "  CAMLxparam%d (%s);\n"
+            (List.length rest) (String.concat ", " rest)
+       | ps ->
+          pr "  CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
+      );
+      pr "  CAMLlocal1 (rv);\n";
+      pr "\n";
+
+      pr "  guestfs_h *g = Guestfs_val (gv);\n";
+      pr "  if (g == NULL)\n";
+      pr "    caml_failwith (\"%s: used handle after closing it\");\n" name;
+      pr "\n";
+
+      List.iter (
+       function
+       | String n ->
+           pr "  const char *%s = String_val (%sv);\n" n n
+       | OptString n ->
+           pr "  const char *%s =\n" 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
+       | Bool n ->
+           pr "  int %s = Bool_val (%sv);\n" n n
+       | Int n ->
+           pr "  int %s = Int_val (%sv);\n" n n
+      ) (snd style);
+      let error_code =
+       match fst style with
+       | RErr -> pr "  int r;\n"; "-1"
+       | RInt _ -> pr "  int r;\n"; "-1"
+       | RBool _ -> pr "  int r;\n"; "-1"
+       | RConstString _ -> pr "  const char *r;\n"; "NULL"
+       | RString _ -> pr "  char *r;\n"; "NULL"
+       | RStringList _ ->
+           pr "  int i;\n";
+           pr "  char **r;\n";
+           "NULL"
+       | RIntBool _ ->
+           pr "  struct guestfs_int_bool *r;\n";
+           "NULL"
+       | RPVList _ ->
+           pr "  struct guestfs_lvm_pv_list *r;\n";
+           "NULL"
+       | RVGList _ ->
+           pr "  struct guestfs_lvm_vg_list *r;\n";
+           "NULL"
+       | RLVList _ ->
+           pr "  struct guestfs_lvm_lv_list *r;\n";
+           "NULL" in
+      pr "\n";
+
+      pr "  caml_enter_blocking_section ();\n";
+      pr "  r = guestfs_%s " name;
+      generate_call_args ~handle:"g" style;
+      pr ";\n";
+      pr "  caml_leave_blocking_section ();\n";
+
+      List.iter (
+       function
+       | StringList n ->
+           pr "  ocaml_guestfs_free_strings (%s);\n" n;
+       | String _ | OptString _ | Bool _ | Int _ -> ()
+      ) (snd style);
+
+      pr "  if (r == %s)\n" error_code;
+      pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
+      pr "\n";
+
+      (match fst style with
+       | RErr -> pr "  rv = Val_unit;\n"
+       | RInt _ -> pr "  rv = Val_int (r);\n"
+       | RBool _ -> pr "  rv = Val_bool (r);\n"
+       | RConstString _ -> pr "  rv = caml_copy_string (r);\n"
+       | RString _ ->
+          pr "  rv = caml_copy_string (r);\n";
+          pr "  free (r);\n"
+       | RStringList _ ->
+          pr "  rv = caml_copy_string_array ((const char **) r);\n";
+          pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
+          pr "  free (r);\n"
+       | RIntBool _ ->
+          pr "  rv = caml_alloc (2, 0);\n";
+          pr "  Store_field (rv, 0, Val_int (r->i));\n";
+          pr "  Store_field (rv, 1, Val_bool (r->b));\n";
+          pr "  guestfs_free_int_bool (r);\n";
+       | RPVList _ ->
+          pr "  rv = copy_lvm_pv_list (r);\n";
+          pr "  guestfs_free_lvm_pv_list (r);\n";
+       | RVGList _ ->
+          pr "  rv = copy_lvm_vg_list (r);\n";
+          pr "  guestfs_free_lvm_vg_list (r);\n";
+       | RLVList _ ->
+          pr "  rv = copy_lvm_lv_list (r);\n";
+          pr "  guestfs_free_lvm_lv_list (r);\n";
+      );
+
+      pr "  CAMLreturn (rv);\n";

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

-      pr "\n"
-  ) sorted_functions
+      pr "\n";
+
+      if List.length params > 5 then (
+       pr "CAMLprim value\n";
+       pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
+       pr "{\n";
+       pr "  return ocaml_guestfs_%s (argv[0]" name;
+       iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
+       pr ");\n";
+       pr "}\n";
+       pr "\n"
+      )
+  ) all_functions

 
 and generate_ocaml_lvm_structure_decls () =
   List.iter (
 
 and generate_ocaml_lvm_structure_decls () =
   List.iter (


@@ -1496,19 +3198,32 @@ and generate_ocaml_lvm_structure_decls () =
 and generate_ocaml_prototype ?(is_external = false) name style =
   if is_external then pr "external " else pr "val ";
   pr "%s : t -> " name;
 and generate_ocaml_prototype ?(is_external = false) name style =
   if is_external then pr "external " else pr "val ";
   pr "%s : t -> " name;

-  iter_args (
+  List.iter (

     function
     function

-    | String _ -> pr "string -> " (* note String is not allowed to be NULL *)
+    | String _ -> pr "string -> "
+    | OptString _ -> pr "string option -> "
+    | StringList _ -> pr "string array -> "
+    | Bool _ -> pr "bool -> "
+    | Int _ -> pr "int -> "

   ) (snd style);
   (match fst style with
   ) (snd style);
   (match fst style with

-   | Err -> pr "unit" (* all errors are turned into exceptions *)
+   | RErr -> pr "unit" (* all errors are turned into exceptions *)
+   | RInt _ -> pr "int"
+   | RBool _ -> pr "bool"
+   | RConstString _ -> pr "string"

    | RString _ -> pr "string"
    | RString _ -> pr "string"

-   | RStringList _ -> pr "string list"
-   | RPVList _ -> pr "lvm_pv list"
-   | RVGList _ -> pr "lvm_vg list"
-   | RLVList _ -> pr "lvm_lv list"
+   | RStringList _ -> pr "string array"
+   | RIntBool _ -> pr "int * bool"
+   | RPVList _ -> pr "lvm_pv array"
+   | RVGList _ -> pr "lvm_vg array"
+   | RLVList _ -> pr "lvm_lv array"
+  );
+  if is_external then (
+    pr " = ";
+    if List.length (snd style) + 1 > 5 then
+      pr "\"ocaml_guestfs_%s_byte\" " name;
+    pr "\"ocaml_guestfs_%s\"" name

   );
   );

-  if is_external then pr " = \"ocaml_guestfs_%s\"" name;

   pr "\n"
 
 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)
   pr "\n"
 
 (* Generate Perl xs code, a sort of crazy variation of C with macros. *)


@@ -1554,20 +3269,32 @@ my_newSVull(unsigned long long val) {
 #endif
 }
 
 #endif
 }
 

-/* XXX Not thread-safe, and in general not safe if the caller is
- * issuing multiple requests in parallel (on different guestfs
- * handles).  We should use the guestfs_h handle passed to the
- * error handle to distinguish these cases.
- */
-static char *last_error = NULL;
+/* http://www.perlmonks.org/?node_id=680842 */
+static char **
+XS_unpack_charPtrPtr (SV *arg) {
+  char **ret;
+  AV *av;
+  I32 i;

 
 

-static void
-error_handler (guestfs_h *g,
-              void *data,
-              const char *msg)
-{
-  if (last_error != NULL) free (last_error);
-  last_error = strdup (msg);
+  if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
+    croak (\"array reference expected\");
+  }
+
+  av = (AV *)SvRV (arg);
+  ret = (char **)malloc (av_len (av) + 1 + 1);
+
+  for (i = 0; i <= av_len (av); i++) {
+    SV **elem = av_fetch (av, i, 0);
+
+    if (!elem || !*elem)
+      croak (\"missing element in list\");
+
+    ret[i] = SvPV_nolen (*elem);
+  }
+
+  ret[i] = NULL;
+
+  return ret;

 }
 
 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
 }
 
 MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs


@@ -1578,7 +3305,7 @@ _create ()
       RETVAL = guestfs_create ();
       if (!RETVAL)
         croak (\"could not create guestfs handle\");
       RETVAL = guestfs_create ();
       if (!RETVAL)
         croak (\"could not create guestfs handle\");

-      guestfs_set_error_handler (RETVAL, error_handler, NULL);
+      guestfs_set_error_handler (RETVAL, NULL, NULL);

  OUTPUT:
       RETVAL
 
  OUTPUT:
       RETVAL
 


@@ -1588,107 +3315,18 @@ DESTROY (g)
  PPCODE:
       guestfs_close (g);
 
  PPCODE:
       guestfs_close (g);
 

-void
-add_drive (g, filename)
-      guestfs_h *g;
-      const char *filename;
-   CODE:
-      if (guestfs_add_drive (g, filename) == -1)
-        croak (\"add_drive: %%s\", last_error);
-
-void
-add_cdrom (g, filename)
-      guestfs_h *g;
-      const char *filename;
-   CODE:
-      if (guestfs_add_cdrom (g, filename) == -1)
-        croak (\"add_cdrom: %%s\", last_error);
-
-void
-config (g, param, value)
-      guestfs_h *g;
-      const char *param;
-      const char *value;
-   CODE:
-      if (guestfs_config (g, param, value) == -1)
-        croak (\"config: %%s\", last_error);
-
-void
-launch (g)
-      guestfs_h *g;
-   CODE:
-      if (guestfs_launch (g) == -1)
-        croak (\"launch: %%s\", last_error);
-
-void
-wait_ready (g)
-      guestfs_h *g;
-   CODE:
-      if (guestfs_wait_ready (g) == -1)
-        croak (\"wait_ready: %%s\", last_error);
-
-void
-set_path (g, path)
-      guestfs_h *g;
-      const char *path;
-   CODE:
-      guestfs_set_path (g, path);
-
-SV *
-get_path (g)
-      guestfs_h *g;
-PREINIT:
-      const char *path;
-   CODE:
-      path = guestfs_get_path (g);
-      RETVAL = newSVpv (path, 0);
- OUTPUT:
-      RETVAL
-
-void
-set_autosync (g, autosync)
-      guestfs_h *g;
-      int autosync;
-   CODE:
-      guestfs_set_autosync (g, autosync);
-
-SV *
-get_autosync (g)
-      guestfs_h *g;
-PREINIT:
-      int autosync;
-   CODE:
-      autosync = guestfs_get_autosync (g);
-      RETVAL = newSViv (autosync);
- OUTPUT:
-      RETVAL
-
-void
-set_verbose (g, verbose)
-      guestfs_h *g;
-      int verbose;
-   CODE:
-      guestfs_set_verbose (g, verbose);
-
-SV *
-get_verbose (g)
-      guestfs_h *g;
-PREINIT:
-      int verbose;
-   CODE:
-      verbose = guestfs_get_verbose (g);
-      RETVAL = newSViv (verbose);
- OUTPUT:
-      RETVAL
-

 ";
 
   List.iter (
 ";
 
   List.iter (

-    fun (name, style, _, _, _, _) ->
+    fun (name, style, _, _, _, _, _) ->

       (match fst style with
       (match fst style with

-       | Err -> pr "void\n"
+       | RErr -> pr "void\n"
+       | RInt _ -> pr "SV *\n"
+       | RBool _ -> pr "SV *\n"
+       | RConstString _ -> pr "SV *\n"

        | RString _ -> pr "SV *\n"
        | RStringList _
        | RString _ -> pr "SV *\n"
        | RStringList _

+       | RIntBool _

        | RPVList _ | RVGList _ | RLVList _ ->
           pr "void\n" (* all lists returned implictly on the stack *)
       );
        | RPVList _ | RVGList _ | RLVList _ ->
           pr "void\n" (* all lists returned implictly on the stack *)
       );


@@ -1697,18 +3335,65 @@ PREINIT:
       generate_call_args ~handle:"g" style;
       pr "\n";
       pr "      guestfs_h *g;\n";
       generate_call_args ~handle:"g" style;
       pr "\n";
       pr "      guestfs_h *g;\n";

-      iter_args (
+      List.iter (

        function
        | String n -> pr "      char *%s;\n" n
        function
        | String 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

       ) (snd style);
       ) (snd style);

+
+      let do_cleanups () =
+       List.iter (
+         function
+         | String _
+         | OptString _
+         | Bool _
+         | Int _ -> ()
+         | StringList n -> pr "        free (%s);\n" n
+       ) (snd style)
+      in
+

       (* Code. *)
       (match fst style with
       (* Code. *)
       (match fst style with

-       | Err ->
+       | RErr ->

           pr " PPCODE:\n";
           pr "      if (guestfs_%s " name;
           generate_call_args ~handle:"g" style;
           pr " PPCODE:\n";
           pr "      if (guestfs_%s " name;
           generate_call_args ~handle:"g" style;

-          pr " == -1)\n";
-          pr "        croak (\"%s: %%s\", last_error);\n" name
+          pr " == -1) {\n";
+          do_cleanups ();
+          pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+          pr "      }\n"
+       | RInt n
+       | RBool n ->
+          pr "PREINIT:\n";
+          pr "      int %s;\n" n;
+          pr "   CODE:\n";
+          pr "      %s = guestfs_%s " n name;
+          generate_call_args ~handle:"g" style;
+          pr ";\n";
+          pr "      if (%s == -1) {\n" n;
+          do_cleanups ();
+          pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+          pr "      }\n";
+          pr "      RETVAL = newSViv (%s);\n" n;
+          pr " OUTPUT:\n";
+          pr "      RETVAL\n"
+       | RConstString n ->
+          pr "PREINIT:\n";
+          pr "      const char *%s;\n" n;
+          pr "   CODE:\n";
+          pr "      %s = guestfs_%s " n name;
+          generate_call_args ~handle:"g" style;
+          pr ";\n";
+          pr "      if (%s == NULL) {\n" n;
+          do_cleanups ();
+          pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+          pr "      }\n";
+          pr "      RETVAL = newSVpv (%s, 0);\n" n;
+          pr " OUTPUT:\n";
+          pr "      RETVAL\n"

        | RString n ->
           pr "PREINIT:\n";
           pr "      char *%s;\n" n;
        | RString n ->
           pr "PREINIT:\n";
           pr "      char *%s;\n" n;


@@ -1716,8 +3401,10 @@ PREINIT:
           pr "      %s = guestfs_%s " n name;
           generate_call_args ~handle:"g" style;
           pr ";\n";
           pr "      %s = guestfs_%s " n name;
           generate_call_args ~handle:"g" style;
           pr ";\n";

-          pr "      if (%s == NULL)\n" n;
-          pr "        croak (\"%s: %%s\", last_error);\n" name;
+          pr "      if (%s == NULL) {\n" n;
+          do_cleanups ();
+          pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+          pr "      }\n";

           pr "      RETVAL = newSVpv (%s, 0);\n" n;
           pr "      free (%s);\n" n;
           pr " OUTPUT:\n";
           pr "      RETVAL = newSVpv (%s, 0);\n" n;
           pr "      free (%s);\n" n;
           pr " OUTPUT:\n";


@@ -1730,8 +3417,10 @@ PREINIT:
           pr "      %s = guestfs_%s " n name;
           generate_call_args ~handle:"g" style;
           pr ";\n";
           pr "      %s = guestfs_%s " n name;
           generate_call_args ~handle:"g" style;
           pr ";\n";

-          pr "      if (%s == NULL)\n" n;
-          pr "        croak (\"%s: %%s\", last_error);\n" name;
+          pr "      if (%s == NULL) {\n" n;
+          do_cleanups ();
+          pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+          pr "      }\n";

           pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
           pr "      EXTEND (SP, n);\n";
           pr "      for (i = 0; i < n; ++i) {\n";
           pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
           pr "      EXTEND (SP, n);\n";
           pr "      for (i = 0; i < n; ++i) {\n";


@@ -1739,6 +3428,21 @@ PREINIT:
           pr "        free (%s[i]);\n" n;
           pr "      }\n";
           pr "      free (%s);\n" n;
           pr "        free (%s[i]);\n" n;
           pr "      }\n";
           pr "      free (%s);\n" n;

+       | RIntBool _ ->
+          pr "PREINIT:\n";
+          pr "      struct guestfs_int_bool *r;\n";
+          pr " PPCODE:\n";
+          pr "      r = guestfs_%s " name;
+          generate_call_args ~handle:"g" style;
+          pr ";\n";
+          pr "      if (r == NULL) {\n";
+          do_cleanups ();
+          pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+          pr "      }\n";
+          pr "      EXTEND (SP, 2);\n";
+          pr "      PUSHs (sv_2mortal (newSViv (r->i)));\n";
+          pr "      PUSHs (sv_2mortal (newSViv (r->b)));\n";
+          pr "      guestfs_free_int_bool (r);\n";

        | RPVList n ->
           generate_perl_lvm_code "pv" pv_cols name style n;
        | RVGList n ->
        | RPVList n ->
           generate_perl_lvm_code "pv" pv_cols name style n;
        | RVGList n ->


@@ -1746,8 +3450,11 @@ PREINIT:
        | RLVList n ->
           generate_perl_lvm_code "lv" lv_cols name style n;
       );
        | RLVList n ->
           generate_perl_lvm_code "lv" lv_cols name style n;
       );

+
+      do_cleanups ();
+

       pr "\n"
       pr "\n"

-  ) functions
+  ) all_functions

 
 and generate_perl_lvm_code typ cols name style n =
   pr "PREINIT:\n";
 
 and generate_perl_lvm_code typ cols name style n =
   pr "PREINIT:\n";


@@ -1759,7 +3466,7 @@ and generate_perl_lvm_code typ cols name style n =
   generate_call_args ~handle:"g" style;
   pr ";\n";
   pr "      if (%s == NULL)\n" n;
   generate_call_args ~handle:"g" style;
   pr ";\n";
   pr "      if (%s == NULL)\n" n;

-  pr "        croak (\"%s: %%s\", last_error);\n" name;
+  pr "        croak (\"%s: %%s\", guestfs_last_error (g));\n" name;

   pr "      EXTEND (SP, %s->len);\n" n;
   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
   pr "        hv = newHV ();\n";
   pr "      EXTEND (SP, %s->len);\n" n;
   pr "      for (i = 0; i < %s->len; ++i) {\n" n;
   pr "        hv = newHV ();\n";


@@ -1863,79 +3570,23 @@ sub new {
   return $self;
 }
 
   return $self;
 }
 

-=item $h->add_drive ($filename);
-
-=item $h->add_cdrom ($filename);
-
-This function adds a virtual machine disk image C<filename> to the
-guest.  The first time you call this function, the disk appears as IDE
-disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
-so on.
-
-You don't necessarily need to be root when using libguestfs.  However
-you obviously do need sufficient permissions to access the filename
-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).
-
-The C<add_cdrom> variation adds a CD-ROM device.
-
-=item $h->config ($param, $value);
-
-=item $h->config ($param);
-
-Use this to add arbitrary parameters to the C<qemu> command line.
-See L<qemu(1)>.
-
-=item $h->launch ();
-
-=item $h->wait_ready ();
-
-Internally libguestfs is implemented by running a virtual machine
-using L<qemu(1)>.  These calls are necessary in order to boot the
-virtual machine.
-
-You should call these two functions after configuring the handle
-(eg. adding drives) but before performing any actions.
-
-=item $h->set_path ($path);
-
-=item $path = $h->get_path ();
-
-See the discussion of C<PATH> in the L<guestfs(3)>
-manpage.
-
-=item $h->set_autosync ($autosync);
-
-=item $autosync = $h->get_autosync ();
-
-See the discussion of I<AUTOSYNC> in the L<guestfs(3)>
-manpage.
-
-=item $h->set_verbose ($verbose);
-
-=item $verbose = $h->get_verbose ();
-
-This sets or gets the verbose messages flag.  Verbose
-messages are sent to C<stderr>.
-

 ";
 
   (* Actions.  We only need to print documentation for these as
    * they are pulled in from the XS code automatically.
    *)
   List.iter (
 ";
 
   (* Actions.  We only need to print documentation for these as
    * they are pulled in from the XS code automatically.
    *)
   List.iter (

-    fun (name, style, _, flags, _, longdesc) ->
+    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
       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 "Because of the message protocol, there is a transfer limit 
-of somewhere between 2MB and 4MB.  To transfer large files you should use
-FTP.\n\n";
-  ) sorted_functions;
+       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. *)
   pr "\
 
   (* End of file. *)
   pr "\


@@ -1962,8 +3613,12 @@ L<guestfs(3)>, L<guestfish(1)>.
 
 and generate_perl_prototype name style =
   (match fst style with
 
 and generate_perl_prototype name style =
   (match fst style with

-   | Err -> ()
+   | RErr -> ()
+   | RBool n
+   | RInt n
+   | RConstString n

    | RString n -> pr "$%s = " n
    | RString n -> pr "$%s = " n

+   | RIntBool (n, m) -> pr "($%s, $%s) = " n m

    | RStringList n
    | RPVList n
    | RVGList n
    | RStringList n
    | RPVList n
    | RVGList n


@@ -1971,15 +3626,366 @@ and generate_perl_prototype name style =
   );
   pr "$h->%s (" name;
   let comma = ref false in
   );
   pr "$h->%s (" name;
   let comma = ref false in

-  iter_args (
+  List.iter (

     fun arg ->
       if !comma then pr ", ";
       comma := true;
       match arg with
     fun arg ->
       if !comma then pr ", ";
       comma := true;
       match arg with

-      | String n -> pr "%s" n
+      | String n | OptString n | Bool n | Int n ->
+         pr "$%s" n
+      | StringList n ->
+         pr "\\@%s" n

   ) (snd style);
   pr ");"
 
   ) (snd style);
   pr ");"
 

+(* Generate Python C module. *)
+and generate_python_c () =
+  generate_header CStyle LGPLv2;
+
+  pr "\
+#include <stdio.h>
+#include <stdlib.h>
+#include <assert.h>
+
+#include <Python.h>
+
+#include \"guestfs.h\"
+
+typedef struct {
+  PyObject_HEAD
+  guestfs_h *g;
+} Pyguestfs_Object;
+
+static guestfs_h *
+get_handle (PyObject *obj)
+{
+  assert (obj);
+  assert (obj != Py_None);
+  return ((Pyguestfs_Object *) obj)->g;
+}
+
+static PyObject *
+put_handle (guestfs_h *g)
+{
+  assert (g);
+  return
+    PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
+}
+
+/* This list should be freed (but not the strings) after use. */
+static const char **
+get_string_list (PyObject *obj)
+{
+  int i, len;
+  const char **r;
+
+  assert (obj);
+
+  if (!PyList_Check (obj)) {
+    PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
+    return NULL;
+  }
+
+  len = PyList_Size (obj);
+  r = malloc (sizeof (char *) * (len+1));
+  if (r == NULL) {
+    PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
+    return NULL;
+  }
+
+  for (i = 0; i < len; ++i)
+    r[i] = PyString_AsString (PyList_GetItem (obj, i));
+  r[len] = NULL;
+
+  return r;
+}
+
+static PyObject *
+put_string_list (char * const * const argv)
+{
+  PyObject *list;
+  int argc, i;
+
+  for (argc = 0; argv[argc] != NULL; ++argc)
+    ;
+
+  list = PyList_New (argc);
+  for (i = 0; i < argc; ++i)
+    PyList_SetItem (list, i, PyString_FromString (argv[i]));
+
+  return list;
+}
+
+static void
+free_strings (char **argv)
+{
+  int argc;
+
+  for (argc = 0; argv[argc] != NULL; ++argc)
+    free (argv[argc]);
+  free (argv);
+}
+
+static PyObject *
+py_guestfs_create (PyObject *self, PyObject *args)
+{
+  guestfs_h *g;
+
+  g = guestfs_create ();
+  if (g == NULL) {
+    PyErr_SetString (PyExc_RuntimeError,
+                     \"guestfs.create: failed to allocate handle\");
+    return NULL;
+  }
+  guestfs_set_error_handler (g, NULL, NULL);
+  return put_handle (g);
+}
+
+static PyObject *
+py_guestfs_close (PyObject *self, PyObject *args)
+{
+  PyObject *py_g;
+  guestfs_h *g;
+
+  if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
+    return NULL;
+  g = get_handle (py_g);
+
+  guestfs_close (g);
+
+  Py_INCREF (Py_None);
+  return Py_None;
+}
+
+";
+
+  (* LVM structures, turned into Python dictionaries. *)
+  List.iter (
+    fun (typ, cols) ->
+      pr "static PyObject *\n";
+      pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
+      pr "{\n";
+      pr "  PyObject *dict;\n";
+      pr "\n";
+      pr "  dict = PyDict_New ();\n";
+      List.iter (
+       function
+       | name, `String ->
+           pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
+           pr "                        PyString_FromString (%s->%s));\n"
+             typ name
+       | name, `UUID ->
+           pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
+           pr "                        PyString_FromStringAndSize (%s->%s, 32));\n"
+             typ name
+       | name, `Bytes ->
+           pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
+           pr "                        PyLong_FromUnsignedLongLong (%s->%s));\n"
+             typ name
+       | name, `Int ->
+           pr "  PyDict_SetItemString (dict, \"%s\",\n" name;
+           pr "                        PyLong_FromLongLong (%s->%s));\n"
+             typ name
+       | name, `OptPercent ->
+           pr "  if (%s->%s >= 0)\n" typ name;
+           pr "    PyDict_SetItemString (dict, \"%s\",\n" name;
+           pr "                          PyFloat_FromDouble ((double) %s->%s));\n"
+             typ name;
+           pr "  else {\n";
+           pr "    Py_INCREF (Py_None);\n";
+           pr "    PyDict_SetItemString (dict, \"%s\", Py_None);" name;
+           pr "  }\n"
+      ) cols;
+      pr "  return dict;\n";
+      pr "};\n";
+      pr "\n";
+
+      pr "static PyObject *\n";
+      pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
+      pr "{\n";
+      pr "  PyObject *list;\n";
+      pr "  int i;\n";
+      pr "\n";
+      pr "  list = PyList_New (%ss->len);\n" typ;
+      pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
+      pr "    PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
+      pr "  return list;\n";
+      pr "};\n";
+      pr "\n"
+  ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
+
+  (* Python wrapper functions. *)
+  List.iter (
+    fun (name, style, _, _, _, _, _) ->
+      pr "static PyObject *\n";
+      pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
+      pr "{\n";
+
+      pr "  PyObject *py_g;\n";
+      pr "  guestfs_h *g;\n";
+      pr "  PyObject *py_r;\n";
+
+      let error_code =
+       match fst style with
+       | RErr | RInt _ | RBool _ -> pr "  int r;\n"; "-1"
+       | RConstString _ -> pr "  const char *r;\n"; "NULL"
+       | RString _ -> pr "  char *r;\n"; "NULL"
+       | RStringList _ -> pr "  char **r;\n"; "NULL"
+       | RIntBool _ -> pr "  struct guestfs_int_bool *r;\n"; "NULL"
+       | RPVList n -> pr "  struct guestfs_lvm_pv_list *r;\n"; "NULL"
+       | RVGList n -> pr "  struct guestfs_lvm_vg_list *r;\n"; "NULL"
+       | RLVList n -> pr "  struct guestfs_lvm_lv_list *r;\n"; "NULL" in
+
+      List.iter (
+       function
+       | String n -> pr "  const char *%s;\n" n
+       | OptString n -> pr "  const char *%s;\n" n
+       | StringList n ->
+           pr "  PyObject *py_%s;\n" n;
+           pr "  const char **%s;\n" n
+       | Bool n -> pr "  int %s;\n" n
+       | Int n -> pr "  int %s;\n" n
+      ) (snd style);
+
+      pr "\n";
+
+      (* Convert the parameters. *)
+      pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
+      List.iter (
+       function
+       | String _ -> pr "s"
+       | OptString _ -> pr "z"
+       | StringList _ -> pr "O"
+       | Bool _ -> pr "i" (* XXX Python has booleans? *)
+       | Int _ -> pr "i"
+      ) (snd style);
+      pr ":guestfs_%s\",\n" name;
+      pr "                         &py_g";
+      List.iter (
+       function
+       | String n -> pr ", &%s" n
+       | OptString n -> pr ", &%s" n
+       | StringList n -> pr ", &py_%s" n
+       | Bool n -> pr ", &%s" n
+       | Int n -> pr ", &%s" n
+      ) (snd style);
+
+      pr "))\n";
+      pr "    return NULL;\n";
+
+      pr "  g = get_handle (py_g);\n";
+      List.iter (
+       function
+       | String _ | OptString _ | Bool _ | Int _ -> ()
+       | StringList n ->
+           pr "  %s = get_string_list (py_%s);\n" n n;
+           pr "  if (!%s) return NULL;\n" n
+      ) (snd style);
+
+      pr "\n";
+
+      pr "  r = guestfs_%s " name;
+      generate_call_args ~handle:"g" style;
+      pr ";\n";
+
+      List.iter (
+       function
+       | String _ | OptString _ | Bool _ | Int _ -> ()
+       | StringList n ->
+           pr "  free (%s);\n" n
+      ) (snd style);
+
+      pr "  if (r == %s) {\n" error_code;
+      pr "    PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
+      pr "    return NULL;\n";
+      pr "  }\n";
+      pr "\n";
+
+      (match fst style with
+       | RErr ->
+          pr "  Py_INCREF (Py_None);\n";
+          pr "  py_r = Py_None;\n"
+       | RInt _
+       | RBool _ -> pr "  py_r = PyInt_FromLong ((long) r);\n"
+       | RConstString _ -> pr "  py_r = PyString_FromString (r);\n"
+       | RString _ ->
+          pr "  py_r = PyString_FromString (r);\n";
+          pr "  free (r);\n"
+       | RStringList _ ->
+          pr "  py_r = put_string_list (r);\n";
+          pr "  free_strings (r);\n"
+       | RIntBool _ ->
+          pr "  py_r = PyTuple_New (2);\n";
+          pr "  PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
+          pr "  PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
+          pr "  guestfs_free_int_bool (r);\n"
+       | RPVList n ->
+          pr "  py_r = put_lvm_pv_list (r);\n";
+          pr "  guestfs_free_lvm_pv_list (r);\n"
+       | RVGList n ->
+          pr "  py_r = put_lvm_vg_list (r);\n";
+          pr "  guestfs_free_lvm_vg_list (r);\n"
+       | RLVList n ->
+          pr "  py_r = put_lvm_lv_list (r);\n";
+          pr "  guestfs_free_lvm_lv_list (r);\n"
+      );
+
+      pr "  return py_r;\n";
+      pr "}\n";
+      pr "\n"
+  ) all_functions;
+
+  (* Table of functions. *)
+  pr "static PyMethodDef methods[] = {\n";
+  pr "  { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
+  pr "  { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
+  List.iter (
+    fun (name, _, _, _, _, _, _) ->
+      pr "  { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
+       name name
+  ) all_functions;
+  pr "  { NULL, NULL, 0, NULL }\n";
+  pr "};\n";
+  pr "\n";
+
+  (* Init function. *)
+  pr "\
+void
+initlibguestfsmod (void)
+{
+  static int initialized = 0;
+
+  if (initialized) return;
+  Py_InitModule ((char *) \"libguestfsmod\", methods);
+  initialized = 1;
+}
+"
+
+(* Generate Python module. *)
+and generate_python_py () =
+  generate_header HashStyle LGPLv2;
+
+  pr "import libguestfsmod\n";
+  pr "\n";
+  pr "class GuestFS:\n";
+  pr "    def __init__ (self):\n";
+  pr "        self._o = libguestfsmod.create ()\n";
+  pr "\n";
+  pr "    def __del__ (self):\n";
+  pr "        libguestfsmod.close (self._o)\n";
+  pr "\n";
+
+  List.iter (
+    fun (name, style, _, _, _, _, _) ->
+      pr "    def %s " name;
+      generate_call_args ~handle:"self" style;
+      pr ":\n";
+      pr "        return libguestfsmod.%s " name;
+      generate_call_args ~handle:"self._o" style;
+      pr "\n";
+      pr "\n";
+  ) all_functions
+

 let output_to filename =
   let filename_new = filename ^ ".new" in
   chan := open_out filename_new;
 let output_to filename =
   let filename_new = filename ^ ".new" in
   chan := open_out filename_new;


@@ -1995,6 +4001,15 @@ let output_to filename =
 let () =
   check_functions ();
 
 let () =
   check_functions ();
 

+  if not (Sys.file_exists "configure.ac") then (
+    eprintf "\
+You are probably running this from the wrong directory.
+Run it from the top source directory using the command
+  src/generator.ml
+";
+    exit 1
+  );
+

   let close = output_to "src/guestfs_protocol.x" in
   generate_xdr ();
   close ();
   let close = output_to "src/guestfs_protocol.x" in
   generate_xdr ();
   close ();


@@ -2019,6 +4034,10 @@ let () =
   generate_daemon_actions ();
   close ();
 
   generate_daemon_actions ();
   close ();
 

+  let close = output_to "tests.c" in
+  generate_tests ();
+  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 ();


@@ -2054,3 +4073,11 @@ let () =
   let close = output_to "perl/lib/Sys/Guestfs.pm" in
   generate_perl_pm ();
   close ();
   let close = output_to "perl/lib/Sys/Guestfs.pm" in
   generate_perl_pm ();
   close ();

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