+Symbolic link
+
+=item 'r'
+
+Regular file
+
+=item 's'
+
+Socket
+
+=item 'u'
+
+Unknown file type
+
+=item '?'
+
+The L<readdir(3)> returned a C<d_type> field with an
+unexpected value
+
+=back
+
+This function is primarily intended for use by programs. To
+get a simple list of names, use C<guestfs_ls>. To get a printable
+directory for human consumption, use C<guestfs_ll>.");
+
+ ("sfdiskM", (RErr, [Device "device"; StringList "lines"]), 139, [DangerWillRobinson],
+ [],
+ "create partitions on a block device",
+ "\
+This is a simplified interface to the C<guestfs_sfdisk>
+command, where partition sizes are specified in megabytes
+only (rounded to the nearest cylinder) and you don't need
+to specify the cyls, heads and sectors parameters which
+were rarely if ever used anyway.
+
+See also: C<guestfs_sfdisk>, the L<sfdisk(8)> manpage
+and C<guestfs_part_disk>");
+
+ ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
+ [],
+ "determine file type inside a compressed file",
+ "\
+This command runs C<file> after first decompressing C<path>
+using C<method>.
+
+C<method> must be one of C<gzip>, C<compress> or C<bzip2>.
+
+Since 1.0.63, use C<guestfs_file> instead which can now
+process compressed files.");
+
+ ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [Optional "linuxxattrs"],
+ [],
+ "list extended attributes of a file or directory",
+ "\
+This call lists the extended attributes of the file or directory
+C<path>.
+
+At the system call level, this is a combination of the
+L<listxattr(2)> and L<getxattr(2)> calls.
+
+See also: C<guestfs_lgetxattrs>, L<attr(5)>.");
+
+ ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [Optional "linuxxattrs"],
+ [],
+ "list extended attributes of a file or directory",
+ "\
+This is the same as C<guestfs_getxattrs>, but if C<path>
+is a symbolic link, then it returns the extended attributes
+of the link itself.");
+
+ ("setxattr", (RErr, [String "xattr";
+ String "val"; Int "vallen"; (* will be BufferIn *)
+ Pathname "path"]), 143, [Optional "linuxxattrs"],
+ [],
+ "set extended attribute of a file or directory",
+ "\
+This call sets the extended attribute named C<xattr>
+of the file C<path> to the value C<val> (of length C<vallen>).
+The value is arbitrary 8 bit data.
+
+See also: C<guestfs_lsetxattr>, L<attr(5)>.");
+
+ ("lsetxattr", (RErr, [String "xattr";
+ String "val"; Int "vallen"; (* will be BufferIn *)
+ Pathname "path"]), 144, [Optional "linuxxattrs"],
+ [],
+ "set extended attribute of a file or directory",
+ "\
+This is the same as C<guestfs_setxattr>, but if C<path>
+is a symbolic link, then it sets an extended attribute
+of the link itself.");
+
+ ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [Optional "linuxxattrs"],
+ [],
+ "remove extended attribute of a file or directory",
+ "\
+This call removes the extended attribute named C<xattr>
+of the file C<path>.
+
+See also: C<guestfs_lremovexattr>, L<attr(5)>.");
+
+ ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [Optional "linuxxattrs"],
+ [],
+ "remove extended attribute of a file or directory",
+ "\
+This is the same as C<guestfs_removexattr>, but if C<path>
+is a symbolic link, then it removes an extended attribute
+of the link itself.");
+
+ ("mountpoints", (RHashtable "mps", []), 147, [],
+ [],
+ "show mountpoints",
+ "\
+This call is similar to C<guestfs_mounts>. That call returns
+a list of devices. This one returns a hash table (map) of
+device name to directory where the device is mounted.");
+
+ ("mkmountpoint", (RErr, [String "exemptpath"]), 148, [],
+ (* This is a special case: while you would expect a parameter
+ * of type "Pathname", that doesn't work, because it implies
+ * NEED_ROOT in the generated calling code in stubs.c, and
+ * this function cannot use NEED_ROOT.
+ *)
+ [],
+ "create a mountpoint",
+ "\
+C<guestfs_mkmountpoint> and C<guestfs_rmmountpoint> are
+specialized calls that can be used to create extra mountpoints
+before mounting the first filesystem.
+
+These calls are I<only> necessary in some very limited circumstances,
+mainly the case where you want to mount a mix of unrelated and/or
+read-only filesystems together.
+
+For example, live CDs often contain a \"Russian doll\" nest of
+filesystems, an ISO outer layer, with a squashfs image inside, with
+an ext2/3 image inside that. You can unpack this as follows
+in guestfish:
+
+ add-ro Fedora-11-i686-Live.iso
+ run
+ mkmountpoint /cd
+ mkmountpoint /squash
+ mkmountpoint /ext3
+ mount /dev/sda /cd
+ mount-loop /cd/LiveOS/squashfs.img /squash
+ mount-loop /squash/LiveOS/ext3fs.img /ext3
+
+The inner filesystem is now unpacked under the /ext3 mountpoint.");
+
+ ("rmmountpoint", (RErr, [String "exemptpath"]), 149, [],
+ [],
+ "remove a mountpoint",
+ "\
+This calls removes a mountpoint that was previously created
+with C<guestfs_mkmountpoint>. See C<guestfs_mkmountpoint>
+for full details.");
+
+ ("read_file", (RBufferOut "content", [Pathname "path"]), 150, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputBuffer (
+ [["read_file"; "/known-4"]], "abc\ndef\nghi")],
+ "read a file",
+ "\
+This calls returns the contents of the file C<path> as a
+buffer.
+
+Unlike C<guestfs_cat>, this function can correctly
+handle files that contain embedded ASCII NUL characters.
+However unlike C<guestfs_download>, this function is limited
+in the total size of file that can be handled.");
+
+ ("grep", (RStringList "lines", [String "regex"; Pathname "path"]), 151, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputList (
+ [["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
+ InitISOFS, Always, TestOutputList (
+ [["grep"; "nomatch"; "/test-grep.txt"]], [])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<grep> program and returns the
+matching lines.");
+
+ ("egrep", (RStringList "lines", [String "regex"; Pathname "path"]), 152, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputList (
+ [["egrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<egrep> program and returns the
+matching lines.");
+
+ ("fgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 153, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputList (
+ [["fgrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<fgrep> program and returns the
+matching lines.");
+
+ ("grepi", (RStringList "lines", [String "regex"; Pathname "path"]), 154, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputList (
+ [["grepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<grep -i> program and returns the
+matching lines.");
+
+ ("egrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 155, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputList (
+ [["egrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<egrep -i> program and returns the
+matching lines.");
+
+ ("fgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 156, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputList (
+ [["fgrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<fgrep -i> program and returns the
+matching lines.");
+
+ ("zgrep", (RStringList "lines", [String "regex"; Pathname "path"]), 157, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputList (
+ [["zgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<zgrep> program and returns the
+matching lines.");
+
+ ("zegrep", (RStringList "lines", [String "regex"; Pathname "path"]), 158, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputList (
+ [["zegrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<zegrep> program and returns the
+matching lines.");
+
+ ("zfgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 159, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputList (
+ [["zfgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<zfgrep> program and returns the
+matching lines.");
+
+ ("zgrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 160, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputList (
+ [["zgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<zgrep -i> program and returns the
+matching lines.");
+
+ ("zegrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 161, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputList (
+ [["zegrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<zegrep -i> program and returns the
+matching lines.");
+
+ ("zfgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 162, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputList (
+ [["zfgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<zfgrep -i> program and returns the
+matching lines.");
+
+ ("realpath", (RString "rpath", [Pathname "path"]), 163, [Optional "realpath"],
+ [InitISOFS, Always, TestOutput (
+ [["realpath"; "/../directory"]], "/directory")],
+ "canonicalized absolute pathname",
+ "\
+Return the canonicalized absolute pathname of C<path>. The
+returned path has no C<.>, C<..> or symbolic link path elements.");
+
+ ("ln", (RErr, [String "target"; Pathname "linkname"]), 164, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["touch"; "/a"];
+ ["ln"; "/a"; "/b"];
+ ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
+ "create a hard link",
+ "\
+This command creates a hard link using the C<ln> command.");
+
+ ("ln_f", (RErr, [String "target"; Pathname "linkname"]), 165, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["touch"; "/a"];
+ ["touch"; "/b"];
+ ["ln_f"; "/a"; "/b"];
+ ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
+ "create a hard link",
+ "\
+This command creates a hard link using the C<ln -f> command.
+The C<-f> option removes the link (C<linkname>) if it exists already.");
+
+ ("ln_s", (RErr, [String "target"; Pathname "linkname"]), 166, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["touch"; "/a"];
+ ["ln_s"; "a"; "/b"];
+ ["lstat"; "/b"]], [CompareWithInt ("mode", 0o120777)])],
+ "create a symbolic link",
+ "\
+This command creates a symbolic link using the C<ln -s> command.");
+
+ ("ln_sf", (RErr, [String "target"; Pathname "linkname"]), 167, [],
+ [InitBasicFS, Always, TestOutput (
+ [["mkdir_p"; "/a/b"];
+ ["touch"; "/a/b/c"];
+ ["ln_sf"; "../d"; "/a/b/c"];
+ ["readlink"; "/a/b/c"]], "../d")],
+ "create a symbolic link",
+ "\
+This command creates a symbolic link using the C<ln -sf> command,
+The C<-f> option removes the link (C<linkname>) if it exists already.");
+
+ ("readlink", (RString "link", [Pathname "path"]), 168, [],
+ [] (* XXX tested above *),
+ "read the target of a symbolic link",
+ "\
+This command reads the target of a symbolic link.");
+
+ ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["fallocate"; "/a"; "1000000"];
+ ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
+ "preallocate a file in the guest filesystem",
+ "\
+This command preallocates a file (containing zero bytes) named
+C<path> of size C<len> bytes. If the file exists already, it
+is overwritten.
+
+Do not confuse this with the guestfish-specific
+C<alloc> command which allocates a file in the host and
+attaches it as a device.");
+
+ ("swapon_device", (RErr, [Device "device"]), 170, [],
+ [InitPartition, Always, TestRun (
+ [["mkswap"; "/dev/sda1"];
+ ["swapon_device"; "/dev/sda1"];
+ ["swapoff_device"; "/dev/sda1"]])],
+ "enable swap on device",
+ "\
+This command enables the libguestfs appliance to use the
+swap device or partition named C<device>. The increased
+memory is made available for all commands, for example
+those run using C<guestfs_command> or C<guestfs_sh>.
+
+Note that you should not swap to existing guest swap
+partitions unless you know what you are doing. They may
+contain hibernation information, or other information that
+the guest doesn't want you to trash. You also risk leaking
+information about the host to the guest this way. Instead,
+attach a new host device to the guest and swap on that.");
+
+ ("swapoff_device", (RErr, [Device "device"]), 171, [],
+ [], (* XXX tested by swapon_device *)
+ "disable swap on device",
+ "\
+This command disables the libguestfs appliance swap
+device or partition named C<device>.
+See C<guestfs_swapon_device>.");
+
+ ("swapon_file", (RErr, [Pathname "file"]), 172, [],
+ [InitBasicFS, Always, TestRun (
+ [["fallocate"; "/swap"; "8388608"];
+ ["mkswap_file"; "/swap"];
+ ["swapon_file"; "/swap"];
+ ["swapoff_file"; "/swap"]])],
+ "enable swap on file",
+ "\
+This command enables swap to a file.
+See C<guestfs_swapon_device> for other notes.");
+
+ ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
+ [], (* XXX tested by swapon_file *)
+ "disable swap on file",
+ "\
+This command disables the libguestfs appliance swap on file.");
+
+ ("swapon_label", (RErr, [String "label"]), 174, [],
+ [InitEmpty, Always, TestRun (
+ [["part_disk"; "/dev/sdb"; "mbr"];
+ ["mkswap_L"; "swapit"; "/dev/sdb1"];
+ ["swapon_label"; "swapit"];
+ ["swapoff_label"; "swapit"];
+ ["zero"; "/dev/sdb"];
+ ["blockdev_rereadpt"; "/dev/sdb"]])],
+ "enable swap on labeled swap partition",
+ "\
+This command enables swap to a labeled swap partition.
+See C<guestfs_swapon_device> for other notes.");
+
+ ("swapoff_label", (RErr, [String "label"]), 175, [],
+ [], (* XXX tested by swapon_label *)
+ "disable swap on labeled swap partition",
+ "\
+This command disables the libguestfs appliance swap on
+labeled swap partition.");
+
+ ("swapon_uuid", (RErr, [String "uuid"]), 176, [Optional "linuxfsuuid"],
+ (let uuid = uuidgen () in
+ [InitEmpty, Always, TestRun (
+ [["mkswap_U"; uuid; "/dev/sdb"];
+ ["swapon_uuid"; uuid];
+ ["swapoff_uuid"; uuid]])]),
+ "enable swap on swap partition by UUID",
+ "\
+This command enables swap to a swap partition with the given UUID.
+See C<guestfs_swapon_device> for other notes.");
+
+ ("swapoff_uuid", (RErr, [String "uuid"]), 177, [Optional "linuxfsuuid"],
+ [], (* XXX tested by swapon_uuid *)
+ "disable swap on swap partition by UUID",
+ "\
+This command disables the libguestfs appliance swap partition
+with the given UUID.");
+
+ ("mkswap_file", (RErr, [Pathname "path"]), 178, [],
+ [InitBasicFS, Always, TestRun (
+ [["fallocate"; "/swap"; "8388608"];
+ ["mkswap_file"; "/swap"]])],
+ "create a swap file",
+ "\
+Create a swap file.
+
+This command just writes a swap file signature to an existing
+file. To create the file itself, use something like C<guestfs_fallocate>.");
+
+ ("inotify_init", (RErr, [Int "maxevents"]), 179, [Optional "inotify"],
+ [InitISOFS, Always, TestRun (
+ [["inotify_init"; "0"]])],
+ "create an inotify handle",
+ "\
+This command creates a new inotify handle.
+The inotify subsystem can be used to notify events which happen to
+objects in the guest filesystem.
+
+C<maxevents> is the maximum number of events which will be
+queued up between calls to C<guestfs_inotify_read> or
+C<guestfs_inotify_files>.
+If this is passed as C<0>, then the kernel (or previously set)
+default is used. For Linux 2.6.29 the default was 16384 events.
+Beyond this limit, the kernel throws away events, but records
+the fact that it threw them away by setting a flag
+C<IN_Q_OVERFLOW> in the returned structure list (see
+C<guestfs_inotify_read>).
+
+Before any events are generated, you have to add some
+watches to the internal watch list. See:
+C<guestfs_inotify_add_watch>,
+C<guestfs_inotify_rm_watch> and
+C<guestfs_inotify_watch_all>.
+
+Queued up events should be read periodically by calling
+C<guestfs_inotify_read>
+(or C<guestfs_inotify_files> which is just a helpful
+wrapper around C<guestfs_inotify_read>). If you don't
+read the events out often enough then you risk the internal
+queue overflowing.
+
+The handle should be closed after use by calling
+C<guestfs_inotify_close>. This also removes any
+watches automatically.
+
+See also L<inotify(7)> for an overview of the inotify interface
+as exposed by the Linux kernel, which is roughly what we expose
+via libguestfs. Note that there is one global inotify handle
+per libguestfs instance.");
+
+ ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [Optional "inotify"],
+ [InitBasicFS, Always, TestOutputList (
+ [["inotify_init"; "0"];
+ ["inotify_add_watch"; "/"; "1073741823"];
+ ["touch"; "/a"];
+ ["touch"; "/b"];
+ ["inotify_files"]], ["a"; "b"])],
+ "add an inotify watch",
+ "\
+Watch C<path> for the events listed in C<mask>.
+
+Note that if C<path> is a directory then events within that
+directory are watched, but this does I<not> happen recursively
+(in subdirectories).
+
+Note for non-C or non-Linux callers: the inotify events are
+defined by the Linux kernel ABI and are listed in
+C</usr/include/sys/inotify.h>.");
+
+ ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [Optional "inotify"],
+ [],
+ "remove an inotify watch",
+ "\
+Remove a previously defined inotify watch.
+See C<guestfs_inotify_add_watch>.");
+
+ ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [Optional "inotify"],
+ [],
+ "return list of inotify events",
+ "\
+Return the complete queue of events that have happened
+since the previous read call.
+
+If no events have happened, this returns an empty list.
+
+I<Note>: In order to make sure that all events have been
+read, you must call this function repeatedly until it
+returns an empty list. The reason is that the call will
+read events up to the maximum appliance-to-host message
+size and leave remaining events in the queue.");
+
+ ("inotify_files", (RStringList "paths", []), 183, [Optional "inotify"],
+ [],
+ "return list of watched files that had events",
+ "\
+This function is a helpful wrapper around C<guestfs_inotify_read>
+which just returns a list of pathnames of objects that were
+touched. The returned pathnames are sorted and deduplicated.");
+
+ ("inotify_close", (RErr, []), 184, [Optional "inotify"],
+ [],
+ "close the inotify handle",
+ "\
+This closes the inotify handle which was previously
+opened by inotify_init. It removes all watches, throws
+away any pending events, and deallocates all resources.");
+
+ ("setcon", (RErr, [String "context"]), 185, [Optional "selinux"],
+ [],
+ "set SELinux security context",
+ "\
+This sets the SELinux security context of the daemon
+to the string C<context>.
+
+See the documentation about SELINUX in L<guestfs(3)>.");
+
+ ("getcon", (RString "context", []), 186, [Optional "selinux"],
+ [],
+ "get SELinux security context",
+ "\
+This gets the SELinux security context of the daemon.
+
+See the documentation about SELINUX in L<guestfs(3)>,
+and C<guestfs_setcon>");
+
+ ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
+ [InitEmpty, Always, TestOutput (
+ [["part_disk"; "/dev/sda"; "mbr"];
+ ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
+ ["mount_options"; ""; "/dev/sda1"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "make a filesystem with block size",
+ "\
+This call is similar to C<guestfs_mkfs>, but it allows you to
+control the block size of the resulting filesystem. Supported
+block sizes depend on the filesystem type, but typically they
+are C<1024>, C<2048> or C<4096> only.");
+
+ ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ",100 ,"];
+ ["mke2journal"; "4096"; "/dev/sda1"];
+ ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
+ ["mount_options"; ""; "/dev/sda2"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "make ext2/3/4 external journal",
+ "\
+This creates an ext2 external journal on C<device>. It is equivalent
+to the command:
+
+ mke2fs -O journal_dev -b blocksize device");
+
+ ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ",100 ,"];
+ ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
+ ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
+ ["mount_options"; ""; "/dev/sda2"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "make ext2/3/4 external journal with label",
+ "\
+This creates an ext2 external journal on C<device> with label C<label>.");
+
+ ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [Optional "linuxfsuuid"],
+ (let uuid = uuidgen () in
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ",100 ,"];
+ ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
+ ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
+ ["mount_options"; ""; "/dev/sda2"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")]),
+ "make ext2/3/4 external journal with UUID",
+ "\
+This creates an ext2 external journal on C<device> with UUID C<uuid>.");
+
+ ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
+ [],
+ "make ext2/3/4 filesystem with external journal",
+ "\
+This creates an ext2/3/4 filesystem on C<device> with
+an external journal on C<journal>. It is equivalent
+to the command:
+
+ mke2fs -t fstype -b blocksize -J device=<journal> <device>
+
+See also C<guestfs_mke2journal>.");
+
+ ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
+ [],
+ "make ext2/3/4 filesystem with external journal",
+ "\
+This creates an ext2/3/4 filesystem on C<device> with
+an external journal on the journal labeled C<label>.
+
+See also C<guestfs_mke2journal_L>.");
+
+ ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [Optional "linuxfsuuid"],
+ [],
+ "make ext2/3/4 filesystem with external journal",
+ "\
+This creates an ext2/3/4 filesystem on C<device> with
+an external journal on the journal with UUID C<uuid>.
+
+See also C<guestfs_mke2journal_U>.");
+
+ ("modprobe", (RErr, [String "modulename"]), 194, [Optional "linuxmodules"],
+ [InitNone, Always, TestRun [["modprobe"; "fat"]]],
+ "load a kernel module",
+ "\
+This loads a kernel module in the appliance.
+
+The kernel module must have been whitelisted when libguestfs
+was built (see C<appliance/kmod.whitelist.in> in the source).");
+
+ ("echo_daemon", (RString "output", [StringList "words"]), 195, [],
+ [InitNone, Always, TestOutput (
+ [["echo_daemon"; "This is a test"]], "This is a test"
+ )],
+ "echo arguments back to the client",
+ "\
+This command concatenate the list of C<words> passed with single spaces between
+them and returns the resulting string.
+
+You can use this command to test the connection through to the daemon.
+
+See also C<guestfs_ping_daemon>.");
+
+ ("find0", (RErr, [Pathname "directory"; FileOut "files"]), 196, [],
+ [], (* There is a regression test for this. *)
+ "find all files and directories, returning NUL-separated list",
+ "\
+This command lists out all files and directories, recursively,
+starting at C<directory>, placing the resulting list in the
+external file called C<files>.
+
+This command works the same way as C<guestfs_find> with the
+following exceptions:
+
+=over 4
+
+=item *
+
+The resulting list is written to an external file.
+
+=item *
+
+Items (filenames) in the result are separated
+by C<\\0> characters. See L<find(1)> option I<-print0>.
+
+=item *
+
+This command is not limited in the number of names that it
+can return.
+
+=item *
+
+The result list is not sorted.
+
+=back");
+
+ ("case_sensitive_path", (RString "rpath", [Pathname "path"]), 197, [],
+ [InitISOFS, Always, TestOutput (
+ [["case_sensitive_path"; "/DIRECTORY"]], "/directory");
+ InitISOFS, Always, TestOutput (
+ [["case_sensitive_path"; "/DIRECTORY/"]], "/directory");
+ InitISOFS, Always, TestOutput (
+ [["case_sensitive_path"; "/Known-1"]], "/known-1");
+ InitISOFS, Always, TestLastFail (
+ [["case_sensitive_path"; "/Known-1/"]]);
+ InitBasicFS, Always, TestOutput (
+ [["mkdir"; "/a"];
+ ["mkdir"; "/a/bbb"];
+ ["touch"; "/a/bbb/c"];
+ ["case_sensitive_path"; "/A/bbB/C"]], "/a/bbb/c");
+ InitBasicFS, Always, TestOutput (
+ [["mkdir"; "/a"];
+ ["mkdir"; "/a/bbb"];
+ ["touch"; "/a/bbb/c"];
+ ["case_sensitive_path"; "/A////bbB/C"]], "/a/bbb/c");
+ InitBasicFS, Always, TestLastFail (
+ [["mkdir"; "/a"];
+ ["mkdir"; "/a/bbb"];
+ ["touch"; "/a/bbb/c"];
+ ["case_sensitive_path"; "/A/bbb/../bbb/C"]])],
+ "return true path on case-insensitive filesystem",
+ "\
+This can be used to resolve case insensitive paths on
+a filesystem which is case sensitive. The use case is
+to resolve paths which you have read from Windows configuration
+files or the Windows Registry, to the true path.
+
+The command handles a peculiarity of the Linux ntfs-3g
+filesystem driver (and probably others), which is that although
+the underlying filesystem is case-insensitive, the driver
+exports the filesystem to Linux as case-sensitive.
+
+One consequence of this is that special directories such
+as C<c:\\windows> may appear as C</WINDOWS> or C</windows>
+(or other things) depending on the precise details of how
+they were created. In Windows itself this would not be
+a problem.
+
+Bug or feature? You decide:
+L<http://www.tuxera.com/community/ntfs-3g-faq/#posixfilenames1>
+
+This function resolves the true case of each element in the
+path and returns the case-sensitive path.
+
+Thus C<guestfs_case_sensitive_path> (\"/Windows/System32\")
+might return C<\"/WINDOWS/system32\"> (the exact return value
+would depend on details of how the directories were originally
+created under Windows).
+
+I<Note>:
+This function does not handle drive names, backslashes etc.
+
+See also C<guestfs_realpath>.");
+
+ ("vfs_type", (RString "fstype", [Device "device"]), 198, [],
+ [InitBasicFS, Always, TestOutput (
+ [["vfs_type"; "/dev/sda1"]], "ext2")],
+ "get the Linux VFS type corresponding to a mounted device",
+ "\
+This command gets the block device type corresponding to
+a mounted device called C<device>.
+
+Usually the result is the name of the Linux VFS module that
+is used to mount this device (probably determined automatically
+if you used the C<guestfs_mount> call).");
+
+ ("truncate", (RErr, [Pathname "path"]), 199, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["write_file"; "/test"; "some stuff so size is not zero"; "0"];
+ ["truncate"; "/test"];
+ ["stat"; "/test"]], [CompareWithInt ("size", 0)])],
+ "truncate a file to zero size",
+ "\
+This command truncates C<path> to a zero-length file. The
+file must exist already.");
+
+ ("truncate_size", (RErr, [Pathname "path"; Int64 "size"]), 200, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["touch"; "/test"];
+ ["truncate_size"; "/test"; "1000"];
+ ["stat"; "/test"]], [CompareWithInt ("size", 1000)])],
+ "truncate a file to a particular size",
+ "\
+This command truncates C<path> to size C<size> bytes. The file
+must exist already. If the file is smaller than C<size> then
+the file is extended to the required size with null bytes.");
+
+ ("utimens", (RErr, [Pathname "path"; Int64 "atsecs"; Int64 "atnsecs"; Int64 "mtsecs"; Int64 "mtnsecs"]), 201, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["touch"; "/test"];
+ ["utimens"; "/test"; "12345"; "67890"; "9876"; "5432"];
+ ["stat"; "/test"]], [CompareWithInt ("mtime", 9876)])],
+ "set timestamp of a file with nanosecond precision",
+ "\
+This command sets the timestamps of a file with nanosecond
+precision.
+
+C<atsecs, atnsecs> are the last access time (atime) in secs and
+nanoseconds from the epoch.
+
+C<mtsecs, mtnsecs> are the last modification time (mtime) in
+secs and nanoseconds from the epoch.
+
+If the C<*nsecs> field contains the special value C<-1> then
+the corresponding timestamp is set to the current time. (The
+C<*secs> field is ignored in this case).
+
+If the C<*nsecs> field contains the special value C<-2> then
+the corresponding timestamp is left unchanged. (The
+C<*secs> field is ignored in this case).");
+
+ ("mkdir_mode", (RErr, [Pathname "path"; Int "mode"]), 202, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["mkdir_mode"; "/test"; "0o111"];
+ ["stat"; "/test"]], [CompareWithInt ("mode", 0o40111)])],
+ "create a directory with a particular mode",
+ "\
+This command creates a directory, setting the initial permissions
+of the directory to C<mode>. See also C<guestfs_mkdir>.");
+
+ ("lchown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 203, [],
+ [], (* XXX *)
+ "change file owner and group",
+ "\
+Change the file owner to C<owner> and group to C<group>.
+This is like C<guestfs_chown> but if C<path> is a symlink then
+the link itself is changed, not the target.
+
+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).");
+
+ ("lstatlist", (RStructList ("statbufs", "stat"), [Pathname "path"; StringList "names"]), 204, [],
+ [], (* XXX *)
+ "lstat on multiple files",
+ "\
+This call allows you to perform the C<guestfs_lstat> operation
+on multiple files, where all files are in the directory C<path>.
+C<names> is the list of files from this directory.
+
+On return you get a list of stat structs, with a one-to-one
+correspondence to the C<names> list. If any name did not exist
+or could not be lstat'd, then the C<ino> field of that structure
+is set to C<-1>.
+
+This call is intended for programs that want to efficiently
+list a directory contents without making many round-trips.
+See also C<guestfs_lxattrlist> for a similarly efficient call
+for getting extended attributes. Very long directory listings
+might cause the protocol message size to be exceeded, causing
+this call to fail. The caller must split up such requests
+into smaller groups of names.");
+
+ ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [Optional "linuxxattrs"],
+ [], (* XXX *)
+ "lgetxattr on multiple files",
+ "\
+This call allows you to get the extended attributes
+of multiple files, where all files are in the directory C<path>.
+C<names> is the list of files from this directory.
+
+On return you get a flat list of xattr structs which must be
+interpreted sequentially. The first xattr struct always has a zero-length
+C<attrname>. C<attrval> in this struct is zero-length
+to indicate there was an error doing C<lgetxattr> for this
+file, I<or> is a C string which is a decimal number
+(the number of following attributes for this file, which could
+be C<\"0\">). Then after the first xattr struct are the
+zero or more attributes for the first named file.
+This repeats for the second and subsequent files.
+
+This call is intended for programs that want to efficiently
+list a directory contents without making many round-trips.
+See also C<guestfs_lstatlist> for a similarly efficient call
+for getting standard stats. Very long directory listings
+might cause the protocol message size to be exceeded, causing
+this call to fail. The caller must split up such requests
+into smaller groups of names.");
+
+ ("readlinklist", (RStringList "links", [Pathname "path"; StringList "names"]), 206, [],
+ [], (* XXX *)
+ "readlink on multiple files",
+ "\
+This call allows you to do a C<readlink> operation
+on multiple files, where all files are in the directory C<path>.
+C<names> is the list of files from this directory.
+
+On return you get a list of strings, with a one-to-one
+correspondence to the C<names> list. Each string is the
+value of the symbol link.
+
+If the C<readlink(2)> operation fails on any name, then
+the corresponding result string is the empty string C<\"\">.
+However the whole operation is completed even if there
+were C<readlink(2)> errors, and so you can call this
+function with names where you don't know if they are
+symbolic links already (albeit slightly less efficient).
+
+This call is intended for programs that want to efficiently
+list a directory contents without making many round-trips.
+Very long directory listings might cause the protocol
+message size to be exceeded, causing
+this call to fail. The caller must split up such requests
+into smaller groups of names.");
+
+ ("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputBuffer (
+ [["pread"; "/known-4"; "1"; "3"]], "\n");
+ InitISOFS, Always, TestOutputBuffer (
+ [["pread"; "/empty"; "0"; "100"]], "")],
+ "read part of a file",
+ "\
+This command lets you read part of a file. It reads C<count>
+bytes of the file, starting at C<offset>, from file C<path>.
+
+This may read fewer bytes than requested. For further details
+see the L<pread(2)> system call.");
+
+ ("part_init", (RErr, [Device "device"; String "parttype"]), 208, [],
+ [InitEmpty, Always, TestRun (
+ [["part_init"; "/dev/sda"; "gpt"]])],
+ "create an empty partition table",
+ "\
+This creates an empty partition table on C<device> of one of the
+partition types listed below. Usually C<parttype> should be
+either C<msdos> or C<gpt> (for large disks).
+
+Initially there are no partitions. Following this, you should
+call C<guestfs_part_add> for each partition required.
+
+Possible values for C<parttype> are:
+
+=over 4
+
+=item B<efi> | B<gpt>
+
+Intel EFI / GPT partition table.
+
+This is recommended for >= 2 TB partitions that will be accessed
+from Linux and Intel-based Mac OS X. It also has limited backwards
+compatibility with the C<mbr> format.
+
+=item B<mbr> | B<msdos>
+
+The standard PC \"Master Boot Record\" (MBR) format used
+by MS-DOS and Windows. This partition type will B<only> work
+for device sizes up to 2 TB. For large disks we recommend
+using C<gpt>.
+
+=back
+
+Other partition table types that may work but are not
+supported include:
+
+=over 4
+
+=item B<aix>
+
+AIX disk labels.
+
+=item B<amiga> | B<rdb>
+
+Amiga \"Rigid Disk Block\" format.
+
+=item B<bsd>
+
+BSD disk labels.
+
+=item B<dasd>
+
+DASD, used on IBM mainframes.
+
+=item B<dvh>
+
+MIPS/SGI volumes.
+
+=item B<mac>
+
+Old Mac partition format. Modern Macs use C<gpt>.
+
+=item B<pc98>
+
+NEC PC-98 format, common in Japan apparently.
+
+=item B<sun>
+
+Sun disk labels.
+
+=back");
+
+ ("part_add", (RErr, [Device "device"; String "prlogex"; Int64 "startsect"; Int64 "endsect"]), 209, [],
+ [InitEmpty, Always, TestRun (
+ [["part_init"; "/dev/sda"; "mbr"];
+ ["part_add"; "/dev/sda"; "primary"; "1"; "-1"]]);
+ InitEmpty, Always, TestRun (
+ [["part_init"; "/dev/sda"; "gpt"];
+ ["part_add"; "/dev/sda"; "primary"; "34"; "127"];
+ ["part_add"; "/dev/sda"; "primary"; "128"; "-34"]]);
+ InitEmpty, Always, TestRun (
+ [["part_init"; "/dev/sda"; "mbr"];
+ ["part_add"; "/dev/sda"; "primary"; "32"; "127"];
+ ["part_add"; "/dev/sda"; "primary"; "128"; "255"];
+ ["part_add"; "/dev/sda"; "primary"; "256"; "511"];
+ ["part_add"; "/dev/sda"; "primary"; "512"; "-1"]])],
+ "add a partition to the device",
+ "\
+This command adds a partition to C<device>. If there is no partition
+table on the device, call C<guestfs_part_init> first.
+
+The C<prlogex> parameter is the type of partition. Normally you
+should pass C<p> or C<primary> here, but MBR partition tables also
+support C<l> (or C<logical>) and C<e> (or C<extended>) partition
+types.
+
+C<startsect> and C<endsect> are the start and end of the partition
+in I<sectors>. C<endsect> may be negative, which means it counts
+backwards from the end of the disk (C<-1> is the last sector).
+
+Creating a partition which covers the whole disk is not so easy.
+Use C<guestfs_part_disk> to do that.");
+
+ ("part_disk", (RErr, [Device "device"; String "parttype"]), 210, [DangerWillRobinson],
+ [InitEmpty, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "mbr"]]);
+ InitEmpty, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "gpt"]])],
+ "partition whole disk with a single primary partition",
+ "\
+This command is simply a combination of C<guestfs_part_init>
+followed by C<guestfs_part_add> to create a single primary partition
+covering the whole disk.
+
+C<parttype> is the partition table type, usually C<mbr> or C<gpt>,
+but other possible values are described in C<guestfs_part_init>.");
+
+ ("part_set_bootable", (RErr, [Device "device"; Int "partnum"; Bool "bootable"]), 211, [],
+ [InitEmpty, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "mbr"];
+ ["part_set_bootable"; "/dev/sda"; "1"; "true"]])],
+ "make a partition bootable",
+ "\
+This sets the bootable flag on partition numbered C<partnum> on
+device C<device>. Note that partitions are numbered from 1.
+
+The bootable flag is used by some PC BIOSes to determine which
+partition to boot from. It is by no means universally recognized,
+and in any case if your operating system installed a boot
+sector on the device itself, then that takes precedence.");
+
+ ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [],
+ [InitEmpty, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "gpt"];
+ ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])],
+ "set partition name",
+ "\
+This sets the partition name on partition numbered C<partnum> on
+device C<device>. Note that partitions are numbered from 1.
+
+The partition name can only be set on certain types of partition
+table. This works on C<gpt> but not on C<mbr> partitions.");
+
+ ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [],
+ [], (* XXX Add a regression test for this. *)
+ "list partitions on a device",
+ "\
+This command parses the partition table on C<device> and
+returns the list of partitions found.
+
+The fields in the returned structure are:
+
+=over 4
+
+=item B<part_num>
+
+Partition number, counting from 1.
+
+=item B<part_start>
+
+Start of the partition I<in bytes>. To get sectors you have to
+divide by the device's sector size, see C<guestfs_blockdev_getss>.
+
+=item B<part_end>
+
+End of the partition in bytes.
+
+=item B<part_size>
+
+Size of the partition in bytes.
+
+=back");
+
+ ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [],
+ [InitEmpty, Always, TestOutput (
+ [["part_disk"; "/dev/sda"; "gpt"];
+ ["part_get_parttype"; "/dev/sda"]], "gpt")],
+ "get the partition table type",
+ "\
+This command examines the partition table on C<device> and
+returns the partition table type (format) being used.
+
+Common return values include: C<msdos> (a DOS/Windows style MBR
+partition table), C<gpt> (a GPT/EFI-style partition table). Other
+values are possible, although unusual. See C<guestfs_part_init>
+for a full list.");
+
+ ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
+ [InitBasicFS, Always, TestOutputBuffer (
+ [["fill"; "0x63"; "10"; "/test"];
+ ["read_file"; "/test"]], "cccccccccc")],
+ "fill a file with octets",
+ "\
+This command creates a new file called C<path>. The initial
+content of the file is C<len> octets of C<c>, where C<c>
+must be a number in the range C<[0..255]>.
+
+To fill a file with zero bytes (sparsely), it is
+much more efficient to use C<guestfs_truncate_size>.");
+
+ ("available", (RErr, [StringList "groups"]), 216, [],
+ [InitNone, Always, TestRun [["available"; ""]]],
+ "test availability of some parts of the API",
+ "\
+This command is used to check the availability of some
+groups of functionality in the appliance, which not all builds of
+the libguestfs appliance will be able to provide.
+
+The libguestfs groups, and the functions that those
+groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
+
+The argument C<groups> is a list of group names, eg:
+C<[\"inotify\", \"augeas\"]> would check for the availability of
+the Linux inotify functions and Augeas (configuration file
+editing) functions.
+
+The command returns no error if I<all> requested groups are available.
+
+It fails with an error if one or more of the requested
+groups is unavailable in the appliance.
+
+If an unknown group name is included in the
+list of groups then an error is always returned.
+
+I<Notes:>
+
+=over 4
+
+=item *
+
+You must call C<guestfs_launch> before calling this function.
+
+The reason is because we don't know what groups are
+supported by the appliance/daemon until it is running and can
+be queried.
+
+=item *
+
+If a group of functions is available, this does not necessarily
+mean that they will work. You still have to check for errors
+when calling individual API functions even if they are
+available.
+
+=item *
+
+It is usually the job of distro packagers to build
+complete functionality into the libguestfs appliance.
+Upstream libguestfs, if built from source with all
+requirements satisfied, will support everything.
+
+=item *
+
+This call was added in version C<1.0.80>. In previous
+versions of libguestfs all you could do would be to speculatively
+execute a command to find out if the daemon implemented it.
+See also C<guestfs_version>.
+
+=back");
+
+ ("dd", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"]), 217, [],
+ [InitBasicFS, Always, TestOutputBuffer (
+ [["write_file"; "/src"; "hello, world"; "0"];
+ ["dd"; "/src"; "/dest"];
+ ["read_file"; "/dest"]], "hello, world")],
+ "copy from source to destination using dd",
+ "\
+This command copies from one source device or file C<src>
+to another destination device or file C<dest>. Normally you
+would use this to copy to or from a device or partition, for
+example to duplicate a filesystem.
+
+If the destination is a device, it must be as large or larger
+than the source file or device, otherwise the copy will fail.
+This command cannot do partial copies.");
+
+ ("filesize", (RInt64 "size", [Pathname "file"]), 218, [],
+ [InitBasicFS, Always, TestOutputInt (
+ [["write_file"; "/file"; "hello, world"; "0"];
+ ["filesize"; "/file"]], 12)],
+ "return the size of the file in bytes",
+ "\
+This command returns the size of C<file> in bytes.
+
+To get other stats about a file, use C<guestfs_stat>, C<guestfs_lstat>,
+C<guestfs_is_dir>, C<guestfs_is_file> etc.
+To get the size of block devices, use C<guestfs_blockdev_getsize64>.");
+
+ ("lvrename", (RErr, [String "logvol"; String "newlogvol"]), 219, [],
+ [InitBasicFSonLVM, Always, TestOutputList (
+ [["lvrename"; "/dev/VG/LV"; "/dev/VG/LV2"];
+ ["lvs"]], ["/dev/VG/LV2"])],
+ "rename an LVM logical volume",
+ "\
+Rename a logical volume C<logvol> with the new name C<newlogvol>.");
+
+ ("vgrename", (RErr, [String "volgroup"; String "newvolgroup"]), 220, [],
+ [InitBasicFSonLVM, Always, TestOutputList (
+ [["umount"; "/"];
+ ["vg_activate"; "false"; "VG"];
+ ["vgrename"; "VG"; "VG2"];
+ ["vg_activate"; "true"; "VG2"];
+ ["mount_options"; ""; "/dev/VG2/LV"; "/"];
+ ["vgs"]], ["VG2"])],
+ "rename an LVM volume group",
+ "\
+Rename a volume group C<volgroup> with the new name C<newvolgroup>.");
+
+ ("initrd_cat", (RBufferOut "content", [Pathname "initrdpath"; String "filename"]), 221, [],
+ [InitISOFS, Always, TestOutputBuffer (
+ [["initrd_cat"; "/initrd"; "known-4"]], "abc\ndef\nghi")],
+ "list the contents of a single file in an initrd",
+ "\
+This command unpacks the file C<filename> from the initrd file
+called C<initrdpath>. The filename must be given I<without> the
+initial C</> character.
+
+For example, in guestfish you could use the following command
+to examine the boot script (usually called C</init>)
+contained in a Linux initrd or initramfs image:
+
+ initrd-cat /boot/initrd-<version>.img init
+
+See also C<guestfs_initrd_list>.");
+
+]
+
+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
+
+(* Field types for structures. *)
+type field =
+ | FChar (* C 'char' (really, a 7 bit byte). *)
+ | FString (* nul-terminated ASCII string, NOT NULL. *)
+ | FBuffer (* opaque buffer of bytes, (char *, int) pair *)
+ | FUInt32
+ | FInt32
+ | FUInt64
+ | FInt64
+ | FBytes (* Any int measure that counts bytes. *)
+ | FUUID (* 32 bytes long, NOT nul-terminated. *)
+ | FOptPercent (* [0..100], or -1 meaning "not present". *)
+
+(* Because we generate extra parsing code for LVM command line tools,
+ * we have to pull out the LVM columns separately here.
+ *)
+let lvm_pv_cols = [
+ "pv_name", FString;
+ "pv_uuid", FUUID;
+ "pv_fmt", FString;
+ "pv_size", FBytes;
+ "dev_size", FBytes;
+ "pv_free", FBytes;
+ "pv_used", FBytes;
+ "pv_attr", FString (* XXX *);
+ "pv_pe_count", FInt64;
+ "pv_pe_alloc_count", FInt64;
+ "pv_tags", FString;
+ "pe_start", FBytes;
+ "pv_mda_count", FInt64;
+ "pv_mda_free", FBytes;
+ (* Not in Fedora 10:
+ "pv_mda_size", FBytes;
+ *)
+]
+let lvm_vg_cols = [
+ "vg_name", FString;
+ "vg_uuid", FUUID;
+ "vg_fmt", FString;
+ "vg_attr", FString (* XXX *);
+ "vg_size", FBytes;
+ "vg_free", FBytes;
+ "vg_sysid", FString;
+ "vg_extent_size", FBytes;
+ "vg_extent_count", FInt64;
+ "vg_free_count", FInt64;
+ "max_lv", FInt64;
+ "max_pv", FInt64;
+ "pv_count", FInt64;
+ "lv_count", FInt64;
+ "snap_count", FInt64;
+ "vg_seqno", FInt64;
+ "vg_tags", FString;
+ "vg_mda_count", FInt64;
+ "vg_mda_free", FBytes;
+ (* Not in Fedora 10:
+ "vg_mda_size", FBytes;
+ *)
+]
+let lvm_lv_cols = [
+ "lv_name", FString;
+ "lv_uuid", FUUID;
+ "lv_attr", FString (* XXX *);
+ "lv_major", FInt64;
+ "lv_minor", FInt64;
+ "lv_kernel_major", FInt64;
+ "lv_kernel_minor", FInt64;
+ "lv_size", FBytes;
+ "seg_count", FInt64;
+ "origin", FString;
+ "snap_percent", FOptPercent;
+ "copy_percent", FOptPercent;
+ "move_pv", FString;
+ "lv_tags", FString;
+ "mirror_log", FString;
+ "modules", FString;
+]
+
+(* Names and fields in all structures (in RStruct and RStructList)
+ * that we support.
+ *)
+let structs = [
+ (* The old RIntBool return type, only ever used for aug_defnode. Do
+ * not use this struct in any new code.
+ *)
+ "int_bool", [
+ "i", FInt32; (* for historical compatibility *)
+ "b", FInt32; (* for historical compatibility *)
+ ];
+
+ (* LVM PVs, VGs, LVs. *)
+ "lvm_pv", lvm_pv_cols;
+ "lvm_vg", lvm_vg_cols;
+ "lvm_lv", lvm_lv_cols;
+
+ (* 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.
+ *)
+ "stat", [
+ "dev", FInt64;
+ "ino", FInt64;
+ "mode", FInt64;
+ "nlink", FInt64;
+ "uid", FInt64;
+ "gid", FInt64;
+ "rdev", FInt64;
+ "size", FInt64;
+ "blksize", FInt64;
+ "blocks", FInt64;
+ "atime", FInt64;
+ "mtime", FInt64;
+ "ctime", FInt64;
+ ];
+ "statvfs", [
+ "bsize", FInt64;
+ "frsize", FInt64;
+ "blocks", FInt64;
+ "bfree", FInt64;
+ "bavail", FInt64;
+ "files", FInt64;
+ "ffree", FInt64;
+ "favail", FInt64;
+ "fsid", FInt64;
+ "flag", FInt64;
+ "namemax", FInt64;
+ ];
+
+ (* Column names in dirent structure. *)
+ "dirent", [
+ "ino", FInt64;
+ (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *)
+ "ftyp", FChar;
+ "name", FString;
+ ];
+
+ (* Version numbers. *)
+ "version", [
+ "major", FInt64;
+ "minor", FInt64;
+ "release", FInt64;
+ "extra", FString;
+ ];
+
+ (* Extended attribute. *)
+ "xattr", [
+ "attrname", FString;
+ "attrval", FBuffer;
+ ];
+
+ (* Inotify events. *)
+ "inotify_event", [
+ "in_wd", FInt64;
+ "in_mask", FUInt32;
+ "in_cookie", FUInt32;
+ "in_name", FString;
+ ];
+
+ (* Partition table entry. *)
+ "partition", [
+ "part_num", FInt32;
+ "part_start", FBytes;
+ "part_end", FBytes;
+ "part_size", FBytes;
+ ];
+] (* end of structs *)
+
+(* Ugh, Java has to be different ..
+ * These names are also used by the Haskell bindings.
+ *)
+let java_structs = [
+ "int_bool", "IntBool";
+ "lvm_pv", "PV";
+ "lvm_vg", "VG";
+ "lvm_lv", "LV";
+ "stat", "Stat";
+ "statvfs", "StatVFS";
+ "dirent", "Dirent";
+ "version", "Version";
+ "xattr", "XAttr";
+ "inotify_event", "INotifyEvent";
+ "partition", "Partition";
+]
+
+(* What structs are actually returned. *)
+type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
+
+(* Returns a list of RStruct/RStructList structs that are returned
+ * by any function. Each element of returned list is a pair:
+ *
+ * (structname, RStructOnly)
+ * == there exists function which returns RStruct (_, structname)
+ * (structname, RStructListOnly)
+ * == there exists function which returns RStructList (_, structname)
+ * (structname, RStructAndList)
+ * == there are functions returning both RStruct (_, structname)
+ * and RStructList (_, structname)
+ *)
+let rstructs_used_by functions =
+ (* ||| is a "logical OR" for rstructs_used_t *)
+ let (|||) a b =
+ match a, b with
+ | RStructAndList, _
+ | _, RStructAndList -> RStructAndList
+ | RStructOnly, RStructListOnly
+ | RStructListOnly, RStructOnly -> RStructAndList
+ | RStructOnly, RStructOnly -> RStructOnly
+ | RStructListOnly, RStructListOnly -> RStructListOnly
+ in
+
+ let h = Hashtbl.create 13 in
+
+ (* if elem->oldv exists, update entry using ||| operator,
+ * else just add elem->newv to the hash
+ *)
+ let update elem newv =
+ try let oldv = Hashtbl.find h elem in
+ Hashtbl.replace h elem (newv ||| oldv)
+ with Not_found -> Hashtbl.add h elem newv
+ in
+
+ List.iter (
+ fun (_, style, _, _, _, _, _) ->
+ match fst style with
+ | RStruct (_, structname) -> update structname RStructOnly
+ | RStructList (_, structname) -> update structname RStructListOnly
+ | _ -> ()
+ ) functions;
+
+ (* return key->values as a list of (key,value) *)
+ Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
+
+(* Used for testing language bindings. *)
+type callt =
+ | CallString of string
+ | CallOptString of string option
+ | CallStringList of string list
+ | CallInt of int
+ | CallInt64 of int64
+ | CallBool of bool
+
+(* Used to memoize the result of pod2text. *)
+let pod2text_memo_filename = "src/.pod2text.data"
+let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
+ try
+ let chan = open_in pod2text_memo_filename in
+ let v = input_value chan in
+ close_in chan;
+ v
+ with
+ _ -> Hashtbl.create 13
+let pod2text_memo_updated () =
+ let chan = open_out pod2text_memo_filename in
+ output_value chan pod2text_memo;
+ close_out chan
+
+(* Useful functions.
+ * Note we don't want to use any external OCaml libraries which
+ * makes this a bit harder than it should be.
+ *)
+module StringMap = Map.Make (String)
+
+let failwithf fs = ksprintf failwith fs
+
+let unique = let i = ref 0 in fun () -> incr i; !i
+
+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 filter_map f = function
+ | [] -> []
+ | x :: xs ->
+ match f x with
+ | Some y -> y :: filter_map f xs
+ | None -> filter_map f xs
+
+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 count_chars c str =
+ let count = ref 0 in
+ for i = 0 to String.length str - 1 do
+ if c = String.unsafe_get str i then incr count
+ done;
+ !count
+
+let name_of_argt = function
+ | Pathname n | Device n | Dev_or_Path n | String n | OptString n
+ | StringList n | DeviceList n | Bool n | Int n | Int64 n
+ | FileIn n | FileOut n -> n
+
+let java_name_of_struct typ =
+ try List.assoc typ java_structs
+ with Not_found ->
+ failwithf
+ "java_name_of_struct: no java_structs entry corresponding to %s" typ
+
+let cols_of_struct typ =
+ try List.assoc typ structs
+ with Not_found ->
+ failwithf "cols_of_struct: unknown struct %s" typ
+
+let seq_of_test = function
+ | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
+ | TestOutputListOfDevices (s, _)
+ | TestOutputInt (s, _) | TestOutputIntOp (s, _, _)
+ | TestOutputTrue s | TestOutputFalse s
+ | TestOutputLength (s, _) | TestOutputBuffer (s, _)
+ | TestOutputStruct (s, _)
+ | TestLastFail s -> s
+
+(* Handling for function flags. *)
+let protocol_limit_warning =
+ "Because of the message protocol, there is a transfer limit
+of somewhere between 2MB and 4MB. To transfer large files, see
+L<guestfs(3)/UPLOADING>."
+
+let danger_will_robinson =
+ "B<This command is dangerous. Without careful use you
+can easily destroy all your data>."
+
+let deprecation_notice flags =
+ try
+ let alt =
+ find_map (function DeprecatedBy str -> Some str | _ -> None) flags in
+ let txt =
+ sprintf "This function is deprecated.
+In new code, use the C<%s> call instead.
+
+Deprecated functions will not be removed from the API, but the
+fact that they are deprecated indicates that there are problems
+with correct use of these functions." alt in
+ Some txt
+ with
+ Not_found -> None
+
+(* Create list of optional groups. *)
+let optgroups =
+ let h = Hashtbl.create 13 in
+ List.iter (
+ fun (name, _, _, flags, _, _, _) ->
+ List.iter (
+ function
+ | Optional group ->
+ let names = try Hashtbl.find h group with Not_found -> [] in
+ Hashtbl.replace h group (name :: names)
+ | _ -> ()
+ ) flags
+ ) daemon_functions;
+ let groups = Hashtbl.fold (fun k _ ks -> k :: ks) h [] in
+ let groups =
+ List.map (
+ fun group -> group, List.sort compare (Hashtbl.find h group)
+ ) groups in
+ List.sort (fun x y -> compare (fst x) (fst y)) groups
+
+(* 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 name = "" then
+ failwithf "function name is empty";
+ if name.[0] < 'a' || name.[0] > 'z' then
+ failwithf "function name %s must start with lowercase a-z" name;
+ if String.contains name '-' then
+ failwithf "function name %s should not contain '-', use '_' instead."
+ name
+ ) 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" name;
+ if n = "int" || n = "char" || n = "short" || n = "long" then
+ failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
+ if n = "i" || n = "n" then
+ failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
+ if n = "argv" || n = "args" then
+ failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
+
+ (* List Haskell, OCaml and C keywords here.
+ * http://www.haskell.org/haskellwiki/Keywords
+ * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
+ * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
+ * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
+ * |perl -pe 's/(.+)/"$1";/'|fmt -70
+ * Omitting _-containing words, since they're handled above.
+ * Omitting the OCaml reserved word, "val", is ok,
+ * and saves us from renaming several parameters.
+ *)
+ let reserved = [
+ "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
+ "char"; "class"; "const"; "constraint"; "continue"; "data";
+ "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
+ "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
+ "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
+ "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
+ "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
+ "interface";
+ "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
+ "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
+ "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
+ "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
+ "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
+ "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
+ "volatile"; "when"; "where"; "while";
+ ] in
+ if List.mem n reserved then
+ failwithf "%s has param/ret using reserved word %s" name n;
+ in
+
+ (match fst style with
+ | RErr -> ()
+ | RInt n | RInt64 n | RBool n
+ | RConstString n | RConstOptString n | RString n
+ | RStringList n | RStruct (n, _) | RStructList (n, _)
+ | RHashtable n | RBufferOut n ->
+ check_arg_ret_name n
+ );
+ 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 Pervasives.stdout
+let lines = ref 0
+let pr fs =
+ ksprintf
+ (fun str ->
+ let i = count_chars '\n' str in
+ lines := !lines + i;
+ output_string !chan str
+ ) fs
+
+let copyright_years =
+ let this_year = 1900 + (localtime (time ())).tm_year in
+ if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
+
+(* Generate a header block in a number of standard styles. *)
+type comment_style =
+ CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
+type license = GPLv2plus | LGPLv2plus
+
+let generate_header ?(extra_inputs = []) comment license =
+ let inputs = "src/generator.ml" :: extra_inputs in
+ let c = match comment with
+ | CStyle -> pr "/* "; " *"
+ | CPlusPlusStyle -> pr "// "; "//"
+ | HashStyle -> pr "# "; "#"
+ | OCamlStyle -> pr "(* "; " *"
+ | HaskellStyle -> pr "{- "; " " in
+ pr "libguestfs generated file\n";
+ pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
+ List.iter (pr "%s %s\n" c) inputs;
+ pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
+ pr "%s\n" c;
+ pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
+ pr "%s\n" c;
+ (match license with
+ | GPLv2plus ->
+ 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;
+
+ | LGPLv2plus ->
+ 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"
+ | CPlusPlusStyle
+ | HashStyle -> ()
+ | OCamlStyle -> pr " *)\n"
+ | HaskellStyle -> 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) ->
+ if not (List.mem NotInDocs flags) then (
+ let name = "guestfs_" ^ shortname in
+ pr "=head2 %s\n\n" name;
+ pr " ";
+ generate_prototype ~extern:false ~handle:"handle" name style;
+ pr "\n\n";
+ pr "%s\n\n" longdesc;
+ (match fst style with
+ | RErr ->
+ pr "This function returns 0 on success or -1 on error.\n\n"
+ | RInt _ ->
+ pr "On error this function returns -1.\n\n"
+ | RInt64 _ ->
+ pr "On error this function returns -1.\n\n"
+ | RBool _ ->
+ pr "This function returns a C truth value on success or -1 on error.\n\n"
+ | RConstString _ ->
+ pr "This function returns a string, or NULL on error.
+The string is owned by the guest handle and must I<not> be freed.\n\n"
+ | RConstOptString _ ->
+ pr "This function returns a string which may be NULL.
+There is way to return an error from this function.
+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"
+ | RStruct (_, typ) ->
+ pr "This function returns a C<struct guestfs_%s *>,
+or NULL if there was an error.
+I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
+ | RStructList (_, typ) ->
+ pr "This function returns a C<struct guestfs_%s_list *>
+(see E<lt>guestfs-structs.hE<gt>),
+or NULL if there was an error.
+I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
+ | 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"
+ | RBufferOut _ ->
+ pr "This function returns a buffer, or NULL on error.
+The size of the returned buffer is written to C<*size_r>.
+I<The caller must free the returned buffer 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;
+ match deprecation_notice flags with
+ | None -> ()
+ | Some txt -> pr "%s\n\n" txt
+ )
+ ) all_functions_sorted
+
+and generate_structs_pod () =
+ (* Structs documentation. *)
+ List.iter (
+ fun (typ, cols) ->
+ pr "=head2 guestfs_%s\n" typ;
+ pr "\n";
+ pr " struct guestfs_%s {\n" typ;
+ List.iter (
+ function
+ | name, FChar -> pr " char %s;\n" name
+ | name, FUInt32 -> pr " uint32_t %s;\n" name
+ | name, FInt32 -> pr " int32_t %s;\n" name
+ | name, (FUInt64|FBytes) -> pr " uint64_t %s;\n" name
+ | name, FInt64 -> pr " int64_t %s;\n" name
+ | name, FString -> pr " char *%s;\n" name
+ | name, FBuffer ->
+ pr " /* The next two fields describe a byte array. */\n";
+ pr " uint32_t %s_len;\n" name;
+ pr " char *%s;\n" name
+ | name, FUUID ->
+ pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
+ pr " char %s[32];\n" name
+ | name, FOptPercent ->
+ pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
+ pr " float %s;\n" name
+ ) cols;
+ pr " };\n";
+ pr " \n";
+ pr " struct guestfs_%s_list {\n" typ;
+ pr " uint32_t len; /* Number of elements in list. */\n";
+ pr " struct guestfs_%s *val; /* Elements. */\n" typ;
+ pr " };\n";
+ pr " \n";
+ pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
+ pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
+ typ typ;
+ pr "\n"
+ ) structs
+
+and generate_availability_pod () =
+ (* Availability documentation. *)
+ pr "=over 4\n";
+ pr "\n";
+ List.iter (
+ fun (group, functions) ->
+ pr "=item B<%s>\n" group;
+ pr "\n";
+ pr "The following functions:\n";
+ List.iter (pr "L</guestfs_%s>\n") functions;
+ pr "\n"
+ ) optgroups;
+ pr "=back\n";
+ pr "\n"
+
+(* 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 LGPLv2plus;
+
+ (* This has to be defined to get around a limitation in Sun's rpcgen. *)
+ pr "typedef string str<>;\n";
+ pr "\n";
+
+ (* Internal structures. *)
+ List.iter (
+ function
+ | typ, cols ->
+ pr "struct guestfs_int_%s {\n" typ;
+ List.iter (function
+ | name, FChar -> pr " char %s;\n" name
+ | name, FString -> pr " string %s<>;\n" name
+ | name, FBuffer -> pr " opaque %s<>;\n" name
+ | name, FUUID -> pr " opaque %s[32];\n" name
+ | name, (FInt32|FUInt32) -> pr " int %s;\n" name
+ | name, (FInt64|FUInt64|FBytes) -> pr " hyper %s;\n" name
+ | name, FOptPercent -> pr " float %s;\n" name
+ ) cols;
+ pr "};\n";
+ pr "\n";
+ pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
+ pr "\n";
+ ) structs;
+
+ List.iter (
+ fun (shortname, style, _, _, _, _, _) ->
+ let name = "guestfs_" ^ shortname in
+
+ (match snd style with
+ | [] -> ()
+ | args ->
+ pr "struct %s_args {\n" name;
+ List.iter (
+ function
+ | Pathname n | Device n | Dev_or_Path n | String n ->
+ pr " string %s<>;\n" n
+ | OptString n -> pr " str *%s;\n" n
+ | StringList n | DeviceList n -> pr " str %s<>;\n" n
+ | Bool n -> pr " bool %s;\n" n
+ | Int n -> pr " int %s;\n" n
+ | Int64 n -> pr " hyper %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 _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
+ | 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"
+ | RStruct (n, typ) ->
+ pr "struct %s_ret {\n" name;
+ pr " guestfs_int_%s %s;\n" typ n;
+ pr "};\n\n"
+ | RStructList (n, typ) ->
+ pr "struct %s_ret {\n" name;
+ pr " guestfs_int_%s_list %s;\n" typ n;
+ pr "};\n\n"
+ | RHashtable n ->
+ pr "struct %s_ret {\n" name;
+ pr " str %s<>;\n" n;
+ pr "};\n\n"
+ | RBufferOut n ->
+ pr "struct %s_ret {\n" name;
+ pr " opaque %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.
+ *)
+ 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 LGPLv2plus;
+
+ (* 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.
+ *)
+
+ (* Public structures. *)
+ List.iter (
+ fun (typ, cols) ->
+ pr "struct guestfs_%s {\n" typ;
+ List.iter (
+ function
+ | name, FChar -> pr " char %s;\n" name
+ | name, FString -> pr " char *%s;\n" name
+ | name, FBuffer ->
+ pr " uint32_t %s_len;\n" name;
+ pr " char *%s;\n" name
+ | name, FUUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
+ | name, FUInt32 -> pr " uint32_t %s;\n" name
+ | name, FInt32 -> pr " int32_t %s;\n" name
+ | name, (FUInt64|FBytes) -> pr " uint64_t %s;\n" name
+ | name, FInt64 -> pr " int64_t %s;\n" name
+ | name, FOptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
+ ) cols;
+ pr "};\n";
+ pr "\n";
+ pr "struct guestfs_%s_list {\n" typ;
+ pr " uint32_t len;\n";
+ pr " struct guestfs_%s *val;\n" typ;
+ pr "};\n";
+ pr "\n";
+ pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
+ pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
+ pr "\n"
+ ) structs
+
+(* Generate the guestfs-actions.h file. *)
+and generate_actions_h () =
+ generate_header CStyle LGPLv2plus;
+ 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 guestfs-internal-actions.h file. *)
+and generate_internal_actions_h () =
+ generate_header CStyle LGPLv2plus;
+ List.iter (
+ fun (shortname, style, _, _, _, _, _) ->
+ let name = "guestfs__" ^ shortname in
+ generate_prototype ~single_line:true ~newline:true ~handle:"handle"
+ name style
+ ) non_daemon_functions
+
+(* Generate the client-side dispatch stubs. *)
+and generate_client_actions () =
+ generate_header CStyle LGPLv2plus;
+
+ pr "\
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdint.h>
+#include <inttypes.h>
+
+#include \"guestfs.h\"
+#include \"guestfs-internal.h\"
+#include \"guestfs-internal-actions.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,
+ unsigned int proc_nr, unsigned 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) || guestfs__is_launching (g))
+ error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
+ caller);
+ else
+ error (g, \"%%s called from the wrong state, %%d != READY\",
+ caller, guestfs__get_state (g));
+ return -1;
+ }
+ return 0;
+}
+
+";
+
+ (* Generate code to generate guestfish call traces. *)
+ let trace_call shortname style =
+ pr " if (guestfs__get_trace (g)) {\n";
+
+ let needs_i =
+ List.exists (function
+ | StringList _ | DeviceList _ -> true
+ | _ -> false) (snd style) in
+ if needs_i then (
+ pr " int i;\n";
+ pr "\n"
+ );
+
+ pr " printf (\"%s\");\n" shortname;
+ List.iter (
+ function
+ | String n (* strings *)
+ | Device n
+ | Pathname n
+ | Dev_or_Path n
+ | FileIn n
+ | FileOut n ->
+ (* guestfish doesn't support string escaping, so neither do we *)
+ pr " printf (\" \\\"%%s\\\"\", %s);\n" n
+ | OptString n -> (* string option *)
+ pr " if (%s) printf (\" \\\"%%s\\\"\", %s);\n" n n;
+ pr " else printf (\" null\");\n"
+ | StringList n
+ | DeviceList n -> (* string list *)
+ pr " putchar (' ');\n";
+ pr " putchar ('\"');\n";
+ pr " for (i = 0; %s[i]; ++i) {\n" n;
+ pr " if (i > 0) putchar (' ');\n";
+ pr " fputs (%s[i], stdout);\n" n;
+ pr " }\n";
+ pr " putchar ('\"');\n";
+ | Bool n -> (* boolean *)
+ pr " fputs (%s ? \" true\" : \" false\", stdout);\n" n
+ | Int n -> (* int *)
+ pr " printf (\" %%d\", %s);\n" n
+ | Int64 n ->
+ pr " printf (\" %%\" PRIi64, %s);\n" n
+ ) (snd style);
+ pr " putchar ('\\n');\n";
+ pr " }\n";
+ pr "\n";
+ in
+
+ (* For non-daemon functions, generate a wrapper around each function. *)
+ List.iter (
+ fun (shortname, style, _, _, _, _, _) ->
+ let name = "guestfs_" ^ shortname in
+
+ generate_prototype ~extern:false ~semicolon:false ~newline:true
+ ~handle:"g" name style;
+ pr "{\n";
+ trace_call shortname style;
+ pr " return guestfs__%s " shortname;
+ generate_c_call_args ~handle:"g" style;
+ pr ";\n";
+ pr "}\n";
+ pr "\n"
+ ) non_daemon_functions;
+
+ (* Client-side stubs for each function. *)
+ List.iter (
+ fun (shortname, style, _, _, _, _, _) ->
+ let name = "guestfs_" ^ shortname in
+
+ (* 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 _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
+ | RString _ | RStringList _
+ | RStruct _ | RStructList _
+ | RHashtable _ | RBufferOut _ ->
+ "NULL" in
+
+ pr "{\n";
+
+ (match snd style with
+ | [] -> ()
+ | _ -> pr " struct %s_args args;\n" name
+ );
+
+ pr " guestfs_message_header hdr;\n";
+ pr " guestfs_message_error err;\n";
+ let has_ret =
+ match fst style with
+ | RErr -> false
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
+ | RInt _ | RInt64 _
+ | RBool _ | RString _ | RStringList _
+ | RStruct _ | RStructList _
+ | RHashtable _ | RBufferOut _ ->
+ pr " struct %s_ret ret;\n" name;
+ true in
+
+ pr " int serial;\n";
+ pr " int r;\n";
+ pr "\n";
+ trace_call shortname style;
+ pr " if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
+ pr " guestfs___set_busy (g);\n";
+ pr "\n";
+
+ (* Send the main header and arguments. *)
+ (match snd style with
+ | [] ->
+ pr " serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
+ (String.uppercase shortname)
+ | args ->
+ List.iter (
+ function
+ | Pathname n | Device n | Dev_or_Path n | 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 | DeviceList n ->
+ pr " args.%s.%s_val = (char **) %s;\n" n n n;
+ pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
+ | Bool n ->
+ pr " args.%s = %s;\n" n n
+ | Int n ->
+ pr " args.%s = %s;\n" n n
+ | Int64 n ->
+ pr " args.%s = %s;\n" n n
+ | FileIn _ | FileOut _ -> ()
+ ) args;
+ pr " serial = guestfs___send (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___end_busy (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 " r = guestfs___send_file (g, %s);\n" n;
+ pr " if (r == -1) {\n";
+ pr " guestfs___end_busy (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";
+ | _ -> ()
+ ) (snd style);
+
+ (* Wait for the reply from the remote end. *)
+ if !need_read_reply_label then pr " read_reply:\n";
+ pr " memset (&hdr, 0, sizeof hdr);\n";
+ pr " memset (&err, 0, sizeof err);\n";
+ if has_ret then pr " memset (&ret, 0, sizeof ret);\n";
+ pr "\n";
+ pr " r = guestfs___recv (g, \"%s\", &hdr, &err,\n " shortname;
+ if not has_ret then
+ pr "NULL, NULL"
+ else
+ pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
+ pr ");\n";
+
+ pr " if (r == -1) {\n";
+ pr " guestfs___end_busy (g);\n";
+ pr " return %s;\n" error_code;
+ pr " }\n";
+ pr "\n";
+
+ pr " if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
+ (String.uppercase shortname);
+ pr " guestfs___end_busy (g);\n";
+ pr " return %s;\n" error_code;
+ pr " }\n";
+ pr "\n";
+
+ pr " if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
+ pr " error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
+ pr " free (err.error_message);\n";
+ pr " guestfs___end_busy (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___recv_file (g, %s) == -1) {\n" n;
+ pr " guestfs___end_busy (g);\n";
+ pr " return %s;\n" error_code;
+ pr " }\n";
+ pr "\n";
+ | _ -> ()
+ ) (snd style);
+
+ pr " guestfs___end_busy (g);\n";
+
+ (match fst style with
+ | RErr -> pr " return 0;\n"
+ | RInt n | RInt64 n | RBool n ->
+ pr " return ret.%s;\n" n
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
+ | RString n ->
+ pr " return 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 " ret.%s.%s_val =\n" n n;
+ pr " safe_realloc (g, ret.%s.%s_val,\n" n n;
+ pr " sizeof (char *) * (ret.%s.%s_len + 1));\n"
+ n n;
+ pr " ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
+ pr " return ret.%s.%s_val;\n" n n
+ | RStruct (n, _) ->
+ pr " /* caller will free this */\n";
+ pr " return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
+ | RStructList (n, _) ->
+ pr " /* caller will free this */\n";
+ pr " return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
+ | RBufferOut n ->
+ pr " /* RBufferOut is tricky: If the buffer is zero-length, then\n";
+ pr " * _val might be NULL here. To make the API saner for\n";
+ pr " * callers, we turn this case into a unique pointer (using\n";
+ pr " * malloc(1)).\n";
+ pr " */\n";
+ pr " if (ret.%s.%s_len > 0) {\n" n n;
+ pr " *size_r = ret.%s.%s_len;\n" n n;
+ pr " return ret.%s.%s_val; /* caller will free */\n" n n;
+ pr " } else {\n";
+ pr " free (ret.%s.%s_val);\n" n n;
+ pr " char *p = safe_malloc (g, 1);\n";
+ pr " *size_r = ret.%s.%s_len;\n" n n;
+ pr " return p;\n";
+ pr " }\n";
+ );
+
+ pr "}\n\n"
+ ) daemon_functions;
+
+ (* Functions to free structures. *)
+ pr "/* Structure-freeing functions. These rely on the fact that the\n";
+ pr " * structure format is identical to the XDR format. See note in\n";
+ pr " * generator.ml.\n";
+ pr " */\n";
+ pr "\n";
+
+ List.iter (
+ fun (typ, _) ->
+ pr "void\n";
+ pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
+ pr "{\n";
+ pr " xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
+ pr " free (x);\n";
+ pr "}\n";
+ pr "\n";
+
+ pr "void\n";
+ pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
+ pr "{\n";
+ pr " xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
+ pr " free (x);\n";
+ pr "}\n";
+ pr "\n";
+
+ ) structs;
+
+(* Generate daemon/actions.h. *)
+and generate_daemon_actions_h () =
+ generate_header CStyle GPLv2plus;
+
+ 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 linker script which controls the visibility of
+ * symbols in the public ABI and ensures no other symbols get
+ * exported accidentally.
+ *)
+and generate_linker_script () =
+ generate_header HashStyle GPLv2plus;
+
+ let globals = [
+ "guestfs_create";
+ "guestfs_close";
+ "guestfs_get_error_handler";
+ "guestfs_get_out_of_memory_handler";
+ "guestfs_last_error";
+ "guestfs_set_error_handler";
+ "guestfs_set_launch_done_callback";
+ "guestfs_set_log_message_callback";
+ "guestfs_set_out_of_memory_handler";
+ "guestfs_set_subprocess_quit_callback";
+
+ (* Unofficial parts of the API: the bindings code use these
+ * functions, so it is useful to export them.
+ *)
+ "guestfs_safe_calloc";
+ "guestfs_safe_malloc";
+ ] in
+ let functions =
+ List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
+ all_functions in
+ let structs =
+ List.concat (
+ List.map (fun (typ, _) ->
+ ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
+ structs
+ ) in
+ let globals = List.sort compare (globals @ functions @ structs) in
+
+ pr "{\n";
+ pr " global:\n";
+ List.iter (pr " %s;\n") globals;
+ pr "\n";
+
+ pr " local:\n";
+ pr " *;\n";
+ pr "};\n"
+
+(* Generate the server-side stubs. *)
+and generate_daemon_actions () =
+ generate_header CStyle GPLv2plus;
+
+ 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 <rpc/types.h>\n";
+ pr "#include <rpc/xdr.h>\n";
+ pr "\n";
+ pr "#include \"daemon.h\"\n";
+ pr "#include \"c-ctype.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 _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
+ | RString _ -> pr " char *r;\n"; "NULL"
+ | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
+ | RStruct (_, typ) -> pr " guestfs_int_%s *r;\n" typ; "NULL"
+ | RStructList (_, typ) -> pr " guestfs_int_%s_list *r;\n" typ; "NULL"
+ | RBufferOut _ ->
+ pr " size_t size = 1;\n";
+ pr " char *r;\n";
+ "NULL" in
+
+ (match snd style with
+ | [] -> ()
+ | args ->
+ pr " struct guestfs_%s_args args;\n" name;
+ List.iter (
+ function
+ | Device n | Dev_or_Path n
+ | Pathname n
+ | String n -> ()
+ | OptString n -> pr " char *%s;\n" n
+ | StringList n | DeviceList n -> pr " char **%s;\n" n
+ | Bool n -> pr " int %s;\n" n
+ | Int n -> pr " int %s;\n" n
+ | Int64 n -> pr " int64_t %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 (\"daemon failed to decode procedure arguments\");\n";
+ pr " return;\n";
+ pr " }\n";
+ let pr_args n =
+ pr " char *%s = args.%s;\n" n n
+ in
+ let pr_list_handling_code n =
+ pr " %s = realloc (args.%s.%s_val,\n" n n n;
+ pr " sizeof (char *) * (args.%s.%s_len+1));\n" n n;
+ pr " if (%s == NULL) {\n" n;
+ pr " reply_with_perror (\"realloc\");\n";
+ pr " goto done;\n";
+ pr " }\n";
+ pr " %s[args.%s.%s_len] = NULL;\n" n n n;
+ pr " args.%s.%s_val = %s;\n" n n n;
+ in
+ List.iter (
+ function
+ | Pathname n ->
+ pr_args n;
+ pr " ABS_PATH (%s, goto done);\n" n;
+ | Device n ->
+ pr_args n;
+ pr " RESOLVE_DEVICE (%s, goto done);\n" n;
+ | Dev_or_Path n ->
+ pr_args n;
+ pr " REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);\n" n;
+ | String n -> pr_args n
+ | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
+ | StringList n ->
+ pr_list_handling_code n;
+ | DeviceList n ->
+ pr_list_handling_code n;
+ pr " /* Ensure that each is a device,\n";
+ pr " * and perform device name translation. */\n";
+ pr " { int pvi; for (pvi = 0; physvols[pvi] != NULL; ++pvi)\n";
+ pr " RESOLVE_DEVICE (physvols[pvi], goto done);\n";
+ pr " }\n";
+ | Bool n -> pr " %s = args.%s;\n" n n
+ | Int n -> pr " %s = args.%s;\n" n n
+ | Int64 n -> pr " %s = args.%s;\n" n n
+ | FileIn _ | FileOut _ -> ()
+ ) args;
+ pr "\n"
+ );
+
+
+ (* this is used at least for do_equal *)
+ if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
+ (* Emit NEED_ROOT just once, even when there are two or
+ more Pathname args *)
+ pr " NEED_ROOT (goto done);\n";
+ );
+
+ (* Don't want to call the impl with any FileIn or FileOut
+ * parameters, since these go "outside" the RPC protocol.
+ *)
+ let args' =
+ List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
+ (snd style) in
+ pr " r = do_%s " name;
+ generate_c_call_args (fst style, args');
+ pr ";\n";
+
+ (match fst style with
+ | RErr | RInt _ | RInt64 _ | RBool _
+ | RConstString _ | RConstOptString _
+ | RString _ | RStringList _ | RHashtable _
+ | RStruct (_, _) | RStructList (_, _) ->
+ pr " if (r == %s)\n" error_code;
+ pr " /* do_%s has already called reply_with_error */\n" name;
+ pr " goto done;\n";
+ pr "\n"
+ | RBufferOut _ ->
+ pr " /* size == 0 && r == NULL could be a non-error case (just\n";
+ pr " * an ordinary zero-length buffer), so be careful ...\n";
+ pr " */\n";
+ pr " if (size == 1 && 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 _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
+ | 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"
+ | RStruct (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
+ | RStructList (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
+ | RBufferOut n ->
+ pr " struct guestfs_%s_ret ret;\n" name;
+ pr " ret.%s.%s_val = r;\n" n n;
+ pr " ret.%s.%s_len = size;\n" n n;
+ pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
+ name;
+ pr " free (r);\n"
+ );
+
+ (* 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, set LIBGUESTFS_PATH to point to the matching libguestfs appliance directory\", 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, guestfs_int_lvm_%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 || c_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
+ | FString ->
+ pr " r->%s = strdup (tok);\n" name;
+ pr " if (r->%s == NULL) {\n" name;
+ pr " perror (\"strdup\");\n";
+ pr " return -1;\n";
+ pr " }\n"
+ | FUUID ->
+ 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";
+ | FBytes ->
+ 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";
+ | FInt64 ->
+ 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";
+ | FOptPercent ->
+ 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";
+ | FBuffer | FInt32 | FUInt32 | FUInt64 | FChar ->
+ assert false (* can never be an LVM column *)
+ );
+ 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_int_lvm_%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_int_lvm_%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_int_lvm_%s_list_len = 0;\n" typ;
+ pr " ret->guestfs_int_lvm_%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 && c_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_int_lvm_%s_list_val,\n" typ;
+ pr " sizeof (guestfs_int_lvm_%s) * (i+1));\n" typ;
+ pr " if (newp == NULL) {\n";
+ pr " reply_with_perror (\"realloc\");\n";
+ pr " free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
+ pr " free (ret);\n";
+ pr " free (out);\n";
+ pr " return NULL;\n";
+ pr " }\n";
+ pr " ret->guestfs_int_lvm_%s_list_val = newp;\n" typ;
+ pr "\n";
+ pr " /* Tokenize the next entry. */\n";
+ pr " r = lvm_tokenize_%s (p, &ret->guestfs_int_lvm_%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_int_lvm_%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_int_lvm_%s_list_len = i;\n" typ;
+ pr "\n";
+ pr " free (out);\n";
+ pr " return ret;\n";
+ pr "}\n"
+
+ ) ["pv", lvm_pv_cols; "vg", lvm_vg_cols; "lv", lvm_lv_cols]
+
+(* Generate a list of function names, for debugging in the daemon.. *)
+and generate_daemon_names () =
+ generate_header CStyle GPLv2plus;
+
+ pr "#include <config.h>\n";
+ pr "\n";
+ pr "#include \"daemon.h\"\n";
+ pr "\n";
+
+ pr "/* This array is indexed by proc_nr. See guestfs_protocol.x. */\n";
+ pr "const char *function_names[] = {\n";
+ List.iter (
+ fun (name, _, proc_nr, _, _, _, _) -> pr " [%d] = \"%s\",\n" proc_nr name
+ ) daemon_functions;
+ pr "};\n";
+
+(* Generate the optional groups for the daemon to implement
+ * guestfs_available.
+ *)
+and generate_daemon_optgroups_c () =
+ generate_header CStyle GPLv2plus;
+
+ pr "#include <config.h>\n";
+ pr "\n";
+ pr "#include \"daemon.h\"\n";
+ pr "#include \"optgroups.h\"\n";
+ pr "\n";
+
+ pr "struct optgroup optgroups[] = {\n";
+ List.iter (
+ fun (group, _) ->
+ pr " { \"%s\", optgroup_%s_available },\n" group group
+ ) optgroups;
+ pr " { NULL, NULL }\n";
+ pr "};\n"
+
+and generate_daemon_optgroups_h () =
+ generate_header CStyle GPLv2plus;
+
+ List.iter (
+ fun (group, _) ->
+ pr "extern int optgroup_%s_available (void);\n" group
+ ) optgroups
+
+(* Generate the tests. *)
+and generate_tests () =
+ generate_header CStyle GPLv2plus;
+
+ pr "\
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+#include <sys/types.h>
+#include <fcntl.h>
+
+#include \"guestfs.h\"
+#include \"guestfs-internal.h\"
+
+static guestfs_h *g;
+static int suppress_error = 0;
+
+static void print_error (guestfs_h *g, void *data, const char *msg)
+{
+ if (!suppress_error)
+ fprintf (stderr, \"%%s\\n\", msg);
+}
+
+/* FIXME: nearly identical code appears in fish.c */
+static void print_strings (char *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]);
+}
+*/
+
+";
+
+ (* Generate a list of commands which are not tested anywhere. *)
+ pr "static void no_test_warnings (void)\n";
+ pr "{\n";
+
+ let hash : (string, bool) Hashtbl.t = Hashtbl.create 13 in
+ List.iter (
+ fun (_, _, _, _, tests, _, _) ->
+ let tests = filter_map (
+ function
+ | (_, (Always|If _|Unless _), test) -> Some test
+ | (_, Disabled, _) -> None
+ ) tests in
+ let seq = List.concat (List.map seq_of_test tests) in
+ let cmds_tested = List.map List.hd seq in
+ List.iter (fun cmd -> Hashtbl.replace hash cmd true) cmds_tested
+ ) all_functions;
+
+ List.iter (
+ fun (name, _, _, _, _, _, _) ->
+ if not (Hashtbl.mem hash name) then
+ pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
+ ) 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, _, _, flags, tests, _, _) ->
+ mapi (generate_one_test name flags) 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;
+ unsigned long int n_failed = 0;
+ const char *filename;
+ int fd;
+ int nr_tests, test_num = 0;
+
+ setbuf (stdout, NULL);
+
+ no_test_warnings ();
+
+ g = guestfs_create ();
+ if (g == NULL) {
+ printf (\"guestfs_create FAILED\\n\");
+ exit (EXIT_FAILURE);
+ }
+
+ guestfs_set_error_handler (g, print_error, NULL);
+
+ guestfs_set_path (g, \"../appliance\");
+
+ filename = \"test1.img\";
+ fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
+ if (fd == -1) {
+ perror (filename);
+ exit (EXIT_FAILURE);
+ }
+ if (lseek (fd, %d, SEEK_SET) == -1) {
+ perror (\"lseek\");
+ close (fd);
+ unlink (filename);
+ exit (EXIT_FAILURE);
+ }
+ if (write (fd, &c, 1) == -1) {
+ perror (\"write\");
+ close (fd);
+ unlink (filename);
+ exit (EXIT_FAILURE);
+ }
+ if (close (fd) == -1) {
+ perror (filename);
+ unlink (filename);
+ exit (EXIT_FAILURE);
+ }
+ if (guestfs_add_drive (g, filename) == -1) {
+ printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
+ exit (EXIT_FAILURE);
+ }
+
+ filename = \"test2.img\";
+ fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
+ if (fd == -1) {
+ perror (filename);
+ exit (EXIT_FAILURE);
+ }
+ if (lseek (fd, %d, SEEK_SET) == -1) {
+ perror (\"lseek\");
+ close (fd);
+ unlink (filename);
+ exit (EXIT_FAILURE);
+ }
+ if (write (fd, &c, 1) == -1) {
+ perror (\"write\");
+ close (fd);
+ unlink (filename);
+ exit (EXIT_FAILURE);
+ }
+ if (close (fd) == -1) {
+ perror (filename);
+ unlink (filename);
+ exit (EXIT_FAILURE);
+ }
+ if (guestfs_add_drive (g, filename) == -1) {
+ printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
+ exit (EXIT_FAILURE);
+ }
+
+ filename = \"test3.img\";
+ fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
+ if (fd == -1) {
+ perror (filename);
+ exit (EXIT_FAILURE);
+ }
+ if (lseek (fd, %d, SEEK_SET) == -1) {
+ perror (\"lseek\");
+ close (fd);
+ unlink (filename);
+ exit (EXIT_FAILURE);
+ }
+ if (write (fd, &c, 1) == -1) {
+ perror (\"write\");
+ close (fd);
+ unlink (filename);
+ exit (EXIT_FAILURE);
+ }
+ if (close (fd) == -1) {
+ perror (filename);
+ unlink (filename);
+ exit (EXIT_FAILURE);
+ }
+ if (guestfs_add_drive (g, filename) == -1) {
+ printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
+ exit (EXIT_FAILURE);
+ }
+
+ if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
+ printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
+ exit (EXIT_FAILURE);
+ }
+
+ if (guestfs_launch (g) == -1) {
+ printf (\"guestfs_launch FAILED\\n\");
+ exit (EXIT_FAILURE);
+ }
+
+ /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
+ alarm (600);
+
+ /* Cancel previous alarm. */
+ alarm (0);
+
+ 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;