Implement 'strings' and 'hexdump' commands.

[libguestfs.git] / src / generator.ml

#!/usr/bin/env ocaml
(* libguestfs
 * Copyright (C) 2009 Red Hat Inc.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 *)

(* 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 (see the big table below), and
 * 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 "str.cma";;

open Printf

type style = ret * args
and ret =
    (* "RErr" as a return value means an int used as a simple error
     * indication, ie. 0 or -1.
     *)
  | RErr
    (* "RInt" as a return value means an int which is -1 for error
     * or any value >= 0 on success.  Only use this for smallish
     * positive ints (0 <= i < 2^30).
     *)
  | RInt of string
    (* "RInt64" is the same as RInt, but is guaranteed to be able
     * to return a full 64 bit value, _except_ that -1 means error
     * (so -1 cannot be a valid, non-error return value).
     *)
  | RInt64 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
    (* Some limited tuples are possible: *)
  | RIntBool of string * string
    (* LVM PVs, VGs and LVs. *)
  | RPVList of string
  | RVGList of string
  | RLVList of string
    (* Stat buffers. *)
  | RStat of string
  | RStatVFS of string
    (* Key-value pairs of untyped strings.  Turns into a hashtable or
     * dictionary in languages which support it.  DON'T use this as a
     * general "bucket" for results.  Prefer a stronger typed return
     * value if one is available, or write a custom struct.  Don't use
     * this if the list could potentially be very long, since it is
     * inefficient.  Keys should be unique.  NULLs are not permitted.
     *)
  | RHashtable of string

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 *)
  | 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) *)
    (* These are treated as filenames (simple string parameters) in
     * the C API and bindings.  But in the RPC protocol, we transfer
     * the actual file content up to or down from the daemon.
     * FileIn: local machine -> daemon (in request)
     * FileOut: daemon -> local machine (in reply)
     * In guestfish (only), the special name "-" means read from
     * stdin or write to stdout.
     *)
  | FileIn of string
  | FileOut of string

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 blockdev-setrw, umount-all, lvm-remove-all
 * (except InitNone).
 *
 * If the appliance is running an older Linux kernel (eg. RHEL 5) then
 * devices are named /dev/hda etc.  To cope with this, the test suite
 * adds some hairly logic to detect this case, and then automagically
 * replaces all strings which match "/dev/sd.*" with "/dev/hd.*".
 * When writing test cases you shouldn't have to worry about this
 * difference.
 *
 * Don't assume anything about the previous contents of the block
 * devices.  Use 'Init*' to create some initial scenarios.
 *)
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 output of the final
     * command to be a structure.
     *)
  | TestOutputStruct of seq * test_field_compare list
    (* Run the command sequence and expect the final command (only)
     * to fail.
     *)
  | TestLastFail of seq

and test_field_compare =
  | CompareWithInt of string * int
  | CompareWithString of string * string
  | CompareFieldsIntEq of string * string
  | CompareFieldsStrEq of string * string

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

(* 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
 * the C function).  This will be replaced as appropriate in other
 * language bindings.
 *
 * Apart from that, long descriptions are just perldoc paragraphs.
 *)

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_qemu", (RErr, [String "qemu"]), -1, [FishAlias "qemu"],
   [],
   "set the qemu binary",
   "\
Set the qemu binary that we will use.

The default is chosen when the library was compiled by the
configure script.

You can also override this by setting the C<LIBGUESTFS_QEMU>
environment variable.

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

Setting C<qemu> to C<NULL> restores the default qemu binary.");

  ("get_qemu", (RConstString "qemu", []), -1, [],
   [],
   "get the qemu binary",
   "\
Return the current qemu binary.

This is always non-NULL.  If it wasn't set already, then this will
return the default qemu binary name.");

  ("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_umount_all> followed by
C<guestfs_sync> when the handle is closed
(also if the program exits without closing handles).

This is disabled by default (except in guestfish where it is
enabled by default).");

  ("get_autosync", (RBool "autosync", []), -1, [],
   [],
   "get autosync 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.");

  ("is_ready", (RBool "ready", []), -1, [],
   [],
   "is ready to accept commands",
   "\
This returns true iff this handle is ready to accept commands
(in the C<READY> state).

For more information on states, see L<guestfs(3)>.");

  ("is_config", (RBool "config", []), -1, [],
   [],
   "is in configuration state",
   "\
This returns true iff this handle is being configured
(in the C<CONFIG> state).

For more information on states, see L<guestfs(3)>.");

  ("is_launching", (RBool "launching", []), -1, [],
   [],
   "is launching subprocess",
   "\
This returns true iff this handle is launching the subprocess
(in the C<LAUNCHING> state).

For more information on states, see L<guestfs(3)>.");

  ("is_busy", (RBool "busy", []), -1, [],
   [],
   "is busy processing a command",
   "\
This returns true iff this handle is busy processing a command
(in the C<BUSY> state).

For more information on states, see L<guestfs(3)>.");

  ("get_state", (RInt "state", []), -1, [],
   [],
   "get the current state",
   "\
This returns the current state as an opaque integer.  This is
only useful for printing debug and internal error messages.

For more information on states, see L<guestfs(3)>.");

  ("set_busy", (RErr, []), -1, [NotInFish],
   [],
   "set state to busy",
   "\
This sets the state to C<BUSY>.  This is only used when implementing
actions using the low-level API.

For more information on states, see L<guestfs(3)>.");

  ("set_ready", (RErr, []), -1, [NotInFish],
   [],
   "set state to ready",
   "\
This sets the state to C<READY>.  This is only used when implementing
actions using the low-level API.

For more information on states, see L<guestfs(3)>.");

]

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
are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
the guest.  If those block devices contain partitions, they will have
the usual names (eg. C</dev/sda1>).  Also LVM C</dev/VG/LV>-style
names can be used.

The rules are the same as for L<mount(2)>:  A filesystem must
first be mounted on C</> before others can be mounted.  Other
filesystems can only be mounted on directories which already
exist.

The mounted filesystem is writable, if we have sufficient permissions
on the underlying device.

The filesystem options C<sync> and C<noatime> are set with this
call, in order to improve reliability.");

  ("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
underlying disk image.

You should always call this if you have modified a disk image, before
closing the handle.");

  ("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.");

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

Note that this function cannot correctly handle binary files
(specifically, files containing C<\\0> character which is treated
as end of string).  For those you need to use the C<guestfs_download>
function which has a more complex interface.");

  ("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,
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.");

  ("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,
there is no cwd).  The '.' and '..' entries are not returned, but
hidden files are shown.

This command is mostly useful for interactive sessions.  Programs
should probably use C<guestfs_readdir> instead.");

  ("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_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.

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>.");

  ("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
of the L<pvs(8)> command.

This returns a list of just the device names that contain
PVs (eg. C</dev/sda2>).

See also C<guestfs_pvs_full>.");

  ("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
of the L<vgs(8)> command.

This returns a list of just the volume group names that were
detected (eg. C<VolGroup00>).

See also C<guestfs_vgs_full>.");

  ("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
of the L<lvs(8)> command.

This returns a list of the logical volume device names
(eg. C</dev/VolGroup00/LogVol00>).

See also C<guestfs_lvs_full>.");

  ("pvs_full", (RPVList "physvols", []), 12, [],
   [], (* XXX how to test? *)
   "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", []), 13, [],
   [], (* XXX how to test? *)
   "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", []), 14, [],
   [], (* XXX how to test? *)
   "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
or 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],
   [InitBasicFS, TestOutput (
      [["write_file"; "/new"; "new file contents"; "0"];
       ["cat"; "/new"]], "new file contents");
    InitBasicFS, TestOutput (
      [["write_file"; "/new"; "\nnew file contents\n"; "0"];
       ["cat"; "/new"]], "\nnew file contents\n");
    InitBasicFS, TestOutput (
      [["write_file"; "/new"; "\n\n"; "0"];
       ["cat"; "/new"]], "\n\n");
    InitBasicFS, TestOutput (
      [["write_file"; "/new"; ""; "0"];
       ["cat"; "/new"]], "");
    InitBasicFS, TestOutput (
      [["write_file"; "/new"; "\n\n\n"; "0"];
       ["cat"; "/new"]], "\n\n\n");
    InitBasicFS, TestOutput (
      [["write_file"; "/new"; "\n"; "0"];
       ["cat"; "/new"]], "\n")],
   "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).

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

  ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
   [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"]], []);
    (* check that umount_all can unmount nested mounts correctly: *)
    InitEmpty, TestOutputList (
      [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
       ["mkfs"; "ext2"; "/dev/sda1"];
       ["mkfs"; "ext2"; "/dev/sda2"];
       ["mkfs"; "ext2"; "/dev/sda3"];
       ["mount"; "/dev/sda1"; "/"];
       ["mkdir"; "/mp1"];
       ["mount"; "/dev/sda2"; "/mp1"];
       ["mkdir"; "/mp1/mp2"];
       ["mount"; "/dev/sda3"; "/mp1/mp2"];
       ["mkdir"; "/mp1/mp2/mp3"];
       ["umount_all"];
       ["mounts"]], [])],
   "unmount all filesystems",
   "\
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).");

  ("command", (RString "output", [StringList "arguments"]), 50, [],
   [], (* XXX how to test? *)
   "run a command from the guest filesystem",
   "\
This call runs a command from the guest filesystem.  The
filesystem must be mounted, and must contain a compatible
operating system (ie. something Linux, with the same
or compatible processor architecture).

The single parameter is an argv-style list of arguments.
The first element is the name of the program to run.
Subsequent elements are parameters.  The list must be
non-empty (ie. must contain a program name).

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

Shared libraries and data files required by the program
must be available on filesystems which are mounted in the
correct places.  It is the caller's responsibility to ensure
all filesystems that are needed are mounted at the right
locations.");

  ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [],
   [], (* XXX how to test? *)
   "run a command, returning lines",
   "\
This is the same as C<guestfs_command>, but splits the
result into a list of lines.");

  ("stat", (RStat "statbuf", [String "path"]), 52, [],
   [InitBasicFS, TestOutputStruct (
      [["touch"; "/new"];
       ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
   "get file information",
   "\
Returns file information for the given C<path>.

This is the same as the C<stat(2)> system call.");

  ("lstat", (RStat "statbuf", [String "path"]), 53, [],
   [InitBasicFS, TestOutputStruct (
      [["touch"; "/new"];
       ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
   "get file information for a symbolic link",
   "\
Returns file information for the given C<path>.

This is the same as C<guestfs_stat> except that if C<path>
is a symbolic link, then the link is stat-ed, not the file it
refers to.

This is the same as the C<lstat(2)> system call.");

  ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
   [InitBasicFS, TestOutputStruct (
      [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
                           CompareWithInt ("blocks", 490020);
                           CompareWithInt ("bsize", 1024)])],
   "get file system statistics",
   "\
Returns file system statistics for any mounted file system.
C<path> should be a file or directory in the mounted file system
(typically it is the mount point itself, but it doesn't need to be).

This is the same as the C<statvfs(2)> system call.");

  ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
   [], (* XXX test *)
   "get ext2/ext3/ext4 superblock details",
   "\
This returns the contents of the ext2, ext3 or ext4 filesystem
superblock on C<device>.

It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
manpage for more details.  The list of fields returned isn't
clearly defined, and depends on both the version of C<tune2fs>
that libguestfs was built against, and the filesystem itself.");

  ("blockdev_setro", (RErr, [String "device"]), 56, [],
   [InitEmpty, TestOutputTrue (
      [["blockdev_setro"; "/dev/sda"];
       ["blockdev_getro"; "/dev/sda"]])],
   "set block device to read-only",
   "\
Sets the block device named C<device> to read-only.

This uses the L<blockdev(8)> command.");

  ("blockdev_setrw", (RErr, [String "device"]), 57, [],
   [InitEmpty, TestOutputFalse (
      [["blockdev_setrw"; "/dev/sda"];
       ["blockdev_getro"; "/dev/sda"]])],
   "set block device to read-write",
   "\
Sets the block device named C<device> to read-write.

This uses the L<blockdev(8)> command.");

  ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
   [InitEmpty, TestOutputTrue (
      [["blockdev_setro"; "/dev/sda"];
       ["blockdev_getro"; "/dev/sda"]])],
   "is block device set to read-only",
   "\
Returns a boolean indicating if the block device is read-only
(true if read-only, false if not).

This uses the L<blockdev(8)> command.");

  ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
   [InitEmpty, TestOutputInt (
      [["blockdev_getss"; "/dev/sda"]], 512)],
   "get sectorsize of block device",
   "\
This returns the size of sectors on a block device.
Usually 512, but can be larger for modern devices.

(Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
for that).

This uses the L<blockdev(8)> command.");

  ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
   [InitEmpty, TestOutputInt (
      [["blockdev_getbsz"; "/dev/sda"]], 4096)],
   "get blocksize of block device",
   "\
This returns the block size of a device.

(Note this is different from both I<size in blocks> and
I<filesystem block size>).

This uses the L<blockdev(8)> command.");

  ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
   [], (* XXX test *)
   "set blocksize of block device",
   "\
This sets the block size of a device.

(Note this is different from both I<size in blocks> and
I<filesystem block size>).

This uses the L<blockdev(8)> command.");

  ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
   [InitEmpty, TestOutputInt (
      [["blockdev_getsz"; "/dev/sda"]], 1024000)],
   "get total size of device in 512-byte sectors",
   "\
This returns the size of the device in units of 512-byte sectors
(even if the sectorsize isn't 512 bytes ... weird).

See also C<guestfs_blockdev_getss> for the real sector size of
the device, and C<guestfs_blockdev_getsize64> for the more
useful I<size in bytes>.

This uses the L<blockdev(8)> command.");

  ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
   [InitEmpty, TestOutputInt (
      [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
   "get total size of device in bytes",
   "\
This returns the size of the device in bytes.

See also C<guestfs_blockdev_getsz>.

This uses the L<blockdev(8)> command.");

  ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
   [InitEmpty, TestRun
      [["blockdev_flushbufs"; "/dev/sda"]]],
   "flush device buffers",
   "\
This tells the kernel to flush internal buffers associated
with C<device>.

This uses the L<blockdev(8)> command.");

  ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
   [InitEmpty, TestRun
      [["blockdev_rereadpt"; "/dev/sda"]]],
   "reread partition table",
   "\
Reread the partition table on C<device>.

This uses the L<blockdev(8)> command.");

  ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
   [InitBasicFS, TestOutput (
      (* Pick a file from cwd which isn't likely to change. *)
    [["upload"; "COPYING.LIB"; "/COPYING.LIB"];
     ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
   "upload a file from the local machine",
   "\
Upload local file C<filename> to C<remotefilename> on the
filesystem.

C<filename> can also be a named pipe.

See also C<guestfs_download>.");

  ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
   [InitBasicFS, TestOutput (
      (* Pick a file from cwd which isn't likely to change. *)
    [["upload"; "COPYING.LIB"; "/COPYING.LIB"];
     ["download"; "/COPYING.LIB"; "testdownload.tmp"];
     ["upload"; "testdownload.tmp"; "/upload"];
     ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
   "download a file to the local machine",
   "\
Download file C<remotefilename> and save it as C<filename>
on the local machine.

C<filename> can also be a named pipe.

See also C<guestfs_upload>, C<guestfs_cat>.");

  ("checksum", (RString "checksum", [String "csumtype"; String "path"]), 68, [],
   [InitBasicFS, TestOutput (
      [["write_file"; "/new"; "test\n"; "0"];
       ["checksum"; "crc"; "/new"]], "935282863");
    InitBasicFS, TestLastFail (
      [["checksum"; "crc"; "/new"]]);
    InitBasicFS, TestOutput (
      [["write_file"; "/new"; "test\n"; "0"];
       ["checksum"; "md5"; "/new"]], "d8e8fca2dc0f896fd7cb4cb0031ba249");
    InitBasicFS, TestOutput (
      [["write_file"; "/new"; "test\n"; "0"];
       ["checksum"; "sha1"; "/new"]], "4e1243bd22c66e76c2ba9eddc1f91394e57f9f83");
    InitBasicFS, TestOutput (
      [["write_file"; "/new"; "test\n"; "0"];
       ["checksum"; "sha224"; "/new"]], "52f1bf093f4b7588726035c176c0cdb4376cfea53819f1395ac9e6ec");
    InitBasicFS, TestOutput (
      [["write_file"; "/new"; "test\n"; "0"];
       ["checksum"; "sha256"; "/new"]], "f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93b7605022da52e6ccc26fd2");
    InitBasicFS, TestOutput (
      [["write_file"; "/new"; "test\n"; "0"];
       ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d");
    InitBasicFS, TestOutput (
      [["write_file"; "/new"; "test\n"; "0"];
       ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123")],
   "compute MD5, SHAx or CRC checksum of file",
   "\
This call computes the MD5, SHAx or CRC checksum of the
file named C<path>.

The type of checksum to compute is given by the C<csumtype>
parameter which must have one of the following values:

=over 4

=item C<crc>

Compute the cyclic redundancy check (CRC) specified by POSIX
for the C<cksum> command.

=item C<md5>

Compute the MD5 hash (using the C<md5sum> program).

=item C<sha1>

Compute the SHA1 hash (using the C<sha1sum> program).

=item C<sha224>

Compute the SHA224 hash (using the C<sha224sum> program).

=item C<sha256>

Compute the SHA256 hash (using the C<sha256sum> program).

=item C<sha384>

Compute the SHA384 hash (using the C<sha384sum> program).

=item C<sha512>

Compute the SHA512 hash (using the C<sha512sum> program).

=back

The checksum is returned as a printable string.");

  ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
   [InitBasicFS, TestOutput (
      [["tar_in"; "images/helloworld.tar"; "/"];
       ["cat"; "/hello"]], "hello\n")],
   "unpack tarfile to directory",
   "\
This command uploads and unpacks local file C<tarfile> (an
I<uncompressed> tar file) into C<directory>.

To upload a compressed tarball, use C<guestfs_tgz_in>.");

  ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
   [],
   "pack directory into tarfile",
   "\
This command packs the contents of C<directory> and downloads
it to local file C<tarfile>.

To download a compressed tarball, use C<guestfs_tgz_out>.");

  ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
   [InitBasicFS, TestOutput (
      [["tgz_in"; "images/helloworld.tar.gz"; "/"];
       ["cat"; "/hello"]], "hello\n")],
   "unpack compressed tarball to directory",
   "\
This command uploads and unpacks local file C<tarball> (a
I<gzip compressed> tar file) into C<directory>.

To upload an uncompressed tarball, use C<guestfs_tar_in>.");

  ("tgz_out", (RErr, [String "directory"; FileOut "tarball"]), 72, [],
   [],
   "pack directory into compressed tarball",
   "\
This command packs the contents of C<directory> and downloads
it to local file C<tarball>.

To download an uncompressed tarball, use C<guestfs_tar_out>.");

  ("mount_ro", (RErr, [String "device"; String "mountpoint"]), 73, [],
   [InitBasicFS, TestLastFail (
      [["umount"; "/"];
       ["mount_ro"; "/dev/sda1"; "/"];
       ["touch"; "/new"]]);
    InitBasicFS, TestOutput (
      [["write_file"; "/new"; "data"; "0"];
       ["umount"; "/"];
       ["mount_ro"; "/dev/sda1"; "/"];
       ["cat"; "/new"]], "data")],
   "mount a guest disk, read-only",
   "\
This is the same as the C<guestfs_mount> command, but it
mounts the filesystem with the read-only (I<-o ro>) flag.");

  ("mount_options", (RErr, [String "options"; String "device"; String "mountpoint"]), 74, [],
   [],
   "mount a guest disk with mount options",
   "\
This is the same as the C<guestfs_mount> command, but it
allows you to set the mount options as for the
L<mount(8)> I<-o> flag.");

  ("mount_vfs", (RErr, [String "options"; String "vfstype"; String "device"; String "mountpoint"]), 75, [],
   [],
   "mount a guest disk with mount options and vfstype",
   "\
This is the same as the C<guestfs_mount> command, but it
allows you to set both the mount options and the vfstype
as for the L<mount(8)> I<-o> and I<-t> flags.");

  ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
   [],
   "debugging and internals",
   "\
The C<guestfs_debug> command exposes some internals of
C<guestfsd> (the guestfs daemon) that runs inside the
qemu subprocess.

There is no comprehensive help for this command.  You have
to look at the file C<daemon/debug.c> in the libguestfs source
to find out what you can do.");

  ("lvremove", (RErr, [String "device"]), 77, [],
   [InitEmpty, TestOutputList (
      [["pvcreate"; "/dev/sda"];
       ["vgcreate"; "VG"; "/dev/sda"];
       ["lvcreate"; "LV1"; "VG"; "50"];
       ["lvcreate"; "LV2"; "VG"; "50"];
       ["lvremove"; "/dev/VG/LV1"];
       ["lvs"]], ["/dev/VG/LV2"]);
    InitEmpty, TestOutputList (
      [["pvcreate"; "/dev/sda"];
       ["vgcreate"; "VG"; "/dev/sda"];
       ["lvcreate"; "LV1"; "VG"; "50"];
       ["lvcreate"; "LV2"; "VG"; "50"];
       ["lvremove"; "/dev/VG"];
       ["lvs"]], []);
    InitEmpty, TestOutputList (
      [["pvcreate"; "/dev/sda"];
       ["vgcreate"; "VG"; "/dev/sda"];
       ["lvcreate"; "LV1"; "VG"; "50"];
       ["lvcreate"; "LV2"; "VG"; "50"];
       ["lvremove"; "/dev/VG"];
       ["vgs"]], ["VG"])],
   "remove an LVM logical volume",
   "\
Remove an LVM logical volume C<device>, where C<device> is
the path to the LV, such as C</dev/VG/LV>.

You can also remove all LVs in a volume group by specifying
the VG name, C</dev/VG>.");

  ("vgremove", (RErr, [String "vgname"]), 78, [],
   [InitEmpty, TestOutputList (
      [["pvcreate"; "/dev/sda"];
       ["vgcreate"; "VG"; "/dev/sda"];
       ["lvcreate"; "LV1"; "VG"; "50"];
       ["lvcreate"; "LV2"; "VG"; "50"];
       ["vgremove"; "VG"];
       ["lvs"]], []);
    InitEmpty, TestOutputList (
      [["pvcreate"; "/dev/sda"];
       ["vgcreate"; "VG"; "/dev/sda"];
       ["lvcreate"; "LV1"; "VG"; "50"];
       ["lvcreate"; "LV2"; "VG"; "50"];
       ["vgremove"; "VG"];
       ["vgs"]], [])],
   "remove an LVM volume group",
   "\
Remove an LVM volume group C<vgname>, (for example C<VG>).

This also forcibly removes all logical volumes in the volume
group (if any).");

  ("pvremove", (RErr, [String "device"]), 79, [],
   [InitEmpty, TestOutputList (
      [["pvcreate"; "/dev/sda"];
       ["vgcreate"; "VG"; "/dev/sda"];
       ["lvcreate"; "LV1"; "VG"; "50"];
       ["lvcreate"; "LV2"; "VG"; "50"];
       ["vgremove"; "VG"];
       ["pvremove"; "/dev/sda"];
       ["lvs"]], []);
    InitEmpty, TestOutputList (
      [["pvcreate"; "/dev/sda"];
       ["vgcreate"; "VG"; "/dev/sda"];
       ["lvcreate"; "LV1"; "VG"; "50"];
       ["lvcreate"; "LV2"; "VG"; "50"];
       ["vgremove"; "VG"];
       ["pvremove"; "/dev/sda"];
       ["vgs"]], []);
    InitEmpty, TestOutputList (
      [["pvcreate"; "/dev/sda"];
       ["vgcreate"; "VG"; "/dev/sda"];
       ["lvcreate"; "LV1"; "VG"; "50"];
       ["lvcreate"; "LV2"; "VG"; "50"];
       ["vgremove"; "VG"];
       ["pvremove"; "/dev/sda"];
       ["pvs"]], [])],
   "remove an LVM physical volume",
   "\
This wipes a physical volume C<device> so that LVM will no longer
recognise it.

The implementation uses the C<pvremove> command which refuses to
wipe physical volumes that contain any volume groups, so you have
to remove those first.");

  ("set_e2label", (RErr, [String "device"; String "label"]), 80, [],
   [InitBasicFS, TestOutput (
      [["set_e2label"; "/dev/sda1"; "testlabel"];
       ["get_e2label"; "/dev/sda1"]], "testlabel")],
   "set the ext2/3/4 filesystem label",
   "\
This sets the ext2/3/4 filesystem label of the filesystem on
C<device> to C<label>.  Filesystem labels are limited to
16 characters.

You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
to return the existing label on a filesystem.");

  ("get_e2label", (RString "label", [String "device"]), 81, [],
   [],
   "get the ext2/3/4 filesystem label",
   "\
This returns the ext2/3/4 filesystem label of the filesystem on
C<device>.");

  ("set_e2uuid", (RErr, [String "device"; String "uuid"]), 82, [],
   [InitBasicFS, TestOutput (
      [["set_e2uuid"; "/dev/sda1"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"];
       ["get_e2uuid"; "/dev/sda1"]], "a3a61220-882b-4f61-89f4-cf24dcc7297d");
    InitBasicFS, TestOutput (
      [["set_e2uuid"; "/dev/sda1"; "clear"];
       ["get_e2uuid"; "/dev/sda1"]], "");
    (* We can't predict what UUIDs will be, so just check the commands run. *)
    InitBasicFS, TestRun (
      [["set_e2uuid"; "/dev/sda1"; "random"]]);
    InitBasicFS, TestRun (
      [["set_e2uuid"; "/dev/sda1"; "time"]])],
   "set the ext2/3/4 filesystem UUID",
   "\
This sets the ext2/3/4 filesystem UUID of the filesystem on
C<device> to C<uuid>.  The format of the UUID and alternatives
such as C<clear>, C<random> and C<time> are described in the
L<tune2fs(8)> manpage.

You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
to return the existing UUID of a filesystem.");

  ("get_e2uuid", (RString "uuid", [String "device"]), 83, [],
   [],
   "get the ext2/3/4 filesystem UUID",
   "\
This returns the ext2/3/4 filesystem UUID of the filesystem on
C<device>.");

  ("fsck", (RInt "status", [String "fstype"; String "device"]), 84, [],
   [InitBasicFS, TestOutputInt (
      [["umount"; "/dev/sda1"];
       ["fsck"; "ext2"; "/dev/sda1"]], 0);
    InitBasicFS, TestOutputInt (
      [["umount"; "/dev/sda1"];
       ["zero"; "/dev/sda1"];
       ["fsck"; "ext2"; "/dev/sda1"]], 8)],
   "run the filesystem checker",
   "\
This runs the filesystem checker (fsck) on C<device> which
should have filesystem type C<fstype>.

The returned integer is the status.  See L<fsck(8)> for the
list of status codes from C<fsck>.

Notes:

=over 4

=item *

Multiple status codes can be summed together.

=item *

A non-zero return code can mean \"success\", for example if
errors have been corrected on the filesystem.

=item *

Checking or repairing NTFS volumes is not supported
(by linux-ntfs).

=back

This command is entirely equivalent to running C<fsck -a -t fstype device>.");

  ("zero", (RErr, [String "device"]), 85, [],
   [InitBasicFS, TestOutput (
      [["umount"; "/dev/sda1"];
       ["zero"; "/dev/sda1"];
       ["file"; "/dev/sda1"]], "data")],
   "write zeroes to the device",
   "\
This command writes zeroes over the first few blocks of C<device>.

How many blocks are zeroed isn't specified (but it's I<not> enough
to securely wipe the device).  It should be sufficient to remove
any partition tables, filesystem superblocks and so on.");

  ("grub_install", (RErr, [String "root"; String "device"]), 86, [],
   [InitBasicFS, TestOutputTrue (
      [["grub_install"; "/"; "/dev/sda1"];
       ["is_dir"; "/boot"]])],
   "install GRUB",
   "\
This command installs GRUB (the Grand Unified Bootloader) on
C<device>, with the root directory being C<root>.");

  ("cp", (RErr, [String "src"; String "dest"]), 87, [],
   [InitBasicFS, TestOutput (
      [["write_file"; "/old"; "file content"; "0"];
       ["cp"; "/old"; "/new"];
       ["cat"; "/new"]], "file content");
    InitBasicFS, TestOutputTrue (
      [["write_file"; "/old"; "file content"; "0"];
       ["cp"; "/old"; "/new"];
       ["is_file"; "/old"]]);
    InitBasicFS, TestOutput (
      [["write_file"; "/old"; "file content"; "0"];
       ["mkdir"; "/dir"];
       ["cp"; "/old"; "/dir/new"];
       ["cat"; "/dir/new"]], "file content")],
   "copy a file",
   "\
This copies a file from C<src> to C<dest> where C<dest> is
either a destination filename or destination directory.");

  ("cp_a", (RErr, [String "src"; String "dest"]), 88, [],
   [InitBasicFS, TestOutput (
      [["mkdir"; "/olddir"];
       ["mkdir"; "/newdir"];
       ["write_file"; "/olddir/file"; "file content"; "0"];
       ["cp_a"; "/olddir"; "/newdir"];
       ["cat"; "/newdir/olddir/file"]], "file content")],
   "copy a file or directory recursively",
   "\
This copies a file or directory from C<src> to C<dest>
recursively using the C<cp -a> command.");

  ("mv", (RErr, [String "src"; String "dest"]), 89, [],
   [InitBasicFS, TestOutput (
      [["write_file"; "/old"; "file content"; "0"];
       ["mv"; "/old"; "/new"];
       ["cat"; "/new"]], "file content");
    InitBasicFS, TestOutputFalse (
      [["write_file"; "/old"; "file content"; "0"];
       ["mv"; "/old"; "/new"];
       ["is_file"; "/old"]])],
   "move a file",
   "\
This moves a file from C<src> to C<dest> where C<dest> is
either a destination filename or destination directory.");

  ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
   [InitEmpty, TestRun (
      [["drop_caches"; "3"]])],
   "drop kernel page cache, dentries and inodes",
   "\
This instructs the guest kernel to drop its page cache,
and/or dentries and inode caches.  The parameter C<whattodrop>
tells the kernel what precisely to drop, see
L<http://linux-mm.org/Drop_Caches>

Setting C<whattodrop> to 3 should drop everything.

This automatically calls L<sync(2)> before the operation,
so that the maximum guest memory is freed.");

  ("dmesg", (RString "kmsgs", []), 91, [],
   [InitEmpty, TestRun (
      [["dmesg"]])],
   "return kernel messages",
   "\
This returns the kernel messages (C<dmesg> output) from
the guest kernel.  This is sometimes useful for extended
debugging of problems.

Another way to get the same information is to enable
verbose messages with C<guestfs_set_verbose> or by setting
the environment variable C<LIBGUESTFS_DEBUG=1> before
running the program.");

  ("ping_daemon", (RErr, []), 92, [],
   [InitEmpty, TestRun (
      [["ping_daemon"]])],
   "ping the guest daemon",
   "\
This is a test probe into the guestfs daemon running inside
the qemu subprocess.  Calling this function checks that the
daemon responds to the ping message, without affecting the daemon
or attached block device(s) in any other way.");

  ("equal", (RBool "equality", [String "file1"; String "file2"]), 93, [],
   [InitBasicFS, TestOutputTrue (
      [["write_file"; "/file1"; "contents of a file"; "0"];
       ["cp"; "/file1"; "/file2"];
       ["equal"; "/file1"; "/file2"]]);
    InitBasicFS, TestOutputFalse (
      [["write_file"; "/file1"; "contents of a file"; "0"];
       ["write_file"; "/file2"; "contents of another file"; "0"];
       ["equal"; "/file1"; "/file2"]]);
    InitBasicFS, TestLastFail (
      [["equal"; "/file1"; "/file2"]])],
   "test if two files have equal contents",
   "\
This compares the two files C<file1> and C<file2> and returns
true if their content is exactly equal, or false otherwise.

The external L<cmp(1)> program is used for the comparison.");

  ("strings", (RStringList "stringsout", [String "path"]), 94, [ProtocolLimitWarning],
   [InitBasicFS, TestOutputList (
      [["write_file"; "/new"; "hello\nworld\n"; "0"];
       ["strings"; "/new"]], ["hello"; "world"])],
   "print the printable strings in a file",
   "\
This runs the L<strings(1)> command on a file and returns
the list of printable strings found.");

  ("strings_e", (RStringList "stringsout", [String "encoding"; String "path"]), 95, [ProtocolLimitWarning],
   [InitBasicFS, TestOutputList (
      [["write_file"; "/new"; "hello\nworld\n"; "0"];
       ["strings_e"; "b"; "/new"]], []);
    (*InitBasicFS, TestOutputList (
      [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
       ["strings_e"; "b"; "/new"]], ["hello"; "world"])*)],
   "print the printable strings in a file",
   "\
This is like the C<guestfs_strings> command, but allows you to
specify the encoding.

See the L<strings(1)> manpage for the full list of encodings.

Commonly useful encodings are C<l> (lower case L) which will
show strings inside Windows/x86 files.

The returned strings are transcoded to UTF-8.");

  ("hexdump", (RString "dump", [String "path"]), 96, [ProtocolLimitWarning],
   [InitBasicFS, TestOutput (
      [["write_file"; "/new"; "hello\nworld\n"; "12"];
       ["hexdump"; "/new"]], "00000000  68 65 6c 6c 6f 0a 77 6f  72 6c 64 0a              |hello.world.|\n0000000c\n")],
   "dump a file in hexadecimal",
   "\
This runs C<hexdump -C> on the given C<path>.  The result is
the human-readable, canonical hex dump of the file.");

]

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;
  "pv_uuid", `UUID;
  "pv_fmt", `String;
  "pv_size", `Bytes;
  "dev_size", `Bytes;
  "pv_free", `Bytes;
  "pv_used", `Bytes;
  "pv_attr", `String (* XXX *);
  "pv_pe_count", `Int;
  "pv_pe_alloc_count", `Int;
  "pv_tags", `String;
  "pe_start", `Bytes;
  "pv_mda_count", `Int;
  "pv_mda_free", `Bytes;
(* Not in Fedora 10:
  "pv_mda_size", `Bytes;
*)
]
let vg_cols = [
  "vg_name", `String;
  "vg_uuid", `UUID;
  "vg_fmt", `String;
  "vg_attr", `String (* XXX *);
  "vg_size", `Bytes;
  "vg_free", `Bytes;
  "vg_sysid", `String;
  "vg_extent_size", `Bytes;
  "vg_extent_count", `Int;
  "vg_free_count", `Int;
  "max_lv", `Int;
  "max_pv", `Int;
  "pv_count", `Int;
  "lv_count", `Int;
  "snap_count", `Int;
  "vg_seqno", `Int;
  "vg_tags", `String;
  "vg_mda_count", `Int;
  "vg_mda_free", `Bytes;
(* Not in Fedora 10:
  "vg_mda_size", `Bytes;
*)
]
let lv_cols = [
  "lv_name", `String;
  "lv_uuid", `UUID;
  "lv_attr", `String (* XXX *);
  "lv_major", `Int;
  "lv_minor", `Int;
  "lv_kernel_major", `Int;
  "lv_kernel_minor", `Int;
  "lv_size", `Bytes;
  "seg_count", `Int;
  "origin", `String;
  "snap_percent", `OptPercent;
  "copy_percent", `OptPercent;
  "move_pv", `String;
  "lv_tags", `String;
  "mirror_log", `String;
  "modules", `String;
]

(* Column names and types from stat structures.
 * NB. Can't use things like 'st_atime' because glibc header files
 * define some of these as macros.  Ugh.
 *)
let stat_cols = [
  "dev", `Int;
  "ino", `Int;
  "mode", `Int;
  "nlink", `Int;
  "uid", `Int;
  "gid", `Int;
  "rdev", `Int;
  "size", `Int;
  "blksize", `Int;
  "blocks", `Int;
  "atime", `Int;
  "mtime", `Int;
  "ctime", `Int;
]
let statvfs_cols = [
  "bsize", `Int;
  "frsize", `Int;
  "blocks", `Int;
  "bfree", `Int;
  "bavail", `Int;
  "files", `Int;
  "ffree", `Int;
  "favail", `Int;
  "fsid", `Int;
  "flag", `Int;
  "namemax", `Int;
]

(* Useful functions.
 * Note we don't want to use any external OCaml libraries which
 * makes this a bit harder than it should be.
 *)
let failwithf fs = ksprintf failwith fs

let replace_char s c1 c2 =
  let s2 = String.copy s in
  let r = ref false in
  for i = 0 to String.length s2 - 1 do
    if String.unsafe_get s2 i = c1 then (
      String.unsafe_set s2 i c2;
      r := true
    )
  done;
  if not !r then s else s2

let isspace c =
  c = ' '
  (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)

let triml ?(test = isspace) str =
  let i = ref 0 in
  let n = ref (String.length str) in
  while !n > 0 && test str.[!i]; do
    decr n;
    incr i
  done;
  if !i = 0 then str
  else String.sub str !i !n

let trimr ?(test = isspace) str =
  let n = ref (String.length str) in
  while !n > 0 && test str.[!n-1]; do
    decr n
  done;
  if !n = String.length str then str
  else String.sub str 0 !n

let trim ?(test = isspace) str =
  trimr ~test (triml ~test str)

let rec find s sub =
  let len = String.length s in
  let sublen = String.length sub in
  let rec loop i =
    if i <= len-sublen then (
      let rec loop2 j =
        if j < sublen then (
          if s.[i+j] = sub.[j] then loop2 (j+1)
          else -1
        ) else
          i (* found *)
      in
      let r = loop2 0 in
      if r = -1 then loop (i+1) else r
    ) else
      -1 (* not found *)
  in
  loop 0

let rec replace_str s s1 s2 =
  let len = String.length s in
  let sublen = String.length s1 in
  let i = find s s1 in
  if i = -1 then s
  else (
    let s' = String.sub s 0 i in
    let s'' = String.sub s (i+sublen) (len-i-sublen) in
    s' ^ s2 ^ replace_str s'' s1 s2
  )

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

let rec find_map f = function
  | [] -> raise Not_found
  | x :: xs ->
      match f x with
      | Some y -> y
      | None -> find_map f xs

let iteri f xs =
  let rec loop i = function
    | [] -> ()
    | x :: xs -> f i x; loop (i+1) xs
  in
  loop 0 xs

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 name_of_argt = function
  | String n | OptString n | StringList n | Bool n | Int n
  | FileIn n | FileOut n -> n

let seq_of_test = function
  | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
  | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
  | TestOutputLength (s, _) | TestOutputStruct (s, _)
  | TestLastFail s -> s

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

      (match fst style with
       | RErr -> ()
       | RInt n | RInt64 n | RBool n | RConstString n | RString n
       | RStringList n | RPVList n | RVGList n | RLVList n
       | RStat n | RStatVFS n
       | RHashtable 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
        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 =
    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
    | [] -> ()
    | [_] -> ()
    | (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)"
          name1 name2 nr1 nr2
  in
  loop proc_nrs;

  (* Check tests. *)
  List.iter (
    function
      (* Ignore functions that have no tests.  We generate a
       * warning when the user does 'make check' instead.
       *)
    | name, _, _, _, [], _, _ -> ()
    | name, _, _, _, tests, _, _ ->
        let funcs =
          List.map (
            fun (_, test) ->
              match seq_of_test test with
              | [] ->
                  failwithf "%s has a test containing an empty sequence" name
              | cmds -> List.map List.hd cmds
          ) tests in
        let funcs = List.flatten funcs in

        let tested = List.mem name funcs in

        if not tested then
          failwithf "function %s has tests but does not test itself" name
  ) all_functions

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

let generate_header comment license =
  let c = match comment with
    | CStyle ->     pr "/* "; " *"
    | HashStyle ->  pr "# ";  "#"
    | OCamlStyle -> pr "(* "; " *" in
  pr "libguestfs generated file\n";
  pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
  pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
  pr "%s\n" c;
  pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
  pr "%s\n" c;
  (match license with
   | GPLv2 ->
       pr "%s This program is free software; you can redistribute it and/or modify\n" c;
       pr "%s it under the terms of the GNU General Public License as published by\n" c;
       pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
       pr "%s (at your option) any later version.\n" c;
       pr "%s\n" c;
       pr "%s This program is distributed in the hope that it will be useful,\n" c;
       pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
       pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n" c;
       pr "%s GNU General Public License for more details.\n" c;
       pr "%s\n" c;
       pr "%s You should have received a copy of the GNU General Public License along\n" c;
       pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
       pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;

   | LGPLv2 ->
       pr "%s This library is free software; you can redistribute it and/or\n" c;
       pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
       pr "%s License as published by the Free Software Foundation; either\n" c;
       pr "%s version 2 of the License, or (at your option) any later version.\n" c;
       pr "%s\n" c;
       pr "%s This library is distributed in the hope that it will be useful,\n" c;
       pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
       pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU\n" c;
       pr "%s Lesser General Public License for more details.\n" c;
       pr "%s\n" c;
       pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
       pr "%s License along with this library; if not, write to the Free Software\n" c;
       pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
  );
  (match comment with
   | CStyle -> pr " */\n"
   | HashStyle -> ()
   | OCamlStyle -> pr " *)\n"
  );
  pr "\n"

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

(* Generate the pod documentation for the C API. *)
let rec generate_actions_pod () =
  List.iter (
    fun (shortname, style, _, flags, _, _, longdesc) ->
      let name = "guestfs_" ^ shortname in
      pr "=head2 %s\n\n" name;
      pr " ";
      generate_prototype ~extern:false ~handle:"handle" name style;
      pr "\n\n";
      pr "%s\n\n" longdesc;
      (match fst style with
       | RErr ->
           pr "This function returns 0 on success or -1 on error.\n\n"
       | RInt _ ->
           pr "On error this function returns -1.\n\n"
       | RInt64 _ ->
           pr "On error this function returns -1.\n\n"
       | RBool _ ->
           pr "This function returns a C truth value on success or -1 on error.\n\n"
       | RConstString _ ->
           pr "This function returns a string, or NULL on error.
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"
       | RStringList _ ->
           pr "This function returns a NULL-terminated array of strings
(like L<environ(3)>), or NULL if there was an error.
I<The caller must free the strings and the array after use>.\n\n"
       | RIntBool _ ->
           pr "This function returns a C<struct guestfs_int_bool *>,
or NULL if there was an error.
I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
       | RPVList _ ->
           pr "This function returns a C<struct guestfs_lvm_pv_list *>
(see E<lt>guestfs-structs.hE<gt>),
or NULL if there was an error.
I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
       | RVGList _ ->
           pr "This function returns a C<struct guestfs_lvm_vg_list *>
(see E<lt>guestfs-structs.hE<gt>),
or NULL if there was an error.
I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
       | RLVList _ ->
           pr "This function returns a C<struct guestfs_lvm_lv_list *>
(see E<lt>guestfs-structs.hE<gt>),
or NULL if there was an error.
I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
       | RStat _ ->
           pr "This function returns a C<struct guestfs_stat *>
(see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
or NULL if there was an error.
I<The caller must call C<free> after use>.\n\n"
       | RStatVFS _ ->
           pr "This function returns a C<struct guestfs_statvfs *>
(see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
or NULL if there was an error.
I<The caller must call C<free> after use>.\n\n"
       | RHashtable _ ->
           pr "This function returns a NULL-terminated array of
strings, or NULL if there was an error.
The array of strings will always have length C<2n+1>, where
C<n> keys and values alternate, followed by the trailing NULL entry.
I<The caller must free the strings and the array after use>.\n\n"
      );
      if List.mem ProtocolLimitWarning flags then
        pr "%s\n\n" protocol_limit_warning;
      if List.mem DangerWillRobinson flags then
        pr "%s\n\n" danger_will_robinson;
  ) all_functions_sorted

and generate_structs_pod () =
  (* LVM structs documentation. *)
  List.iter (
    fun (typ, cols) ->
      pr "=head2 guestfs_lvm_%s\n" typ;
      pr "\n";
      pr " struct guestfs_lvm_%s {\n" typ;
      List.iter (
        function
        | name, `String -> pr "  char *%s;\n" name
        | name, `UUID ->
            pr "  /* The next field is NOT nul-terminated, be careful when printing it: */\n";
            pr "  char %s[32];\n" name
        | name, `Bytes -> pr "  uint64_t %s;\n" name
        | name, `Int -> pr "  int64_t %s;\n" name
        | name, `OptPercent ->
            pr "  /* The next field is [0..100] or -1 meaning 'not present': */\n";
            pr "  float %s;\n" name
      ) cols;
      pr " \n";
      pr " struct guestfs_lvm_%s_list {\n" typ;
      pr "   uint32_t len; /* Number of elements in list. */\n";
      pr "   struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
      pr " };\n";
      pr " \n";
      pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
        typ typ;
      pr "\n"
  ) ["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
 * rpcgen generates incorrect code.
 *
 * This header is NOT exported to clients, but see also generate_structs_h.
 *)
and generate_xdr () =
  generate_header CStyle LGPLv2;

  (* This has to be defined to get around a limitation in Sun's rpcgen. *)
  pr "typedef string str<>;\n";
  pr "\n";

  (* LVM internal structures. *)
  List.iter (
    function
    | typ, cols ->
        pr "struct guestfs_lvm_int_%s {\n" typ;
        List.iter (function
                   | name, `String -> pr "  string %s<>;\n" name
                   | name, `UUID -> pr "  opaque %s[32];\n" name
                   | name, `Bytes -> pr "  hyper %s;\n" name
                   | name, `Int -> pr "  hyper %s;\n" name
                   | name, `OptPercent -> pr "  float %s;\n" name
                  ) cols;
        pr "};\n";
        pr "\n";
        pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
        pr "\n";
  ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];

  (* Stat internal structures. *)
  List.iter (
    function
    | typ, cols ->
        pr "struct guestfs_int_%s {\n" typ;
        List.iter (function
                   | name, `Int -> pr "  hyper %s;\n" name
                  ) cols;
        pr "};\n";
        pr "\n";
  ) ["stat", stat_cols; "statvfs", statvfs_cols];

  List.iter (
    fun (shortname, style, _, _, _, _, _) ->
      let name = "guestfs_" ^ shortname in

      (match snd style with
       | [] -> ()
       | args ->
           pr "struct %s_args {\n" name;
           List.iter (
             function
             | 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
             | FileIn _ | FileOut _ -> ()
           ) args;
           pr "};\n\n"
      );
      (match fst style with
       | RErr -> ()
       | RInt n ->
           pr "struct %s_ret {\n" name;
           pr "  int %s;\n" n;
           pr "};\n\n"
       | RInt64 n ->
           pr "struct %s_ret {\n" name;
           pr "  hyper %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;
           pr "};\n\n"
       | RStringList 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;
           pr "};\n\n"
       | RVGList n ->
           pr "struct %s_ret {\n" name;
           pr "  guestfs_lvm_int_vg_list %s;\n" n;
           pr "};\n\n"
       | RLVList n ->
           pr "struct %s_ret {\n" name;
           pr "  guestfs_lvm_int_lv_list %s;\n" n;
           pr "};\n\n"
       | RStat n ->
           pr "struct %s_ret {\n" name;
           pr "  guestfs_int_stat %s;\n" n;
           pr "};\n\n"
       | RStatVFS n ->
           pr "struct %s_ret {\n" name;
           pr "  guestfs_int_statvfs %s;\n" n;
           pr "};\n\n"
       | RHashtable n ->
           pr "struct %s_ret {\n" name;
           pr "  str %s<>;\n" n;
           pr "};\n\n"
      );
  ) daemon_functions;

  (* Table of procedure numbers. *)
  pr "enum guestfs_procedure {\n";
  List.iter (
    fun (shortname, _, proc_nr, _, _, _, _) ->
      pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
  ) daemon_functions;
  pr "  GUESTFS_PROC_NR_PROCS\n";
  pr "};\n";
  pr "\n";

  (* Having to choose a maximum message size is annoying for several
   * reasons (it limits what we can do in the API), but it (a) makes
   * the protocol a lot simpler, and (b) provides a bound on the size
   * of the daemon which operates in limited memory space.  For large
   * file transfers you should use FTP.
   *)
  pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
  pr "\n";

  (* Message header, etc. *)
  pr "\
/* The communication protocol is now documented in the guestfs(3)
 * manpage.
 */

const GUESTFS_PROGRAM = 0x2000F5F5;
const GUESTFS_PROTOCOL_VERSION = 1;

/* These constants must be larger than any possible message length. */
const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
const GUESTFS_CANCEL_FLAG = 0xffffeeee;

enum guestfs_message_direction {
  GUESTFS_DIRECTION_CALL = 0,        /* client -> daemon */
  GUESTFS_DIRECTION_REPLY = 1        /* daemon -> client */
};

enum guestfs_message_status {
  GUESTFS_STATUS_OK = 0,
  GUESTFS_STATUS_ERROR = 1
};

const GUESTFS_ERROR_LEN = 256;

struct guestfs_message_error {
  string error_message<GUESTFS_ERROR_LEN>;
};

struct guestfs_message_header {
  unsigned prog;                     /* GUESTFS_PROGRAM */
  unsigned vers;                     /* GUESTFS_PROTOCOL_VERSION */
  guestfs_procedure proc;            /* GUESTFS_PROC_x */
  guestfs_message_direction direction;
  unsigned serial;                   /* message serial number */
  guestfs_message_status status;
};

const GUESTFS_MAX_CHUNK_SIZE = 8192;

struct guestfs_chunk {
  int cancel;                        /* if non-zero, transfer is cancelled */
  /* data size is 0 bytes if the transfer has finished successfully */
  opaque data<GUESTFS_MAX_CHUNK_SIZE>;
};
"

(* Generate the guestfs-structs.h file. *)
and generate_structs_h () =
  generate_header CStyle LGPLv2;

  (* This is a public exported header file containing various
   * structures.  The structures are carefully written to have
   * exactly the same in-memory format as the XDR structures that
   * we use on the wire to the daemon.  The reason for creating
   * copies of these structures here is just so we don't have to
   * export the whole of guestfs_protocol.h (which includes much
   * unrelated and XDR-dependent stuff that we don't want to be
   * public, or required by clients).
   *
   * To reiterate, we will pass these structures to and from the
   * client with a simple assignment or memcpy, so the format
   * 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
    | typ, cols ->
        pr "struct guestfs_lvm_%s {\n" typ;
        List.iter (
          function
          | name, `String -> pr "  char *%s;\n" name
          | name, `UUID -> pr "  char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
          | name, `Bytes -> pr "  uint64_t %s;\n" name
          | name, `Int -> pr "  int64_t %s;\n" name
          | name, `OptPercent -> pr "  float %s; /* [0..100] or -1 */\n" name
        ) cols;
        pr "};\n";
        pr "\n";
        pr "struct guestfs_lvm_%s_list {\n" typ;
        pr "  uint32_t len;\n";
        pr "  struct guestfs_lvm_%s *val;\n" typ;
        pr "};\n";
        pr "\n"
  ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];

  (* Stat structures. *)
  List.iter (
    function
    | typ, cols ->
        pr "struct guestfs_%s {\n" typ;
        List.iter (
          function
          | name, `Int -> pr "  int64_t %s;\n" name
        ) cols;
        pr "};\n";
        pr "\n"
  ) ["stat", stat_cols; "statvfs", statvfs_cols]

(* Generate the guestfs-actions.h file. *)
and generate_actions_h () =
  generate_header CStyle LGPLv2;
  List.iter (
    fun (shortname, style, _, _, _, _, _) ->
      let name = "guestfs_" ^ shortname in
      generate_prototype ~single_line:true ~newline:true ~handle:"handle"
        name style
  ) all_functions

(* Generate the client-side dispatch stubs. *)
and generate_client_actions () =
  generate_header CStyle LGPLv2;

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

#include \"guestfs.h\"
#include \"guestfs_protocol.h\"

#define error guestfs_error
#define perrorf guestfs_perrorf
#define safe_malloc guestfs_safe_malloc
#define safe_realloc guestfs_safe_realloc
#define safe_strdup guestfs_safe_strdup
#define safe_memdup guestfs_safe_memdup

/* Check the return message from a call for validity. */
static int
check_reply_header (guestfs_h *g,
                    const struct guestfs_message_header *hdr,
                    int proc_nr, int serial)
{
  if (hdr->prog != GUESTFS_PROGRAM) {
    error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
    return -1;
  }
  if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
    error (g, \"wrong protocol version (%%d/%%d)\",
           hdr->vers, GUESTFS_PROTOCOL_VERSION);
    return -1;
  }
  if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
    error (g, \"unexpected message direction (%%d/%%d)\",
           hdr->direction, GUESTFS_DIRECTION_REPLY);
    return -1;
  }
  if (hdr->proc != proc_nr) {
    error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
    return -1;
  }
  if (hdr->serial != serial) {
    error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
    return -1;
  }

  return 0;
}

/* Check we are in the right state to run a high-level action. */
static int
check_state (guestfs_h *g, const char *caller)
{
  if (!guestfs_is_ready (g)) {
    if (guestfs_is_config (g))
      error (g, \"%%s: call launch() before using this function\",
        caller);
    else if (guestfs_is_launching (g))
      error (g, \"%%s: call wait_ready() before using this function\",
        caller);
    else
      error (g, \"%%s called from the wrong state, %%d != READY\",
        caller, guestfs_get_state (g));
    return -1;
  }
  return 0;
}

";

  (* Client-side stubs for each function. *)
  List.iter (
    fun (shortname, style, _, _, _, _, _) ->
      let name = "guestfs_" ^ shortname in

      (* Generate the context struct which stores the high-level
       * state between callback functions.
       *)
      pr "struct %s_ctx {\n" shortname;
      pr "  /* This flag is set by the callbacks, so we know we've done\n";
      pr "   * the callbacks as expected, and in the right sequence.\n";
      pr "   * 0 = not called, 1 = reply_cb called.\n";
      pr "   */\n";
      pr "  int cb_sequence;\n";
      pr "  struct guestfs_message_header hdr;\n";
      pr "  struct guestfs_message_error err;\n";
      (match fst style with
       | RErr -> ()
       | RConstString _ ->
           failwithf "RConstString cannot be returned from a daemon function"
       | RInt _ | RInt64 _
       | RBool _ | RString _ | RStringList _
       | RIntBool _
       | RPVList _ | RVGList _ | RLVList _
       | RStat _ | RStatVFS _
       | RHashtable _ ->
           pr "  struct %s_ret ret;\n" name
      );
      pr "};\n";
      pr "\n";

      (* Generate the reply callback function. *)
      pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
      pr "{\n";
      pr "  guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
      pr "  struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
      pr "\n";
      pr "  /* This should definitely not happen. */\n";
      pr "  if (ctx->cb_sequence != 0) {\n";
      pr "    ctx->cb_sequence = 9999;\n";
      pr "    error (g, \"%%s: internal error: reply callback called twice\", \"%s\");\n" name;
      pr "    return;\n";
      pr "  }\n";
      pr "\n";
      pr "  ml->main_loop_quit (ml, g);\n";
      pr "\n";
      pr "  if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
      pr "    error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
      pr "    return;\n";
      pr "  }\n";
      pr "  if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
      pr "    if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
      pr "      error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
        name;
      pr "      return;\n";
      pr "    }\n";
      pr "    goto done;\n";
      pr "  }\n";

      (match fst style with
       | RErr -> ()
       | RConstString _ ->
           failwithf "RConstString cannot be returned from a daemon function"
       | RInt _ | RInt64 _
       | RBool _ | RString _ | RStringList _
       | RIntBool _
       | RPVList _ | RVGList _ | RLVList _
       | RStat _ | RStatVFS _
       | RHashtable _ ->
            pr "  if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
            pr "    error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
            pr "    return;\n";
            pr "  }\n";
      );

      pr " done:\n";
      pr "  ctx->cb_sequence = 1;\n";
      pr "}\n\n";

      (* Generate the action stub. *)
      generate_prototype ~extern:false ~semicolon:false ~newline:true
        ~handle:"g" name style;

      let error_code =
        match fst style with
        | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
        | RConstString _ ->
            failwithf "RConstString cannot be returned from a daemon function"
        | RString _ | RStringList _ | RIntBool _
        | RPVList _ | RVGList _ | RLVList _
        | RStat _ | RStatVFS _
        | RHashtable _ ->
            "NULL" in

      pr "{\n";

      (match snd style with
       | [] -> ()
       | _ -> pr "  struct %s_args args;\n" name
      );

      pr "  struct %s_ctx ctx;\n" shortname;
      pr "  guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
      pr "  int serial;\n";
      pr "\n";
      pr "  if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
      pr "  guestfs_set_busy (g);\n";
      pr "\n";
      pr "  memset (&ctx, 0, sizeof ctx);\n";
      pr "\n";

      (* Send the main header and arguments. *)
      (match snd style with
       | [] ->
           pr "  serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
             (String.uppercase shortname)
       | args ->
           List.iter (
             function
             | 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
             | FileIn _ | FileOut _ -> ()
           ) args;
           pr "  serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
             (String.uppercase shortname);
           pr "        (xdrproc_t) xdr_%s_args, (char *) &args);\n"
             name;
      );
      pr "  if (serial == -1) {\n";
      pr "    guestfs_set_ready (g);\n";
      pr "    return %s;\n" error_code;
      pr "  }\n";
      pr "\n";

      (* Send any additional files (FileIn) requested. *)
      let need_read_reply_label = ref false in
      List.iter (
        function
        | FileIn n ->
            pr "  {\n";
            pr "    int r;\n";
            pr "\n";
            pr "    r = guestfs__send_file_sync (g, %s);\n" n;
            pr "    if (r == -1) {\n";
            pr "      guestfs_set_ready (g);\n";
            pr "      return %s;\n" error_code;
            pr "    }\n";
            pr "    if (r == -2) /* daemon cancelled */\n";
            pr "      goto read_reply;\n";
            need_read_reply_label := true;
            pr "  }\n";
            pr "\n";
        | _ -> ()
      ) (snd style);

      (* Wait for the reply from the remote end. *)
      if !need_read_reply_label then pr " read_reply:\n";
      pr "  guestfs__switch_to_receiving (g);\n";
      pr "  ctx.cb_sequence = 0;\n";
      pr "  guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
      pr "  (void) ml->main_loop_run (ml, g);\n";
      pr "  guestfs_set_reply_callback (g, NULL, NULL);\n";
      pr "  if (ctx.cb_sequence != 1) {\n";
      pr "    error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
      pr "    guestfs_set_ready (g);\n";
      pr "    return %s;\n" error_code;
      pr "  }\n";
      pr "\n";

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

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

      (* Expecting to receive further files (FileOut)? *)
      List.iter (
        function
        | FileOut n ->
            pr "  if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
            pr "    guestfs_set_ready (g);\n";
            pr "    return %s;\n" error_code;
            pr "  }\n";
            pr "\n";
        | _ -> ()
      ) (snd style);

      pr "  guestfs_set_ready (g);\n";

      (match fst style with
       | RErr -> pr "  return 0;\n"
       | RInt n | RInt64 n | RBool n ->
           pr "  return ctx.ret.%s;\n" n
       | RConstString _ ->
           failwithf "RConstString cannot be returned from a daemon function"
       | RString n ->
           pr "  return ctx.ret.%s; /* caller will free */\n" n
       | RStringList n | RHashtable n ->
           pr "  /* caller will free this, but we need to add a NULL entry */\n";
           pr "  ctx.ret.%s.%s_val =\n" n n;
           pr "    safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
           pr "                  sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n"
             n n;
           pr "  ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
           pr "  return ctx.ret.%s.%s_val;\n" n n
       | RIntBool _ ->
           pr "  /* caller with free this */\n";
           pr "  return safe_memdup (g, &ctx.ret, sizeof (ctx.ret));\n"
       | RPVList n | RVGList n | RLVList n
       | RStat n | RStatVFS n ->
           pr "  /* caller will free this */\n";
           pr "  return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
      );

      pr "}\n\n"
  ) daemon_functions

(* Generate daemon/actions.h. *)
and generate_daemon_actions_h () =
  generate_header CStyle GPLv2;

  pr "#include \"../src/guestfs_protocol.h\"\n";
  pr "\n";

  List.iter (
    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_header CStyle GPLv2;

  pr "#include <config.h>\n";
  pr "\n";
  pr "#include <stdio.h>\n";
  pr "#include <stdlib.h>\n";
  pr "#include <string.h>\n";
  pr "#include <inttypes.h>\n";
  pr "#include <ctype.h>\n";
  pr "#include <rpc/types.h>\n";
  pr "#include <rpc/xdr.h>\n";
  pr "\n";
  pr "#include \"daemon.h\"\n";
  pr "#include \"../src/guestfs_protocol.h\"\n";
  pr "#include \"actions.h\"\n";
  pr "\n";

  List.iter (
    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
        | RErr | RInt _ -> pr "  int r;\n"; "-1"
        | RInt64 _ -> pr "  int64_t 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 _ | RHashtable _ -> 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"
        | RStat _ -> pr "  guestfs_int_stat *r;\n"; "NULL"
        | RStatVFS _ -> pr "  guestfs_int_statvfs *r;\n"; "NULL" in

      (match snd style with
       | [] -> ()
       | args ->
           pr "  struct guestfs_%s_args args;\n" name;
           List.iter (
             function
             | 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
             | FileIn _ | FileOut _ -> ()
           ) args
      );
      pr "\n";

      (match snd style with
       | [] -> ()
       | 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\", \"%s\");\n" name;
           pr "    return;\n";
           pr "  }\n";
           List.iter (
             function
             | 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 "  %s = realloc (args.%s.%s_val,\n" n n n;
                 pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
                 pr "  if (%s == NULL) {\n" n;
                 pr "    reply_with_perror (\"realloc\");\n";
                 pr "    goto done;\n";
                 pr "  }\n";
                 pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
                 pr "  args.%s.%s_val = %s;\n" n n n;
             | Bool n -> pr "  %s = args.%s;\n" n n
             | Int n -> pr "  %s = args.%s;\n" n n
             | FileIn _ | FileOut _ -> ()
           ) args;
           pr "\n"
      );

      (* Don't want to call the impl with any FileIn or FileOut
       * parameters, since these go "outside" the RPC protocol.
       *)
      let argsnofile =
        List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
          (snd style) in
      pr "  r = do_%s " name;
      generate_call_args argsnofile;
      pr ";\n";

      pr "  if (r == %s)\n" error_code;
      pr "    /* do_%s has already called reply_with_error */\n" name;
      pr "    goto done;\n";
      pr "\n";

      (* If there are any FileOut parameters, then the impl must
       * send its own reply.
       *)
      let no_reply =
        List.exists (function FileOut _ -> true | _ -> false) (snd style) in
      if no_reply then
        pr "  /* do_%s has already sent a reply */\n" name
      else (
        match fst style with
        | RErr -> pr "  reply (NULL, NULL);\n"
        | RInt n | RInt64 n | 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;
            pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
              name;
            pr "  free (r);\n"
        | RStringList n | RHashtable n ->
            pr "  struct guestfs_%s_ret ret;\n" name;
            pr "  ret.%s.%s_len = count_strings (r);\n" n 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 | RVGList n | RLVList n
        | RStat n | RStatVFS 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 "  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";
  ) daemon_functions;

  (* Dispatch function. *)
  pr "void dispatch_incoming_message (XDR *xdr_in)\n";
  pr "{\n";
  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"
  ) daemon_functions;

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

  (* LVM columns and tokenization functions. *)
  (* XXX This generates crap code.  We should rethink how we
   * do this parsing.
   *)
  List.iter (
    function
    | typ, cols ->
        pr "static const char *lvm_%s_cols = \"%s\";\n"
          typ (String.concat "," (List.map fst cols));
        pr "\n";

        pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
        pr "{\n";
        pr "  char *tok, *p, *next;\n";
        pr "  int i, j;\n";
        pr "\n";
        (*
        pr "  fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
        pr "\n";
        *)
        pr "  if (!str) {\n";
        pr "    fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
        pr "    return -1;\n";
        pr "  }\n";
        pr "  if (!*str || isspace (*str)) {\n";
        pr "    fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
        pr "    return -1;\n";
        pr "  }\n";
        pr "  tok = str;\n";
        List.iter (
          fun (name, coltype) ->
            pr "  if (!tok) {\n";
            pr "    fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
            pr "    return -1;\n";
            pr "  }\n";
            pr "  p = strchrnul (tok, ',');\n";
            pr "  if (*p) next = p+1; else next = NULL;\n";
            pr "  *p = '\\0';\n";
            (match coltype with
             | `String ->
                 pr "  r->%s = strdup (tok);\n" name;
                 pr "  if (r->%s == NULL) {\n" name;
                 pr "    perror (\"strdup\");\n";
                 pr "    return -1;\n";
                 pr "  }\n"
             | `UUID ->
                 pr "  for (i = j = 0; i < 32; ++j) {\n";
                 pr "    if (tok[j] == '\\0') {\n";
                 pr "      fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
                 pr "      return -1;\n";
                 pr "    } else if (tok[j] != '-')\n";
                 pr "      r->%s[i++] = tok[j];\n" name;
                 pr "  }\n";
             | `Bytes ->
                 pr "  if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
                 pr "    fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
                 pr "    return -1;\n";
                 pr "  }\n";
             | `Int ->
                 pr "  if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
                 pr "    fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
                 pr "    return -1;\n";
                 pr "  }\n";
             | `OptPercent ->
                 pr "  if (tok[0] == '\\0')\n";
                 pr "    r->%s = -1;\n" name;
                 pr "  else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
                 pr "    fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
                 pr "    return -1;\n";
                 pr "  }\n";
            );
            pr "  tok = next;\n";
        ) cols;

        pr "  if (tok != NULL) {\n";
        pr "    fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
        pr "    return -1;\n";
        pr "  }\n";
        pr "  return 0;\n";
        pr "}\n";
        pr "\n";

        pr "guestfs_lvm_int_%s_list *\n" typ;
        pr "parse_command_line_%ss (void)\n" typ;
        pr "{\n";
        pr "  char *out, *err;\n";
        pr "  char *p, *pend;\n";
        pr "  int r, i;\n";
        pr "  guestfs_lvm_int_%s_list *ret;\n" typ;
        pr "  void *newp;\n";
        pr "\n";
        pr "  ret = malloc (sizeof *ret);\n";
        pr "  if (!ret) {\n";
        pr "    reply_with_perror (\"malloc\");\n";
        pr "    return NULL;\n";
        pr "  }\n";
        pr "\n";
        pr "  ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
        pr "  ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
        pr "\n";
        pr "  r = command (&out, &err,\n";
        pr "           \"/sbin/lvm\", \"%ss\",\n" typ;
        pr "           \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
        pr "           \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
        pr "  if (r == -1) {\n";
        pr "    reply_with_error (\"%%s\", err);\n";
        pr "    free (out);\n";
        pr "    free (err);\n";
        pr "    free (ret);\n";
        pr "    return NULL;\n";
        pr "  }\n";
        pr "\n";
        pr "  free (err);\n";
        pr "\n";
        pr "  /* Tokenize each line of the output. */\n";
        pr "  p = out;\n";
        pr "  i = 0;\n";
        pr "  while (p) {\n";
        pr "    pend = strchr (p, '\\n');       /* Get the next line of output. */\n";
        pr "    if (pend) {\n";
        pr "      *pend = '\\0';\n";
        pr "      pend++;\n";
        pr "    }\n";
        pr "\n";
        pr "    while (*p && isspace (*p))      /* Skip any leading whitespace. */\n";
        pr "      p++;\n";
        pr "\n";
        pr "    if (!*p) {                      /* Empty line?  Skip it. */\n";
        pr "      p = pend;\n";
        pr "      continue;\n";
        pr "    }\n";
        pr "\n";
        pr "    /* Allocate some space to store this next entry. */\n";
        pr "    newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
        pr "                sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
        pr "    if (newp == NULL) {\n";
        pr "      reply_with_perror (\"realloc\");\n";
        pr "      free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
        pr "      free (ret);\n";
        pr "      free (out);\n";
        pr "      return NULL;\n";
        pr "    }\n";
        pr "    ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
        pr "\n";
        pr "    /* Tokenize the next entry. */\n";
        pr "    r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
        pr "    if (r == -1) {\n";
        pr "      reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
        pr "      free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
        pr "      free (ret);\n";
        pr "      free (out);\n";
        pr "      return NULL;\n";
        pr "    }\n";
        pr "\n";
        pr "    ++i;\n";
        pr "    p = pend;\n";
        pr "  }\n";
        pr "\n";
        pr "  ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
        pr "\n";
        pr "  free (out);\n";
        pr "  return ret;\n";
        pr "}\n"

  ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]

(* Generate the tests. *)
and generate_tests () =
  generate_header CStyle GPLv2;

  pr "\
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h>
#include <sys/types.h>
#include <fcntl.h>

#include \"guestfs.h\"

static guestfs_h *g;
static int suppress_error = 0;

/* This will be 's' or 'h' depending on whether the guest kernel
 * names IDE devices /dev/sd* or /dev/hd*.
 */
static char devchar = 's';

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]);
}

/*
static void print_table (char * const * const argv)
{
  int i;

  for (i = 0; argv[i] != NULL; i += 2)
    printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
}
*/

static void no_test_warnings (void)
{
";

  List.iter (
    function
    | name, _, _, _, [], _, _ ->
        pr "  fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
    | name, _, _, _, tests, _, _ -> ()
  ) all_functions;

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

  (* Generate the actual tests.  Note that we generate the tests
   * in reverse order, deliberately, so that (in general) the
   * newest tests run first.  This makes it quicker and easier to
   * debug them.
   *)
  let test_names =
    List.map (
      fun (name, _, _, _, tests, _, _) ->
        mapi (generate_one_test name) tests
    ) (List.rev 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;
  const char *filename;
  int fd, i;
  int nr_tests, test_num = 0;
  char **devs;

  no_test_warnings ();

  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 = \".\";
  chdir (srcdir);
  guestfs_set_path (g, \".\");

  filename = \"test1.img\";
  fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
  if (fd == -1) {
    perror (filename);
    exit (1);
  }
  if (lseek (fd, %d, SEEK_SET) == -1) {
    perror (\"lseek\");
    close (fd);
    unlink (filename);
    exit (1);
  }
  if (write (fd, &c, 1) == -1) {
    perror (\"write\");
    close (fd);
    unlink (filename);
    exit (1);
  }
  if (close (fd) == -1) {
    perror (filename);
    unlink (filename);
    exit (1);
  }
  if (guestfs_add_drive (g, filename) == -1) {
    printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
    exit (1);
  }

  filename = \"test2.img\";
  fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
  if (fd == -1) {
    perror (filename);
    exit (1);
  }
  if (lseek (fd, %d, SEEK_SET) == -1) {
    perror (\"lseek\");
    close (fd);
    unlink (filename);
    exit (1);
  }
  if (write (fd, &c, 1) == -1) {
    perror (\"write\");
    close (fd);
    unlink (filename);
    exit (1);
  }
  if (close (fd) == -1) {
    perror (filename);
    unlink (filename);
    exit (1);
  }
  if (guestfs_add_drive (g, filename) == -1) {
    printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
    exit (1);
  }

  filename = \"test3.img\";
  fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
  if (fd == -1) {
    perror (filename);
    exit (1);
  }
  if (lseek (fd, %d, SEEK_SET) == -1) {
    perror (\"lseek\");
    close (fd);
    unlink (filename);
    exit (1);
  }
  if (write (fd, &c, 1) == -1) {
    perror (\"write\");
    close (fd);
    unlink (filename);
    exit (1);
  }
  if (close (fd) == -1) {
    perror (filename);
    unlink (filename);
    exit (1);
  }
  if (guestfs_add_drive (g, filename) == -1) {
    printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
    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);
  }

  /* Detect if the appliance uses /dev/sd* or /dev/hd* in device
   * names.  This changed between RHEL 5 and RHEL 6 so we have to
   * support both.
   */
  devs = guestfs_list_devices (g);
  if (devs == NULL || devs[0] == NULL) {
    printf (\"guestfs_list_devices FAILED\\n\");
    exit (1);
  }
  if (strncmp (devs[0], \"/dev/sd\", 7) == 0)
    devchar = 's';
  else if (strncmp (devs[0], \"/dev/hd\", 7) == 0)
    devchar = 'h';
  else {
    printf (\"guestfs_list_devices returned unexpected string '%%s'\\n\",
            devs[0]);
    exit (1);
  }
  for (i = 0; devs[i] != NULL; ++i)
    free (devs[i]);
  free (devs);

  nr_tests = %d;

" (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;

  iteri (
    fun i test_name ->
      pr "  test_num++;\n";
      pr "  printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" 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 "  unlink (\"test1.img\");\n";
  pr "  unlink (\"test2.img\");\n";
  pr "  unlink (\"test3.img\");\n";
  pr "\n";

  pr "  if (failed > 0) {\n";
  pr "    printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
  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)
         [["blockdev_setrw"; "/dev/sda"];
          ["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)
         [["blockdev_setrw"; "/dev/sda"];
          ["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)
         [["blockdev_setrw"; "/dev/sda"];
          ["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;
       pr "  char expected[] = \"%s\";\n" (c_quote expected);
       if String.length expected > 7 &&
          String.sub expected 0 7 = "/dev/sd" then
         pr "  expected[5] = devchar;\n";
       let seq, last = get_seq_last seq in
       let test () =
         pr "    if (strcmp (r, expected) != 0) {\n";
         pr "      fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
         pr "      return -1;\n";
         pr "    }\n"
       in
       List.iter (generate_test_command_call test_name) seq;
       generate_test_command_call ~test test_name last
   | TestOutputList (seq, expected) ->
       pr "  /* TestOutputList for %s (%d) */\n" name i;
       let seq, last = get_seq_last seq in
       let test () =
         iteri (
           fun i str ->
             pr "    if (!r[%d]) {\n" i;
             pr "      fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
             pr "      print_strings (r);\n";
             pr "      return -1;\n";
             pr "    }\n";
             pr "    {\n";
             pr "      char expected[] = \"%s\";\n" (c_quote str);
             if String.length str > 7 && String.sub str 0 7 = "/dev/sd" then
               pr "      expected[5] = devchar;\n";
             pr "      if (strcmp (r[%d], expected) != 0) {\n" i;
             pr "        fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
             pr "        return -1;\n";
             pr "      }\n";
             pr "    }\n"
         ) expected;
         pr "    if (r[%d] != NULL) {\n" (List.length expected);
         pr "      fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
           test_name;
         pr "      print_strings (r);\n";
         pr "      return -1;\n";
         pr "    }\n"
       in
       List.iter (generate_test_command_call test_name) seq;
       generate_test_command_call ~test test_name last
   | TestOutputInt (seq, expected) ->
       pr "  /* TestOutputInt for %s (%d) */\n" name i;
       let seq, last = get_seq_last seq in
       let test () =
         pr "    if (r != %d) {\n" expected;
         pr "      fprintf (stderr, \"%s: expected %d but got %%d\\n\","
           test_name expected;
         pr "               (int) r);\n";
         pr "      return -1;\n";
         pr "    }\n"
       in
       List.iter (generate_test_command_call test_name) seq;
       generate_test_command_call ~test test_name last
   | TestOutputTrue seq ->
       pr "  /* TestOutputTrue for %s (%d) */\n" name i;
       let seq, last = get_seq_last seq in
       let test () =
         pr "    if (!r) {\n";
         pr "      fprintf (stderr, \"%s: expected true, got false\\n\");\n"
           test_name;
         pr "      return -1;\n";
         pr "    }\n"
       in
       List.iter (generate_test_command_call test_name) seq;
       generate_test_command_call ~test test_name last
   | TestOutputFalse seq ->
       pr "  /* TestOutputFalse for %s (%d) */\n" name i;
       let seq, last = get_seq_last seq in
       let test () =
         pr "    if (r) {\n";
         pr "      fprintf (stderr, \"%s: expected false, got true\\n\");\n"
           test_name;
         pr "      return -1;\n";
         pr "    }\n"
       in
       List.iter (generate_test_command_call test_name) seq;
       generate_test_command_call ~test test_name last
   | TestOutputLength (seq, expected) ->
       pr "  /* TestOutputLength for %s (%d) */\n"