-#!/usr/bin/ocamlrun ocaml
+#!/usr/bin/env ocaml
(* libguestfs
* Copyright (C) 2009 Red Hat Inc.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ *)
+
+(* This script generates a large amount of code and documentation for
+ * all the daemon actions.
*
- * This script generates a large amount of code and documentation for
- * all the daemon actions. To add a new action there are only two
- * files you need to change, this one to describe the interface, and
+ * To add a new action there are only two files you need to change,
+ * this one to describe the interface (see the big table below), and
* daemon/<somefile>.c to write the implementation.
+ *
+ * After editing this file, run it (./src/generator.ml) to regenerate all the
+ * output files. Note that if you are using a separate build directory you must
+ * run generator.ml from your top level build directory. You must also have run
+ * configure before generator.ml will run.
+ *
+ * IMPORTANT: This script should NOT print any warnings. If it prints
+ * warnings, you should treat them as errors.
+ * [Need to add -warn-error to ocaml command line]
*)
#load "unix.cma";;
+#load "str.cma";;
open Printf
type style = ret * args
and ret =
- (* "Err" as a return value means an int used as a simple error
+ (* "RErr" as a return value means an int used as a simple error
* indication, ie. 0 or -1.
*)
- | Err
-and args =
- (* 0 arguments, 1 argument, etc. The guestfs_h param is implicit. *)
- | P0
- | P1 of argt
- | P2 of argt * argt
+ | RErr
+ (* "RInt" as a return value means an int which is -1 for error
+ * or any value >= 0 on success. Only use this for smallish
+ * positive ints (0 <= i < 2^30).
+ *)
+ | RInt of string
+ (* "RInt64" is the same as RInt, but is guaranteed to be able
+ * to return a full 64 bit value, _except_ that -1 means error
+ * (so -1 cannot be a valid, non-error return value).
+ *)
+ | RInt64 of string
+ (* "RBool" is a bool return value which can be true/false or
+ * -1 for error.
+ *)
+ | RBool of string
+ (* "RConstString" is a string that refers to a constant value.
+ * Try to avoid using this. In particular you cannot use this
+ * for values returned from the daemon, because there is no
+ * thread-safe way to return them in the C API.
+ *)
+ | RConstString of string
+ (* "RString" and "RStringList" are caller-frees. *)
+ | RString of string
+ | RStringList of string
+ (* "RStruct" is a function which returns a single named structure
+ * or an error indication (in C, a struct, and in other languages
+ * with varying representations, but usually very efficient). See
+ * after the function list below for the structures.
+ *)
+ | RStruct of string * string (* name of retval, name of struct *)
+ (* "RStructList" is a function which returns either a list/array
+ * of structures (could be zero-length), or an error indication.
+ *)
+ | RStructList of string * string (* name of retval, name of struct *)
+ (* Key-value pairs of untyped strings. Turns into a hashtable or
+ * dictionary in languages which support it. DON'T use this as a
+ * general "bucket" for results. Prefer a stronger typed return
+ * value if one is available, or write a custom struct. Don't use
+ * this if the list could potentially be very long, since it is
+ * inefficient. Keys should be unique. NULLs are not permitted.
+ *)
+ | RHashtable of string
+(* Not implemented:
+ (* "RBufferOut" is handled almost exactly like RString, but
+ * it allows the string to contain arbitrary 8 bit data including
+ * ASCII NUL. In the C API this causes an implicit extra parameter
+ * to be added of type <size_t *size_r>. Other programming languages
+ * support strings with arbitrary 8 bit data. At the RPC layer
+ * we have to use the opaque<> type instead of string<>.
+ *)
+ | RBufferOut of string
+*)
+
+and args = argt list (* Function parameters, guestfs handle is implicit. *)
+
+ (* Note in future we should allow a "variable args" parameter as
+ * the final parameter, to allow commands like
+ * chmod mode file [file(s)...]
+ * This is not implemented yet, but many commands (such as chmod)
+ * are currently defined with the argument order keeping this future
+ * possibility in mind.
+ *)
and argt =
| String of string (* const char *name, cannot be NULL *)
+ | OptString of string (* const char *name, may be NULL *)
+ | StringList of string(* list of strings (each string cannot be NULL) *)
+ | Bool of string (* boolean *)
+ | Int of string (* int (smallish ints, signed, <= 31 bits) *)
+ (* These are treated as filenames (simple string parameters) in
+ * the C API and bindings. But in the RPC protocol, we transfer
+ * the actual file content up to or down from the daemon.
+ * FileIn: local machine -> daemon (in request)
+ * FileOut: daemon -> local machine (in reply)
+ * In guestfish (only), the special name "-" means read from
+ * stdin or write to stdout.
+ *)
+ | FileIn of string
+ | FileOut of string
+(* Not implemented:
+ (* Opaque buffer which can contain arbitrary 8 bit data.
+ * In the C API, this is expressed as <char *, int> pair.
+ * Most other languages have a string type which can contain
+ * ASCII NUL. We use whatever type is appropriate for each
+ * language.
+ * Buffers are limited by the total message size. To transfer
+ * large blocks of data, use FileIn/FileOut parameters instead.
+ * To return an arbitrary buffer, use RBufferOut.
+ *)
+ | BufferIn of string
+*)
+
+type flags =
+ | ProtocolLimitWarning (* display warning about protocol size limits *)
+ | DangerWillRobinson (* flags particularly dangerous commands *)
+ | FishAlias of string (* provide an alias for this cmd in guestfish *)
+ | FishAction of string (* call this function in guestfish *)
+ | NotInFish (* do not export via guestfish *)
+ | NotInDocs (* do not add this function to documentation *)
+
+let protocol_limit_warning =
+ "Because of the message protocol, there is a transfer limit
+of somewhere between 2MB and 4MB. To transfer large files you should use
+FTP."
+
+let danger_will_robinson =
+ "B<This command is dangerous. Without careful use you
+can easily destroy all your data>."
+
+(* You can supply zero or as many tests as you want per API call.
+ *
+ * Note that the test environment has 3 block devices, of size 500MB,
+ * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc), and
+ * a fourth squashfs block device with some known files on it (/dev/sdd).
+ *
+ * Note for partitioning purposes, the 500MB device has 1015 cylinders.
+ * Number of cylinders was 63 for IDE emulated disks with precisely
+ * the same size. How exactly this is calculated is a mystery.
+ *
+ * The squashfs block device (/dev/sdd) comes from images/test.sqsh.
+ *
+ * To be able to run the tests in a reasonable amount of time,
+ * the virtual machine and block devices are reused between tests.
+ * So don't try testing kill_subprocess :-x
+ *
+ * Between each test we blockdev-setrw, umount-all, lvm-remove-all.
+ *
+ * Don't assume anything about the previous contents of the block
+ * devices. Use 'Init*' to create some initial scenarios.
+ *
+ * You can add a prerequisite clause to any individual test. This
+ * is a run-time check, which, if it fails, causes the test to be
+ * skipped. Useful if testing a command which might not work on
+ * all variations of libguestfs builds. A test that has prerequisite
+ * of 'Always' is run unconditionally.
+ *
+ * In addition, packagers can skip individual tests by setting the
+ * environment variables: eg:
+ * SKIP_TEST_<CMD>_<NUM>=1 SKIP_TEST_COMMAND_3=1 (skips test #3 of command)
+ * SKIP_TEST_<CMD>=1 SKIP_TEST_ZEROFREE=1 (skips all zerofree tests)
+ *)
+type tests = (test_init * test_prereq * test) list
+and test =
+ (* Run the command sequence and just expect nothing to fail. *)
+ | TestRun of seq
+ (* Run the command sequence and expect the output of the final
+ * command to be the string.
+ *)
+ | TestOutput of seq * string
+ (* Run the command sequence and expect the output of the final
+ * command to be the list of strings.
+ *)
+ | TestOutputList of seq * string list
+ (* Run the command sequence and expect the output of the final
+ * command to be the list of block devices (could be either
+ * "/dev/sd.." or "/dev/hd.." form - we don't check the 5th
+ * character of each string).
+ *)
+ | TestOutputListOfDevices of seq * string list
+ (* Run the command sequence and expect the output of the final
+ * command to be the integer.
+ *)
+ | TestOutputInt of seq * int
+ (* Run the command sequence and expect the output of the final
+ * command to be <op> <int>, eg. ">=", "1".
+ *)
+ | TestOutputIntOp of seq * string * int
+ (* Run the command sequence and expect the output of the final
+ * command to be a true value (!= 0 or != NULL).
+ *)
+ | TestOutputTrue of seq
+ (* Run the command sequence and expect the output of the final
+ * command to be a false value (== 0 or == NULL, but not an error).
+ *)
+ | TestOutputFalse of seq
+ (* Run the command sequence and expect the output of the final
+ * command to be a list of the given length (but don't care about
+ * content).
+ *)
+ | TestOutputLength of seq * int
+ (* Run the command sequence and expect the output of the final
+ * command to be a structure.
+ *)
+ | TestOutputStruct of seq * test_field_compare list
+ (* Run the command sequence and expect the final command (only)
+ * to fail.
+ *)
+ | TestLastFail of seq
+
+and test_field_compare =
+ | CompareWithInt of string * int
+ | CompareWithIntOp of string * string * int
+ | CompareWithString of string * string
+ | CompareFieldsIntEq of string * string
+ | CompareFieldsStrEq of string * string
+
+(* Test prerequisites. *)
+and test_prereq =
+ (* Test always runs. *)
+ | Always
+ (* Test is currently disabled - eg. it fails, or it tests some
+ * unimplemented feature.
+ *)
+ | Disabled
+ (* 'string' is some C code (a function body) that should return
+ * true or false. The test will run if the code returns true.
+ *)
+ | If of string
+ (* As for 'If' but the test runs _unless_ the code returns true. *)
+ | Unless of string
+
+(* Some initial scenarios for testing. *)
+and test_init =
+ (* Do nothing, block devices could contain random stuff including
+ * LVM PVs, and some filesystems might be mounted. This is usually
+ * a bad idea.
+ *)
+ | InitNone
+ (* Block devices are empty and no filesystems are mounted. *)
+ | InitEmpty
+ (* /dev/sda contains a single partition /dev/sda1, which is formatted
+ * as ext2, empty [except for lost+found] and mounted on /.
+ * /dev/sdb and /dev/sdc may have random content.
+ * No LVM.
+ *)
+ | InitBasicFS
+ (* /dev/sda:
+ * /dev/sda1 (is a PV):
+ * /dev/VG/LV (size 8MB):
+ * formatted as ext2, empty [except for lost+found], mounted on /
+ * /dev/sdb and /dev/sdc may have random content.
+ *)
+ | InitBasicFSonLVM
+
+(* Sequence of commands for testing. *)
+and seq = cmd list
+and cmd = string list
+
+(* Note about long descriptions: When referring to another
+ * action, use the format C<guestfs_other> (ie. the full name of
+ * the C function). This will be replaced as appropriate in other
+ * language bindings.
+ *
+ * Apart from that, long descriptions are just perldoc paragraphs.
+ *)
+
+(* These test functions are used in the language binding tests. *)
+
+let test_all_args = [
+ String "str";
+ OptString "optstr";
+ StringList "strlist";
+ Bool "b";
+ Int "integer";
+ FileIn "filein";
+ FileOut "fileout";
+]
+
+let test_all_rets = [
+ (* except for RErr, which is tested thoroughly elsewhere *)
+ "test0rint", RInt "valout";
+ "test0rint64", RInt64 "valout";
+ "test0rbool", RBool "valout";
+ "test0rconststring", RConstString "valout";
+ "test0rstring", RString "valout";
+ "test0rstringlist", RStringList "valout";
+ "test0rstruct", RStruct ("valout", "lvm_pv");
+ "test0rstructlist", RStructList ("valout", "lvm_pv");
+ "test0rhashtable", RHashtable "valout";
+]
+
+let test_functions = [
+ ("test0", (RErr, test_all_args), -1, [NotInFish; NotInDocs],
+ [],
+ "internal test function - do not use",
+ "\
+This is an internal test function which is used to test whether
+the automatically generated bindings can handle every possible
+parameter type correctly.
+
+It echos the contents of each parameter to stdout.
+
+You probably don't want to call this function.");
+] @ List.flatten (
+ List.map (
+ fun (name, ret) ->
+ [(name, (ret, [String "val"]), -1, [NotInFish; NotInDocs],
+ [],
+ "internal test function - do not use",
+ "\
+This is an internal test function which is used to test whether
+the automatically generated bindings can handle every possible
+return type correctly.
+
+It converts string C<val> to the return type.
+
+You probably don't want to call this function.");
+ (name ^ "err", (ret, []), -1, [NotInFish; NotInDocs],
+ [],
+ "internal test function - do not use",
+ "\
+This is an internal test function which is used to test whether
+the automatically generated bindings can handle every possible
+return type correctly.
+
+This function always returns an error.
+
+You probably don't want to call this function.")]
+ ) test_all_rets
+)
+
+(* non_daemon_functions are any functions which don't get processed
+ * in the daemon, eg. functions for setting and getting local
+ * configuration values.
+ *)
+
+let non_daemon_functions = test_functions @ [
+ ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
+ [],
+ "launch the qemu subprocess",
+ "\
+Internally libguestfs is implemented by running a virtual machine
+using L<qemu(1)>.
+
+You should call this after configuring the handle
+(eg. adding drives) but before performing any actions.");
+
+ ("wait_ready", (RErr, []), -1, [NotInFish],
+ [],
+ "wait until the qemu subprocess launches",
+ "\
+Internally libguestfs is implemented by running a virtual machine
+using L<qemu(1)>.
+
+You should call this after C<guestfs_launch> to wait for the launch
+to complete.");
+
+ ("kill_subprocess", (RErr, []), -1, [],
+ [],
+ "kill the qemu subprocess",
+ "\
+This kills the qemu subprocess. You should never need to call this.");
+
+ ("add_drive", (RErr, [String "filename"]), -1, [FishAlias "add"],
+ [],
+ "add an image to examine or modify",
+ "\
+This function adds a virtual machine disk image C<filename> to the
+guest. The first time you call this function, the disk appears as IDE
+disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
+so on.
+
+You don't necessarily need to be root when using libguestfs. However
+you obviously do need sufficient permissions to access the filename
+for whatever operations you want to perform (ie. read access if you
+just want to read the image or write access if you want to modify the
+image).
+
+This is equivalent to the qemu parameter
+C<-drive file=filename,cache=off,if=...>.
+
+Note that this call checks for the existence of C<filename>. This
+stops you from specifying other types of drive which are supported
+by qemu such as C<nbd:> and C<http:> URLs. To specify those, use
+the general C<guestfs_config> call instead.");
+
+ ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
+ [],
+ "add a CD-ROM disk image to examine",
+ "\
+This function adds a virtual CD-ROM disk image to the guest.
+
+This is equivalent to the qemu parameter C<-cdrom filename>.
+
+Note that this call checks for the existence of C<filename>. This
+stops you from specifying other types of drive which are supported
+by qemu such as C<nbd:> and C<http:> URLs. To specify those, use
+the general C<guestfs_config> call instead.");
+
+ ("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"],
+ [],
+ "add a drive in snapshot mode (read-only)",
+ "\
+This adds a drive in snapshot mode, making it effectively
+read-only.
+
+Note that writes to the device are allowed, and will be seen for
+the duration of the guestfs handle, but they are written
+to a temporary file which is discarded as soon as the guestfs
+handle is closed. We don't currently have any method to enable
+changes to be committed, although qemu can support this.
+
+This is equivalent to the qemu parameter
+C<-drive file=filename,snapshot=on,if=...>.
+
+Note that this call checks for the existence of C<filename>. This
+stops you from specifying other types of drive which are supported
+by qemu such as C<nbd:> and C<http:> URLs. To specify those, use
+the general C<guestfs_config> call instead.");
+
+ ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
+ [],
+ "add qemu parameters",
+ "\
+This can be used to add arbitrary qemu command line parameters
+of the form C<-param value>. Actually it's not quite arbitrary - we
+prevent you from setting some parameters which would interfere with
+parameters that we use.
+
+The first character of C<param> string must be a C<-> (dash).
+
+C<value> can be NULL.");
+
+ ("set_qemu", (RErr, [String "qemu"]), -1, [FishAlias "qemu"],
+ [],
+ "set the qemu binary",
+ "\
+Set the qemu binary that we will use.
+
+The default is chosen when the library was compiled by the
+configure script.
+
+You can also override this by setting the C<LIBGUESTFS_QEMU>
+environment variable.
+
+Setting C<qemu> to C<NULL> restores the default qemu binary.");
+
+ ("get_qemu", (RConstString "qemu", []), -1, [],
+ [InitNone, Always, TestRun (
+ [["get_qemu"]])],
+ "get the qemu binary",
+ "\
+Return the current qemu binary.
+
+This is always non-NULL. If it wasn't set already, then this will
+return the default qemu binary name.");
+
+ ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
+ [],
+ "set the search path",
+ "\
+Set the path that libguestfs searches for kernel and initrd.img.
+
+The default is C<$libdir/guestfs> unless overridden by setting
+C<LIBGUESTFS_PATH> environment variable.
+
+Setting C<path> to C<NULL> restores the default path.");
+
+ ("get_path", (RConstString "path", []), -1, [],
+ [InitNone, Always, TestRun (
+ [["get_path"]])],
+ "get the search path",
+ "\
+Return the current search path.
+
+This is always non-NULL. If it wasn't set already, then this will
+return the default path.");
+
+ ("set_append", (RErr, [String "append"]), -1, [FishAlias "append"],
+ [],
+ "add options to kernel command line",
+ "\
+This function is used to add additional options to the
+guest kernel command line.
+
+The default is C<NULL> unless overridden by setting
+C<LIBGUESTFS_APPEND> environment variable.
+
+Setting C<append> to C<NULL> means I<no> additional options
+are passed (libguestfs always adds a few of its own).");
+
+ ("get_append", (RConstString "append", []), -1, [],
+ (* This cannot be tested with the current framework. The
+ * function can return NULL in normal operations, which the
+ * test framework interprets as an error.
+ *)
+ [],
+ "get the additional kernel options",
+ "\
+Return the additional kernel options which are added to the
+guest kernel command line.
+
+If C<NULL> then no options are added.");
+
+ ("set_autosync", (RErr, [Bool "autosync"]), -1, [FishAlias "autosync"],
+ [],
+ "set autosync mode",
+ "\
+If C<autosync> is true, this enables autosync. Libguestfs will make a
+best effort attempt to run C<guestfs_umount_all> followed by
+C<guestfs_sync> when the handle is closed
+(also if the program exits without closing handles).
+
+This is disabled by default (except in guestfish where it is
+enabled by default).");
+
+ ("get_autosync", (RBool "autosync", []), -1, [],
+ [InitNone, Always, TestRun (
+ [["get_autosync"]])],
+ "get autosync mode",
+ "\
+Get the autosync flag.");
+
+ ("set_verbose", (RErr, [Bool "verbose"]), -1, [FishAlias "verbose"],
+ [],
+ "set verbose mode",
+ "\
+If C<verbose> is true, this turns on verbose messages (to C<stderr>).
+
+Verbose messages are disabled unless the environment variable
+C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
+
+ ("get_verbose", (RBool "verbose", []), -1, [],
+ [],
+ "get verbose mode",
+ "\
+This returns the verbose messages flag.");
+
+ ("is_ready", (RBool "ready", []), -1, [],
+ [InitNone, Always, TestOutputTrue (
+ [["is_ready"]])],
+ "is ready to accept commands",
+ "\
+This returns true iff this handle is ready to accept commands
+(in the C<READY> state).
+
+For more information on states, see L<guestfs(3)>.");
-let functions = [
- ("mount", (Err, P2 (String "device", String "mountpoint")), 1,
- "Mount a guest disk at a position in the filesystem",
+ ("is_config", (RBool "config", []), -1, [],
+ [InitNone, Always, TestOutputFalse (
+ [["is_config"]])],
+ "is in configuration state",
+ "\
+This returns true iff this handle is being configured
+(in the C<CONFIG> state).
+
+For more information on states, see L<guestfs(3)>.");
+
+ ("is_launching", (RBool "launching", []), -1, [],
+ [InitNone, Always, TestOutputFalse (
+ [["is_launching"]])],
+ "is launching subprocess",
+ "\
+This returns true iff this handle is launching the subprocess
+(in the C<LAUNCHING> state).
+
+For more information on states, see L<guestfs(3)>.");
+
+ ("is_busy", (RBool "busy", []), -1, [],
+ [InitNone, Always, TestOutputFalse (
+ [["is_busy"]])],
+ "is busy processing a command",
+ "\
+This returns true iff this handle is busy processing a command
+(in the C<BUSY> state).
+
+For more information on states, see L<guestfs(3)>.");
+
+ ("get_state", (RInt "state", []), -1, [],
+ [],
+ "get the current state",
+ "\
+This returns the current state as an opaque integer. This is
+only useful for printing debug and internal error messages.
+
+For more information on states, see L<guestfs(3)>.");
+
+ ("set_busy", (RErr, []), -1, [NotInFish],
+ [],
+ "set state to busy",
+ "\
+This sets the state to C<BUSY>. This is only used when implementing
+actions using the low-level API.
+
+For more information on states, see L<guestfs(3)>.");
+
+ ("set_ready", (RErr, []), -1, [NotInFish],
+ [],
+ "set state to ready",
+ "\
+This sets the state to C<READY>. This is only used when implementing
+actions using the low-level API.
+
+For more information on states, see L<guestfs(3)>.");
+
+ ("end_busy", (RErr, []), -1, [NotInFish],
+ [],
+ "leave the busy state",
+ "\
+This sets the state to C<READY>, or if in C<CONFIG> then it leaves the
+state as is. This is only used when implementing
+actions using the low-level API.
+
+For more information on states, see L<guestfs(3)>.");
+
+ ("set_memsize", (RErr, [Int "memsize"]), -1, [FishAlias "memsize"],
+ [InitNone, Always, TestOutputInt (
+ [["set_memsize"; "500"];
+ ["get_memsize"]], 500)],
+ "set memory allocated to the qemu subprocess",
+ "\
+This sets the memory size in megabytes allocated to the
+qemu subprocess. This only has any effect if called before
+C<guestfs_launch>.
+
+You can also change this by setting the environment
+variable C<LIBGUESTFS_MEMSIZE> before the handle is
+created.
+
+For more information on the architecture of libguestfs,
+see L<guestfs(3)>.");
+
+ ("get_memsize", (RInt "memsize", []), -1, [],
+ [InitNone, Always, TestOutputIntOp (
+ [["get_memsize"]], ">=", 256)],
+ "get memory allocated to the qemu subprocess",
+ "\
+This gets the memory size in megabytes allocated to the
+qemu subprocess.
+
+If C<guestfs_set_memsize> was not called
+on this handle, and if C<LIBGUESTFS_MEMSIZE> was not set,
+then this returns the compiled-in default value for memsize.
+
+For more information on the architecture of libguestfs,
+see L<guestfs(3)>.");
+
+ ("get_pid", (RInt "pid", []), -1, [FishAlias "pid"],
+ [InitNone, Always, TestOutputIntOp (
+ [["get_pid"]], ">=", 1)],
+ "get PID of qemu subprocess",
+ "\
+Return the process ID of the qemu subprocess. If there is no
+qemu subprocess, then this will return an error.
+
+This is an internal call used for debugging and testing.");
+
+ ("version", (RStruct ("version", "version"), []), -1, [],
+ [InitNone, Always, TestOutputStruct (
+ [["version"]], [CompareWithInt ("major", 1)])],
+ "get the library version number",
+ "\
+Return the libguestfs version number that the program is linked
+against.
+
+Note that because of dynamic linking this is not necessarily
+the version of libguestfs that you compiled against. You can
+compile the program, and then at runtime dynamically link
+against a completely different C<libguestfs.so> library.
+
+This call was added in version C<1.0.58>. In previous
+versions of libguestfs there was no way to get the version
+number. From C code you can use ELF weak linking tricks to find out if
+this symbol exists (if it doesn't, then it's an earlier version).
+
+The call returns a structure with four elements. The first
+three (C<major>, C<minor> and C<release>) are numbers and
+correspond to the usual version triplet. The fourth element
+(C<extra>) is a string and is normally empty, but may be
+used for distro-specific information.
+
+To construct the original version string:
+C<$major.$minor.$release$extra>
+
+I<Note:> Don't use this call to test for availability
+of features. Distro backports makes this unreliable.");
+
+]
+
+(* daemon_functions are any functions which cause some action
+ * to take place in the daemon.
+ *)
+
+let daemon_functions = [
+ ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["mkfs"; "ext2"; "/dev/sda1"];
+ ["mount"; "/dev/sda1"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "mount a guest disk at a position in the filesystem",
"\
Mount a guest disk at a position in the filesystem. Block devices
are named C</dev/sda>, C</dev/sdb> and so on, as they were added to
The filesystem options C<sync> and C<noatime> are set with this
call, in order to improve reliability.");
- ("sync", (Err, P0), 2,
- "Sync disks, writes are flushed through to the disk image",
+ ("sync", (RErr, []), 2, [],
+ [ InitEmpty, Always, TestRun [["sync"]]],
+ "sync disks, writes are flushed through to the disk image",
"\
This syncs the disk, so that any writes are flushed through to the
underlying disk image.
You should always call this if you have modified a disk image, before
-calling C<guestfs_close>.");
+closing the handle.");
- ("touch", (Err, P1 (String "path")), 3,
- "Update file timestamps or create a new file",
+ ("touch", (RErr, [String "path"]), 3, [],
+ [InitBasicFS, Always, TestOutputTrue (
+ [["touch"; "/new"];
+ ["exists"; "/new"]])],
+ "update file timestamps or create a new file",
"\
Touch acts like the L<touch(1)> command. It can be used to
-update the filesystems on a file, or, if the file does not exist,
+update the timestamps on a file, or, if the file does not exist,
to create a new zero-length file.");
-]
-(* 'pr' prints to the current output file. *)
-let chan = ref stdout
-let pr fs = ksprintf (output_string !chan) fs
+ ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
+ [InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "list the contents of a file",
+ "\
+Return the contents of the file named C<path>.
-let iter_args f = function
- | P0 -> ()
- | P1 arg1 -> f arg1
- | P2 (arg1, arg2) -> f arg1; f arg2
+Note that this function cannot correctly handle binary files
+(specifically, files containing C<\\0> character which is treated
+as end of string). For those you need to use the C<guestfs_download>
+function which has a more complex interface.");
-type comment_style = CStyle | HashStyle | OCamlStyle
-type license = GPLv2 | LGPLv2
+ ("ll", (RString "listing", [String "directory"]), 5, [],
+ [], (* XXX Tricky to test because it depends on the exact format
+ * of the 'ls -l' command, which changes between F10 and F11.
+ *)
+ "list the files in a directory (long format)",
+ "\
+List the files in C<directory> (relative to the root directory,
+there is no cwd) in the format of 'ls -la'.
-(* Generate a header block in a number of standard styles. *)
-let rec generate_header comment license =
- let c = match comment with
- | CStyle -> pr "/* "; " *"
- | HashStyle -> pr "# "; "#"
- | OCamlStyle -> pr "(* "; " *" in
- pr "libguestfs generated file\n";
- pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
- pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
- pr "%s\n" c;
- pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
- pr "%s\n" c;
- (match license with
- | GPLv2 ->
- pr "%s This program is free software; you can redistribute it and/or modify\n" c;
- pr "%s it under the terms of the GNU General Public License as published by\n" c;
- pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
- pr "%s (at your option) any later version.\n" c;
- pr "%s\n" c;
- pr "%s This program is distributed in the hope that it will be useful,\n" c;
- pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
- pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
- pr "%s GNU General Public License for more details.\n" c;
- pr "%s\n" c;
- pr "%s You should have received a copy of the GNU General Public License along\n" c;
- pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
- pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
+This command is mostly useful for interactive sessions. It
+is I<not> intended that you try to parse the output string.");
- | LGPLv2 ->
- pr "%s This library is free software; you can redistribute it and/or\n" c;
- pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
- pr "%s License as published by the Free Software Foundation; either\n" c;
- pr "%s version 2 of the License, or (at your option) any later version.\n" c;
- pr "%s\n" c;
- pr "%s This library is distributed in the hope that it will be useful,\n" c;
- pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
- pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
- pr "%s Lesser General Public License for more details.\n" c;
- pr "%s\n" c;
- pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
- pr "%s License along with this library; if not, write to the Free Software\n" c;
- pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
- );
- (match comment with
- | CStyle -> pr " */\n"
- | HashStyle -> ()
- | OCamlStyle -> pr " *)\n"
- );
- pr "\n"
+ ("ls", (RStringList "listing", [String "directory"]), 6, [],
+ [InitBasicFS, Always, TestOutputList (
+ [["touch"; "/new"];
+ ["touch"; "/newer"];
+ ["touch"; "/newest"];
+ ["ls"; "/"]], ["lost+found"; "new"; "newer"; "newest"])],
+ "list the files in a directory",
+ "\
+List the files in C<directory> (relative to the root directory,
+there is no cwd). The '.' and '..' entries are not returned, but
+hidden files are shown.
-(* Generate the pod documentation for the C API. *)
-and generate_pod () =
- List.iter (
- fun (shortname, style, _, _, longdesc) ->
- let name = "guestfs_" ^ shortname in
- pr "=head2 %s\n\n" name;
- pr " ";
- generate_prototype ~extern:false ~handle:"handle" name style;
- pr "\n\n";
- pr "%s\n\n" longdesc;
- (match style with
- | (Err, _) ->
- pr "This function return 0 on success or -1 on error.\n\n"
- );
- ) functions
+This command is mostly useful for interactive sessions. Programs
+should probably use C<guestfs_readdir> instead.");
-(* Generate the protocol (XDR) file. *)
-and generate_xdr () =
- generate_header CStyle LGPLv2;
+ ("list_devices", (RStringList "devices", []), 7, [],
+ [InitEmpty, Always, TestOutputListOfDevices (
+ [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],
+ "list the block devices",
+ "\
+List all the block devices.
- List.iter (
- fun (shortname, style, _, _, _) ->
- let name = "guestfs_" ^ shortname in
- pr "/* %s */\n\n" name;
- (match style with
- | (_, P0) -> ()
- | (_, args) ->
- pr "struct %s_args {\n" name;
- iter_args (
- function
- | String name -> pr " string %s<>;\n" name
- ) args;
- pr "};\n\n"
- );
- (match style with
- | (Err, _) -> ()
- (* | ... -> pr "struct %s_ret ...\n" name; *)
- );
- ) functions;
+The full block device names are returned, eg. C</dev/sda>");
- (* 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
- ) functions;
- pr " GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
- pr "};\n";
- pr "\n";
+ ("list_partitions", (RStringList "partitions", []), 8, [],
+ [InitBasicFS, Always, TestOutputListOfDevices (
+ [["list_partitions"]], ["/dev/sda1"]);
+ InitEmpty, Always, TestOutputListOfDevices (
+ [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
+ ["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
+ "list the partitions",
+ "\
+List all the partitions detected on all block devices.
- (* Having to choose a maximum message size is annoying for several
- * reasons (it limits what we can do in the API), but it (a) makes
- * the protocol a lot simpler, and (b) provides a bound on the size
- * of the daemon which operates in limited memory space. For large
- * file transfers you should use FTP.
- *)
- pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
- pr "\n";
+The full partition device names are returned, eg. C</dev/sda1>
+
+This does not return logical volumes. For that you will need to
+call C<guestfs_lvs>.");
+
+ ("pvs", (RStringList "physvols", []), 9, [],
+ [InitBasicFSonLVM, Always, TestOutputListOfDevices (
+ [["pvs"]], ["/dev/sda1"]);
+ InitEmpty, Always, TestOutputListOfDevices (
+ [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
+ ["pvcreate"; "/dev/sda1"];
+ ["pvcreate"; "/dev/sda2"];
+ ["pvcreate"; "/dev/sda3"];
+ ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
+ "list the LVM physical volumes (PVs)",
+ "\
+List all the physical volumes detected. This is the equivalent
+of the L<pvs(8)> command.
+
+This returns a list of just the device names that contain
+PVs (eg. C</dev/sda2>).
+
+See also C<guestfs_pvs_full>.");
+
+ ("vgs", (RStringList "volgroups", []), 10, [],
+ [InitBasicFSonLVM, Always, TestOutputList (
+ [["vgs"]], ["VG"]);
+ InitEmpty, Always, TestOutputList (
+ [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
+ ["pvcreate"; "/dev/sda1"];
+ ["pvcreate"; "/dev/sda2"];
+ ["pvcreate"; "/dev/sda3"];
+ ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
+ ["vgcreate"; "VG2"; "/dev/sda3"];
+ ["vgs"]], ["VG1"; "VG2"])],
+ "list the LVM volume groups (VGs)",
+ "\
+List all the volumes groups detected. This is the equivalent
+of the L<vgs(8)> command.
+
+This returns a list of just the volume group names that were
+detected (eg. C<VolGroup00>).
+
+See also C<guestfs_vgs_full>.");
+
+ ("lvs", (RStringList "logvols", []), 11, [],
+ [InitBasicFSonLVM, Always, TestOutputList (
+ [["lvs"]], ["/dev/VG/LV"]);
+ InitEmpty, Always, TestOutputList (
+ [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
+ ["pvcreate"; "/dev/sda1"];
+ ["pvcreate"; "/dev/sda2"];
+ ["pvcreate"; "/dev/sda3"];
+ ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
+ ["vgcreate"; "VG2"; "/dev/sda3"];
+ ["lvcreate"; "LV1"; "VG1"; "50"];
+ ["lvcreate"; "LV2"; "VG1"; "50"];
+ ["lvcreate"; "LV3"; "VG2"; "50"];
+ ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
+ "list the LVM logical volumes (LVs)",
+ "\
+List all the logical volumes detected. This is the equivalent
+of the L<lvs(8)> command.
+
+This returns a list of the logical volume device names
+(eg. C</dev/VolGroup00/LogVol00>).
+
+See also C<guestfs_lvs_full>.");
+
+ ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [],
+ [], (* XXX how to test? *)
+ "list the LVM physical volumes (PVs)",
+ "\
+List all the physical volumes detected. This is the equivalent
+of the L<pvs(8)> command. The \"full\" version includes all fields.");
+
+ ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [],
+ [], (* XXX how to test? *)
+ "list the LVM volume groups (VGs)",
+ "\
+List all the volumes groups detected. This is the equivalent
+of the L<vgs(8)> command. The \"full\" version includes all fields.");
+
+ ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [],
+ [], (* XXX how to test? *)
+ "list the LVM logical volumes (LVs)",
+ "\
+List all the logical volumes detected. This is the equivalent
+of the L<lvs(8)> command. The \"full\" version includes all fields.");
+
+ ("read_lines", (RStringList "lines", [String "path"]), 15, [],
+ [InitBasicFS, Always, TestOutputList (
+ [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
+ ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
+ InitBasicFS, Always, TestOutputList (
+ [["write_file"; "/new"; ""; "0"];
+ ["read_lines"; "/new"]], [])],
+ "read file as lines",
+ "\
+Return the contents of the file named C<path>.
+
+The file contents are returned as a list of lines. Trailing
+C<LF> and C<CRLF> character sequences are I<not> returned.
+
+Note that this function cannot correctly handle binary files
+(specifically, files containing C<\\0> character which is treated
+as end of line). For those you need to use the C<guestfs_read_file>
+function which has a more complex interface.");
+
+ ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
+ [], (* XXX Augeas code needs tests. *)
+ "create a new Augeas handle",
+ "\
+Create a new Augeas handle for editing configuration files.
+If there was any previous Augeas handle associated with this
+guestfs session, then it is closed.
+
+You must call this before using any other C<guestfs_aug_*>
+commands.
+
+C<root> is the filesystem root. C<root> must not be NULL,
+use C</> instead.
+
+The flags are the same as the flags defined in
+E<lt>augeas.hE<gt>, the logical I<or> of the following
+integers:
+
+=over 4
+
+=item C<AUG_SAVE_BACKUP> = 1
+
+Keep the original file with a C<.augsave> extension.
+
+=item C<AUG_SAVE_NEWFILE> = 2
+
+Save changes into a file with extension C<.augnew>, and
+do not overwrite original. Overrides C<AUG_SAVE_BACKUP>.
+
+=item C<AUG_TYPE_CHECK> = 4
+
+Typecheck lenses (can be expensive).
+
+=item C<AUG_NO_STDINC> = 8
+
+Do not use standard load path for modules.
+
+=item C<AUG_SAVE_NOOP> = 16
+
+Make save a no-op, just record what would have been changed.
+
+=item C<AUG_NO_LOAD> = 32
+
+Do not load the tree in C<guestfs_aug_init>.
+
+=back
+
+To close the handle, you can call C<guestfs_aug_close>.
+
+To find out more about Augeas, see L<http://augeas.net/>.");
+
+ ("aug_close", (RErr, []), 26, [],
+ [], (* XXX Augeas code needs tests. *)
+ "close the current Augeas handle",
+ "\
+Close the current Augeas handle and free up any resources
+used by it. After calling this, you have to call
+C<guestfs_aug_init> again before you can use any other
+Augeas functions.");
+
+ ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
+ [], (* XXX Augeas code needs tests. *)
+ "define an Augeas variable",
+ "\
+Defines an Augeas variable C<name> whose value is the result
+of evaluating C<expr>. If C<expr> is NULL, then C<name> is
+undefined.
+
+On success this returns the number of nodes in C<expr>, or
+C<0> if C<expr> evaluates to something which is not a nodeset.");
+
+ ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [],
+ [], (* XXX Augeas code needs tests. *)
+ "define an Augeas node",
+ "\
+Defines a variable C<name> whose value is the result of
+evaluating C<expr>.
+
+If C<expr> evaluates to an empty nodeset, a node is created,
+equivalent to calling C<guestfs_aug_set> C<expr>, C<value>.
+C<name> will be the nodeset containing that single node.
+
+On success this returns a pair containing the
+number of nodes in the nodeset, and a boolean flag
+if a node was created.");
+
+ ("aug_get", (RString "val", [String "path"]), 19, [],
+ [], (* XXX Augeas code needs tests. *)
+ "look up the value of an Augeas path",
+ "\
+Look up the value associated with C<path>. If C<path>
+matches exactly one node, the C<value> is returned.");
+
+ ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
+ [], (* XXX Augeas code needs tests. *)
+ "set Augeas path to value",
+ "\
+Set the value associated with C<path> to C<value>.");
+
+ ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
+ [], (* XXX Augeas code needs tests. *)
+ "insert a sibling Augeas node",
+ "\
+Create a new sibling C<label> for C<path>, inserting it into
+the tree before or after C<path> (depending on the boolean
+flag C<before>).
+
+C<path> must match exactly one existing node in the tree, and
+C<label> must be a label, ie. not contain C</>, C<*> or end
+with a bracketed index C<[N]>.");
+
+ ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
+ [], (* XXX Augeas code needs tests. *)
+ "remove an Augeas path",
+ "\
+Remove C<path> and all of its children.
+
+On success this returns the number of entries which were removed.");
+
+ ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
+ [], (* XXX Augeas code needs tests. *)
+ "move Augeas node",
+ "\
+Move the node C<src> to C<dest>. C<src> must match exactly
+one node. C<dest> is overwritten if it exists.");
+
+ ("aug_match", (RStringList "matches", [String "path"]), 24, [],
+ [], (* XXX Augeas code needs tests. *)
+ "return Augeas nodes which match path",
+ "\
+Returns a list of paths which match the path expression C<path>.
+The returned paths are sufficiently qualified so that they match
+exactly one node in the current tree.");
+
+ ("aug_save", (RErr, []), 25, [],
+ [], (* XXX Augeas code needs tests. *)
+ "write all pending Augeas changes to disk",
+ "\
+This writes all pending changes to disk.
+
+The flags which were passed to C<guestfs_aug_init> affect exactly
+how files are saved.");
+
+ ("aug_load", (RErr, []), 27, [],
+ [], (* XXX Augeas code needs tests. *)
+ "load files into the tree",
+ "\
+Load files into the tree.
+
+See C<aug_load> in the Augeas documentation for the full gory
+details.");
+
+ ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
+ [], (* XXX Augeas code needs tests. *)
+ "list Augeas nodes under a path",
+ "\
+This is just a shortcut for listing C<guestfs_aug_match>
+C<path/*> and sorting the resulting nodes into alphabetical order.");
+
+ ("rm", (RErr, [String "path"]), 29, [],
+ [InitBasicFS, Always, TestRun
+ [["touch"; "/new"];
+ ["rm"; "/new"]];
+ InitBasicFS, Always, TestLastFail
+ [["rm"; "/new"]];
+ InitBasicFS, Always, TestLastFail
+ [["mkdir"; "/new"];
+ ["rm"; "/new"]]],
+ "remove a file",
+ "\
+Remove the single file C<path>.");
+
+ ("rmdir", (RErr, [String "path"]), 30, [],
+ [InitBasicFS, Always, TestRun
+ [["mkdir"; "/new"];
+ ["rmdir"; "/new"]];
+ InitBasicFS, Always, TestLastFail
+ [["rmdir"; "/new"]];
+ InitBasicFS, Always, TestLastFail
+ [["touch"; "/new"];
+ ["rmdir"; "/new"]]],
+ "remove a directory",
+ "\
+Remove the single directory C<path>.");
+
+ ("rm_rf", (RErr, [String "path"]), 31, [],
+ [InitBasicFS, Always, TestOutputFalse
+ [["mkdir"; "/new"];
+ ["mkdir"; "/new/foo"];
+ ["touch"; "/new/foo/bar"];
+ ["rm_rf"; "/new"];
+ ["exists"; "/new"]]],
+ "remove a file or directory recursively",
+ "\
+Remove the file or directory C<path>, recursively removing the
+contents if its a directory. This is like the C<rm -rf> shell
+command.");
+
+ ("mkdir", (RErr, [String "path"]), 32, [],
+ [InitBasicFS, Always, TestOutputTrue
+ [["mkdir"; "/new"];
+ ["is_dir"; "/new"]];
+ InitBasicFS, Always, TestLastFail
+ [["mkdir"; "/new/foo/bar"]]],
+ "create a directory",
+ "\
+Create a directory named C<path>.");
+
+ ("mkdir_p", (RErr, [String "path"]), 33, [],
+ [InitBasicFS, Always, TestOutputTrue
+ [["mkdir_p"; "/new/foo/bar"];
+ ["is_dir"; "/new/foo/bar"]];
+ InitBasicFS, Always, TestOutputTrue
+ [["mkdir_p"; "/new/foo/bar"];
+ ["is_dir"; "/new/foo"]];
+ InitBasicFS, Always, TestOutputTrue
+ [["mkdir_p"; "/new/foo/bar"];
+ ["is_dir"; "/new"]];
+ (* Regression tests for RHBZ#503133: *)
+ InitBasicFS, Always, TestRun
+ [["mkdir"; "/new"];
+ ["mkdir_p"; "/new"]];
+ InitBasicFS, Always, TestLastFail
+ [["touch"; "/new"];
+ ["mkdir_p"; "/new"]]],
+ "create a directory and parents",
+ "\
+Create a directory named C<path>, creating any parent directories
+as necessary. This is like the C<mkdir -p> shell command.");
+
+ ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
+ [], (* XXX Need stat command to test *)
+ "change file mode",
+ "\
+Change the mode (permissions) of C<path> to C<mode>. Only
+numeric modes are supported.");
+
+ ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
+ [], (* XXX Need stat command to test *)
+ "change file owner and group",
+ "\
+Change the file owner to C<owner> and group to C<group>.
+
+Only numeric uid and gid are supported. If you want to use
+names, you will need to locate and parse the password file
+yourself (Augeas support makes this relatively easy).");
+
+ ("exists", (RBool "existsflag", [String "path"]), 36, [],
+ [InitBasicFS, Always, TestOutputTrue (
+ [["touch"; "/new"];
+ ["exists"; "/new"]]);
+ InitBasicFS, Always, TestOutputTrue (
+ [["mkdir"; "/new"];
+ ["exists"; "/new"]])],
+ "test if file or directory exists",
+ "\
+This returns C<true> if and only if there is a file, directory
+(or anything) with the given C<path> name.
+
+See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
+
+ ("is_file", (RBool "fileflag", [String "path"]), 37, [],
+ [InitBasicFS, Always, TestOutputTrue (
+ [["touch"; "/new"];
+ ["is_file"; "/new"]]);
+ InitBasicFS, Always, TestOutputFalse (
+ [["mkdir"; "/new"];
+ ["is_file"; "/new"]])],
+ "test if file exists",
+ "\
+This returns C<true> if and only if there is a file
+with the given C<path> name. Note that it returns false for
+other objects like directories.
+
+See also C<guestfs_stat>.");
+
+ ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
+ [InitBasicFS, Always, TestOutputFalse (
+ [["touch"; "/new"];
+ ["is_dir"; "/new"]]);
+ InitBasicFS, Always, TestOutputTrue (
+ [["mkdir"; "/new"];
+ ["is_dir"; "/new"]])],
+ "test if file exists",
+ "\
+This returns C<true> if and only if there is a directory
+with the given C<path> name. Note that it returns false for
+other objects like files.
+
+See also C<guestfs_stat>.");
+
+ ("pvcreate", (RErr, [String "device"]), 39, [],
+ [InitEmpty, Always, TestOutputListOfDevices (
+ [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
+ ["pvcreate"; "/dev/sda1"];
+ ["pvcreate"; "/dev/sda2"];
+ ["pvcreate"; "/dev/sda3"];
+ ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
+ "create an LVM physical volume",
+ "\
+This creates an LVM physical volume on the named C<device>,
+where C<device> should usually be a partition name such
+as C</dev/sda1>.");
+
+ ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
+ [InitEmpty, Always, TestOutputList (
+ [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
+ ["pvcreate"; "/dev/sda1"];
+ ["pvcreate"; "/dev/sda2"];
+ ["pvcreate"; "/dev/sda3"];
+ ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
+ ["vgcreate"; "VG2"; "/dev/sda3"];
+ ["vgs"]], ["VG1"; "VG2"])],
+ "create an LVM volume group",
+ "\
+This creates an LVM volume group called C<volgroup>
+from the non-empty list of physical volumes C<physvols>.");
+
+ ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
+ [InitEmpty, Always, TestOutputList (
+ [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
+ ["pvcreate"; "/dev/sda1"];
+ ["pvcreate"; "/dev/sda2"];
+ ["pvcreate"; "/dev/sda3"];
+ ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
+ ["vgcreate"; "VG2"; "/dev/sda3"];
+ ["lvcreate"; "LV1"; "VG1"; "50"];
+ ["lvcreate"; "LV2"; "VG1"; "50"];
+ ["lvcreate"; "LV3"; "VG2"; "50"];
+ ["lvcreate"; "LV4"; "VG2"; "50"];
+ ["lvcreate"; "LV5"; "VG2"; "50"];
+ ["lvs"]],
+ ["/dev/VG1/LV1"; "/dev/VG1/LV2";
+ "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
+ "create an LVM volume group",
+ "\
+This creates an LVM volume group called C<logvol>
+on the volume group C<volgroup>, with C<size> megabytes.");
+
+ ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["mkfs"; "ext2"; "/dev/sda1"];
+ ["mount"; "/dev/sda1"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "make a filesystem",
+ "\
+This creates a filesystem on C<device> (usually a partition
+or LVM logical volume). The filesystem type is C<fstype>, for
+example C<ext3>.");
+
+ ("sfdisk", (RErr, [String "device";
+ Int "cyls"; Int "heads"; Int "sectors";
+ StringList "lines"]), 43, [DangerWillRobinson],
+ [],
+ "create partitions on a block device",
+ "\
+This is a direct interface to the L<sfdisk(8)> program for creating
+partitions on block devices.
+
+C<device> should be a block device, for example C</dev/sda>.
+
+C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
+and sectors on the device, which are passed directly to sfdisk as
+the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
+of these, then the corresponding parameter is omitted. Usually for
+'large' disks, you can just pass C<0> for these, but for small
+(floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
+out the right geometry and you will need to tell it.
+
+C<lines> is a list of lines that we feed to C<sfdisk>. For more
+information refer to the L<sfdisk(8)> manpage.
+
+To create a single partition occupying the whole disk, you would
+pass C<lines> as a single element list, when the single element being
+the string C<,> (comma).
+
+See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>");
+
+ ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
+ [InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents");
+ InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "\nnew file contents\n"; "0"];
+ ["cat"; "/new"]], "\nnew file contents\n");
+ InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "\n\n"; "0"];
+ ["cat"; "/new"]], "\n\n");
+ InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; ""; "0"];
+ ["cat"; "/new"]], "");
+ InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "\n\n\n"; "0"];
+ ["cat"; "/new"]], "\n\n\n");
+ InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "\n"; "0"];
+ ["cat"; "/new"]], "\n")],
+ "create a file",
+ "\
+This call creates a file called C<path>. The contents of the
+file is the string C<content> (which can contain any 8 bit data),
+with length C<size>.
+
+As a special case, if C<size> is C<0>
+then the length is calculated using C<strlen> (so in this case
+the content cannot contain embedded ASCII NULs).
+
+I<NB.> Owing to a bug, writing content containing ASCII NUL
+characters does I<not> work, even if the length is specified.
+We hope to resolve this bug in a future version. In the meantime
+use C<guestfs_upload>.");
+
+ ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
+ [InitEmpty, Always, TestOutputListOfDevices (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["mkfs"; "ext2"; "/dev/sda1"];
+ ["mount"; "/dev/sda1"; "/"];
+ ["mounts"]], ["/dev/sda1"]);
+ InitEmpty, Always, TestOutputList (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["mkfs"; "ext2"; "/dev/sda1"];
+ ["mount"; "/dev/sda1"; "/"];
+ ["umount"; "/"];
+ ["mounts"]], [])],
+ "unmount a filesystem",
+ "\
+This unmounts the given filesystem. The filesystem may be
+specified either by its mountpoint (path) or the device which
+contains the filesystem.");
+
+ ("mounts", (RStringList "devices", []), 46, [],
+ [InitBasicFS, Always, TestOutputListOfDevices (
+ [["mounts"]], ["/dev/sda1"])],
+ "show mounted filesystems",
+ "\
+This returns the list of currently mounted filesystems. It returns
+the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
+
+Some internal mounts are not shown.");
+
+ ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
+ [InitBasicFS, Always, TestOutputList (
+ [["umount_all"];
+ ["mounts"]], []);
+ (* check that umount_all can unmount nested mounts correctly: *)
+ InitEmpty, Always, TestOutputList (
+ [["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
+ ["mkfs"; "ext2"; "/dev/sda1"];
+ ["mkfs"; "ext2"; "/dev/sda2"];
+ ["mkfs"; "ext2"; "/dev/sda3"];
+ ["mount"; "/dev/sda1"; "/"];
+ ["mkdir"; "/mp1"];
+ ["mount"; "/dev/sda2"; "/mp1"];
+ ["mkdir"; "/mp1/mp2"];
+ ["mount"; "/dev/sda3"; "/mp1/mp2"];
+ ["mkdir"; "/mp1/mp2/mp3"];
+ ["umount_all"];
+ ["mounts"]], [])],
+ "unmount all filesystems",
+ "\
+This unmounts all mounted filesystems.
+
+Some internal mounts are not unmounted by this call.");
+
+ ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
+ [],
+ "remove all LVM LVs, VGs and PVs",
+ "\
+This command removes all LVM logical volumes, volume groups
+and physical volumes.");
+
+ ("file", (RString "description", [String "path"]), 49, [],
+ [InitBasicFS, Always, TestOutput (
+ [["touch"; "/new"];
+ ["file"; "/new"]], "empty");
+ InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "some content\n"; "0"];
+ ["file"; "/new"]], "ASCII text");
+ InitBasicFS, Always, TestLastFail (
+ [["file"; "/nofile"]])],
+ "determine file type",
+ "\
+This call uses the standard L<file(1)> command to determine
+the type or contents of the file. This also works on devices,
+for example to find out whether a partition contains a filesystem.
+
+The exact command which runs is C<file -bsL path>. Note in
+particular that the filename is not prepended to the output
+(the C<-b> option).");
+
+ ("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
+ [InitBasicFS, Always, TestOutput (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command"; "/test-command 1"]], "Result1");
+ InitBasicFS, Always, TestOutput (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command"; "/test-command 2"]], "Result2\n");
+ InitBasicFS, Always, TestOutput (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command"; "/test-command 3"]], "\nResult3");
+ InitBasicFS, Always, TestOutput (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command"; "/test-command 4"]], "\nResult4\n");
+ InitBasicFS, Always, TestOutput (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command"; "/test-command 5"]], "\nResult5\n\n");
+ InitBasicFS, Always, TestOutput (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command"; "/test-command 6"]], "\n\nResult6\n\n");
+ InitBasicFS, Always, TestOutput (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command"; "/test-command 7"]], "");
+ InitBasicFS, Always, TestOutput (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command"; "/test-command 8"]], "\n");
+ InitBasicFS, Always, TestOutput (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command"; "/test-command 9"]], "\n\n");
+ InitBasicFS, Always, TestOutput (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command"; "/test-command 10"]], "Result10-1\nResult10-2\n");
+ InitBasicFS, Always, TestOutput (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command"; "/test-command 11"]], "Result11-1\nResult11-2");
+ InitBasicFS, Always, TestLastFail (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command"; "/test-command"]])],
+ "run a command from the guest filesystem",
+ "\
+This call runs a command from the guest filesystem. The
+filesystem must be mounted, and must contain a compatible
+operating system (ie. something Linux, with the same
+or compatible processor architecture).
+
+The single parameter is an argv-style list of arguments.
+The first element is the name of the program to run.
+Subsequent elements are parameters. The list must be
+non-empty (ie. must contain a program name). Note that
+the command runs directly, and is I<not> invoked via
+the shell (see C<guestfs_sh>).
+
+The return value is anything printed to I<stdout> by
+the command.
+
+If the command returns a non-zero exit status, then
+this function returns an error message. The error message
+string is the content of I<stderr> from the command.
+
+The C<$PATH> environment variable will contain at least
+C</usr/bin> and C</bin>. If you require a program from
+another location, you should provide the full path in the
+first parameter.
+
+Shared libraries and data files required by the program
+must be available on filesystems which are mounted in the
+correct places. It is the caller's responsibility to ensure
+all filesystems that are needed are mounted at the right
+locations.");
+
+ ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [ProtocolLimitWarning],
+ [InitBasicFS, Always, TestOutputList (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command_lines"; "/test-command 1"]], ["Result1"]);
+ InitBasicFS, Always, TestOutputList (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command_lines"; "/test-command 2"]], ["Result2"]);
+ InitBasicFS, Always, TestOutputList (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command_lines"; "/test-command 3"]], ["";"Result3"]);
+ InitBasicFS, Always, TestOutputList (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command_lines"; "/test-command 4"]], ["";"Result4"]);
+ InitBasicFS, Always, TestOutputList (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command_lines"; "/test-command 5"]], ["";"Result5";""]);
+ InitBasicFS, Always, TestOutputList (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command_lines"; "/test-command 6"]], ["";"";"Result6";""]);
+ InitBasicFS, Always, TestOutputList (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command_lines"; "/test-command 7"]], []);
+ InitBasicFS, Always, TestOutputList (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command_lines"; "/test-command 8"]], [""]);
+ InitBasicFS, Always, TestOutputList (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command_lines"; "/test-command 9"]], ["";""]);
+ InitBasicFS, Always, TestOutputList (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command_lines"; "/test-command 10"]], ["Result10-1";"Result10-2"]);
+ InitBasicFS, Always, TestOutputList (
+ [["upload"; "test-command"; "/test-command"];
+ ["chmod"; "0o755"; "/test-command"];
+ ["command_lines"; "/test-command 11"]], ["Result11-1";"Result11-2"])],
+ "run a command, returning lines",
+ "\
+This is the same as C<guestfs_command>, but splits the
+result into a list of lines.
+
+See also: C<guestfs_sh_lines>");
+
+ ("stat", (RStruct ("statbuf", "stat"), [String "path"]), 52, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["touch"; "/new"];
+ ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
+ "get file information",
+ "\
+Returns file information for the given C<path>.
+
+This is the same as the C<stat(2)> system call.");
+
+ ("lstat", (RStruct ("statbuf", "stat"), [String "path"]), 53, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["touch"; "/new"];
+ ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
+ "get file information for a symbolic link",
+ "\
+Returns file information for the given C<path>.
+
+This is the same as C<guestfs_stat> except that if C<path>
+is a symbolic link, then the link is stat-ed, not the file it
+refers to.
+
+This is the same as the C<lstat(2)> system call.");
+
+ ("statvfs", (RStruct ("statbuf", "statvfs"), [String "path"]), 54, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["statvfs"; "/"]], [CompareWithInt ("namemax", 255);
+ CompareWithInt ("bsize", 1024)])],
+ "get file system statistics",
+ "\
+Returns file system statistics for any mounted file system.
+C<path> should be a file or directory in the mounted file system
+(typically it is the mount point itself, but it doesn't need to be).
+
+This is the same as the C<statvfs(2)> system call.");
+
+ ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
+ [], (* XXX test *)
+ "get ext2/ext3/ext4 superblock details",
+ "\
+This returns the contents of the ext2, ext3 or ext4 filesystem
+superblock on C<device>.
+
+It is the same as running C<tune2fs -l device>. See L<tune2fs(8)>
+manpage for more details. The list of fields returned isn't
+clearly defined, and depends on both the version of C<tune2fs>
+that libguestfs was built against, and the filesystem itself.");
+
+ ("blockdev_setro", (RErr, [String "device"]), 56, [],
+ [InitEmpty, Always, TestOutputTrue (
+ [["blockdev_setro"; "/dev/sda"];
+ ["blockdev_getro"; "/dev/sda"]])],
+ "set block device to read-only",
+ "\
+Sets the block device named C<device> to read-only.
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_setrw", (RErr, [String "device"]), 57, [],
+ [InitEmpty, Always, TestOutputFalse (
+ [["blockdev_setrw"; "/dev/sda"];
+ ["blockdev_getro"; "/dev/sda"]])],
+ "set block device to read-write",
+ "\
+Sets the block device named C<device> to read-write.
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
+ [InitEmpty, Always, TestOutputTrue (
+ [["blockdev_setro"; "/dev/sda"];
+ ["blockdev_getro"; "/dev/sda"]])],
+ "is block device set to read-only",
+ "\
+Returns a boolean indicating if the block device is read-only
+(true if read-only, false if not).
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
+ [InitEmpty, Always, TestOutputInt (
+ [["blockdev_getss"; "/dev/sda"]], 512)],
+ "get sectorsize of block device",
+ "\
+This returns the size of sectors on a block device.
+Usually 512, but can be larger for modern devices.
+
+(Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
+for that).
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
+ [InitEmpty, Always, TestOutputInt (
+ [["blockdev_getbsz"; "/dev/sda"]], 4096)],
+ "get blocksize of block device",
+ "\
+This returns the block size of a device.
+
+(Note this is different from both I<size in blocks> and
+I<filesystem block size>).
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
+ [], (* XXX test *)
+ "set blocksize of block device",
+ "\
+This sets the block size of a device.
+
+(Note this is different from both I<size in blocks> and
+I<filesystem block size>).
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
+ [InitEmpty, Always, TestOutputInt (
+ [["blockdev_getsz"; "/dev/sda"]], 1024000)],
+ "get total size of device in 512-byte sectors",
+ "\
+This returns the size of the device in units of 512-byte sectors
+(even if the sectorsize isn't 512 bytes ... weird).
+
+See also C<guestfs_blockdev_getss> for the real sector size of
+the device, and C<guestfs_blockdev_getsize64> for the more
+useful I<size in bytes>.
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
+ [InitEmpty, Always, TestOutputInt (
+ [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
+ "get total size of device in bytes",
+ "\
+This returns the size of the device in bytes.
+
+See also C<guestfs_blockdev_getsz>.
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
+ [InitEmpty, Always, TestRun
+ [["blockdev_flushbufs"; "/dev/sda"]]],
+ "flush device buffers",
+ "\
+This tells the kernel to flush internal buffers associated
+with C<device>.
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
+ [InitEmpty, Always, TestRun
+ [["blockdev_rereadpt"; "/dev/sda"]]],
+ "reread partition table",
+ "\
+Reread the partition table on C<device>.
+
+This uses the L<blockdev(8)> command.");
+
+ ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
+ [InitBasicFS, Always, TestOutput (
+ (* Pick a file from cwd which isn't likely to change. *)
+ [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
+ ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
+ "upload a file from the local machine",
+ "\
+Upload local file C<filename> to C<remotefilename> on the
+filesystem.
+
+C<filename> can also be a named pipe.
+
+See also C<guestfs_download>.");
+
+ ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
+ [InitBasicFS, Always, TestOutput (
+ (* Pick a file from cwd which isn't likely to change. *)
+ [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
+ ["download"; "/COPYING.LIB"; "testdownload.tmp"];
+ ["upload"; "testdownload.tmp"; "/upload"];
+ ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
+ "download a file to the local machine",
+ "\
+Download file C<remotefilename> and save it as C<filename>
+on the local machine.
+
+C<filename> can also be a named pipe.
+
+See also C<guestfs_upload>, C<guestfs_cat>.");
+
+ ("checksum", (RString "checksum", [String "csumtype"; String "path"]), 68, [],
+ [InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "test\n"; "0"];
+ ["checksum"; "crc"; "/new"]], "935282863");
+ InitBasicFS, Always, TestLastFail (
+ [["checksum"; "crc"; "/new"]]);
+ InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "test\n"; "0"];
+ ["checksum"; "md5"; "/new"]], "d8e8fca2dc0f896fd7cb4cb0031ba249");
+ InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "test\n"; "0"];
+ ["checksum"; "sha1"; "/new"]], "4e1243bd22c66e76c2ba9eddc1f91394e57f9f83");
+ InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "test\n"; "0"];
+ ["checksum"; "sha224"; "/new"]], "52f1bf093f4b7588726035c176c0cdb4376cfea53819f1395ac9e6ec");
+ InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "test\n"; "0"];
+ ["checksum"; "sha256"; "/new"]], "f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93b7605022da52e6ccc26fd2");
+ InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "test\n"; "0"];
+ ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d");
+ InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "test\n"; "0"];
+ ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123");
+ InitBasicFS, Always, TestOutput (
+ (* RHEL 5 thinks this is an HFS+ filesystem unless we give
+ * the type explicitly.
+ *)
+ [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+ ["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c")],
+ "compute MD5, SHAx or CRC checksum of file",
+ "\
+This call computes the MD5, SHAx or CRC checksum of the
+file named C<path>.
+
+The type of checksum to compute is given by the C<csumtype>
+parameter which must have one of the following values:
+
+=over 4
+
+=item C<crc>
+
+Compute the cyclic redundancy check (CRC) specified by POSIX
+for the C<cksum> command.
+
+=item C<md5>
+
+Compute the MD5 hash (using the C<md5sum> program).
+
+=item C<sha1>
+
+Compute the SHA1 hash (using the C<sha1sum> program).
+
+=item C<sha224>
+
+Compute the SHA224 hash (using the C<sha224sum> program).
+
+=item C<sha256>
+
+Compute the SHA256 hash (using the C<sha256sum> program).
+
+=item C<sha384>
+
+Compute the SHA384 hash (using the C<sha384sum> program).
+
+=item C<sha512>
+
+Compute the SHA512 hash (using the C<sha512sum> program).
+
+=back
+
+The checksum is returned as a printable string.");
+
+ ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
+ [InitBasicFS, Always, TestOutput (
+ [["tar_in"; "../images/helloworld.tar"; "/"];
+ ["cat"; "/hello"]], "hello\n")],
+ "unpack tarfile to directory",
+ "\
+This command uploads and unpacks local file C<tarfile> (an
+I<uncompressed> tar file) into C<directory>.
+
+To upload a compressed tarball, use C<guestfs_tgz_in>.");
+
+ ("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
+ [],
+ "pack directory into tarfile",
+ "\
+This command packs the contents of C<directory> and downloads
+it to local file C<tarfile>.
+
+To download a compressed tarball, use C<guestfs_tgz_out>.");
+
+ ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
+ [InitBasicFS, Always, TestOutput (
+ [["tgz_in"; "../images/helloworld.tar.gz"; "/"];
+ ["cat"; "/hello"]], "hello\n")],
+ "unpack compressed tarball to directory",
+ "\
+This command uploads and unpacks local file C<tarball> (a
+I<gzip compressed> tar file) into C<directory>.
+
+To upload an uncompressed tarball, use C<guestfs_tar_in>.");
+
+ ("tgz_out", (RErr, [String "directory"; FileOut "tarball"]), 72, [],
+ [],
+ "pack directory into compressed tarball",
+ "\
+This command packs the contents of C<directory> and downloads
+it to local file C<tarball>.
+
+To download an uncompressed tarball, use C<guestfs_tar_out>.");
+
+ ("mount_ro", (RErr, [String "device"; String "mountpoint"]), 73, [],
+ [InitBasicFS, Always, TestLastFail (
+ [["umount"; "/"];
+ ["mount_ro"; "/dev/sda1"; "/"];
+ ["touch"; "/new"]]);
+ InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "data"; "0"];
+ ["umount"; "/"];
+ ["mount_ro"; "/dev/sda1"; "/"];
+ ["cat"; "/new"]], "data")],
+ "mount a guest disk, read-only",
+ "\
+This is the same as the C<guestfs_mount> command, but it
+mounts the filesystem with the read-only (I<-o ro>) flag.");
+
+ ("mount_options", (RErr, [String "options"; String "device"; String "mountpoint"]), 74, [],
+ [],
+ "mount a guest disk with mount options",
+ "\
+This is the same as the C<guestfs_mount> command, but it
+allows you to set the mount options as for the
+L<mount(8)> I<-o> flag.");
+
+ ("mount_vfs", (RErr, [String "options"; String "vfstype"; String "device"; String "mountpoint"]), 75, [],
+ [],
+ "mount a guest disk with mount options and vfstype",
+ "\
+This is the same as the C<guestfs_mount> command, but it
+allows you to set both the mount options and the vfstype
+as for the L<mount(8)> I<-o> and I<-t> flags.");
+
+ ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
+ [],
+ "debugging and internals",
+ "\
+The C<guestfs_debug> command exposes some internals of
+C<guestfsd> (the guestfs daemon) that runs inside the
+qemu subprocess.
+
+There is no comprehensive help for this command. You have
+to look at the file C<daemon/debug.c> in the libguestfs source
+to find out what you can do.");
+
+ ("lvremove", (RErr, [String "device"]), 77, [],
+ [InitEmpty, Always, TestOutputList (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["pvcreate"; "/dev/sda1"];
+ ["vgcreate"; "VG"; "/dev/sda1"];
+ ["lvcreate"; "LV1"; "VG"; "50"];
+ ["lvcreate"; "LV2"; "VG"; "50"];
+ ["lvremove"; "/dev/VG/LV1"];
+ ["lvs"]], ["/dev/VG/LV2"]);
+ InitEmpty, Always, TestOutputList (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["pvcreate"; "/dev/sda1"];
+ ["vgcreate"; "VG"; "/dev/sda1"];
+ ["lvcreate"; "LV1"; "VG"; "50"];
+ ["lvcreate"; "LV2"; "VG"; "50"];
+ ["lvremove"; "/dev/VG"];
+ ["lvs"]], []);
+ InitEmpty, Always, TestOutputList (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["pvcreate"; "/dev/sda1"];
+ ["vgcreate"; "VG"; "/dev/sda1"];
+ ["lvcreate"; "LV1"; "VG"; "50"];
+ ["lvcreate"; "LV2"; "VG"; "50"];
+ ["lvremove"; "/dev/VG"];
+ ["vgs"]], ["VG"])],
+ "remove an LVM logical volume",
+ "\
+Remove an LVM logical volume C<device>, where C<device> is
+the path to the LV, such as C</dev/VG/LV>.
+
+You can also remove all LVs in a volume group by specifying
+the VG name, C</dev/VG>.");
+
+ ("vgremove", (RErr, [String "vgname"]), 78, [],
+ [InitEmpty, Always, TestOutputList (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["pvcreate"; "/dev/sda1"];
+ ["vgcreate"; "VG"; "/dev/sda1"];
+ ["lvcreate"; "LV1"; "VG"; "50"];
+ ["lvcreate"; "LV2"; "VG"; "50"];
+ ["vgremove"; "VG"];
+ ["lvs"]], []);
+ InitEmpty, Always, TestOutputList (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["pvcreate"; "/dev/sda1"];
+ ["vgcreate"; "VG"; "/dev/sda1"];
+ ["lvcreate"; "LV1"; "VG"; "50"];
+ ["lvcreate"; "LV2"; "VG"; "50"];
+ ["vgremove"; "VG"];
+ ["vgs"]], [])],
+ "remove an LVM volume group",
+ "\
+Remove an LVM volume group C<vgname>, (for example C<VG>).
+
+This also forcibly removes all logical volumes in the volume
+group (if any).");
+
+ ("pvremove", (RErr, [String "device"]), 79, [],
+ [InitEmpty, Always, TestOutputListOfDevices (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["pvcreate"; "/dev/sda1"];
+ ["vgcreate"; "VG"; "/dev/sda1"];
+ ["lvcreate"; "LV1"; "VG"; "50"];
+ ["lvcreate"; "LV2"; "VG"; "50"];
+ ["vgremove"; "VG"];
+ ["pvremove"; "/dev/sda1"];
+ ["lvs"]], []);
+ InitEmpty, Always, TestOutputListOfDevices (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["pvcreate"; "/dev/sda1"];
+ ["vgcreate"; "VG"; "/dev/sda1"];
+ ["lvcreate"; "LV1"; "VG"; "50"];
+ ["lvcreate"; "LV2"; "VG"; "50"];
+ ["vgremove"; "VG"];
+ ["pvremove"; "/dev/sda1"];
+ ["vgs"]], []);
+ InitEmpty, Always, TestOutputListOfDevices (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["pvcreate"; "/dev/sda1"];
+ ["vgcreate"; "VG"; "/dev/sda1"];
+ ["lvcreate"; "LV1"; "VG"; "50"];
+ ["lvcreate"; "LV2"; "VG"; "50"];
+ ["vgremove"; "VG"];
+ ["pvremove"; "/dev/sda1"];
+ ["pvs"]], [])],
+ "remove an LVM physical volume",
+ "\
+This wipes a physical volume C<device> so that LVM will no longer
+recognise it.
+
+The implementation uses the C<pvremove> command which refuses to
+wipe physical volumes that contain any volume groups, so you have
+to remove those first.");
+
+ ("set_e2label", (RErr, [String "device"; String "label"]), 80, [],
+ [InitBasicFS, Always, TestOutput (
+ [["set_e2label"; "/dev/sda1"; "testlabel"];
+ ["get_e2label"; "/dev/sda1"]], "testlabel")],
+ "set the ext2/3/4 filesystem label",
+ "\
+This sets the ext2/3/4 filesystem label of the filesystem on
+C<device> to C<label>. Filesystem labels are limited to
+16 characters.
+
+You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
+to return the existing label on a filesystem.");
+
+ ("get_e2label", (RString "label", [String "device"]), 81, [],
+ [],
+ "get the ext2/3/4 filesystem label",
+ "\
+This returns the ext2/3/4 filesystem label of the filesystem on
+C<device>.");
+
+ ("set_e2uuid", (RErr, [String "device"; String "uuid"]), 82, [],
+ [InitBasicFS, Always, TestOutput (
+ [["set_e2uuid"; "/dev/sda1"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"];
+ ["get_e2uuid"; "/dev/sda1"]], "a3a61220-882b-4f61-89f4-cf24dcc7297d");
+ InitBasicFS, Always, TestOutput (
+ [["set_e2uuid"; "/dev/sda1"; "clear"];
+ ["get_e2uuid"; "/dev/sda1"]], "");
+ (* We can't predict what UUIDs will be, so just check the commands run. *)
+ InitBasicFS, Always, TestRun (
+ [["set_e2uuid"; "/dev/sda1"; "random"]]);
+ InitBasicFS, Always, TestRun (
+ [["set_e2uuid"; "/dev/sda1"; "time"]])],
+ "set the ext2/3/4 filesystem UUID",
+ "\
+This sets the ext2/3/4 filesystem UUID of the filesystem on
+C<device> to C<uuid>. The format of the UUID and alternatives
+such as C<clear>, C<random> and C<time> are described in the
+L<tune2fs(8)> manpage.
+
+You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
+to return the existing UUID of a filesystem.");
+
+ ("get_e2uuid", (RString "uuid", [String "device"]), 83, [],
+ [],
+ "get the ext2/3/4 filesystem UUID",
+ "\
+This returns the ext2/3/4 filesystem UUID of the filesystem on
+C<device>.");
+
+ ("fsck", (RInt "status", [String "fstype"; String "device"]), 84, [],
+ [InitBasicFS, Always, TestOutputInt (
+ [["umount"; "/dev/sda1"];
+ ["fsck"; "ext2"; "/dev/sda1"]], 0);
+ InitBasicFS, Always, TestOutputInt (
+ [["umount"; "/dev/sda1"];
+ ["zero"; "/dev/sda1"];
+ ["fsck"; "ext2"; "/dev/sda1"]], 8)],
+ "run the filesystem checker",
+ "\
+This runs the filesystem checker (fsck) on C<device> which
+should have filesystem type C<fstype>.
+
+The returned integer is the status. See L<fsck(8)> for the
+list of status codes from C<fsck>.
+
+Notes:
+
+=over 4
+
+=item *
+
+Multiple status codes can be summed together.
+
+=item *
+
+A non-zero return code can mean \"success\", for example if
+errors have been corrected on the filesystem.
+
+=item *
+
+Checking or repairing NTFS volumes is not supported
+(by linux-ntfs).
+
+=back
+
+This command is entirely equivalent to running C<fsck -a -t fstype device>.");
+
+ ("zero", (RErr, [String "device"]), 85, [],
+ [InitBasicFS, Always, TestOutput (
+ [["umount"; "/dev/sda1"];
+ ["zero"; "/dev/sda1"];
+ ["file"; "/dev/sda1"]], "data")],
+ "write zeroes to the device",
+ "\
+This command writes zeroes over the first few blocks of C<device>.
+
+How many blocks are zeroed isn't specified (but it's I<not> enough
+to securely wipe the device). It should be sufficient to remove
+any partition tables, filesystem superblocks and so on.
+
+See also: C<guestfs_scrub_device>.");
+
+ ("grub_install", (RErr, [String "root"; String "device"]), 86, [],
+ (* Test disabled because grub-install incompatible with virtio-blk driver.
+ * See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760
+ *)
+ [InitBasicFS, Disabled, TestOutputTrue (
+ [["grub_install"; "/"; "/dev/sda1"];
+ ["is_dir"; "/boot"]])],
+ "install GRUB",
+ "\
+This command installs GRUB (the Grand Unified Bootloader) on
+C<device>, with the root directory being C<root>.");
+
+ ("cp", (RErr, [String "src"; String "dest"]), 87, [],
+ [InitBasicFS, Always, TestOutput (
+ [["write_file"; "/old"; "file content"; "0"];
+ ["cp"; "/old"; "/new"];
+ ["cat"; "/new"]], "file content");
+ InitBasicFS, Always, TestOutputTrue (
+ [["write_file"; "/old"; "file content"; "0"];
+ ["cp"; "/old"; "/new"];
+ ["is_file"; "/old"]]);
+ InitBasicFS, Always, TestOutput (
+ [["write_file"; "/old"; "file content"; "0"];
+ ["mkdir"; "/dir"];
+ ["cp"; "/old"; "/dir/new"];
+ ["cat"; "/dir/new"]], "file content")],
+ "copy a file",
+ "\
+This copies a file from C<src> to C<dest> where C<dest> is
+either a destination filename or destination directory.");
+
+ ("cp_a", (RErr, [String "src"; String "dest"]), 88, [],
+ [InitBasicFS, Always, TestOutput (
+ [["mkdir"; "/olddir"];
+ ["mkdir"; "/newdir"];
+ ["write_file"; "/olddir/file"; "file content"; "0"];
+ ["cp_a"; "/olddir"; "/newdir"];
+ ["cat"; "/newdir/olddir/file"]], "file content")],
+ "copy a file or directory recursively",
+ "\
+This copies a file or directory from C<src> to C<dest>
+recursively using the C<cp -a> command.");
+
+ ("mv", (RErr, [String "src"; String "dest"]), 89, [],
+ [InitBasicFS, Always, TestOutput (
+ [["write_file"; "/old"; "file content"; "0"];
+ ["mv"; "/old"; "/new"];
+ ["cat"; "/new"]], "file content");
+ InitBasicFS, Always, TestOutputFalse (
+ [["write_file"; "/old"; "file content"; "0"];
+ ["mv"; "/old"; "/new"];
+ ["is_file"; "/old"]])],
+ "move a file",
+ "\
+This moves a file from C<src> to C<dest> where C<dest> is
+either a destination filename or destination directory.");
+
+ ("drop_caches", (RErr, [Int "whattodrop"]), 90, [],
+ [InitEmpty, Always, TestRun (
+ [["drop_caches"; "3"]])],
+ "drop kernel page cache, dentries and inodes",
+ "\
+This instructs the guest kernel to drop its page cache,
+and/or dentries and inode caches. The parameter C<whattodrop>
+tells the kernel what precisely to drop, see
+L<http://linux-mm.org/Drop_Caches>
+
+Setting C<whattodrop> to 3 should drop everything.
+
+This automatically calls L<sync(2)> before the operation,
+so that the maximum guest memory is freed.");
+
+ ("dmesg", (RString "kmsgs", []), 91, [],
+ [InitEmpty, Always, TestRun (
+ [["dmesg"]])],
+ "return kernel messages",
+ "\
+This returns the kernel messages (C<dmesg> output) from
+the guest kernel. This is sometimes useful for extended
+debugging of problems.
+
+Another way to get the same information is to enable
+verbose messages with C<guestfs_set_verbose> or by setting
+the environment variable C<LIBGUESTFS_DEBUG=1> before
+running the program.");
+
+ ("ping_daemon", (RErr, []), 92, [],
+ [InitEmpty, Always, TestRun (
+ [["ping_daemon"]])],
+ "ping the guest daemon",
+ "\
+This is a test probe into the guestfs daemon running inside
+the qemu subprocess. Calling this function checks that the
+daemon responds to the ping message, without affecting the daemon
+or attached block device(s) in any other way.");
+
+ ("equal", (RBool "equality", [String "file1"; String "file2"]), 93, [],
+ [InitBasicFS, Always, TestOutputTrue (
+ [["write_file"; "/file1"; "contents of a file"; "0"];
+ ["cp"; "/file1"; "/file2"];
+ ["equal"; "/file1"; "/file2"]]);
+ InitBasicFS, Always, TestOutputFalse (
+ [["write_file"; "/file1"; "contents of a file"; "0"];
+ ["write_file"; "/file2"; "contents of another file"; "0"];
+ ["equal"; "/file1"; "/file2"]]);
+ InitBasicFS, Always, TestLastFail (
+ [["equal"; "/file1"; "/file2"]])],
+ "test if two files have equal contents",
+ "\
+This compares the two files C<file1> and C<file2> and returns
+true if their content is exactly equal, or false otherwise.
+
+The external L<cmp(1)> program is used for the comparison.");
+
+ ("strings", (RStringList "stringsout", [String "path"]), 94, [ProtocolLimitWarning],
+ [InitBasicFS, Always, TestOutputList (
+ [["write_file"; "/new"; "hello\nworld\n"; "0"];
+ ["strings"; "/new"]], ["hello"; "world"]);
+ InitBasicFS, Always, TestOutputList (
+ [["touch"; "/new"];
+ ["strings"; "/new"]], [])],
+ "print the printable strings in a file",
+ "\
+This runs the L<strings(1)> command on a file and returns
+the list of printable strings found.");
+
+ ("strings_e", (RStringList "stringsout", [String "encoding"; String "path"]), 95, [ProtocolLimitWarning],
+ [InitBasicFS, Always, TestOutputList (
+ [["write_file"; "/new"; "hello\nworld\n"; "0"];
+ ["strings_e"; "b"; "/new"]], []);
+ InitBasicFS, Disabled, TestOutputList (
+ [["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
+ ["strings_e"; "b"; "/new"]], ["hello"; "world"])],
+ "print the printable strings in a file",
+ "\
+This is like the C<guestfs_strings> command, but allows you to
+specify the encoding.
+
+See the L<strings(1)> manpage for the full list of encodings.
+
+Commonly useful encodings are C<l> (lower case L) which will
+show strings inside Windows/x86 files.
+
+The returned strings are transcoded to UTF-8.");
+
+ ("hexdump", (RString "dump", [String "path"]), 96, [ProtocolLimitWarning],
+ [InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "hello\nworld\n"; "12"];
+ ["hexdump"; "/new"]], "00000000 68 65 6c 6c 6f 0a 77 6f 72 6c 64 0a |hello.world.|\n0000000c\n");
+ (* Test for RHBZ#501888c2 regression which caused large hexdump
+ * commands to segfault.
+ *)
+ InitBasicFS, Always, TestRun (
+ [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+ ["hexdump"; "/100krandom"]])],
+ "dump a file in hexadecimal",
+ "\
+This runs C<hexdump -C> on the given C<path>. The result is
+the human-readable, canonical hex dump of the file.");
+
+ ("zerofree", (RErr, [String "device"]), 97, [],
+ [InitNone, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["mkfs"; "ext3"; "/dev/sda1"];
+ ["mount"; "/dev/sda1"; "/"];
+ ["write_file"; "/new"; "test file"; "0"];
+ ["umount"; "/dev/sda1"];
+ ["zerofree"; "/dev/sda1"];
+ ["mount"; "/dev/sda1"; "/"];
+ ["cat"; "/new"]], "test file")],
+ "zero unused inodes and disk blocks on ext2/3 filesystem",
+ "\
+This runs the I<zerofree> program on C<device>. This program
+claims to zero unused inodes and disk blocks on an ext2/3
+filesystem, thus making it possible to compress the filesystem
+more effectively.
+
+You should B<not> run this program if the filesystem is
+mounted.
+
+It is possible that using this program can damage the filesystem
+or data on the filesystem.");
+
+ ("pvresize", (RErr, [String "device"]), 98, [],
+ [],
+ "resize an LVM physical volume",
+ "\
+This resizes (expands or shrinks) an existing LVM physical
+volume to match the new size of the underlying device.");
+
+ ("sfdisk_N", (RErr, [String "device"; Int "partnum";
+ Int "cyls"; Int "heads"; Int "sectors";
+ String "line"]), 99, [DangerWillRobinson],
+ [],
+ "modify a single partition on a block device",
+ "\
+This runs L<sfdisk(8)> option to modify just the single
+partition C<n> (note: C<n> counts from 1).
+
+For other parameters, see C<guestfs_sfdisk>. You should usually
+pass C<0> for the cyls/heads/sectors parameters.");
+
+ ("sfdisk_l", (RString "partitions", [String "device"]), 100, [],
+ [],
+ "display the partition table",
+ "\
+This displays the partition table on C<device>, in the
+human-readable output of the L<sfdisk(8)> command. It is
+not intended to be parsed.");
+
+ ("sfdisk_kernel_geometry", (RString "partitions", [String "device"]), 101, [],
+ [],
+ "display the kernel geometry",
+ "\
+This displays the kernel's idea of the geometry of C<device>.
+
+The result is in human-readable format, and not designed to
+be parsed.");
+
+ ("sfdisk_disk_geometry", (RString "partitions", [String "device"]), 102, [],
+ [],
+ "display the disk geometry from the partition table",
+ "\
+This displays the disk geometry of C<device> read from the
+partition table. Especially in the case where the underlying
+block device has been resized, this can be different from the
+kernel's idea of the geometry (see C<guestfs_sfdisk_kernel_geometry>).
+
+The result is in human-readable format, and not designed to
+be parsed.");
+
+ ("vg_activate_all", (RErr, [Bool "activate"]), 103, [],
+ [],
+ "activate or deactivate all volume groups",
+ "\
+This command activates or (if C<activate> is false) deactivates
+all logical volumes in all volume groups.
+If activated, then they are made known to the
+kernel, ie. they appear as C</dev/mapper> devices. If deactivated,
+then those devices disappear.
+
+This command is the same as running C<vgchange -a y|n>");
+
+ ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [],
+ [],
+ "activate or deactivate some volume groups",
+ "\
+This command activates or (if C<activate> is false) deactivates
+all logical volumes in the listed volume groups C<volgroups>.
+If activated, then they are made known to the
+kernel, ie. they appear as C</dev/mapper> devices. If deactivated,
+then those devices disappear.
+
+This command is the same as running C<vgchange -a y|n volgroups...>
+
+Note that if C<volgroups> is an empty list then B<all> volume groups
+are activated or deactivated.");
+
+ ("lvresize", (RErr, [String "device"; Int "mbytes"]), 105, [],
+ [InitNone, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["pvcreate"; "/dev/sda1"];
+ ["vgcreate"; "VG"; "/dev/sda1"];
+ ["lvcreate"; "LV"; "VG"; "10"];
+ ["mkfs"; "ext2"; "/dev/VG/LV"];
+ ["mount"; "/dev/VG/LV"; "/"];
+ ["write_file"; "/new"; "test content"; "0"];
+ ["umount"; "/"];
+ ["lvresize"; "/dev/VG/LV"; "20"];
+ ["e2fsck_f"; "/dev/VG/LV"];
+ ["resize2fs"; "/dev/VG/LV"];
+ ["mount"; "/dev/VG/LV"; "/"];
+ ["cat"; "/new"]], "test content")],
+ "resize an LVM logical volume",
+ "\
+This resizes (expands or shrinks) an existing LVM logical
+volume to C<mbytes>. When reducing, data in the reduced part
+is lost.");
+
+ ("resize2fs", (RErr, [String "device"]), 106, [],
+ [], (* lvresize tests this *)
+ "resize an ext2/ext3 filesystem",
+ "\
+This resizes an ext2 or ext3 filesystem to match the size of
+the underlying device.
+
+I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
+on the C<device> before calling this command. For unknown reasons
+C<resize2fs> sometimes gives an error about this and sometimes not.
+In any case, it is always safe to call C<guestfs_e2fsck_f> before
+calling this function.");
+
+ ("find", (RStringList "names", [String "directory"]), 107, [],
+ [InitBasicFS, Always, TestOutputList (
+ [["find"; "/"]], ["lost+found"]);
+ InitBasicFS, Always, TestOutputList (
+ [["touch"; "/a"];
+ ["mkdir"; "/b"];
+ ["touch"; "/b/c"];
+ ["find"; "/"]], ["a"; "b"; "b/c"; "lost+found"]);
+ InitBasicFS, Always, TestOutputList (
+ [["mkdir_p"; "/a/b/c"];
+ ["touch"; "/a/b/c/d"];
+ ["find"; "/a/b/"]], ["c"; "c/d"])],
+ "find all files and directories",
+ "\
+This command lists out all files and directories, recursively,
+starting at C<directory>. It is essentially equivalent to
+running the shell command C<find directory -print> but some
+post-processing happens on the output, described below.
+
+This returns a list of strings I<without any prefix>. Thus
+if the directory structure was:
+
+ /tmp/a
+ /tmp/b
+ /tmp/c/d
+
+then the returned list from C<guestfs_find> C</tmp> would be
+4 elements:
+
+ a
+ b
+ c
+ c/d
+
+If C<directory> is not a directory, then this command returns
+an error.
+
+The returned list is sorted.");
+
+ ("e2fsck_f", (RErr, [String "device"]), 108, [],
+ [], (* lvresize tests this *)
+ "check an ext2/ext3 filesystem",
+ "\
+This runs C<e2fsck -p -f device>, ie. runs the ext2/ext3
+filesystem checker on C<device>, noninteractively (C<-p>),
+even if the filesystem appears to be clean (C<-f>).
+
+This command is only needed because of C<guestfs_resize2fs>
+(q.v.). Normally you should use C<guestfs_fsck>.");
+
+ ("sleep", (RErr, [Int "secs"]), 109, [],
+ [InitNone, Always, TestRun (
+ [["sleep"; "1"]])],
+ "sleep for some seconds",
+ "\
+Sleep for C<secs> seconds.");
+
+ ("ntfs_3g_probe", (RInt "status", [Bool "rw"; String "device"]), 110, [],
+ [InitNone, Always, TestOutputInt (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["mkfs"; "ntfs"; "/dev/sda1"];
+ ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0);
+ InitNone, Always, TestOutputInt (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["mkfs"; "ext2"; "/dev/sda1"];
+ ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)],
+ "probe NTFS volume",
+ "\
+This command runs the L<ntfs-3g.probe(8)> command which probes
+an NTFS C<device> for mountability. (Not all NTFS volumes can
+be mounted read-write, and some cannot be mounted at all).
+
+C<rw> is a boolean flag. Set it to true if you want to test
+if the volume can be mounted read-write. Set it to false if
+you want to test if the volume can be mounted read-only.
+
+The return value is an integer which C<0> if the operation
+would succeed, or some non-zero value documented in the
+L<ntfs-3g.probe(8)> manual page.");
+
+ ("sh", (RString "output", [String "command"]), 111, [],
+ [], (* XXX needs tests *)
+ "run a command via the shell",
+ "\
+This call runs a command from the guest filesystem via the
+guest's C</bin/sh>.
+
+This is like C<guestfs_command>, but passes the command to:
+
+ /bin/sh -c \"command\"
+
+Depending on the guest's shell, this usually results in
+wildcards being expanded, shell expressions being interpolated
+and so on.
+
+All the provisos about C<guestfs_command> apply to this call.");
+
+ ("sh_lines", (RStringList "lines", [String "command"]), 112, [],
+ [], (* XXX needs tests *)
+ "run a command via the shell returning lines",
+ "\
+This is the same as C<guestfs_sh>, but splits the result
+into a list of lines.
+
+See also: C<guestfs_command_lines>");
+
+ ("glob_expand", (RStringList "paths", [String "pattern"]), 113, [],
+ [InitBasicFS, Always, TestOutputList (
+ [["mkdir_p"; "/a/b/c"];
+ ["touch"; "/a/b/c/d"];
+ ["touch"; "/a/b/c/e"];
+ ["glob_expand"; "/a/b/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
+ InitBasicFS, Always, TestOutputList (
+ [["mkdir_p"; "/a/b/c"];
+ ["touch"; "/a/b/c/d"];
+ ["touch"; "/a/b/c/e"];
+ ["glob_expand"; "/a/*/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
+ InitBasicFS, Always, TestOutputList (
+ [["mkdir_p"; "/a/b/c"];
+ ["touch"; "/a/b/c/d"];
+ ["touch"; "/a/b/c/e"];
+ ["glob_expand"; "/a/*/x/*"]], [])],
+ "expand a wildcard path",
+ "\
+This command searches for all the pathnames matching
+C<pattern> according to the wildcard expansion rules
+used by the shell.
+
+If no paths match, then this returns an empty list
+(note: not an error).
+
+It is just a wrapper around the C L<glob(3)> function
+with flags C<GLOB_MARK|GLOB_BRACE>.
+See that manual page for more details.");
+
+ ("scrub_device", (RErr, [String "device"]), 114, [DangerWillRobinson],
+ [InitNone, Always, TestRun ( (* use /dev/sdc because it's smaller *)
+ [["scrub_device"; "/dev/sdc"]])],
+ "scrub (securely wipe) a device",
+ "\
+This command writes patterns over C<device> to make data retrieval
+more difficult.
+
+It is an interface to the L<scrub(1)> program. See that
+manual page for more details.");
+
+ ("scrub_file", (RErr, [String "file"]), 115, [],
+ [InitBasicFS, Always, TestRun (
+ [["write_file"; "/file"; "content"; "0"];
+ ["scrub_file"; "/file"]])],
+ "scrub (securely wipe) a file",
+ "\
+This command writes patterns over a file to make data retrieval
+more difficult.
+
+The file is I<removed> after scrubbing.
+
+It is an interface to the L<scrub(1)> program. See that
+manual page for more details.");
+
+ ("scrub_freespace", (RErr, [String "dir"]), 116, [],
+ [], (* XXX needs testing *)
+ "scrub (securely wipe) free space",
+ "\
+This command creates the directory C<dir> and then fills it
+with files until the filesystem is full, and scrubs the files
+as for C<guestfs_scrub_file>, and deletes them.
+The intention is to scrub any free space on the partition
+containing C<dir>.
+
+It is an interface to the L<scrub(1)> program. See that
+manual page for more details.");
+
+ ("mkdtemp", (RString "dir", [String "template"]), 117, [],
+ [InitBasicFS, Always, TestRun (
+ [["mkdir"; "/tmp"];
+ ["mkdtemp"; "/tmp/tmpXXXXXX"]])],
+ "create a temporary directory",
+ "\
+This command creates a temporary directory. The
+C<template> parameter should be a full pathname for the
+temporary directory name with the final six characters being
+\"XXXXXX\".
+
+For example: \"/tmp/myprogXXXXXX\" or \"/Temp/myprogXXXXXX\",
+the second one being suitable for Windows filesystems.
+
+The name of the temporary directory that was created
+is returned.
+
+The temporary directory is created with mode 0700
+and is owned by root.
+
+The caller is responsible for deleting the temporary
+directory and its contents after use.
+
+See also: L<mkdtemp(3)>");
+
+ ("wc_l", (RInt "lines", [String "path"]), 118, [],
+ [InitBasicFS, Always, TestOutputInt (
+ [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+ ["wc_l"; "/10klines"]], 10000)],
+ "count lines in a file",
+ "\
+This command counts the lines in a file, using the
+C<wc -l> external command.");
+
+ ("wc_w", (RInt "words", [String "path"]), 119, [],
+ [InitBasicFS, Always, TestOutputInt (
+ [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+ ["wc_w"; "/10klines"]], 10000)],
+ "count words in a file",
+ "\
+This command counts the words in a file, using the
+C<wc -w> external command.");
+
+ ("wc_c", (RInt "chars", [String "path"]), 120, [],
+ [InitBasicFS, Always, TestOutputInt (
+ [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+ ["wc_c"; "/100kallspaces"]], 102400)],
+ "count characters in a file",
+ "\
+This command counts the characters in a file, using the
+C<wc -c> external command.");
+
+ ("head", (RStringList "lines", [String "path"]), 121, [ProtocolLimitWarning],
+ [InitBasicFS, Always, TestOutputList (
+ [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+ ["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
+ "return first 10 lines of a file",
+ "\
+This command returns up to the first 10 lines of a file as
+a list of strings.");
+
+ ("head_n", (RStringList "lines", [Int "nrlines"; String "path"]), 122, [ProtocolLimitWarning],
+ [InitBasicFS, Always, TestOutputList (
+ [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+ ["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
+ InitBasicFS, Always, TestOutputList (
+ [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+ ["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
+ InitBasicFS, Always, TestOutputList (
+ [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+ ["head_n"; "0"; "/10klines"]], [])],
+ "return first N lines of a file",
+ "\
+If the parameter C<nrlines> is a positive number, this returns the first
+C<nrlines> lines of the file C<path>.
+
+If the parameter C<nrlines> is a negative number, this returns lines
+from the file C<path>, excluding the last C<nrlines> lines.
+
+If the parameter C<nrlines> is zero, this returns an empty list.");
+
+ ("tail", (RStringList "lines", [String "path"]), 123, [ProtocolLimitWarning],
+ [InitBasicFS, Always, TestOutputList (
+ [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+ ["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
+ "return last 10 lines of a file",
+ "\
+This command returns up to the last 10 lines of a file as
+a list of strings.");
+
+ ("tail_n", (RStringList "lines", [Int "nrlines"; String "path"]), 124, [ProtocolLimitWarning],
+ [InitBasicFS, Always, TestOutputList (
+ [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+ ["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
+ InitBasicFS, Always, TestOutputList (
+ [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+ ["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
+ InitBasicFS, Always, TestOutputList (
+ [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+ ["tail_n"; "0"; "/10klines"]], [])],
+ "return last N lines of a file",
+ "\
+If the parameter C<nrlines> is a positive number, this returns the last
+C<nrlines> lines of the file C<path>.
+
+If the parameter C<nrlines> is a negative number, this returns lines
+from the file C<path>, starting with the C<-nrlines>th line.
+
+If the parameter C<nrlines> is zero, this returns an empty list.");
+
+ ("df", (RString "output", []), 125, [],
+ [], (* XXX Tricky to test because it depends on the exact format
+ * of the 'df' command and other imponderables.
+ *)
+ "report file system disk space usage",
+ "\
+This command runs the C<df> command to report disk space used.
+
+This command is mostly useful for interactive sessions. It
+is I<not> intended that you try to parse the output string.
+Use C<statvfs> from programs.");
+
+ ("df_h", (RString "output", []), 126, [],
+ [], (* XXX Tricky to test because it depends on the exact format
+ * of the 'df' command and other imponderables.
+ *)
+ "report file system disk space usage (human readable)",
+ "\
+This command runs the C<df -h> command to report disk space used
+in human-readable format.
+
+This command is mostly useful for interactive sessions. It
+is I<not> intended that you try to parse the output string.
+Use C<statvfs> from programs.");
+
+ ("du", (RInt64 "sizekb", [String "path"]), 127, [],
+ [InitBasicFS, Always, TestOutputInt (
+ [["mkdir"; "/p"];
+ ["du"; "/p"]], 1 (* ie. 1 block, so depends on ext3 blocksize *))],
+ "estimate file space usage",
+ "\
+This command runs the C<du -s> command to estimate file space
+usage for C<path>.
+
+C<path> can be a file or a directory. If C<path> is a directory
+then the estimate includes the contents of the directory and all
+subdirectories (recursively).
+
+The result is the estimated size in I<kilobytes>
+(ie. units of 1024 bytes).");
+
+ ("initrd_list", (RStringList "filenames", [String "path"]), 128, [],
+ [InitBasicFS, Always, TestOutputList (
+ [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+ ["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3"])],
+ "list files in an initrd",
+ "\
+This command lists out files contained in an initrd.
+
+The files are listed without any initial C</> character. The
+files are listed in the order they appear (not necessarily
+alphabetical). Directory names are listed as separate items.
+
+Old Linux kernels (2.4 and earlier) used a compressed ext2
+filesystem as initrd. We I<only> support the newer initramfs
+format (compressed cpio files).");
+
+ ("mount_loop", (RErr, [String "file"; String "mountpoint"]), 129, [],
+ [],
+ "mount a file using the loop device",
+ "\
+This command lets you mount C<file> (a filesystem image
+in a file) on a mount point. It is entirely equivalent to
+the command C<mount -o loop file mountpoint>.");
+
+ ("mkswap", (RErr, [String "device"]), 130, [],
+ [InitEmpty, Always, TestRun (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["mkswap"; "/dev/sda1"]])],
+ "create a swap partition",
+ "\
+Create a swap partition on C<device>.");
+
+ ("mkswap_L", (RErr, [String "label"; String "device"]), 131, [],
+ [InitEmpty, Always, TestRun (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["mkswap_L"; "hello"; "/dev/sda1"]])],
+ "create a swap partition with a label",
+ "\
+Create a swap partition on C<device> with label C<label>.");
+
+ ("mkswap_U", (RErr, [String "uuid"; String "device"]), 132, [],
+ [InitEmpty, Always, TestRun (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["mkswap_U"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"; "/dev/sda1"]])],
+ "create a swap partition with an explicit UUID",
+ "\
+Create a swap partition on C<device> with UUID C<uuid>.");
+
+ ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; String "path"]), 133, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["mknod"; "0o10777"; "0"; "0"; "/node"];
+ (* NB: default umask 022 means 0777 -> 0755 in these tests *)
+ ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)]);
+ InitBasicFS, Always, TestOutputStruct (
+ [["mknod"; "0o60777"; "66"; "99"; "/node"];
+ ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
+ "make block, character or FIFO devices",
+ "\
+This call creates block or character special devices, or
+named pipes (FIFOs).
+
+The C<mode> parameter should be the mode, using the standard
+constants. C<devmajor> and C<devminor> are the
+device major and minor numbers, only used when creating block
+and character special devices.");
+
+ ("mkfifo", (RErr, [Int "mode"; String "path"]), 134, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["mkfifo"; "0o777"; "/node"];
+ ["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
+ "make FIFO (named pipe)",
+ "\
+This call creates a FIFO (named pipe) called C<path> with
+mode C<mode>. It is just a convenient wrapper around
+C<guestfs_mknod>.");
+
+ ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; String "path"]), 135, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["mknod_b"; "0o777"; "99"; "66"; "/node"];
+ ["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
+ "make block device node",
+ "\
+This call creates a block device node called C<path> with
+mode C<mode> and device major/minor C<devmajor> and C<devminor>.
+It is just a convenient wrapper around C<guestfs_mknod>.");
+
+ ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; String "path"]), 136, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["mknod_c"; "0o777"; "99"; "66"; "/node"];
+ ["stat"; "/node"]], [CompareWithInt ("mode", 0o20755)])],
+ "make char device node",
+ "\
+This call creates a char device node called C<path> with
+mode C<mode> and device major/minor C<devmajor> and C<devminor>.
+It is just a convenient wrapper around C<guestfs_mknod>.");
+
+ ("umask", (RInt "oldmask", [Int "mask"]), 137, [],
+ [], (* XXX umask is one of those stateful things that we should
+ * reset between each test.
+ *)
+ "set file mode creation mask (umask)",
+ "\
+This function sets the mask used for creating new files and
+device nodes to C<mask & 0777>.
+
+Typical umask values would be C<022> which creates new files
+with permissions like \"-rw-r--r--\" or \"-rwxr-xr-x\", and
+C<002> which creates new files with permissions like
+\"-rw-rw-r--\" or \"-rwxrwxr-x\".
+
+The default umask is C<022>. This is important because it
+means that directories and device nodes will be created with
+C<0644> or C<0755> mode even if you specify C<0777>.
+
+See also L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
+
+This call returns the previous umask.");
+
+ ("readdir", (RStructList ("entries", "dirent"), [String "dir"]), 138, [],
+ [],
+ "read directories entries",
+ "\
+This returns the list of directory entries in directory C<dir>.
+
+All entries in the directory are returned, including C<.> and
+C<..>. The entries are I<not> sorted, but returned in the same
+order as the underlying filesystem.
+
+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, [String "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> and the L<sfdisk(8)> manpage.");
+
+ ("zfile", (RString "description", [String "method"; String "path"]), 140, [],
+ [],
+ "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>.
+
+See also: C<guestfs_file>");
+
+]
+
+let all_functions = non_daemon_functions @ daemon_functions
+
+(* In some places we want the functions to be displayed sorted
+ * alphabetically, so this is useful:
+ *)
+let all_functions_sorted =
+ List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
+ compare n1 n2) all_functions
+
+(* Field types for structures. *)
+type field =
+ | FChar (* C 'char' (really, a 7 bit byte). *)
+ | FString (* nul-terminated ASCII string. *)
+ | 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;
+ ];
+] (* 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";
+]
+
+(* Used for testing language bindings. *)
+type callt =
+ | CallString of string
+ | CallOptString of string option
+ | CallStringList of string list
+ | CallInt of int
+ | 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
+
+(* Useful functions.
+ * Note we don't want to use any external OCaml libraries which
+ * makes this a bit harder than it should be.
+ *)
+let failwithf fs = ksprintf failwith fs
+
+let replace_char s c1 c2 =
+ let s2 = String.copy s in
+ let r = ref false in
+ for i = 0 to String.length s2 - 1 do
+ if String.unsafe_get s2 i = c1 then (
+ String.unsafe_set s2 i c2;
+ r := true
+ )
+ done;
+ if not !r then s else s2
+
+let isspace c =
+ c = ' '
+ (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
+
+let triml ?(test = isspace) str =
+ let i = ref 0 in
+ let n = ref (String.length str) in
+ while !n > 0 && test str.[!i]; do
+ decr n;
+ incr i
+ done;
+ if !i = 0 then str
+ else String.sub str !i !n
+
+let trimr ?(test = isspace) str =
+ let n = ref (String.length str) in
+ while !n > 0 && test str.[!n-1]; do
+ decr n
+ done;
+ if !n = String.length str then str
+ else String.sub str 0 !n
+
+let trim ?(test = isspace) str =
+ trimr ~test (triml ~test str)
+
+let rec find s sub =
+ let len = String.length s in
+ let sublen = String.length sub in
+ let rec loop i =
+ if i <= len-sublen then (
+ let rec loop2 j =
+ if j < sublen then (
+ if s.[i+j] = sub.[j] then loop2 (j+1)
+ else -1
+ ) else
+ i (* found *)
+ in
+ let r = loop2 0 in
+ if r = -1 then loop (i+1) else r
+ ) else
+ -1 (* not found *)
+ in
+ loop 0
+
+let rec replace_str s s1 s2 =
+ let len = String.length s in
+ let sublen = String.length s1 in
+ let i = find s s1 in
+ if i = -1 then s
+ else (
+ let s' = String.sub s 0 i in
+ let s'' = String.sub s (i+sublen) (len-i-sublen) in
+ s' ^ s2 ^ replace_str s'' s1 s2
+ )
+
+let rec string_split sep str =
+ let len = String.length str in
+ let seplen = String.length sep in
+ let i = find str sep in
+ if i = -1 then [str]
+ else (
+ let s' = String.sub str 0 i in
+ let s'' = String.sub str (i+seplen) (len-i-seplen) in
+ s' :: string_split sep s''
+ )
+
+let files_equal n1 n2 =
+ let cmd = sprintf "cmp -s %s %s" (Filename.quote n1) (Filename.quote n2) in
+ match Sys.command cmd with
+ | 0 -> true
+ | 1 -> false
+ | i -> failwithf "%s: failed with error code %d" cmd i
+
+let rec find_map f = function
+ | [] -> raise Not_found
+ | x :: xs ->
+ match f x with
+ | Some y -> y
+ | None -> find_map f xs
+
+let iteri f xs =
+ let rec loop i = function
+ | [] -> ()
+ | x :: xs -> f i x; loop (i+1) xs
+ in
+ loop 0 xs
+
+let mapi f xs =
+ let rec loop i = function
+ | [] -> []
+ | x :: xs -> let r = f i x in r :: loop (i+1) xs
+ in
+ loop 0 xs
+
+let name_of_argt = function
+ | String n | OptString n | StringList n | Bool n | Int n
+ | FileIn n | FileOut n -> n
+
+let 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, _) | TestOutputStruct (s, _)
+ | TestLastFail s -> s
+
+(* Check function names etc. for consistency. *)
+let check_functions () =
+ let contains_uppercase str =
+ let len = String.length str in
+ let rec loop i =
+ if i >= len then false
+ else (
+ let c = str.[i] in
+ if c >= 'A' && c <= 'Z' then true
+ else loop (i+1)
+ )
+ in
+ loop 0
+ in
+
+ (* Check function names. *)
+ List.iter (
+ fun (name, _, _, _, _, _, _) ->
+ if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
+ failwithf "function name %s does not need 'guestfs' prefix" name;
+ if 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
+ in
+
+ (match fst style with
+ | RErr -> ()
+ | RInt n | RInt64 n | RBool n | RConstString n | RString n
+ | RStringList n | RStruct (n, _) | RStructList (n, _)
+ | RHashtable 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 stdout
+let pr fs = ksprintf (output_string !chan) fs
+
+(* Generate a header block in a number of standard styles. *)
+type comment_style = CStyle | HashStyle | OCamlStyle | HaskellStyle
+type license = GPLv2 | LGPLv2
+
+let generate_header comment license =
+ let c = match comment with
+ | CStyle -> pr "/* "; " *"
+ | HashStyle -> pr "# "; "#"
+ | OCamlStyle -> pr "(* "; " *"
+ | HaskellStyle -> pr "{- "; " " in
+ pr "libguestfs generated file\n";
+ pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
+ pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
+ pr "%s\n" c;
+ pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
+ pr "%s\n" c;
+ (match license with
+ | GPLv2 ->
+ pr "%s This program is free software; you can redistribute it and/or modify\n" c;
+ pr "%s it under the terms of the GNU General Public License as published by\n" c;
+ pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
+ pr "%s (at your option) any later version.\n" c;
+ pr "%s\n" c;
+ pr "%s This program is distributed in the hope that it will be useful,\n" c;
+ pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
+ pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n" c;
+ pr "%s GNU General Public License for more details.\n" c;
+ pr "%s\n" c;
+ pr "%s You should have received a copy of the GNU General Public License along\n" c;
+ pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
+ pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
+
+ | LGPLv2 ->
+ pr "%s This library is free software; you can redistribute it and/or\n" c;
+ pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
+ pr "%s License as published by the Free Software Foundation; either\n" c;
+ pr "%s version 2 of the License, or (at your option) any later version.\n" c;
+ pr "%s\n" c;
+ pr "%s This library is distributed in the hope that it will be useful,\n" c;
+ pr "%s but WITHOUT ANY WARRANTY; without even the implied warranty of\n" c;
+ pr "%s MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU\n" c;
+ pr "%s Lesser General Public License for more details.\n" c;
+ pr "%s\n" c;
+ pr "%s You should have received a copy of the GNU Lesser General Public\n" c;
+ pr "%s License along with this library; if not, write to the Free Software\n" c;
+ pr "%s Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA\n" c;
+ );
+ (match comment with
+ | CStyle -> pr " */\n"
+ | HashStyle -> ()
+ | OCamlStyle -> pr " *)\n"
+ | 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"
+ | 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"
+ );
+ if List.mem ProtocolLimitWarning flags then
+ pr "%s\n\n" protocol_limit_warning;
+ if List.mem DangerWillRobinson flags then
+ pr "%s\n\n" danger_will_robinson
+ )
+ ) all_functions_sorted
+
+and generate_structs_pod () =
+ (* 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, 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
+
+(* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
+ * indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
+ *
+ * We have to use an underscore instead of a dash because otherwise
+ * rpcgen generates incorrect code.
+ *
+ * This header is NOT exported to clients, but see also generate_structs_h.
+ *)
+and generate_xdr () =
+ generate_header CStyle LGPLv2;
+
+ (* This has to be defined to get around a limitation in Sun's rpcgen. *)
+ pr "typedef string str<>;\n";
+ pr "\n";
+
+ (* 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, 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
+ | String n -> pr " string %s<>;\n" n
+ | OptString n -> pr " str *%s;\n" n
+ | StringList n -> pr " str %s<>;\n" n
+ | Bool n -> pr " bool %s;\n" n
+ | Int n -> pr " int %s;\n" n
+ | FileIn _ | FileOut _ -> ()
+ ) args;
+ pr "};\n\n"
+ );
+ (match fst style with
+ | RErr -> ()
+ | RInt n ->
+ pr "struct %s_ret {\n" name;
+ pr " int %s;\n" n;
+ pr "};\n\n"
+ | RInt64 n ->
+ pr "struct %s_ret {\n" name;
+ pr " hyper %s;\n" n;
+ pr "};\n\n"
+ | RBool n ->
+ pr "struct %s_ret {\n" name;
+ pr " bool %s;\n" n;
+ pr "};\n\n"
+ | RConstString _ ->
+ failwithf "RConstString cannot be returned from a daemon function"
+ | RString n ->
+ pr "struct %s_ret {\n" name;
+ pr " string %s<>;\n" n;
+ pr "};\n\n"
+ | RStringList n ->
+ pr "struct %s_ret {\n" name;
+ pr " str %s<>;\n" n;
+ pr "};\n\n"
+ | 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"
+ );
+ ) daemon_functions;
+
+ (* Table of procedure numbers. *)
+ pr "enum guestfs_procedure {\n";
+ List.iter (
+ fun (shortname, _, proc_nr, _, _, _, _) ->
+ pr " GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
+ ) daemon_functions;
+ pr " GUESTFS_PROC_NR_PROCS\n";
+ pr "};\n";
+ pr "\n";
+
+ (* Having to choose a maximum message size is annoying for several
+ * reasons (it limits what we can do in the API), but it (a) makes
+ * the protocol a lot simpler, and (b) provides a bound on the size
+ * of the daemon which operates in limited memory space. For large
+ * file transfers you should use FTP.
+ *)
+ pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
+ pr "\n";
+
+ (* Message header, etc. *)
+ pr "\
+/* The communication protocol is now documented in the guestfs(3)
+ * manpage.
+ */
+
+const GUESTFS_PROGRAM = 0x2000F5F5;
+const GUESTFS_PROTOCOL_VERSION = 1;
+
+/* These constants must be larger than any possible message length. */
+const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
+const GUESTFS_CANCEL_FLAG = 0xffffeeee;
+
+enum guestfs_message_direction {
+ GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
+ GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
+};
+
+enum guestfs_message_status {
+ GUESTFS_STATUS_OK = 0,
+ GUESTFS_STATUS_ERROR = 1
+};
+
+const GUESTFS_ERROR_LEN = 256;
+
+struct guestfs_message_error {
+ string error_message<GUESTFS_ERROR_LEN>;
+};
+
+struct guestfs_message_header {
+ unsigned prog; /* GUESTFS_PROGRAM */
+ unsigned vers; /* GUESTFS_PROTOCOL_VERSION */
+ guestfs_procedure proc; /* GUESTFS_PROC_x */
+ guestfs_message_direction direction;
+ unsigned serial; /* message serial number */
+ guestfs_message_status status;
+};
+
+const GUESTFS_MAX_CHUNK_SIZE = 8192;
+
+struct guestfs_chunk {
+ int cancel; /* if non-zero, transfer is cancelled */
+ /* data size is 0 bytes if the transfer has finished successfully */
+ opaque data<GUESTFS_MAX_CHUNK_SIZE>;
+};
+"
+
+(* Generate the guestfs-structs.h file. *)
+and generate_structs_h () =
+ generate_header CStyle LGPLv2;
+
+ (* This is a public exported header file containing various
+ * structures. The structures are carefully written to have
+ * exactly the same in-memory format as the XDR structures that
+ * we use on the wire to the daemon. The reason for creating
+ * copies of these structures here is just so we don't have to
+ * export the whole of guestfs_protocol.h (which includes much
+ * unrelated and XDR-dependent stuff that we don't want to be
+ * public, or required by clients).
+ *
+ * To reiterate, we will pass these structures to and from the
+ * client with a simple assignment or memcpy, so the format
+ * must be identical to what rpcgen / the RFC defines.
+ *)
+
+ (* 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, 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 LGPLv2;
+ List.iter (
+ fun (shortname, style, _, _, _, _, _) ->
+ let name = "guestfs_" ^ shortname in
+ generate_prototype ~single_line:true ~newline:true ~handle:"handle"
+ name style
+ ) all_functions
+
+(* Generate the client-side dispatch stubs. *)
+and generate_client_actions () =
+ generate_header CStyle LGPLv2;
+
+ pr "\
+#include <stdio.h>
+#include <stdlib.h>
+
+#include \"guestfs.h\"
+#include \"guestfs_protocol.h\"
+
+#define error guestfs_error
+#define perrorf guestfs_perrorf
+#define safe_malloc guestfs_safe_malloc
+#define safe_realloc guestfs_safe_realloc
+#define safe_strdup guestfs_safe_strdup
+#define safe_memdup guestfs_safe_memdup
+
+/* Check the return message from a call for validity. */
+static int
+check_reply_header (guestfs_h *g,
+ const struct guestfs_message_header *hdr,
+ int proc_nr, int serial)
+{
+ if (hdr->prog != GUESTFS_PROGRAM) {
+ error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
+ return -1;
+ }
+ if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
+ error (g, \"wrong protocol version (%%d/%%d)\",
+ hdr->vers, GUESTFS_PROTOCOL_VERSION);
+ return -1;
+ }
+ if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
+ error (g, \"unexpected message direction (%%d/%%d)\",
+ hdr->direction, GUESTFS_DIRECTION_REPLY);
+ return -1;
+ }
+ if (hdr->proc != proc_nr) {
+ error (g, \"unexpected procedure number (%%d/%%d)\", hdr->proc, proc_nr);
+ return -1;
+ }
+ if (hdr->serial != serial) {
+ error (g, \"unexpected serial (%%d/%%d)\", hdr->serial, serial);
+ return -1;
+ }
+
+ return 0;
+}
+
+/* Check we are in the right state to run a high-level action. */
+static int
+check_state (guestfs_h *g, const char *caller)
+{
+ if (!guestfs_is_ready (g)) {
+ if (guestfs_is_config (g))
+ error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
+ caller);
+ else if (guestfs_is_launching (g))
+ error (g, \"%%s: call wait_ready() before using this function\",
+ caller);
+ else
+ error (g, \"%%s called from the wrong state, %%d != READY\",
+ caller, guestfs_get_state (g));
+ return -1;
+ }
+ return 0;
+}
+
+";
+
+ (* Client-side stubs for each function. *)
+ List.iter (
+ fun (shortname, style, _, _, _, _, _) ->
+ let name = "guestfs_" ^ shortname in
+
+ (* Generate the context struct which stores the high-level
+ * state between callback functions.
+ *)
+ pr "struct %s_ctx {\n" shortname;
+ pr " /* This flag is set by the callbacks, so we know we've done\n";
+ pr " * the callbacks as expected, and in the right sequence.\n";
+ pr " * 0 = not called, 1 = reply_cb called.\n";
+ pr " */\n";
+ pr " int cb_sequence;\n";
+ pr " struct guestfs_message_header hdr;\n";
+ pr " struct guestfs_message_error err;\n";
+ (match fst style with
+ | RErr -> ()
+ | RConstString _ ->
+ failwithf "RConstString cannot be returned from a daemon function"
+ | RInt _ | RInt64 _
+ | RBool _ | RString _ | RStringList _
+ | RStruct _ | RStructList _
+ | RHashtable _ ->
+ pr " struct %s_ret ret;\n" name
+ );
+ pr "};\n";
+ pr "\n";
+
+ (* Generate the reply callback function. *)
+ pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
+ pr "{\n";
+ pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
+ pr " struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
+ pr "\n";
+ pr " /* This should definitely not happen. */\n";
+ pr " if (ctx->cb_sequence != 0) {\n";
+ pr " ctx->cb_sequence = 9999;\n";
+ pr " error (g, \"%%s: internal error: reply callback called twice\", \"%s\");\n" name;
+ pr " return;\n";
+ pr " }\n";
+ pr "\n";
+ pr " ml->main_loop_quit (ml, g);\n";
+ pr "\n";
+ pr " if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
+ pr " error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
+ pr " return;\n";
+ pr " }\n";
+ pr " if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
+ pr " if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
+ pr " error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
+ name;
+ pr " return;\n";
+ pr " }\n";
+ pr " goto done;\n";
+ pr " }\n";
+
+ (match fst style with
+ | RErr -> ()
+ | RConstString _ ->
+ failwithf "RConstString cannot be returned from a daemon function"
+ | RInt _ | RInt64 _
+ | RBool _ | RString _ | RStringList _
+ | RStruct _ | RStructList _
+ | RHashtable _ ->
+ pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
+ pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
+ pr " return;\n";
+ pr " }\n";
+ );
+
+ pr " done:\n";
+ pr " ctx->cb_sequence = 1;\n";
+ pr "}\n\n";
+
+ (* Generate the action stub. *)
+ generate_prototype ~extern:false ~semicolon:false ~newline:true
+ ~handle:"g" name style;
+
+ let error_code =
+ match fst style with
+ | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
+ | RConstString _ ->
+ failwithf "RConstString cannot be returned from a daemon function"
+ | RString _ | RStringList _
+ | RStruct _ | RStructList _
+ | RHashtable _ ->
+ "NULL" in
+
+ pr "{\n";
+
+ (match snd style with
+ | [] -> ()
+ | _ -> pr " struct %s_args args;\n" name
+ );
+
+ pr " struct %s_ctx ctx;\n" shortname;
+ pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
+ pr " int serial;\n";
+ pr "\n";
+ pr " if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
+ pr " guestfs_set_busy (g);\n";
+ pr "\n";
+ pr " memset (&ctx, 0, sizeof ctx);\n";
+ pr "\n";
+
+ (* Send the main header and arguments. *)
+ (match snd style with
+ | [] ->
+ pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
+ (String.uppercase shortname)
+ | args ->
+ List.iter (
+ function
+ | String n ->
+ pr " args.%s = (char *) %s;\n" n n
+ | OptString n ->
+ pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
+ | StringList n ->
+ pr " args.%s.%s_val = (char **) %s;\n" n n n;
+ pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
+ | Bool n ->
+ pr " args.%s = %s;\n" n n
+ | Int n ->
+ pr " args.%s = %s;\n" n n
+ | FileIn _ | FileOut _ -> ()
+ ) args;
+ pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
+ (String.uppercase shortname);
+ pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
+ name;
+ );
+ pr " if (serial == -1) {\n";
+ pr " guestfs_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 " {\n";
+ pr " int r;\n";
+ pr "\n";
+ pr " r = guestfs__send_file_sync (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";
+ pr "\n";
+ | _ -> ()
+ ) (snd style);
+
+ (* Wait for the reply from the remote end. *)
+ if !need_read_reply_label then pr " read_reply:\n";
+ pr " guestfs__switch_to_receiving (g);\n";
+ pr " ctx.cb_sequence = 0;\n";
+ pr " guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
+ pr " (void) ml->main_loop_run (ml, g);\n";
+ pr " guestfs_set_reply_callback (g, NULL, NULL);\n";
+ pr " if (ctx.cb_sequence != 1) {\n";
+ pr " error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
+ pr " guestfs_end_busy (g);\n";
+ pr " return %s;\n" error_code;
+ pr " }\n";
+ pr "\n";
+
+ pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
+ (String.uppercase shortname);
+ pr " guestfs_end_busy (g);\n";
+ pr " return %s;\n" error_code;
+ pr " }\n";
+ pr "\n";
+
+ pr " if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
+ pr " error (g, \"%%s\", ctx.err.error_message);\n";
+ pr " free (ctx.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__receive_file_sync (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 ctx.ret.%s;\n" n
+ | RConstString _ ->
+ failwithf "RConstString cannot be returned from a daemon function"
+ | RString n ->
+ pr " return ctx.ret.%s; /* caller will free */\n" n
+ | RStringList n | RHashtable n ->
+ pr " /* caller will free this, but we need to add a NULL entry */\n";
+ pr " ctx.ret.%s.%s_val =\n" n n;
+ pr " safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
+ pr " sizeof (char *) * (ctx.ret.%s.%s_len + 1));\n"
+ n n;
+ pr " ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
+ pr " return ctx.ret.%s.%s_val;\n" n n
+ | RStruct (n, _) ->
+ pr " /* caller will free this */\n";
+ pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
+ | RStructList (n, _) ->
+ pr " /* caller will free this */\n";
+ pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
+ );
+
+ pr "}\n\n"
+ ) daemon_functions;
+
+ (* 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 GPLv2;
+
+ pr "#include \"../src/guestfs_protocol.h\"\n";
+ pr "\n";
+
+ List.iter (
+ fun (name, style, _, _, _, _, _) ->
+ generate_prototype
+ ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
+ name style;
+ ) daemon_functions
+
+(* Generate the server-side stubs. *)
+and generate_daemon_actions () =
+ generate_header CStyle GPLv2;
+
+ pr "#include <config.h>\n";
+ pr "\n";
+ pr "#include <stdio.h>\n";
+ pr "#include <stdlib.h>\n";
+ pr "#include <string.h>\n";
+ pr "#include <inttypes.h>\n";
+ pr "#include <ctype.h>\n";
+ pr "#include <rpc/types.h>\n";
+ pr "#include <rpc/xdr.h>\n";
+ pr "\n";
+ pr "#include \"daemon.h\"\n";
+ pr "#include \"../src/guestfs_protocol.h\"\n";
+ pr "#include \"actions.h\"\n";
+ pr "\n";
+
+ List.iter (
+ fun (name, style, _, _, _, _, _) ->
+ (* Generate server-side stubs. *)
+ pr "static void %s_stub (XDR *xdr_in)\n" name;
+ pr "{\n";
+ let error_code =
+ match fst style with
+ | RErr | RInt _ -> pr " int r;\n"; "-1"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1"
+ | RBool _ -> pr " int r;\n"; "-1"
+ | RConstString _ ->
+ failwithf "RConstString cannot be returned from a daemon function"
+ | RString _ -> pr " char *r;\n"; "NULL"
+ | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
+ | RStruct (_, typ) -> pr " guestfs_int_%s *r;\n" typ; "NULL"
+ | RStructList (_, typ) -> pr " guestfs_int_%s_list *r;\n" typ; "NULL" in
+
+ (match snd style with
+ | [] -> ()
+ | args ->
+ pr " struct guestfs_%s_args args;\n" name;
+ List.iter (
+ function
+ (* Note we allow the string to be writable, in order to
+ * allow device name translation. This is safe because
+ * we can modify the string (passed from RPC).
+ *)
+ | String n
+ | OptString n -> pr " char *%s;\n" n
+ | StringList n -> pr " char **%s;\n" n
+ | Bool n -> pr " int %s;\n" n
+ | Int n -> pr " int %s;\n" n
+ | FileIn _ | FileOut _ -> ()
+ ) args
+ );
+ pr "\n";
+
+ (match snd style with
+ | [] -> ()
+ | args ->
+ pr " memset (&args, 0, sizeof args);\n";
+ pr "\n";
+ pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
+ pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
+ pr " return;\n";
+ pr " }\n";
+ List.iter (
+ function
+ | String n -> pr " %s = args.%s;\n" n n
+ | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
+ | StringList n ->
+ pr " %s = realloc (args.%s.%s_val,\n" n n n;
+ pr " sizeof (char *) * (args.%s.%s_len+1));\n" n n;
+ pr " if (%s == NULL) {\n" n;
+ pr " reply_with_perror (\"realloc\");\n";
+ pr " goto done;\n";
+ pr " }\n";
+ pr " %s[args.%s.%s_len] = NULL;\n" n n n;
+ pr " args.%s.%s_val = %s;\n" n n n;
+ | Bool n -> pr " %s = args.%s;\n" n n
+ | Int n -> pr " %s = args.%s;\n" n n
+ | FileIn _ | FileOut _ -> ()
+ ) args;
+ pr "\n"
+ );
+
+ (* Don't want to call the impl with any FileIn or FileOut
+ * parameters, since these go "outside" the RPC protocol.
+ *)
+ let argsnofile =
+ List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
+ (snd style) in
+ pr " r = do_%s " name;
+ generate_call_args argsnofile;
+ pr ";\n";
+
+ pr " if (r == %s)\n" error_code;
+ pr " /* do_%s has already called reply_with_error */\n" name;
+ pr " goto done;\n";
+ pr "\n";
+
+ (* If there are any FileOut parameters, then the impl must
+ * send its own reply.
+ *)
+ let no_reply =
+ List.exists (function FileOut _ -> true | _ -> false) (snd style) in
+ if no_reply then
+ pr " /* do_%s has already sent a reply */\n" name
+ else (
+ match fst style with
+ | RErr -> pr " reply (NULL, NULL);\n"
+ | RInt n | RInt64 n | RBool n ->
+ pr " struct guestfs_%s_ret ret;\n" name;
+ pr " ret.%s = r;\n" n;
+ pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
+ name
+ | RConstString _ ->
+ failwithf "RConstString cannot be returned from a daemon function"
+ | RString n ->
+ pr " struct guestfs_%s_ret ret;\n" name;
+ pr " ret.%s = r;\n" n;
+ pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
+ name;
+ pr " free (r);\n"
+ | RStringList n | RHashtable n ->
+ pr " struct guestfs_%s_ret ret;\n" name;
+ pr " ret.%s.%s_len = count_strings (r);\n" n n;
+ pr " ret.%s.%s_val = r;\n" n n;
+ pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
+ name;
+ pr " free_strings (r);\n"
+ | 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
+ );
+
+ (* 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 || 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";
+ | 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 && 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 GPLv2;
+
+ 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 tests. *)
+and generate_tests () =
+ generate_header CStyle GPLv2;
+
+ pr "\
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+#include <sys/types.h>
+#include <fcntl.h>
+
+#include \"guestfs.h\"
+
+static guestfs_h *g;
+static int suppress_error = 0;
+
+static void print_error (guestfs_h *g, void *data, const char *msg)
+{
+ if (!suppress_error)
+ fprintf (stderr, \"%%s\\n\", msg);
+}
+
+static void print_strings (char * const * const argv)
+{
+ int argc;
+
+ for (argc = 0; argv[argc] != NULL; ++argc)
+ printf (\"\\t%%s\\n\", argv[argc]);
+}
+
+/*
+static void print_table (char * const * const argv)
+{
+ int i;
+
+ for (i = 0; argv[i] != NULL; i += 2)
+ printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
+}
+*/
+
+static void no_test_warnings (void)
+{
+";
+
+ List.iter (
+ function
+ | name, _, _, _, [], _, _ ->
+ pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
+ | name, _, _, _, tests, _, _ -> ()
+ ) all_functions;
+
+ pr "}\n";
+ pr "\n";
+
+ (* Generate the actual tests. Note that we generate the tests
+ * in reverse order, deliberately, so that (in general) the
+ * newest tests run first. This makes it quicker and easier to
+ * debug them.
+ *)
+ let test_names =
+ List.map (
+ fun (name, _, _, _, tests, _, _) ->
+ mapi (generate_one_test name) tests
+ ) (List.rev all_functions) in
+ let test_names = List.concat test_names in
+ let nr_tests = List.length test_names in
+
+ pr "\
+int main (int argc, char *argv[])
+{
+ char c = 0;
+ int failed = 0;
+ const char *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 (1);
+ }
+
+ 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 (1);
+ }
+ if (lseek (fd, %d, SEEK_SET) == -1) {
+ perror (\"lseek\");
+ close (fd);
+ unlink (filename);
+ exit (1);
+ }
+ if (write (fd, &c, 1) == -1) {
+ perror (\"write\");
+ close (fd);
+ unlink (filename);
+ exit (1);
+ }
+ if (close (fd) == -1) {
+ perror (filename);
+ unlink (filename);
+ exit (1);
+ }
+ if (guestfs_add_drive (g, filename) == -1) {
+ printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
+ exit (1);
+ }
+
+ filename = \"test2.img\";
+ fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
+ if (fd == -1) {
+ perror (filename);
+ exit (1);
+ }
+ if (lseek (fd, %d, SEEK_SET) == -1) {
+ perror (\"lseek\");
+ close (fd);
+ unlink (filename);
+ exit (1);
+ }
+ if (write (fd, &c, 1) == -1) {
+ perror (\"write\");
+ close (fd);
+ unlink (filename);
+ exit (1);
+ }
+ if (close (fd) == -1) {
+ perror (filename);
+ unlink (filename);
+ exit (1);
+ }
+ if (guestfs_add_drive (g, filename) == -1) {
+ printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
+ exit (1);
+ }
+
+ filename = \"test3.img\";
+ fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
+ if (fd == -1) {
+ perror (filename);
+ exit (1);
+ }
+ if (lseek (fd, %d, SEEK_SET) == -1) {
+ perror (\"lseek\");
+ close (fd);
+ unlink (filename);
+ exit (1);
+ }
+ if (write (fd, &c, 1) == -1) {
+ perror (\"write\");
+ close (fd);
+ unlink (filename);
+ exit (1);
+ }
+ if (close (fd) == -1) {
+ perror (filename);
+ unlink (filename);
+ exit (1);
+ }
+ if (guestfs_add_drive (g, filename) == -1) {
+ printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
+ exit (1);
+ }
+
+ if (guestfs_add_drive_ro (g, \"../images/test.sqsh\") == -1) {
+ printf (\"guestfs_add_drive_ro ../images/test.sqsh FAILED\\n\");
+ exit (1);
+ }
+
+ if (guestfs_launch (g) == -1) {
+ printf (\"guestfs_launch FAILED\\n\");
+ exit (1);
+ }
+
+ /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
+ alarm (600);
+
+ if (guestfs_wait_ready (g) == -1) {
+ printf (\"guestfs_wait_ready FAILED\\n\");
+ exit (1);
+ }
+
+ /* 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;
+ pr " if (%s () == -1) {\n" test_name;
+ pr " printf (\"%s FAILED\\n\");\n" test_name;
+ pr " failed++;\n";
+ pr " }\n";
+ ) test_names;
+ pr "\n";
+
+ pr " guestfs_close (g);\n";
+ pr " unlink (\"test1.img\");\n";
+ pr " unlink (\"test2.img\");\n";
+ pr " unlink (\"test3.img\");\n";
+ pr "\n";
+
+ pr " if (failed > 0) {\n";
+ pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
+ pr " exit (1);\n";
+ pr " }\n";
+ pr "\n";
+
+ pr " exit (0);\n";
+ pr "}\n"
+
+and generate_one_test name i (init, prereq, test) =
+ let test_name = sprintf "test_%s_%d" name i in
+
+ pr "\
+static int %s_skip (void)
+{
+ const char *str;
+
+ str = getenv (\"TEST_ONLY\");
+ if (str)
+ return strstr (str, \"%s\") == NULL;
+ str = getenv (\"SKIP_%s\");
+ if (str && strcmp (str, \"1\") == 0) return 1;
+ str = getenv (\"SKIP_TEST_%s\");
+ if (str && strcmp (str, \"1\") == 0) return 1;
+ return 0;
+}
+
+" test_name name (String.uppercase test_name) (String.uppercase name);
+
+ (match prereq with
+ | Disabled | Always -> ()
+ | If code | Unless code ->
+ pr "static int %s_prereq (void)\n" test_name;
+ pr "{\n";
+ pr " %s\n" code;
+ pr "}\n";
+ pr "\n";
+ );
+
+ pr "\
+static int %s (void)
+{
+ if (%s_skip ()) {
+ printf (\" %%s skipped (reason: environment variable set)\\n\", \"%s\");
+ return 0;
+ }
+
+" test_name test_name test_name;
+
+ (match prereq with
+ | Disabled ->
+ pr " printf (\" %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
+ | If _ ->
+ pr " if (! %s_prereq ()) {\n" test_name;
+ pr " printf (\" %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
+ pr " return 0;\n";
+ pr " }\n";
+ pr "\n";
+ generate_one_test_body name i test_name init test;
+ | Unless _ ->
+ pr " if (%s_prereq ()) {\n" test_name;
+ pr " printf (\" %%s skipped (reason: test prerequisite)\\n\", \"%s\");\n" test_name;
+ pr " return 0;\n";
+ pr " }\n";
+ pr "\n";
+ generate_one_test_body name i test_name init test;
+ | Always ->
+ generate_one_test_body name i test_name init test
+ );
+
+ pr " return 0;\n";
+ pr "}\n";
+ pr "\n";
+ test_name
+
+and generate_one_test_body name i test_name init test =
+ (match init with
+ | InitNone (* XXX at some point, InitNone and InitEmpty became
+ * folded together as the same thing. Really we should
+ * make InitNone do nothing at all, but the tests may
+ * need to be checked to make sure this is OK.
+ *)
+ | InitEmpty ->
+ pr " /* InitNone|InitEmpty for %s */\n" test_name;
+ List.iter (generate_test_command_call test_name)
+ [["blockdev_setrw"; "/dev/sda"];
+ ["umount_all"];
+ ["lvm_remove_all"]]
+ | InitBasicFS ->
+ pr " /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
+ List.iter (generate_test_command_call test_name)
+ [["blockdev_setrw"; "/dev/sda"];
+ ["umount_all"];
+ ["lvm_remove_all"];
+ ["sfdiskM"; "/dev/sda"; ","];
+ ["mkfs"; "ext2"; "/dev/sda1"];
+ ["mount"; "/dev/sda1"; "/"]]
+ | InitBasicFSonLVM ->
+ pr " /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
+ test_name;
+ List.iter (generate_test_command_call test_name)
+ [["blockdev_setrw"; "/dev/sda"];
+ ["umount_all"];
+ ["lvm_remove_all"];
+ ["sfdiskM"; "/dev/sda"; ","];
+ ["pvcreate"; "/dev/sda1"];
+ ["vgcreate"; "VG"; "/dev/sda1"];
+ ["lvcreate"; "LV"; "VG"; "8"];
+ ["mkfs"; "ext2"; "/dev/VG/LV"];
+ ["mount"; "/dev/VG/LV"; "/"]]
+ );
+
+ let get_seq_last = function
+ | [] ->
+ failwithf "%s: you cannot use [] (empty list) when expecting a command"
+ test_name
+ | seq ->
+ let seq = List.rev seq in
+ List.rev (List.tl seq), List.hd seq
+ in
+
+ match test with
+ | TestRun seq ->
+ pr " /* TestRun for %s (%d) */\n" name i;
+ List.iter (generate_test_command_call test_name) seq
+ | TestOutput (seq, expected) ->
+ pr " /* TestOutput for %s (%d) */\n" name i;
+ pr " const char *expected = \"%s\";\n" (c_quote expected);
+ let seq, last = get_seq_last seq in
+ let test () =
+ pr " if (strcmp (r, expected) != 0) {\n";
+ pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
+ pr " return -1;\n";
+ pr " }\n"
+ in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call ~test test_name last
+ | TestOutputList (seq, expected) ->
+ pr " /* TestOutputList for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ let test () =
+ iteri (
+ fun i str ->
+ pr " if (!r[%d]) {\n" i;
+ pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
+ pr " print_strings (r);\n";
+ pr " return -1;\n";
+ pr " }\n";
+ pr " {\n";
+ pr " const char *expected = \"%s\";\n" (c_quote str);
+ pr " if (strcmp (r[%d], expected) != 0) {\n" i;
+ pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
+ pr " return -1;\n";
+ pr " }\n";
+ pr " }\n"
+ ) expected;
+ pr " if (r[%d] != NULL) {\n" (List.length expected);
+ pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
+ test_name;
+ pr " print_strings (r);\n";
+ pr " return -1;\n";
+ pr " }\n"
+ in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call ~test test_name last
+ | TestOutputListOfDevices (seq, expected) ->
+ pr " /* TestOutputListOfDevices for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ let test () =
+ iteri (
+ fun i str ->
+ pr " if (!r[%d]) {\n" i;
+ pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
+ pr " print_strings (r);\n";
+ pr " return -1;\n";
+ pr " }\n";
+ pr " {\n";
+ pr " const char *expected = \"%s\";\n" (c_quote str);
+ pr " r[%d][5] = 's';\n" i;
+ pr " if (strcmp (r[%d], expected) != 0) {\n" i;
+ pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
+ pr " return -1;\n";
+ pr " }\n";
+ pr " }\n"
+ ) expected;
+ pr " if (r[%d] != NULL) {\n" (List.length expected);
+ pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
+ test_name;
+ pr " print_strings (r);\n";
+ pr " return -1;\n";
+ pr " }\n"
+ in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call ~test test_name last
+ | TestOutputInt (seq, expected) ->
+ pr " /* TestOutputInt for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ let test () =
+ pr " if (r != %d) {\n" expected;
+ pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
+ test_name expected;
+ pr " (int) r);\n";
+ pr " return -1;\n";
+ pr " }\n"
+ in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call ~test test_name last
+ | TestOutputIntOp (seq, op, expected) ->
+ pr " /* TestOutputIntOp for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ let test () =
+ pr " if (! (r %s %d)) {\n" op expected;
+ pr " fprintf (stderr, \"%s: expected %s %d but got %%d\\n\","
+ test_name op expected;
+ pr " (int) r);\n";
+ pr " return -1;\n";
+ pr " }\n"
+ in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call ~test test_name last
+ | TestOutputTrue seq ->
+ pr " /* TestOutputTrue for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ let test () =
+ pr " if (!r) {\n";
+ pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
+ test_name;
+ pr " return -1;\n";
+ pr " }\n"
+ in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call ~test test_name last
+ | TestOutputFalse seq ->
+ pr " /* TestOutputFalse for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ let test () =
+ pr " if (r) {\n";
+ pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
+ test_name;
+ pr " return -1;\n";
+ pr " }\n"
+ in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call ~test test_name last
+ | TestOutputLength (seq, expected) ->
+ pr " /* TestOutputLength for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ let test () =
+ pr " int j;\n";
+ pr " for (j = 0; j < %d; ++j)\n" expected;
+ pr " if (r[j] == NULL) {\n";
+ pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
+ test_name;
+ pr " print_strings (r);\n";
+ pr " return -1;\n";
+ pr " }\n";
+ pr " if (r[j] != NULL) {\n";
+ pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
+ test_name;
+ pr " print_strings (r);\n";
+ pr " return -1;\n";
+ pr " }\n"
+ in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call ~test test_name last
+ | TestOutputStruct (seq, checks) ->
+ pr " /* TestOutputStruct for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ let test () =
+ List.iter (
+ function
+ | CompareWithInt (field, expected) ->
+ pr " if (r->%s != %d) {\n" field expected;
+ pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
+ test_name field expected;
+ pr " (int) r->%s);\n" field;
+ pr " return -1;\n";
+ pr " }\n"
+ | CompareWithIntOp (field, op, expected) ->
+ pr " if (!(r->%s %s %d)) {\n" field op expected;
+ pr " fprintf (stderr, \"%s: %s was %%d, expected %s %d\\n\",\n"
+ test_name field op expected;
+ pr " (int) r->%s);\n" field;
+ pr " return -1;\n";
+ pr " }\n"
+ | CompareWithString (field, expected) ->
+ pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
+ pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
+ test_name field expected;
+ pr " r->%s);\n" field;
+ pr " return -1;\n";
+ pr " }\n"
+ | CompareFieldsIntEq (field1, field2) ->
+ pr " if (r->%s != r->%s) {\n" field1 field2;
+ pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
+ test_name field1 field2;
+ pr " (int) r->%s, (int) r->%s);\n" field1 field2;
+ pr " return -1;\n";
+ pr " }\n"
+ | CompareFieldsStrEq (field1, field2) ->
+ pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
+ pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
+ test_name field1 field2;
+ pr " r->%s, r->%s);\n" field1 field2;
+ pr " return -1;\n";
+ pr " }\n"
+ ) checks
+ in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call ~test test_name last
+ | TestLastFail seq ->
+ pr " /* TestLastFail for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call test_name ~expect_error:true last
+
+(* Generate the code to run a command, leaving the result in 'r'.
+ * If you expect to get an error then you should set expect_error:true.
+ *)
+and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
+ match cmd with
+ | [] -> assert false
+ | name :: args ->
+ (* Look up the command to find out what args/ret it has. *)
+ let style =
+ try
+ let _, style, _, _, _, _, _ =
+ List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
+ style
+ with Not_found ->
+ failwithf "%s: in test, command %s was not found" test_name name in
+
+ if List.length (snd style) <> List.length args then
+ failwithf "%s: in test, wrong number of args given to %s"
+ test_name name;
+
+ pr " {\n";
+
+ List.iter (
+ function
+ | OptString n, "NULL" -> ()
+ | String n, arg
+ | OptString n, arg ->
+ pr " const char *%s = \"%s\";\n" n (c_quote arg);
+ | Int _, _
+ | Bool _, _
+ | FileIn _, _ | FileOut _, _ -> ()
+ | StringList n, arg ->
+ let strs = string_split " " arg in
+ iteri (
+ fun i str ->
+ pr " const char *%s_%d = \"%s\";\n" n i (c_quote str);
+ ) strs;
+ pr " const char *%s[] = {\n" n;
+ iteri (
+ fun i _ -> pr " %s_%d,\n" n i
+ ) strs;
+ pr " NULL\n";
+ pr " };\n";
+ ) (List.combine (snd style) args);
+
+ let error_code =
+ match fst style with
+ | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1"
+ | RConstString _ -> pr " const char *r;\n"; "NULL"
+ | RString _ -> pr " char *r;\n"; "NULL"
+ | RStringList _ | RHashtable _ ->
+ pr " char **r;\n";
+ pr " int i;\n";
+ "NULL"
+ | RStruct (_, typ) ->
+ pr " struct guestfs_%s *r;\n" typ; "NULL"
+ | RStructList (_, typ) ->
+ pr " struct guestfs_%s_list *r;\n" typ; "NULL" in
+
+ pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
+ pr " r = guestfs_%s (g" name;
+
+ (* Generate the parameters. *)
+ List.iter (
+ function
+ | OptString _, "NULL" -> pr ", NULL"
+ | String n, _
+ | OptString n, _ ->
+ pr ", %s" n
+ | FileIn _, arg | FileOut _, arg ->
+ pr ", \"%s\"" (c_quote arg)
+ | StringList n, _ ->
+ pr ", %s" n
+ | Int _, arg ->
+ let i =
+ try int_of_string arg
+ with Failure "int_of_string" ->
+ failwithf "%s: expecting an int, but got '%s'" test_name arg in
+ pr ", %d" i
+ | Bool _, arg ->
+ let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
+ ) (List.combine (snd style) args);
+
+ pr ");\n";
+ if not expect_error then
+ pr " if (r == %s)\n" error_code
+ else
+ pr " if (r != %s)\n" error_code;
+ pr " return -1;\n";
+
+ (* Insert the test code. *)
+ (match test with
+ | None -> ()
+ | Some f -> f ()
+ );
+
+ (match fst style with
+ | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
+ | RString _ -> pr " free (r);\n"
+ | RStringList _ | RHashtable _ ->
+ pr " for (i = 0; r[i] != NULL; ++i)\n";
+ pr " free (r[i]);\n";
+ pr " free (r);\n"
+ | RStruct (_, typ) ->
+ pr " guestfs_free_%s (r);\n" typ
+ | RStructList (_, typ) ->
+ pr " guestfs_free_%s_list (r);\n" typ
+ );
+
+ pr " }\n"
+
+and c_quote str =
+ let str = replace_str str "\r" "\\r" in
+ let str = replace_str str "\n" "\\n" in
+ let str = replace_str str "\t" "\\t" in
+ let str = replace_str str "\000" "\\0" in
+ str
+
+(* Generate a lot of different functions for guestfish. *)
+and generate_fish_cmds () =
+ generate_header CStyle GPLv2;
+
+ let all_functions =
+ List.filter (
+ fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
+ ) all_functions in
+ let all_functions_sorted =
+ List.filter (
+ fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
+ ) all_functions_sorted in
+
+ pr "#include <stdio.h>\n";
+ pr "#include <stdlib.h>\n";
+ pr "#include <string.h>\n";
+ pr "#include <inttypes.h>\n";
+ pr "\n";
+ pr "#include <guestfs.h>\n";
+ pr "#include \"fish.h\"\n";
+ pr "\n";
+
+ (* list_commands function, which implements guestfish -h *)
+ pr "void list_commands (void)\n";
+ pr "{\n";
+ pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
+ pr " list_builtin_commands ();\n";
+ List.iter (
+ fun (name, _, _, flags, _, shortdesc, _) ->
+ let name = replace_char name '_' '-' in
+ pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
+ name shortdesc
+ ) all_functions_sorted;
+ pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
+ pr "}\n";
+ pr "\n";
+
+ (* display_command function, which implements guestfish -h cmd *)
+ pr "void display_command (const char *cmd)\n";
+ pr "{\n";
+ List.iter (
+ fun (name, style, _, flags, _, shortdesc, longdesc) ->
+ let name2 = replace_char name '_' '-' in
+ let alias =
+ try find_map (function FishAlias n -> Some n | _ -> None) flags
+ with Not_found -> name in
+ let longdesc = replace_str longdesc "C<guestfs_" "C<" in
+ let synopsis =
+ match snd style with
+ | [] -> name2
+ | args ->
+ sprintf "%s <%s>"
+ name2 (String.concat "> <" (List.map name_of_argt args)) in
+
+ let warnings =
+ if List.mem ProtocolLimitWarning flags then
+ ("\n\n" ^ protocol_limit_warning)
+ else "" in
+
+ (* For DangerWillRobinson commands, we should probably have
+ * guestfish prompt before allowing you to use them (especially
+ * in interactive mode). XXX
+ *)
+ let warnings =
+ warnings ^
+ if List.mem DangerWillRobinson flags then
+ ("\n\n" ^ danger_will_robinson)
+ else "" in
+
+ let describe_alias =
+ if name <> alias then
+ sprintf "\n\nYou can use '%s' as an alias for this command." alias
+ else "" in
+
+ pr " if (";
+ pr "strcasecmp (cmd, \"%s\") == 0" name;
+ if name <> name2 then
+ pr " || strcasecmp (cmd, \"%s\") == 0" name2;
+ if name <> alias then
+ pr " || strcasecmp (cmd, \"%s\") == 0" alias;
+ pr ")\n";
+ pr " pod2text (\"%s - %s\", %S);\n"
+ name2 shortdesc
+ (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
+ pr " else\n"
+ ) all_functions;
+ pr " display_builtin_command (cmd);\n";
+ pr "}\n";
+ pr "\n";
+
+ (* print_* functions *)
+ List.iter (
+ fun (typ, cols) ->
+ let needs_i =
+ List.exists (function (_, FUUID) -> true | _ -> false) cols in
+
+ pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
+ pr "{\n";
+ if needs_i then (
+ pr " int i;\n";
+ pr "\n"
+ );
+ List.iter (
+ function
+ | name, FString ->
+ pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
+ | name, FUUID ->
+ pr " printf (\"%s: \");\n" name;
+ pr " for (i = 0; i < 32; ++i)\n";
+ pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
+ pr " printf (\"\\n\");\n"
+ | name, (FUInt64|FBytes) ->
+ pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
+ | name, FInt64 ->
+ pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
+ | name, FUInt32 ->
+ pr " printf (\"%s: %%\" PRIu32 \"\\n\", %s->%s);\n" name typ name
+ | name, FInt32 ->
+ pr " printf (\"%s: %%\" PRIi32 \"\\n\", %s->%s);\n" name typ name
+ | name, FChar ->
+ pr " printf (\"%s: %%c\\n\", %s->%s);\n" name typ name
+ | name, FOptPercent ->
+ pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
+ typ name name typ name;
+ pr " else printf (\"%s: \\n\");\n" name
+ ) cols;
+ pr "}\n";
+ pr "\n";
+ pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
+ typ typ typ;
+ pr "{\n";
+ pr " int i;\n";
+ pr "\n";
+ pr " for (i = 0; i < %ss->len; ++i)\n" typ;
+ pr " print_%s (&%ss->val[i]);\n" typ typ;
+ pr "}\n";
+ pr "\n";
+ ) structs;
+
+ (* run_<action> actions *)
+ List.iter (
+ fun (name, style, _, flags, _, _, _) ->
+ pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
+ pr "{\n";
+ (match fst style with
+ | RErr
+ | RInt _
+ | RBool _ -> pr " int r;\n"
+ | RInt64 _ -> pr " int64_t r;\n"
+ | RConstString _ -> pr " const char *r;\n"
+ | RString _ -> pr " char *r;\n"
+ | RStringList _ | RHashtable _ -> pr " char **r;\n"
+ | RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ
+ | RStructList (_, typ) -> pr " struct guestfs_%s_list *r;\n" typ
+ );
+ List.iter (
+ function
+ | String n
+ | OptString n
+ | FileIn n
+ | FileOut n -> pr " const char *%s;\n" n
+ | StringList n -> pr " char **%s;\n" n
+ | Bool n -> pr " int %s;\n" n
+ | Int n -> pr " int %s;\n" n
+ ) (snd style);
+
+ (* Check and convert parameters. *)
+ let argc_expected = List.length (snd style) in
+ pr " if (argc != %d) {\n" argc_expected;
+ pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
+ argc_expected;
+ pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
+ pr " return -1;\n";
+ pr " }\n";
+ iteri (
+ fun i ->
+ function
+ | String name -> pr " %s = argv[%d];\n" name i
+ | OptString name ->
+ pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
+ name i i
+ | FileIn name ->
+ pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
+ name i i
+ | FileOut name ->
+ pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
+ name i i
+ | StringList name ->
+ pr " %s = parse_string_list (argv[%d]);\n" name i
+ | Bool name ->
+ pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
+ | Int name ->
+ pr " %s = atoi (argv[%d]);\n" name i
+ ) (snd style);
+
+ (* Call C API function. *)
+ let fn =
+ try find_map (function FishAction n -> Some n | _ -> None) flags
+ with Not_found -> sprintf "guestfs_%s" name in
+ pr " r = %s " fn;
+ generate_call_args ~handle:"g" (snd style);
+ pr ";\n";
+
+ (* Check return value for errors and display command results. *)
+ (match fst style with
+ | RErr -> pr " return r;\n"
+ | RInt _ ->
+ pr " if (r == -1) return -1;\n";
+ pr " printf (\"%%d\\n\", r);\n";
+ pr " return 0;\n"
+ | RInt64 _ ->
+ pr " if (r == -1) return -1;\n";
+ pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
+ pr " return 0;\n"
+ | RBool _ ->
+ pr " if (r == -1) return -1;\n";
+ pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
+ pr " return 0;\n"
+ | RConstString _ ->
+ pr " if (r == NULL) return -1;\n";
+ pr " printf (\"%%s\\n\", r);\n";
+ pr " return 0;\n"
+ | RString _ ->
+ pr " if (r == NULL) return -1;\n";
+ pr " printf (\"%%s\\n\", r);\n";
+ pr " free (r);\n";
+ pr " return 0;\n"
+ | RStringList _ ->
+ pr " if (r == NULL) return -1;\n";
+ pr " print_strings (r);\n";
+ pr " free_strings (r);\n";
+ pr " return 0;\n"
+ | RStruct (_, typ) ->
+ pr " if (r == NULL) return -1;\n";
+ pr " print_%s (r);\n" typ;
+ pr " guestfs_free_%s (r);\n" typ;
+ pr " return 0;\n"
+ | RStructList (_, typ) ->
+ pr " if (r == NULL) return -1;\n";
+ pr " print_%s_list (r);\n" typ;
+ pr " guestfs_free_%s_list (r);\n" typ;
+ pr " return 0;\n"
+ | RHashtable _ ->
+ pr " if (r == NULL) return -1;\n";
+ pr " print_table (r);\n";
+ pr " free_strings (r);\n";
+ pr " return 0;\n"
+ );
+ pr "}\n";
+ pr "\n"
+ ) all_functions;
+
+ (* run_action function *)
+ pr "int run_action (const char *cmd, int argc, char *argv[])\n";
+ pr "{\n";
+ List.iter (
+ fun (name, _, _, flags, _, _, _) ->
+ let name2 = replace_char name '_' '-' in
+ let alias =
+ try find_map (function FishAlias n -> Some n | _ -> None) flags
+ with Not_found -> name in
+ pr " if (";
+ pr "strcasecmp (cmd, \"%s\") == 0" name;
+ if name <> name2 then
+ pr " || strcasecmp (cmd, \"%s\") == 0" name2;
+ if name <> alias then
+ pr " || strcasecmp (cmd, \"%s\") == 0" alias;
+ pr ")\n";
+ pr " return run_%s (cmd, argc, argv);\n" name;
+ pr " else\n";
+ ) all_functions;
+ pr " {\n";
+ pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
+ pr " return -1;\n";
+ pr " }\n";
+ pr " return 0;\n";
+ pr "}\n";
+ pr "\n"
+
+(* Readline completion for guestfish. *)
+and generate_fish_completion () =
+ generate_header CStyle GPLv2;
+
+ let all_functions =
+ List.filter (
+ fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
+ ) all_functions in
+
+ pr "\
+#include <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#ifdef HAVE_LIBREADLINE
+#include <readline/readline.h>
+#endif
+
+#include \"fish.h\"
+
+#ifdef HAVE_LIBREADLINE
+
+static const char *const commands[] = {
+ BUILTIN_COMMANDS_FOR_COMPLETION,
+";
+
+ (* Get the commands, including the aliases. They don't need to be
+ * sorted - the generator() function just does a dumb linear search.
+ *)
+ let commands =
+ List.map (
+ fun (name, _, _, flags, _, _, _) ->
+ let name2 = replace_char name '_' '-' in
+ let alias =
+ try find_map (function FishAlias n -> Some n | _ -> None) flags
+ with Not_found -> name in
+
+ if name <> alias then [name2; alias] else [name2]
+ ) all_functions in
+ let commands = List.flatten commands in
+
+ List.iter (pr " \"%s\",\n") commands;
+
+ pr " NULL
+};
+
+static char *
+generator (const char *text, int state)
+{
+ static int index, len;
+ const char *name;
+
+ if (!state) {
+ index = 0;
+ len = strlen (text);
+ }
+
+ rl_attempted_completion_over = 1;
+
+ while ((name = commands[index]) != NULL) {
+ index++;
+ if (strncasecmp (name, text, len) == 0)
+ return strdup (name);
+ }
+
+ return NULL;
+}
+
+#endif /* HAVE_LIBREADLINE */
+
+char **do_completion (const char *text, int start, int end)
+{
+ char **matches = NULL;
+
+#ifdef HAVE_LIBREADLINE
+ rl_completion_append_character = ' ';
+
+ if (start == 0)
+ matches = rl_completion_matches (text, generator);
+ else if (complete_dest_paths)
+ matches = rl_completion_matches (text, complete_dest_paths_generator);
+#endif
+
+ return matches;
+}
+";
+
+(* Generate the POD documentation for guestfish. *)
+and generate_fish_actions_pod () =
+ let all_functions_sorted =
+ List.filter (
+ fun (_, _, _, flags, _, _, _) ->
+ not (List.mem NotInFish flags || List.mem NotInDocs flags)
+ ) all_functions_sorted in
+
+ let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
+
+ List.iter (
+ fun (name, style, _, flags, _, _, longdesc) ->
+ let longdesc =
+ Str.global_substitute rex (
+ fun s ->
+ let sub =
+ try Str.matched_group 1 s
+ with Not_found ->
+ failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
+ "C<" ^ replace_char sub '_' '-' ^ ">"
+ ) longdesc in
+ let name = replace_char name '_' '-' in
+ let alias =
+ try find_map (function FishAlias n -> Some n | _ -> None) flags
+ with Not_found -> name in
+
+ pr "=head2 %s" name;
+ if name <> alias then
+ pr " | %s" alias;
+ pr "\n";
+ pr "\n";
+ pr " %s" name;
+ List.iter (
+ function
+ | String n -> pr " %s" n
+ | OptString n -> pr " %s" n
+ | StringList n -> pr " '%s ...'" n
+ | Bool _ -> pr " true|false"
+ | Int n -> pr " %s" n
+ | FileIn n | FileOut n -> pr " (%s|-)" n
+ ) (snd style);
+ pr "\n";
+ pr "\n";
+ pr "%s\n\n" longdesc;
+
+ if List.exists (function FileIn _ | FileOut _ -> true
+ | _ -> false) (snd style) then
+ pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
+
+ if List.mem ProtocolLimitWarning flags then
+ pr "%s\n\n" protocol_limit_warning;
+
+ if List.mem DangerWillRobinson flags then
+ pr "%s\n\n" danger_will_robinson
+ ) all_functions_sorted
+
+(* Generate a C function prototype. *)
+and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
+ ?(single_line = false) ?(newline = false) ?(in_daemon = false)
+ ?(prefix = "")
+ ?handle name style =
+ if extern then pr "extern ";
+ if static then pr "static ";
+ (match fst style with
+ | RErr -> pr "int "
+ | RInt _ -> pr "int "
+ | RInt64 _ -> pr "int64_t "
+ | RBool _ -> pr "int "
+ | RConstString _ -> pr "const char *"
+ | RString _ -> pr "char *"
+ | RStringList _ | RHashtable _ -> pr "char **"
+ | RStruct (_, typ) ->
+ if not in_daemon then pr "struct guestfs_%s *" typ
+ else pr "guestfs_int_%s *" typ
+ | RStructList (_, typ) ->
+ if not in_daemon then pr "struct guestfs_%s_list *" typ
+ else pr "guestfs_int_%s_list *" typ
+ );
+ pr "%s%s (" prefix name;
+ if handle = None && List.length (snd style) = 0 then
+ pr "void"
+ else (
+ let comma = ref false in
+ (match handle with
+ | None -> ()
+ | Some handle -> pr "guestfs_h *%s" handle; comma := true
+ );
+ let next () =
+ if !comma then (
+ if single_line then pr ", " else pr ",\n\t\t"
+ );
+ comma := true
+ in
+ List.iter (
+ function
+ | String n
+ | OptString n ->
+ next ();
+ if not in_daemon then pr "const char *%s" n
+ else pr "char *%s" n
+ | StringList n ->
+ next ();
+ if not in_daemon then pr "char * const* const %s" n
+ else pr "char **%s" n
+ | Bool n -> next (); pr "int %s" n
+ | Int n -> next (); pr "int %s" n
+ | FileIn n
+ | FileOut n ->
+ if not in_daemon then (next (); pr "const char *%s" n)
+ ) (snd style);
+ );
+ pr ")";
+ if semicolon then pr ";";
+ if newline then pr "\n"
+
+(* Generate C call arguments, eg "(handle, foo, bar)" *)
+and generate_call_args ?handle args =
+ pr "(";
+ let comma = ref false in
+ (match handle with
+ | None -> ()
+ | Some handle -> pr "%s" handle; comma := true
+ );
+ List.iter (
+ fun arg ->
+ if !comma then pr ", ";
+ comma := true;
+ pr "%s" (name_of_argt arg)
+ ) args;
+ pr ")"
+
+(* Generate the OCaml bindings interface. *)
+and generate_ocaml_mli () =
+ generate_header OCamlStyle LGPLv2;
+
+ pr "\
+(** For API documentation you should refer to the C API
+ in the guestfs(3) manual page. The OCaml API uses almost
+ exactly the same calls. *)
+
+type t
+(** A [guestfs_h] handle. *)
+
+exception Error of string
+(** This exception is raised when there is an error. *)
+
+val create : unit -> t
+
+val close : t -> unit
+(** Handles are closed by the garbage collector when they become
+ unreferenced, but callers can also call this in order to
+ provide predictable cleanup. *)
+
+";
+ generate_ocaml_structure_decls ();
+
+ (* The actions. *)
+ List.iter (
+ fun (name, style, _, _, _, shortdesc, _) ->
+ generate_ocaml_prototype name style;
+ pr "(** %s *)\n" shortdesc;
+ pr "\n"
+ ) all_functions
+
+(* Generate the OCaml bindings implementation. *)
+and generate_ocaml_ml () =
+ generate_header OCamlStyle LGPLv2;
+
+ pr "\
+type t
+exception Error of string
+external create : unit -> t = \"ocaml_guestfs_create\"
+external close : t -> unit = \"ocaml_guestfs_close\"
+
+let () =
+ Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
+
+";
+
+ generate_ocaml_structure_decls ();
+
+ (* The actions. *)
+ List.iter (
+ fun (name, style, _, _, _, shortdesc, _) ->
+ generate_ocaml_prototype ~is_external:true name style;
+ ) all_functions
+
+(* Generate the OCaml bindings C implementation. *)
+and generate_ocaml_c () =
+ generate_header CStyle LGPLv2;
+
+ pr "\
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include <caml/config.h>
+#include <caml/alloc.h>
+#include <caml/callback.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+
+#include <guestfs.h>
+
+#include \"guestfs_c.h\"
+
+/* Copy a hashtable of string pairs into an assoc-list. We return
+ * the list in reverse order, but hashtables aren't supposed to be
+ * ordered anyway.
+ */
+static CAMLprim value
+copy_table (char * const * argv)
+{
+ CAMLparam0 ();
+ CAMLlocal5 (rv, pairv, kv, vv, cons);
+ int i;
+
+ rv = Val_int (0);
+ for (i = 0; argv[i] != NULL; i += 2) {
+ kv = caml_copy_string (argv[i]);
+ vv = caml_copy_string (argv[i+1]);
+ pairv = caml_alloc (2, 0);
+ Store_field (pairv, 0, kv);
+ Store_field (pairv, 1, vv);
+ cons = caml_alloc (2, 0);
+ Store_field (cons, 1, rv);
+ rv = cons;
+ Store_field (cons, 0, pairv);
+ }
+
+ CAMLreturn (rv);
+}
+
+";
+
+ (* Struct copy functions. *)
+ List.iter (
+ fun (typ, cols) ->
+ let has_optpercent_col =
+ List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
+
+ pr "static CAMLprim value\n";
+ pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
+ pr "{\n";
+ pr " CAMLparam0 ();\n";
+ if has_optpercent_col then
+ pr " CAMLlocal3 (rv, v, v2);\n"
+ else
+ pr " CAMLlocal2 (rv, v);\n";
+ pr "\n";
+ pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
+ iteri (
+ fun i col ->
+ (match col with
+ | name, FString ->
+ pr " v = caml_copy_string (%s->%s);\n" typ name
+ | name, FUUID ->
+ pr " v = caml_alloc_string (32);\n";
+ pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
+ | name, (FBytes|FInt64|FUInt64) ->
+ pr " v = caml_copy_int64 (%s->%s);\n" typ name
+ | name, (FInt32|FUInt32) ->
+ pr " v = caml_copy_int32 (%s->%s);\n" typ name
+ | name, FOptPercent ->
+ pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
+ pr " v2 = caml_copy_double (%s->%s);\n" typ name;
+ pr " v = caml_alloc (1, 0);\n";
+ pr " Store_field (v, 0, v2);\n";
+ pr " } else /* None */\n";
+ pr " v = Val_int (0);\n";
+ | name, FChar ->
+ pr " v = Val_int (%s->%s);\n" typ name
+ );
+ pr " Store_field (rv, %d, v);\n" i
+ ) cols;
+ pr " CAMLreturn (rv);\n";
+ pr "}\n";
+ pr "\n";
+
+ pr "static CAMLprim value\n";
+ pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n"
+ typ typ typ;
+ pr "{\n";
+ pr " CAMLparam0 ();\n";
+ pr " CAMLlocal2 (rv, v);\n";
+ pr " int i;\n";
+ pr "\n";
+ pr " if (%ss->len == 0)\n" typ;
+ pr " CAMLreturn (Atom (0));\n";
+ pr " else {\n";
+ pr " rv = caml_alloc (%ss->len, 0);\n" typ;
+ pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
+ pr " v = copy_%s (&%ss->val[i]);\n" typ typ;
+ pr " caml_modify (&Field (rv, i), v);\n";
+ pr " }\n";
+ pr " CAMLreturn (rv);\n";
+ pr " }\n";
+ pr "}\n";
+ pr "\n";
+ ) structs;
+
+ (* The wrappers. *)
+ List.iter (
+ fun (name, style, _, _, _, _, _) ->
+ let params =
+ "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
+
+ pr "CAMLprim value\n";
+ pr "ocaml_guestfs_%s (value %s" name (List.hd params);
+ List.iter (pr ", value %s") (List.tl params);
+ pr ")\n";
+ pr "{\n";
+
+ (match params with
+ | [p1; p2; p3; p4; p5] ->
+ pr " CAMLparam5 (%s);\n" (String.concat ", " params)
+ | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
+ pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
+ pr " CAMLxparam%d (%s);\n"
+ (List.length rest) (String.concat ", " rest)
+ | ps ->
+ pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
+ );
+ pr " CAMLlocal1 (rv);\n";
+ pr "\n";
+
+ pr " guestfs_h *g = Guestfs_val (gv);\n";
+ pr " if (g == NULL)\n";
+ pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
+ pr "\n";
+
+ List.iter (
+ function
+ | String n
+ | FileIn n
+ | FileOut n ->
+ pr " const char *%s = String_val (%sv);\n" n n
+ | OptString n ->
+ pr " const char *%s =\n" n;
+ pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
+ n n
+ | StringList n ->
+ pr " char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
+ | Bool n ->
+ pr " int %s = Bool_val (%sv);\n" n n
+ | Int n ->
+ pr " int %s = Int_val (%sv);\n" n n
+ ) (snd style);
+ let error_code =
+ match fst style with
+ | RErr -> pr " int r;\n"; "-1"
+ | RInt _ -> pr " int r;\n"; "-1"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1"
+ | RBool _ -> pr " int r;\n"; "-1"
+ | RConstString _ -> pr " const char *r;\n"; "NULL"
+ | RString _ -> pr " char *r;\n"; "NULL"
+ | RStringList _ ->
+ pr " int i;\n";
+ pr " char **r;\n";
+ "NULL"
+ | RStruct (_, typ) ->
+ pr " struct guestfs_%s *r;\n" typ; "NULL"
+ | RStructList (_, typ) ->
+ pr " struct guestfs_%s_list *r;\n" typ; "NULL"
+ | RHashtable _ ->
+ pr " int i;\n";
+ pr " char **r;\n";
+ "NULL" in
+ pr "\n";
+
+ pr " caml_enter_blocking_section ();\n";
+ pr " r = guestfs_%s " name;
+ generate_call_args ~handle:"g" (snd style);
+ pr ";\n";
+ pr " caml_leave_blocking_section ();\n";
+
+ List.iter (
+ function
+ | StringList n ->
+ pr " ocaml_guestfs_free_strings (%s);\n" n;
+ | String _ | OptString _ | Bool _ | Int _ | FileIn _ | FileOut _ -> ()
+ ) (snd style);
+
+ pr " if (r == %s)\n" error_code;
+ pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
+ pr "\n";
+
+ (match fst style with
+ | RErr -> pr " rv = Val_unit;\n"
+ | RInt _ -> pr " rv = Val_int (r);\n"
+ | RInt64 _ ->
+ pr " rv = caml_copy_int64 (r);\n"
+ | RBool _ -> pr " rv = Val_bool (r);\n"
+ | RConstString _ -> pr " rv = caml_copy_string (r);\n"
+ | RString _ ->
+ pr " rv = caml_copy_string (r);\n";
+ pr " free (r);\n"
+ | RStringList _ ->
+ pr " rv = caml_copy_string_array ((const char **) r);\n";
+ pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
+ pr " free (r);\n"
+ | RStruct (_, typ) ->
+ pr " rv = copy_%s (r);\n" typ;
+ pr " guestfs_free_%s (r);\n" typ;
+ | RStructList (_, typ) ->
+ pr " rv = copy_%s_list (r);\n" typ;
+ pr " guestfs_free_%s_list (r);\n" typ;
+ | RHashtable _ ->
+ pr " rv = copy_table (r);\n";
+ pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
+ pr " free (r);\n";
+ );
+
+ pr " CAMLreturn (rv);\n";
+ pr "}\n";
+ pr "\n";
+
+ if List.length params > 5 then (
+ pr "CAMLprim value\n";
+ pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
+ pr "{\n";
+ pr " return ocaml_guestfs_%s (argv[0]" name;
+ iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
+ pr ");\n";
+ pr "}\n";
+ pr "\n"
+ )
+ ) all_functions
+
+and generate_ocaml_structure_decls () =
+ List.iter (
+ fun (typ, cols) ->
+ pr "type %s = {\n" typ;
+ List.iter (
+ function
+ | name, FString -> pr " %s : string;\n" name
+ | name, FUUID -> pr " %s : string;\n" name
+ | name, (FBytes|FInt64|FUInt64) -> pr " %s : int64;\n" name
+ | name, (FInt32|FUInt32) -> pr " %s : int32;\n" name
+ | name, FChar -> pr " %s : char;\n" name
+ | name, FOptPercent -> pr " %s : float option;\n" name
+ ) cols;
+ pr "}\n";
+ pr "\n"
+ ) structs
+
+and generate_ocaml_prototype ?(is_external = false) name style =
+ if is_external then pr "external " else pr "val ";
+ pr "%s : t -> " name;
+ List.iter (
+ function
+ | String _ | FileIn _ | FileOut _ -> pr "string -> "
+ | OptString _ -> pr "string option -> "
+ | StringList _ -> pr "string array -> "
+ | Bool _ -> pr "bool -> "
+ | Int _ -> pr "int -> "
+ ) (snd style);
+ (match fst style with
+ | RErr -> pr "unit" (* all errors are turned into exceptions *)
+ | RInt _ -> pr "int"
+ | RInt64 _ -> pr "int64"
+ | RBool _ -> pr "bool"
+ | RConstString _ -> pr "string"
+ | RString _ -> pr "string"
+ | RStringList _ -> pr "string array"
+ | RStruct (_, typ) -> pr "%s" typ
+ | RStructList (_, typ) -> pr "%s array" typ
+ | RHashtable _ -> pr "(string * string) list"
+ );
+ if is_external then (
+ pr " = ";
+ if List.length (snd style) + 1 > 5 then
+ pr "\"ocaml_guestfs_%s_byte\" " name;
+ pr "\"ocaml_guestfs_%s\"" name
+ );
+ pr "\n"
+
+(* Generate Perl xs code, a sort of crazy variation of C with macros. *)
+and generate_perl_xs () =
+ generate_header CStyle LGPLv2;
+
+ pr "\
+#include \"EXTERN.h\"
+#include \"perl.h\"
+#include \"XSUB.h\"
+
+#include <guestfs.h>
+
+#ifndef PRId64
+#define PRId64 \"lld\"
+#endif
+
+static SV *
+my_newSVll(long long val) {
+#ifdef USE_64_BIT_ALL
+ return newSViv(val);
+#else
+ char buf[100];
+ int len;
+ len = snprintf(buf, 100, \"%%\" PRId64, val);
+ return newSVpv(buf, len);
+#endif
+}
+
+#ifndef PRIu64
+#define PRIu64 \"llu\"
+#endif
+
+static SV *
+my_newSVull(unsigned long long val) {
+#ifdef USE_64_BIT_ALL
+ return newSVuv(val);
+#else
+ char buf[100];
+ int len;
+ len = snprintf(buf, 100, \"%%\" PRIu64, val);
+ return newSVpv(buf, len);
+#endif
+}
+
+/* http://www.perlmonks.org/?node_id=680842 */
+static char **
+XS_unpack_charPtrPtr (SV *arg) {
+ char **ret;
+ AV *av;
+ I32 i;
+
+ if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
+ croak (\"array reference expected\");
+
+ av = (AV *)SvRV (arg);
+ ret = malloc ((av_len (av) + 1 + 1) * sizeof (char *));
+ if (!ret)
+ croak (\"malloc failed\");
+
+ for (i = 0; i <= av_len (av); i++) {
+ SV **elem = av_fetch (av, i, 0);
+
+ if (!elem || !*elem)
+ croak (\"missing element in list\");
+
+ ret[i] = SvPV_nolen (*elem);
+ }
+
+ ret[i] = NULL;
+
+ return ret;
+}
+
+MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
+
+PROTOTYPES: ENABLE
+
+guestfs_h *
+_create ()
+ CODE:
+ RETVAL = guestfs_create ();
+ if (!RETVAL)
+ croak (\"could not create guestfs handle\");
+ guestfs_set_error_handler (RETVAL, NULL, NULL);
+ OUTPUT:
+ RETVAL
+
+void
+DESTROY (g)
+ guestfs_h *g;
+ PPCODE:
+ guestfs_close (g);
+
+";
+
+ List.iter (
+ fun (name, style, _, _, _, _, _) ->
+ (match fst style with
+ | RErr -> pr "void\n"
+ | RInt _ -> pr "SV *\n"
+ | RInt64 _ -> pr "SV *\n"
+ | RBool _ -> pr "SV *\n"
+ | RConstString _ -> pr "SV *\n"
+ | RString _ -> pr "SV *\n"
+ | RStringList _
+ | RStruct _ | RStructList _
+ | RHashtable _ ->
+ pr "void\n" (* all lists returned implictly on the stack *)
+ );
+ (* Call and arguments. *)
+ pr "%s " name;
+ generate_call_args ~handle:"g" (snd style);
+ pr "\n";
+ pr " guestfs_h *g;\n";
+ iteri (
+ fun i ->
+ function
+ | String n | FileIn n | FileOut n -> pr " char *%s;\n" n
+ | OptString n ->
+ (* http://www.perlmonks.org/?node_id=554277
+ * Note that the implicit handle argument means we have
+ * to add 1 to the ST(x) operator.
+ *)
+ pr " char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
+ | StringList n -> pr " char **%s;\n" n
+ | Bool n -> pr " int %s;\n" n
+ | Int n -> pr " int %s;\n" n
+ ) (snd style);
+
+ let do_cleanups () =
+ List.iter (
+ function
+ | String _ | OptString _ | Bool _ | Int _
+ | FileIn _ | FileOut _ -> ()
+ | StringList n -> pr " free (%s);\n" n
+ ) (snd style)
+ in
+
+ (* Code. *)
+ (match fst style with
+ | RErr ->
+ pr "PREINIT:\n";
+ pr " int r;\n";
+ pr " PPCODE:\n";
+ pr " r = guestfs_%s " name;
+ generate_call_args ~handle:"g" (snd style);
+ pr ";\n";
+ do_cleanups ();
+ pr " if (r == -1)\n";
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ | RInt n
+ | RBool n ->
+ pr "PREINIT:\n";
+ pr " int %s;\n" n;
+ pr " CODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_call_args ~handle:"g" (snd style);
+ pr ";\n";
+ do_cleanups ();
+ pr " if (%s == -1)\n" n;
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " RETVAL = newSViv (%s);\n" n;
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
+ | RInt64 n ->
+ pr "PREINIT:\n";
+ pr " int64_t %s;\n" n;
+ pr " CODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_call_args ~handle:"g" (snd style);
+ pr ";\n";
+ do_cleanups ();
+ pr " if (%s == -1)\n" n;
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " RETVAL = my_newSVll (%s);\n" n;
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
+ | RConstString n ->
+ pr "PREINIT:\n";
+ pr " const char *%s;\n" n;
+ pr " CODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_call_args ~handle:"g" (snd style);
+ pr ";\n";
+ do_cleanups ();
+ pr " if (%s == NULL)\n" n;
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " RETVAL = newSVpv (%s, 0);\n" n;
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
+ | RString n ->
+ pr "PREINIT:\n";
+ pr " char *%s;\n" n;
+ pr " CODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_call_args ~handle:"g" (snd style);
+ pr ";\n";
+ do_cleanups ();
+ pr " if (%s == NULL)\n" n;
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " RETVAL = newSVpv (%s, 0);\n" n;
+ pr " free (%s);\n" n;
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
+ | RStringList n | RHashtable n ->
+ pr "PREINIT:\n";
+ pr " char **%s;\n" n;
+ pr " int i, n;\n";
+ pr " PPCODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_call_args ~handle:"g" (snd style);
+ pr ";\n";
+ do_cleanups ();
+ pr " if (%s == NULL)\n" n;
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
+ pr " EXTEND (SP, n);\n";
+ pr " for (i = 0; i < n; ++i) {\n";
+ pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
+ pr " free (%s[i]);\n" n;
+ pr " }\n";
+ pr " free (%s);\n" n;
+ | RStruct (n, typ) ->
+ let cols = cols_of_struct typ in
+ generate_perl_struct_code typ cols name style n do_cleanups
+ | RStructList (n, typ) ->
+ let cols = cols_of_struct typ in
+ generate_perl_struct_list_code typ cols name style n do_cleanups
+ );
+
+ pr "\n"
+ ) all_functions
+
+and generate_perl_struct_list_code typ cols name style n do_cleanups =
+ pr "PREINIT:\n";
+ pr " struct guestfs_%s_list *%s;\n" typ n;
+ pr " int i;\n";
+ pr " HV *hv;\n";
+ pr " PPCODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_call_args ~handle:"g" (snd style);
+ pr ";\n";
+ do_cleanups ();
+ pr " if (%s == NULL)\n" n;
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " EXTEND (SP, %s->len);\n" n;
+ pr " for (i = 0; i < %s->len; ++i) {\n" n;
+ pr " hv = newHV ();\n";
+ List.iter (
+ function
+ | name, FString ->
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
+ name (String.length name) n name
+ | name, FUUID ->
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
+ name (String.length name) n name
+ | name, (FBytes|FUInt64) ->
+ pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
+ name (String.length name) n name
+ | name, FInt64 ->
+ pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
+ name (String.length name) n name
+ | name, (FInt32|FUInt32) ->
+ pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
+ name (String.length name) n name
+ | name, FChar ->
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
+ name (String.length name) n name
+ | name, FOptPercent ->
+ pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
+ name (String.length name) n name
+ ) cols;
+ pr " PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
+ pr " }\n";
+ pr " guestfs_free_%s_list (%s);\n" typ n
+
+and generate_perl_struct_code typ cols name style n do_cleanups =
+ pr "PREINIT:\n";
+ pr " struct guestfs_%s *%s;\n" typ n;
+ pr " PPCODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_call_args ~handle:"g" (snd style);
+ pr ";\n";
+ do_cleanups ();
+ pr " if (%s == NULL)\n" n;
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " EXTEND (SP, 2 * %d);\n" (List.length cols);
+ List.iter (
+ fun ((name, _) as col) ->
+ pr " PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
+
+ match col with
+ | name, FString ->
+ pr " PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
+ n name
+ | name, FUUID ->
+ pr " PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
+ n name
+ | name, (FBytes|FUInt64) ->
+ pr " PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
+ n name
+ | name, FInt64 ->
+ pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
+ n name
+ | name, (FInt32|FUInt32) ->
+ pr " PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
+ n name
+ | name, FChar ->
+ pr " PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
+ n name
+ | name, FOptPercent ->
+ pr " PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
+ n name
+ ) cols;
+ pr " free (%s);\n" n
+
+(* Generate Sys/Guestfs.pm. *)
+and generate_perl_pm () =
+ generate_header HashStyle LGPLv2;
+
+ pr "\
+=pod
+
+=head1 NAME
+
+Sys::Guestfs - Perl bindings for libguestfs
+
+=head1 SYNOPSIS
+
+ use Sys::Guestfs;
+
+ my $h = Sys::Guestfs->new ();
+ $h->add_drive ('guest.img');
+ $h->launch ();
+ $h->wait_ready ();
+ $h->mount ('/dev/sda1', '/');
+ $h->touch ('/hello');
+ $h->sync ();
+
+=head1 DESCRIPTION
+
+The C<Sys::Guestfs> module provides a Perl XS binding to the
+libguestfs API for examining and modifying virtual machine
+disk images.
+
+Amongst the things this is good for: making batch configuration
+changes to guests, getting disk used/free statistics (see also:
+virt-df), migrating between virtualization systems (see also:
+virt-p2v), performing partial backups, performing partial guest
+clones, cloning guests and changing registry/UUID/hostname info, and
+much else besides.
+
+Libguestfs uses Linux kernel and qemu code, and can access any type of
+guest filesystem that Linux and qemu can, including but not limited
+to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
+schemes, qcow, qcow2, vmdk.
+
+Libguestfs provides ways to enumerate guest storage (eg. partitions,
+LVs, what filesystem is in each LV, etc.). It can also run commands
+in the context of the guest. Also you can access filesystems over FTP.
+
+See also L<Sys::Guestfs::Lib(3)> for a set of useful library
+functions for using libguestfs from Perl, including integration
+with libvirt.
+
+=head1 ERRORS
+
+All errors turn into calls to C<croak> (see L<Carp(3)>).
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Sys::Guestfs;
+
+use strict;
+use warnings;
+
+require XSLoader;
+XSLoader::load ('Sys::Guestfs');
+
+=item $h = Sys::Guestfs->new ();
+
+Create a new guestfs handle.
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref ($proto) || $proto;
+
+ my $self = Sys::Guestfs::_create ();
+ bless $self, $class;
+ return $self;
+}
+
+";
+
+ (* Actions. We only need to print documentation for these as
+ * they are pulled in from the XS code automatically.
+ *)
+ List.iter (
+ fun (name, style, _, flags, _, _, longdesc) ->
+ if not (List.mem NotInDocs flags) then (
+ let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
+ pr "=item ";
+ generate_perl_prototype name style;
+ pr "\n\n";
+ pr "%s\n\n" longdesc;
+ if List.mem ProtocolLimitWarning flags then
+ pr "%s\n\n" protocol_limit_warning;
+ if List.mem DangerWillRobinson flags then
+ pr "%s\n\n" danger_will_robinson
+ )
+ ) all_functions_sorted;
+
+ (* End of file. *)
+ pr "\
+=cut
+
+1;
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<guestfs(3)>,
+L<guestfish(1)>,
+L<http://libguestfs.org>,
+L<Sys::Guestfs::Lib(3)>.
+
+=cut
+"
+
+and generate_perl_prototype name style =
+ (match fst style with
+ | RErr -> ()
+ | RBool n
+ | RInt n
+ | RInt64 n
+ | RConstString n
+ | RString n -> pr "$%s = " n
+ | RStruct (n,_)
+ | RHashtable n -> pr "%%%s = " n
+ | RStringList n
+ | RStructList (n,_) -> pr "@%s = " n
+ );
+ pr "$h->%s (" name;
+ let comma = ref false in
+ List.iter (
+ fun arg ->
+ if !comma then pr ", ";
+ comma := true;
+ match arg with
+ | String n | OptString n | Bool n | Int n | FileIn n | FileOut n ->
+ pr "$%s" n
+ | StringList n ->
+ pr "\\@%s" n
+ ) (snd style);
+ pr ");"
+
+(* Generate Python C module. *)
+and generate_python_c () =
+ generate_header CStyle LGPLv2;
+
+ pr "\
+#include <stdio.h>
+#include <stdlib.h>
+#include <assert.h>
+
+#include <Python.h>
+
+#include \"guestfs.h\"
+
+typedef struct {
+ PyObject_HEAD
+ guestfs_h *g;
+} Pyguestfs_Object;
+
+static guestfs_h *
+get_handle (PyObject *obj)
+{
+ assert (obj);
+ assert (obj != Py_None);
+ return ((Pyguestfs_Object *) obj)->g;
+}
+
+static PyObject *
+put_handle (guestfs_h *g)
+{
+ assert (g);
+ return
+ PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
+}
+
+/* This list should be freed (but not the strings) after use. */
+static const char **
+get_string_list (PyObject *obj)
+{
+ int i, len;
+ const char **r;
+
+ assert (obj);
+
+ if (!PyList_Check (obj)) {
+ PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
+ return NULL;
+ }
+
+ len = PyList_Size (obj);
+ r = malloc (sizeof (char *) * (len+1));
+ if (r == NULL) {
+ PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
+ return NULL;
+ }
+
+ for (i = 0; i < len; ++i)
+ r[i] = PyString_AsString (PyList_GetItem (obj, i));
+ r[len] = NULL;
+
+ return r;
+}
+
+static PyObject *
+put_string_list (char * const * const argv)
+{
+ PyObject *list;
+ int argc, i;
+
+ for (argc = 0; argv[argc] != NULL; ++argc)
+ ;
+
+ list = PyList_New (argc);
+ for (i = 0; i < argc; ++i)
+ PyList_SetItem (list, i, PyString_FromString (argv[i]));
+
+ return list;
+}
+
+static PyObject *
+put_table (char * const * const argv)
+{
+ PyObject *list, *item;
+ int argc, i;
+
+ for (argc = 0; argv[argc] != NULL; ++argc)
+ ;
+
+ list = PyList_New (argc >> 1);
+ for (i = 0; i < argc; i += 2) {
+ item = PyTuple_New (2);
+ PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
+ PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
+ PyList_SetItem (list, i >> 1, item);
+ }
+
+ return list;
+}
+
+static void
+free_strings (char **argv)
+{
+ int argc;
+
+ for (argc = 0; argv[argc] != NULL; ++argc)
+ free (argv[argc]);
+ free (argv);
+}
+
+static PyObject *
+py_guestfs_create (PyObject *self, PyObject *args)
+{
+ guestfs_h *g;
+
+ g = guestfs_create ();
+ if (g == NULL) {
+ PyErr_SetString (PyExc_RuntimeError,
+ \"guestfs.create: failed to allocate handle\");
+ return NULL;
+ }
+ guestfs_set_error_handler (g, NULL, NULL);
+ return put_handle (g);
+}
+
+static PyObject *
+py_guestfs_close (PyObject *self, PyObject *args)
+{
+ PyObject *py_g;
+ guestfs_h *g;
+
+ if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
+ return NULL;
+ g = get_handle (py_g);
+
+ guestfs_close (g);
+
+ Py_INCREF (Py_None);
+ return Py_None;
+}
+
+";
+
+ (* Structures, turned into Python dictionaries. *)
+ List.iter (
+ fun (typ, cols) ->
+ pr "static PyObject *\n";
+ pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
+ pr "{\n";
+ pr " PyObject *dict;\n";
+ pr "\n";
+ pr " dict = PyDict_New ();\n";
+ List.iter (
+ function
+ | name, FString ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyString_FromString (%s->%s));\n"
+ typ name
+ | name, FUUID ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyString_FromStringAndSize (%s->%s, 32));\n"
+ typ name
+ | name, (FBytes|FUInt64) ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
+ typ name
+ | name, FInt64 ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyLong_FromLongLong (%s->%s));\n"
+ typ name
+ | name, FUInt32 ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyLong_FromUnsignedLong (%s->%s));\n"
+ typ name
+ | name, FInt32 ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyLong_FromLong (%s->%s));\n"
+ typ name
+ | name, FOptPercent ->
+ pr " if (%s->%s >= 0)\n" typ name;
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyFloat_FromDouble ((double) %s->%s));\n"
+ typ name;
+ pr " else {\n";
+ pr " Py_INCREF (Py_None);\n";
+ pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
+ pr " }\n"
+ | name, FChar ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyString_FromStringAndSize (&dirent->%s, 1));\n" name
+ ) cols;
+ pr " return dict;\n";
+ pr "};\n";
+ pr "\n";
+
+ pr "static PyObject *\n";
+ pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
+ pr "{\n";
+ pr " PyObject *list;\n";
+ pr " int i;\n";
+ pr "\n";
+ pr " list = PyList_New (%ss->len);\n" typ;
+ pr " for (i = 0; i < %ss->len; ++i)\n" typ;
+ pr " PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
+ pr " return list;\n";
+ pr "};\n";
+ pr "\n"
+ ) structs;
+
+ (* Python wrapper functions. *)
+ List.iter (
+ fun (name, style, _, _, _, _, _) ->
+ pr "static PyObject *\n";
+ pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
+ pr "{\n";
+
+ pr " PyObject *py_g;\n";
+ pr " guestfs_h *g;\n";
+ pr " PyObject *py_r;\n";
+
+ let error_code =
+ match fst style with
+ | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1"
+ | RConstString _ -> pr " const char *r;\n"; "NULL"
+ | RString _ -> pr " char *r;\n"; "NULL"
+ | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
+ | RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ; "NULL"
+ | RStructList (_, typ) ->
+ pr " struct guestfs_%s_list *r;\n" typ; "NULL" in
+
+ List.iter (
+ function
+ | String n | FileIn n | FileOut n -> pr " const char *%s;\n" n
+ | OptString n -> pr " const char *%s;\n" n
+ | StringList n ->
+ pr " PyObject *py_%s;\n" n;
+ pr " const char **%s;\n" n
+ | Bool n -> pr " int %s;\n" n
+ | Int n -> pr " int %s;\n" n
+ ) (snd style);
+
+ pr "\n";
+
+ (* Convert the parameters. *)
+ pr " if (!PyArg_ParseTuple (args, (char *) \"O";
+ List.iter (
+ function
+ | String _ | FileIn _ | FileOut _ -> pr "s"
+ | OptString _ -> pr "z"
+ | StringList _ -> pr "O"
+ | Bool _ -> pr "i" (* XXX Python has booleans? *)
+ | Int _ -> pr "i"
+ ) (snd style);
+ pr ":guestfs_%s\",\n" name;
+ pr " &py_g";
+ List.iter (
+ function
+ | String n | FileIn n | FileOut n -> pr ", &%s" n
+ | OptString n -> pr ", &%s" n
+ | StringList n -> pr ", &py_%s" n
+ | Bool n -> pr ", &%s" n
+ | Int n -> pr ", &%s" n
+ ) (snd style);
+
+ pr "))\n";
+ pr " return NULL;\n";
+
+ pr " g = get_handle (py_g);\n";
+ List.iter (
+ function
+ | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
+ | StringList n ->
+ pr " %s = get_string_list (py_%s);\n" n n;
+ pr " if (!%s) return NULL;\n" n
+ ) (snd style);
+
+ pr "\n";
+
+ pr " r = guestfs_%s " name;
+ generate_call_args ~handle:"g" (snd style);
+ pr ";\n";
+
+ List.iter (
+ function
+ | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
+ | StringList n ->
+ pr " free (%s);\n" n
+ ) (snd style);
+
+ pr " if (r == %s) {\n" error_code;
+ pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
+ pr " return NULL;\n";
+ pr " }\n";
+ pr "\n";
+
+ (match fst style with
+ | RErr ->
+ pr " Py_INCREF (Py_None);\n";
+ pr " py_r = Py_None;\n"
+ | RInt _
+ | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
+ | RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
+ | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
+ | RString _ ->
+ pr " py_r = PyString_FromString (r);\n";
+ pr " free (r);\n"
+ | RStringList _ ->
+ pr " py_r = put_string_list (r);\n";
+ pr " free_strings (r);\n"
+ | RStruct (_, typ) ->
+ pr " py_r = put_%s (r);\n" typ;
+ pr " guestfs_free_%s (r);\n" typ
+ | RStructList (_, typ) ->
+ pr " py_r = put_%s_list (r);\n" typ;
+ pr " guestfs_free_%s_list (r);\n" typ
+ | RHashtable n ->
+ pr " py_r = put_table (r);\n";
+ pr " free_strings (r);\n"
+ );
+
+ pr " return py_r;\n";
+ pr "}\n";
+ pr "\n"
+ ) all_functions;
+
+ (* Table of functions. *)
+ pr "static PyMethodDef methods[] = {\n";
+ pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
+ pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
+ List.iter (
+ fun (name, _, _, _, _, _, _) ->
+ pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
+ name name
+ ) all_functions;
+ pr " { NULL, NULL, 0, NULL }\n";
+ pr "};\n";
+ pr "\n";
+
+ (* Init function. *)
+ pr "\
+void
+initlibguestfsmod (void)
+{
+ static int initialized = 0;
+
+ if (initialized) return;
+ Py_InitModule ((char *) \"libguestfsmod\", methods);
+ initialized = 1;
+}
+"
+
+(* Generate Python module. *)
+and generate_python_py () =
+ generate_header HashStyle LGPLv2;
+
+ pr "\
+u\"\"\"Python bindings for libguestfs
+
+import guestfs
+g = guestfs.GuestFS ()
+g.add_drive (\"guest.img\")
+g.launch ()
+g.wait_ready ()
+parts = g.list_partitions ()
+
+The guestfs module provides a Python binding to the libguestfs API
+for examining and modifying virtual machine disk images.
+
+Amongst the things this is good for: making batch configuration
+changes to guests, getting disk used/free statistics (see also:
+virt-df), migrating between virtualization systems (see also:
+virt-p2v), performing partial backups, performing partial guest
+clones, cloning guests and changing registry/UUID/hostname info, and
+much else besides.
+
+Libguestfs uses Linux kernel and qemu code, and can access any type of
+guest filesystem that Linux and qemu can, including but not limited
+to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
+schemes, qcow, qcow2, vmdk.
+
+Libguestfs provides ways to enumerate guest storage (eg. partitions,
+LVs, what filesystem is in each LV, etc.). It can also run commands
+in the context of the guest. Also you can access filesystems over FTP.
+
+Errors which happen while using the API are turned into Python
+RuntimeError exceptions.
+
+To create a guestfs handle you usually have to perform the following
+sequence of calls:
+
+# Create the handle, call add_drive at least once, and possibly
+# several times if the guest has multiple block devices:
+g = guestfs.GuestFS ()
+g.add_drive (\"guest.img\")
+
+# Launch the qemu subprocess and wait for it to become ready:
+g.launch ()
+g.wait_ready ()
+
+# Now you can issue commands, for example:
+logvols = g.lvs ()
+
+\"\"\"
+
+import libguestfsmod
+
+class GuestFS:
+ \"\"\"Instances of this class are libguestfs API handles.\"\"\"
+
+ def __init__ (self):
+ \"\"\"Create a new libguestfs handle.\"\"\"
+ self._o = libguestfsmod.create ()
+
+ def __del__ (self):
+ libguestfsmod.close (self._o)
+
+";
+
+ List.iter (
+ fun (name, style, _, flags, _, _, longdesc) ->
+ pr " def %s " name;
+ generate_call_args ~handle:"self" (snd style);
+ pr ":\n";
+
+ if not (List.mem NotInDocs flags) then (
+ let doc = replace_str longdesc "C<guestfs_" "C<g." in
+ let doc =
+ match fst style with
+ | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
+ | RString _ -> doc
+ | RStringList _ ->
+ doc ^ "\n\nThis function returns a list of strings."
+ | RStruct (_, typ) ->
+ doc ^ sprintf "\n\nThis function returns a dictionary, with keys matching the various fields in the guestfs_%s structure." typ
+ | RStructList (_, typ) ->
+ doc ^ sprintf "\n\nThis function returns a list of %ss. Each %s is represented as a dictionary." typ typ
+ | RHashtable _ ->
+ doc ^ "\n\nThis function returns a dictionary." in
+ let doc =
+ if List.mem ProtocolLimitWarning flags then
+ doc ^ "\n\n" ^ protocol_limit_warning
+ else doc in
+ let doc =
+ if List.mem DangerWillRobinson flags then
+ doc ^ "\n\n" ^ danger_will_robinson
+ else doc in
+ let doc = pod2text ~width:60 name doc in
+ let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
+ let doc = String.concat "\n " doc in
+ pr " u\"\"\"%s\"\"\"\n" doc;
+ );
+ pr " return libguestfsmod.%s " name;
+ generate_call_args ~handle:"self._o" (snd style);
+ pr "\n";
+ pr "\n";
+ ) all_functions
+
+(* Useful if you need the longdesc POD text as plain text. Returns a
+ * list of lines.
+ *
+ * Because this is very slow (the slowest part of autogeneration),
+ * we memoize the results.
+ *)
+and pod2text ~width name longdesc =
+ let key = width, name, longdesc in
+ try Hashtbl.find pod2text_memo key
+ with Not_found ->
+ let filename, chan = Filename.open_temp_file "gen" ".tmp" in
+ fprintf chan "=head1 %s\n\n%s\n" name longdesc;
+ close_out chan;
+ let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
+ let chan = Unix.open_process_in cmd in
+ let lines = ref [] in
+ let rec loop i =
+ let line = input_line chan in
+ if i = 1 then (* discard the first line of output *)
+ loop (i+1)
+ else (
+ let line = triml line in
+ lines := line :: !lines;
+ loop (i+1)
+ ) in
+ let lines = try loop 1 with End_of_file -> List.rev !lines in
+ Unix.unlink filename;
+ (match Unix.close_process_in chan with
+ | Unix.WEXITED 0 -> ()
+ | Unix.WEXITED i ->
+ failwithf "pod2text: process exited with non-zero status (%d)" i
+ | Unix.WSIGNALED i | Unix.WSTOPPED i ->
+ failwithf "pod2text: process signalled or stopped by signal %d" i
+ );
+ Hashtbl.add pod2text_memo key lines;
+ let chan = open_out pod2text_memo_filename in
+ output_value chan pod2text_memo;
+ close_out chan;
+ lines
+
+(* Generate ruby bindings. *)
+and generate_ruby_c () =
+ generate_header CStyle LGPLv2;
+
+ pr "\
+#include <stdio.h>
+#include <stdlib.h>
+
+#include <ruby.h>
+
+#include \"guestfs.h\"
+
+#include \"extconf.h\"
+
+/* For Ruby < 1.9 */
+#ifndef RARRAY_LEN
+#define RARRAY_LEN(r) (RARRAY((r))->len)
+#endif
+
+static VALUE m_guestfs; /* guestfs module */
+static VALUE c_guestfs; /* guestfs_h handle */
+static VALUE e_Error; /* used for all errors */
+
+static void ruby_guestfs_free (void *p)
+{
+ if (!p) return;
+ guestfs_close ((guestfs_h *) p);
+}
+
+static VALUE ruby_guestfs_create (VALUE m)
+{
+ guestfs_h *g;
+
+ g = guestfs_create ();
+ if (!g)
+ rb_raise (e_Error, \"failed to create guestfs handle\");
+
+ /* Don't print error messages to stderr by default. */
+ guestfs_set_error_handler (g, NULL, NULL);
+
+ /* Wrap it, and make sure the close function is called when the
+ * handle goes away.
+ */
+ return Data_Wrap_Struct (c_guestfs, NULL, ruby_guestfs_free, g);
+}
+
+static VALUE ruby_guestfs_close (VALUE gv)
+{
+ guestfs_h *g;
+ Data_Get_Struct (gv, guestfs_h, g);
+
+ ruby_guestfs_free (g);
+ DATA_PTR (gv) = NULL;
+
+ return Qnil;
+}
+
+";
+
+ List.iter (
+ fun (name, style, _, _, _, _, _) ->
+ pr "static VALUE ruby_guestfs_%s (VALUE gv" name;
+ List.iter (fun arg -> pr ", VALUE %sv" (name_of_argt arg)) (snd style);
+ pr ")\n";
+ pr "{\n";
+ pr " guestfs_h *g;\n";
+ pr " Data_Get_Struct (gv, guestfs_h, g);\n";
+ pr " if (!g)\n";
+ pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
+ name;
+ pr "\n";
+
+ List.iter (
+ function
+ | String n | FileIn n | FileOut n ->
+ pr " Check_Type (%sv, T_STRING);\n" n;
+ pr " const char *%s = StringValueCStr (%sv);\n" n n;
+ pr " if (!%s)\n" n;
+ pr " rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
+ pr " \"%s\", \"%s\");\n" n name
+ | OptString n ->
+ pr " const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
+ | StringList n ->
+ pr " char **%s;\n" n;
+ pr " Check_Type (%sv, T_ARRAY);\n" n;
+ pr " {\n";
+ pr " int i, len;\n";
+ pr " len = RARRAY_LEN (%sv);\n" n;
+ pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
+ n;
+ pr " for (i = 0; i < len; ++i) {\n";
+ pr " VALUE v = rb_ary_entry (%sv, i);\n" n;
+ pr " %s[i] = StringValueCStr (v);\n" n;
+ pr " }\n";
+ pr " %s[len] = NULL;\n" n;
+ pr " }\n";
+ | Bool n ->
+ pr " int %s = RTEST (%sv);\n" n n
+ | Int n ->
+ pr " int %s = NUM2INT (%sv);\n" n n
+ ) (snd style);
+ pr "\n";
+
+ let error_code =
+ match fst style with
+ | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1"
+ | RConstString _ -> pr " const char *r;\n"; "NULL"
+ | RString _ -> pr " char *r;\n"; "NULL"
+ | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
+ | RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ; "NULL"
+ | RStructList (_, typ) ->
+ pr " struct guestfs_%s_list *r;\n" typ; "NULL" in
+ pr "\n";
+
+ pr " r = guestfs_%s " name;
+ generate_call_args ~handle:"g" (snd style);
+ pr ";\n";
+
+ List.iter (
+ function
+ | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
+ | StringList n ->
+ pr " free (%s);\n" n
+ ) (snd style);
+
+ pr " if (r == %s)\n" error_code;
+ pr " rb_raise (e_Error, \"%%s\", guestfs_last_error (g));\n";
+ pr "\n";
+
+ (match fst style with
+ | RErr ->
+ pr " return Qnil;\n"
+ | RInt _ | RBool _ ->
+ pr " return INT2NUM (r);\n"
+ | RInt64 _ ->
+ pr " return ULL2NUM (r);\n"
+ | RConstString _ ->
+ pr " return rb_str_new2 (r);\n";
+ | RString _ ->
+ pr " VALUE rv = rb_str_new2 (r);\n";
+ pr " free (r);\n";
+ pr " return rv;\n";
+ | RStringList _ ->
+ pr " int i, len = 0;\n";
+ pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
+ pr " VALUE rv = rb_ary_new2 (len);\n";
+ pr " for (i = 0; r[i] != NULL; ++i) {\n";
+ pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
+ pr " free (r[i]);\n";
+ pr " }\n";
+ pr " free (r);\n";
+ pr " return rv;\n"
+ | RStruct (_, typ) ->
+ let cols = cols_of_struct typ in
+ generate_ruby_struct_code typ cols
+ | RStructList (_, typ) ->
+ let cols = cols_of_struct typ in
+ generate_ruby_struct_list_code typ cols
+ | RHashtable _ ->
+ pr " VALUE rv = rb_hash_new ();\n";
+ pr " int i;\n";
+ pr " for (i = 0; r[i] != NULL; i+=2) {\n";
+ pr " rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
+ pr " free (r[i]);\n";
+ pr " free (r[i+1]);\n";
+ pr " }\n";
+ pr " free (r);\n";
+ pr " return rv;\n"
+ );
+
+ pr "}\n";
+ pr "\n"
+ ) all_functions;
+
+ pr "\
+/* Initialize the module. */
+void Init__guestfs ()
+{
+ m_guestfs = rb_define_module (\"Guestfs\");
+ c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
+ e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
+
+ rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
+ rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
+
+";
+ (* Define the rest of the methods. *)
+ List.iter (
+ fun (name, style, _, _, _, _, _) ->
+ pr " rb_define_method (c_guestfs, \"%s\",\n" name;
+ pr " ruby_guestfs_%s, %d);\n" name (List.length (snd style))
+ ) all_functions;
+
+ pr "}\n"
+
+(* Ruby code to return a struct. *)
+and generate_ruby_struct_code typ cols =
+ pr " VALUE rv = rb_hash_new ();\n";
+ List.iter (
+ function
+ | name, FString ->
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
+ | name, FUUID ->
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name
+ | name, (FBytes|FUInt64) ->
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
+ | name, FInt64 ->
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), LL2NUM (r->%s));\n" name name
+ | name, FUInt32 ->
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), UINT2NUM (r->%s));\n" name name
+ | name, FInt32 ->
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), INT2NUM (r->%s));\n" name name
+ | name, FOptPercent ->
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->%s));\n" name name
+ | name, FChar -> (* XXX wrong? *)
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
+ ) cols;
+ pr " guestfs_free_%s (r);\n" typ;
+ pr " return rv;\n"
+
+(* Ruby code to return a struct list. *)
+and generate_ruby_struct_list_code typ cols =
+ pr " VALUE rv = rb_ary_new2 (r->len);\n";
+ pr " int i;\n";
+ pr " for (i = 0; i < r->len; ++i) {\n";
+ pr " VALUE hv = rb_hash_new ();\n";
+ List.iter (
+ function
+ | name, FString ->
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
+ | name, FUUID ->
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
+ | name, (FBytes|FUInt64) ->
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
+ | name, FInt64 ->
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), LL2NUM (r->val[i].%s));\n" name name
+ | name, FUInt32 ->
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), UINT2NUM (r->val[i].%s));\n" name name
+ | name, FInt32 ->
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), INT2NUM (r->val[i].%s));\n" name name
+ | name, FOptPercent ->
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
+ | name, FChar -> (* XXX wrong? *)
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
+ ) cols;
+ pr " rb_ary_push (rv, hv);\n";
+ pr " }\n";
+ pr " guestfs_free_%s_list (r);\n" typ;
+ pr " return rv;\n"
+
+(* Generate Java bindings GuestFS.java file. *)
+and generate_java_java () =
+ generate_header CStyle LGPLv2;
+
+ pr "\
+package com.redhat.et.libguestfs;
+
+import java.util.HashMap;
+import com.redhat.et.libguestfs.LibGuestFSException;
+import com.redhat.et.libguestfs.PV;
+import com.redhat.et.libguestfs.VG;
+import com.redhat.et.libguestfs.LV;
+import com.redhat.et.libguestfs.Stat;
+import com.redhat.et.libguestfs.StatVFS;
+import com.redhat.et.libguestfs.IntBool;
+import com.redhat.et.libguestfs.Dirent;
+
+/**
+ * The GuestFS object is a libguestfs handle.
+ *
+ * @author rjones
+ */
+public class GuestFS {
+ // Load the native code.
+ static {
+ System.loadLibrary (\"guestfs_jni\");
+ }
+
+ /**
+ * The native guestfs_h pointer.
+ */
+ long g;
+
+ /**
+ * Create a libguestfs handle.
+ *
+ * @throws LibGuestFSException
+ */
+ public GuestFS () throws LibGuestFSException
+ {
+ g = _create ();
+ }
+ private native long _create () throws LibGuestFSException;
+
+ /**
+ * Close a libguestfs handle.
+ *
+ * You can also leave handles to be collected by the garbage
+ * collector, but this method ensures that the resources used
+ * by the handle are freed up immediately. If you call any
+ * other methods after closing the handle, you will get an
+ * exception.
+ *
+ * @throws LibGuestFSException
+ */
+ public void close () throws LibGuestFSException
+ {
+ if (g != 0)
+ _close (g);
+ g = 0;
+ }
+ private native void _close (long g) throws LibGuestFSException;
+
+ public void finalize () throws LibGuestFSException
+ {
+ close ();
+ }
+
+";
+
+ List.iter (
+ fun (name, style, _, flags, _, shortdesc, longdesc) ->
+ if not (List.mem NotInDocs flags); then (
+ let doc = replace_str longdesc "C<guestfs_" "C<g." in
+ let doc =
+ if List.mem ProtocolLimitWarning flags then
+ doc ^ "\n\n" ^ protocol_limit_warning
+ else doc in
+ let doc =
+ if List.mem DangerWillRobinson flags then
+ doc ^ "\n\n" ^ danger_will_robinson
+ else doc in
+ let doc = pod2text ~width:60 name doc in
+ let doc = List.map ( (* RHBZ#501883 *)
+ function
+ | "" -> "<p>"
+ | nonempty -> nonempty
+ ) doc in
+ let doc = String.concat "\n * " doc in
+
+ pr " /**\n";
+ pr " * %s\n" shortdesc;
+ pr " * <p>\n";
+ pr " * %s\n" doc;
+ pr " * @throws LibGuestFSException\n";
+ pr " */\n";
+ pr " ";
+ );
+ generate_java_prototype ~public:true ~semicolon:false name style;
+ pr "\n";
+ pr " {\n";
+ pr " if (g == 0)\n";
+ pr " throw new LibGuestFSException (\"%s: handle is closed\");\n"
+ name;
+ pr " ";
+ if fst style <> RErr then pr "return ";
+ pr "_%s " name;
+ generate_call_args ~handle:"g" (snd style);
+ pr ";\n";
+ pr " }\n";
+ pr " ";
+ generate_java_prototype ~privat:true ~native:true name style;
+ pr "\n";
+ pr "\n";
+ ) all_functions;
+
+ pr "}\n"
+
+and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
+ ?(semicolon=true) name style =
+ if privat then pr "private ";
+ if public then pr "public ";
+ if native then pr "native ";
+
+ (* return type *)
+ (match fst style with
+ | RErr -> pr "void ";
+ | RInt _ -> pr "int ";
+ | RInt64 _ -> pr "long ";
+ | RBool _ -> pr "boolean ";
+ | RConstString _ | RString _ -> pr "String ";
+ | RStringList _ -> pr "String[] ";
+ | RStruct (_, typ) ->
+ let name = java_name_of_struct typ in
+ pr "%s " name;
+ | RStructList (_, typ) ->
+ let name = java_name_of_struct typ in
+ pr "%s[] " name;
+ | RHashtable _ -> pr "HashMap<String,String> ";
+ );
+
+ if native then pr "_%s " name else pr "%s " name;
+ pr "(";
+ let needs_comma = ref false in
+ if native then (
+ pr "long g";
+ needs_comma := true
+ );
+
+ (* args *)
+ List.iter (
+ fun arg ->
+ if !needs_comma then pr ", ";
+ needs_comma := true;
+
+ match arg with
+ | String n
+ | OptString n
+ | FileIn n
+ | FileOut n ->
+ pr "String %s" n
+ | StringList n ->
+ pr "String[] %s" n
+ | Bool n ->
+ pr "boolean %s" n
+ | Int n ->
+ pr "int %s" n
+ ) (snd style);
+
+ pr ")\n";
+ pr " throws LibGuestFSException";
+ if semicolon then pr ";"
+
+and generate_java_struct jtyp cols =
+ generate_header CStyle LGPLv2;
+
+ pr "\
+package com.redhat.et.libguestfs;
+
+/**
+ * Libguestfs %s structure.
+ *
+ * @author rjones
+ * @see GuestFS
+ */
+public class %s {
+" jtyp jtyp;
+
+ List.iter (
+ function
+ | name, FString
+ | name, FUUID -> pr " public String %s;\n" name
+ | name, (FBytes|FUInt64|FInt64) -> pr " public long %s;\n" name
+ | name, (FUInt32|FInt32) -> pr " public int %s;\n" name
+ | name, FChar -> pr " public char %s;\n" name
+ | name, FOptPercent ->
+ pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
+ pr " public float %s;\n" name
+ ) cols;
+
+ pr "}\n"
+
+and generate_java_c () =
+ generate_header CStyle LGPLv2;
+
+ pr "\
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include \"com_redhat_et_libguestfs_GuestFS.h\"
+#include \"guestfs.h\"
+
+/* Note that this function returns. The exception is not thrown
+ * until after the wrapper function returns.
+ */
+static void
+throw_exception (JNIEnv *env, const char *msg)
+{
+ jclass cl;
+ cl = (*env)->FindClass (env,
+ \"com/redhat/et/libguestfs/LibGuestFSException\");
+ (*env)->ThrowNew (env, cl, msg);
+}
+
+JNIEXPORT jlong JNICALL
+Java_com_redhat_et_libguestfs_GuestFS__1create
+ (JNIEnv *env, jobject obj)
+{
+ guestfs_h *g;
+
+ g = guestfs_create ();
+ if (g == NULL) {
+ throw_exception (env, \"GuestFS.create: failed to allocate handle\");
+ return 0;
+ }
+ guestfs_set_error_handler (g, NULL, NULL);
+ return (jlong) (long) g;
+}
+
+JNIEXPORT void JNICALL
+Java_com_redhat_et_libguestfs_GuestFS__1close
+ (JNIEnv *env, jobject obj, jlong jg)
+{
+ guestfs_h *g = (guestfs_h *) (long) jg;
+ guestfs_close (g);
+}
+
+";
+
+ List.iter (
+ fun (name, style, _, _, _, _, _) ->
+ pr "JNIEXPORT ";
+ (match fst style with
+ | RErr -> pr "void ";
+ | RInt _ -> pr "jint ";
+ | RInt64 _ -> pr "jlong ";
+ | RBool _ -> pr "jboolean ";
+ | RConstString _ | RString _ -> pr "jstring ";
+ | RStruct _ | RHashtable _ ->
+ pr "jobject ";
+ | RStringList _ | RStructList _ ->
+ pr "jobjectArray ";
+ );
+ pr "JNICALL\n";
+ pr "Java_com_redhat_et_libguestfs_GuestFS_";
+ pr "%s" (replace_str ("_" ^ name) "_" "_1");
+ pr "\n";
+ pr " (JNIEnv *env, jobject obj, jlong jg";
+ List.iter (
+ function
+ | String n
+ | OptString n
+ | FileIn n
+ | FileOut n ->
+ pr ", jstring j%s" n
+ | StringList n ->
+ pr ", jobjectArray j%s" n
+ | Bool n ->
+ pr ", jboolean j%s" n
+ | Int n ->
+ pr ", jint j%s" n
+ ) (snd style);
+ pr ")\n";
+ pr "{\n";
+ pr " guestfs_h *g = (guestfs_h *) (long) jg;\n";
+ let error_code, no_ret =
+ match fst style with
+ | RErr -> pr " int r;\n"; "-1", ""
+ | RBool _
+ | RInt _ -> pr " int r;\n"; "-1", "0"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1", "0"
+ | RConstString _ -> pr " const char *r;\n"; "NULL", "NULL"
+ | RString _ ->
+ pr " jstring jr;\n";
+ pr " char *r;\n"; "NULL", "NULL"
+ | RStringList _ ->
+ pr " jobjectArray jr;\n";
+ pr " int r_len;\n";
+ pr " jclass cl;\n";
+ pr " jstring jstr;\n";
+ pr " char **r;\n"; "NULL", "NULL"
+ | RStruct (_, typ) ->
+ pr " jobject jr;\n";
+ pr " jclass cl;\n";
+ pr " jfieldID fl;\n";
+ pr " struct guestfs_%s *r;\n" typ; "NULL", "NULL"
+ | RStructList (_, typ) ->
+ pr " jobjectArray jr;\n";
+ pr " jclass cl;\n";
+ pr " jfieldID fl;\n";
+ pr " jobject jfl;\n";
+ pr " struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
+ | RHashtable _ -> pr " char **r;\n"; "NULL", "NULL" in
+ List.iter (
+ function
+ | String n
+ | OptString n
+ | FileIn n
+ | FileOut n ->
+ pr " const char *%s;\n" n
+ | StringList n ->
+ pr " int %s_len;\n" n;
+ pr " const char **%s;\n" n
+ | Bool n
+ | Int n ->
+ pr " int %s;\n" n
+ ) (snd style);
+
+ let needs_i =
+ (match fst style with
+ | RStringList _ | RStructList _ -> true
+ | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
+ | RString _ | RStruct _ | RHashtable _ -> false) ||
+ List.exists (function StringList _ -> true | _ -> false) (snd style) in
+ if needs_i then
+ pr " int i;\n";
+
+ pr "\n";
+
+ (* Get the parameters. *)
+ List.iter (
+ function
+ | String n
+ | FileIn n
+ | FileOut n ->
+ pr " %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
+ | OptString n ->
+ (* This is completely undocumented, but Java null becomes
+ * a NULL parameter.
+ *)
+ pr " %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
+ | StringList n ->
+ pr " %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
+ pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
+ pr " for (i = 0; i < %s_len; ++i) {\n" n;
+ pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
+ n;
+ pr " %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
+ pr " }\n";
+ pr " %s[%s_len] = NULL;\n" n n;
+ | Bool n
+ | Int n ->
+ pr " %s = j%s;\n" n n
+ ) (snd style);
+
+ (* Make the call. *)
+ pr " r = guestfs_%s " name;
+ generate_call_args ~handle:"g" (snd style);
+ pr ";\n";
+
+ (* Release the parameters. *)
+ List.iter (
+ function
+ | String n
+ | FileIn n
+ | FileOut n ->
+ pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
+ | OptString n ->
+ pr " if (j%s)\n" n;
+ pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
+ | StringList n ->
+ pr " for (i = 0; i < %s_len; ++i) {\n" n;
+ pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
+ n;
+ pr " (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
+ pr " }\n";
+ pr " free (%s);\n" n
+ | Bool n
+ | Int n -> ()
+ ) (snd style);
+
+ (* Check for errors. *)
+ pr " if (r == %s) {\n" error_code;
+ pr " throw_exception (env, guestfs_last_error (g));\n";
+ pr " return %s;\n" no_ret;
+ pr " }\n";
+
+ (* Return value. *)
+ (match fst style with
+ | RErr -> ()
+ | RInt _ -> pr " return (jint) r;\n"
+ | RBool _ -> pr " return (jboolean) r;\n"
+ | RInt64 _ -> pr " return (jlong) r;\n"
+ | RConstString _ -> pr " return (*env)->NewStringUTF (env, r);\n"
+ | RString _ ->
+ pr " jr = (*env)->NewStringUTF (env, r);\n";
+ pr " free (r);\n";
+ pr " return jr;\n"
+ | RStringList _ ->
+ pr " for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
+ pr " cl = (*env)->FindClass (env, \"java/lang/String\");\n";
+ pr " jstr = (*env)->NewStringUTF (env, \"\");\n";
+ pr " jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
+ pr " for (i = 0; i < r_len; ++i) {\n";
+ pr " jstr = (*env)->NewStringUTF (env, r[i]);\n";
+ pr " (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
+ pr " free (r[i]);\n";
+ pr " }\n";
+ pr " free (r);\n";
+ pr " return jr;\n"
+ | RStruct (_, typ) ->
+ let jtyp = java_name_of_struct typ in
+ let cols = cols_of_struct typ in
+ generate_java_struct_return typ jtyp cols
+ | RStructList (_, typ) ->
+ let jtyp = java_name_of_struct typ in
+ let cols = cols_of_struct typ in
+ generate_java_struct_list_return typ jtyp cols
+ | RHashtable _ ->
+ (* XXX *)
+ pr " throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
+ pr " return NULL;\n"
+ );
+
+ pr "}\n";
+ pr "\n"
+ ) all_functions
+
+and generate_java_struct_return typ jtyp cols =
+ pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
+ pr " jr = (*env)->AllocObject (env, cl);\n";
+ List.iter (
+ function
+ | name, FString ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
+ pr " (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, r->%s));\n" name;
+ | name, FUUID ->
+ pr " {\n";
+ pr " char s[33];\n";
+ pr " memcpy (s, r->%s, 32);\n" name;
+ pr " s[32] = 0;\n";
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
+ pr " (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
+ pr " }\n";
+ | name, (FBytes|FUInt64|FInt64) ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
+ pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
+ | name, (FUInt32|FInt32) ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
+ pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
+ | name, FOptPercent ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
+ pr " (*env)->SetFloatField (env, jr, fl, r->%s);\n" name;
+ | name, FChar ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
+ pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
+ ) cols;
+ pr " free (r);\n";
+ pr " return jr;\n"
+
+and generate_java_struct_list_return typ jtyp cols =
+ pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
+ pr " jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
+ pr " for (i = 0; i < r->len; ++i) {\n";
+ pr " jfl = (*env)->AllocObject (env, cl);\n";
+ List.iter (
+ function
+ | name, FString ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
+ pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
+ | name, FUUID ->
+ pr " {\n";
+ pr " char s[33];\n";
+ pr " memcpy (s, r->val[i].%s, 32);\n" name;
+ pr " s[32] = 0;\n";
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
+ pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
+ pr " }\n";
+ | name, (FBytes|FUInt64|FInt64) ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
+ pr " (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
+ | name, (FUInt32|FInt32) ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
+ pr " (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
+ | name, FOptPercent ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
+ pr " (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
+ | name, FChar ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
+ pr " (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
+ ) cols;
+ pr " (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
+ pr " }\n";
+ pr " guestfs_free_%s_list (r);\n" typ;
+ pr " return jr;\n"
+
+and generate_haskell_hs () =
+ generate_header HaskellStyle LGPLv2;
+
+ (* XXX We only know how to generate partial FFI for Haskell
+ * at the moment. Please help out!
+ *)
+ let can_generate style =
+ match style with
+ | RErr, _
+ | RInt _, _
+ | RInt64 _, _ -> true
+ | RBool _, _
+ | RConstString _, _
+ | RString _, _
+ | RStringList _, _
+ | RStruct _, _
+ | RStructList _, _
+ | RHashtable _, _ -> false in
+
+ pr "\
+{-# INCLUDE <guestfs.h> #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Guestfs (
+ create";
+
+ (* List out the names of the actions we want to export. *)
+ List.iter (
+ fun (name, style, _, _, _, _, _) ->
+ if can_generate style then pr ",\n %s" name
+ ) all_functions;
+
+ pr "
+ ) where
+import Foreign
+import Foreign.C
+import Foreign.C.Types
+import IO
+import Control.Exception
+import Data.Typeable
+
+data GuestfsS = GuestfsS -- represents the opaque C struct
+type GuestfsP = Ptr GuestfsS -- guestfs_h *
+type GuestfsH = ForeignPtr GuestfsS -- guestfs_h * with attached finalizer
+
+-- XXX define properly later XXX
+data PV = PV
+data VG = VG
+data LV = LV
+data IntBool = IntBool
+data Stat = Stat
+data StatVFS = StatVFS
+data Hashtable = Hashtable
+
+foreign import ccall unsafe \"guestfs_create\" c_create
+ :: IO GuestfsP
+foreign import ccall unsafe \"&guestfs_close\" c_close
+ :: FunPtr (GuestfsP -> IO ())
+foreign import ccall unsafe \"guestfs_set_error_handler\" c_set_error_handler
+ :: GuestfsP -> Ptr CInt -> Ptr CInt -> IO ()
+
+create :: IO GuestfsH
+create = do
+ p <- c_create
+ c_set_error_handler p nullPtr nullPtr
+ h <- newForeignPtr c_close p
+ return h
+
+foreign import ccall unsafe \"guestfs_last_error\" c_last_error
+ :: GuestfsP -> IO CString
+
+-- last_error :: GuestfsH -> IO (Maybe String)
+-- last_error h = do
+-- str <- withForeignPtr h (\\p -> c_last_error p)
+-- maybePeek peekCString str
+
+last_error :: GuestfsH -> IO (String)
+last_error h = do
+ str <- withForeignPtr h (\\p -> c_last_error p)
+ if (str == nullPtr)
+ then return \"no error\"
+ else peekCString str
+
+";
+
+ (* Generate wrappers for each foreign function. *)
+ List.iter (
+ fun (name, style, _, _, _, _, _) ->
+ if can_generate style then (
+ pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
+ pr " :: ";
+ generate_haskell_prototype ~handle:"GuestfsP" style;
+ pr "\n";
+ pr "\n";
+ pr "%s :: " name;
+ generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
+ pr "\n";
+ pr "%s %s = do\n" name
+ (String.concat " " ("h" :: List.map name_of_argt (snd style)));
+ pr " r <- ";
+ (* Convert pointer arguments using with* functions. *)
+ List.iter (
+ function
+ | FileIn n
+ | FileOut n
+ | String n -> pr "withCString %s $ \\%s -> " n n
+ | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
+ | StringList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
+ | Bool _ | Int _ -> ()
+ ) (snd style);
+ (* Convert integer arguments. *)
+ let args =
+ List.map (
+ function
+ | Bool n -> sprintf "(fromBool %s)" n
+ | Int n -> sprintf "(fromIntegral %s)" n
+ | FileIn n | FileOut n | String n | OptString n | StringList n -> n
+ ) (snd style) in
+ pr "withForeignPtr h (\\p -> c_%s %s)\n" name
+ (String.concat " " ("p" :: args));
+ (match fst style with
+ | RErr | RInt _ | RInt64 _ | RBool _ ->
+ pr " if (r == -1)\n";
+ pr " then do\n";
+ pr " err <- last_error h\n";
+ pr " fail err\n";
+ | RConstString _ | RString _ | RStringList _ | RStruct _
+ | RStructList _ | RHashtable _ ->
+ pr " if (r == nullPtr)\n";
+ pr " then do\n";
+ pr " err <- last_error h\n";
+ pr " fail err\n";
+ );
+ (match fst style with
+ | RErr ->
+ pr " else return ()\n"
+ | RInt _ ->
+ pr " else return (fromIntegral r)\n"
+ | RInt64 _ ->
+ pr " else return (fromIntegral r)\n"
+ | RBool _ ->
+ pr " else return (toBool r)\n"
+ | RConstString _
+ | RString _
+ | RStringList _
+ | RStruct _
+ | RStructList _
+ | RHashtable _ ->
+ pr " else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
+ );
+ pr "\n";
+ )
+ ) all_functions
+
+and generate_haskell_prototype ~handle ?(hs = false) style =
+ pr "%s -> " handle;
+ let string = if hs then "String" else "CString" in
+ let int = if hs then "Int" else "CInt" in
+ let bool = if hs then "Bool" else "CInt" in
+ let int64 = if hs then "Integer" else "Int64" in
+ List.iter (
+ fun arg ->
+ (match arg with
+ | String _ -> pr "%s" string
+ | OptString _ -> if hs then pr "Maybe String" else pr "CString"
+ | StringList _ -> if hs then pr "[String]" else pr "Ptr CString"
+ | Bool _ -> pr "%s" bool
+ | Int _ -> pr "%s" int
+ | FileIn _ -> pr "%s" string
+ | FileOut _ -> pr "%s" string
+ );
+ pr " -> ";
+ ) (snd style);
+ pr "IO (";
+ (match fst style with
+ | RErr -> if not hs then pr "CInt"
+ | RInt _ -> pr "%s" int
+ | RInt64 _ -> pr "%s" int64
+ | RBool _ -> pr "%s" bool
+ | RConstString _ -> pr "%s" string
+ | RString _ -> pr "%s" string
+ | RStringList _ -> pr "[%s]" string
+ | RStruct (_, typ) ->
+ let name = java_name_of_struct typ in
+ pr "%s" name
+ | RStructList (_, typ) ->
+ let name = java_name_of_struct typ in
+ pr "[%s]" name
+ | RHashtable _ -> pr "Hashtable"
+ );
+ pr ")"
+
+and generate_bindtests () =
+ generate_header CStyle LGPLv2;
- (* Message header, etc. *)
pr "\
-const GUESTFS_PROGRAM = 0x2000F5F5;
-const GUESTFS_PROTOCOL_VERSION = 1;
+#include <stdio.h>
+#include <stdlib.h>
+#include <inttypes.h>
+#include <string.h>
-enum guestfs_message_direction {
- GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
- GUESTFS_DIRECTION_REPLY = 1 /* daemon -> client */
-};
+#include \"guestfs.h\"
+#include \"guestfs_protocol.h\"
-enum guestfs_message_status {
- GUESTFS_STATUS_OK = 0,
- GUESTFS_STATUS_ERROR = 1
-};
+#define error guestfs_error
+#define safe_calloc guestfs_safe_calloc
+#define safe_malloc guestfs_safe_malloc
-const GUESTFS_ERROR_LEN = 256;
+static void
+print_strings (char * const* const argv)
+{
+ int argc;
-struct guestfs_message_error {
- string error<GUESTFS_ERROR_LEN>; /* error message */
-};
+ printf (\"[\");
+ for (argc = 0; argv[argc] != NULL; ++argc) {
+ if (argc > 0) printf (\", \");
+ printf (\"\\\"%%s\\\"\", argv[argc]);
+ }
+ printf (\"]\\n\");
+}
-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;
-};
-"
+/* The test0 function prints its parameters to stdout. */
+";
-(* Generate the guestfs-actions.h file. *)
-and generate_actions_h () =
- generate_header CStyle LGPLv2;
- List.iter (
- fun (shortname, style, _, _, _) ->
- let name = "guestfs_" ^ shortname in
- generate_prototype ~single_line:true ~newline:true ~handle:"handle"
- name style
- ) functions
+ let test0, tests =
+ match test_functions with
+ | [] -> assert false
+ | test0 :: tests -> test0, tests in
+
+ let () =
+ let (name, style, _, _, _, _, _) = test0 in
+ generate_prototype ~extern:false ~semicolon:false ~newline:true
+ ~handle:"g" ~prefix:"guestfs_" name style;
+ pr "{\n";
+ List.iter (
+ function
+ | String n
+ | FileIn n
+ | FileOut n -> pr " printf (\"%%s\\n\", %s);\n" n
+ | OptString n -> pr " printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
+ | StringList n -> pr " print_strings (%s);\n" n
+ | Bool n -> pr " printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
+ | Int n -> pr " printf (\"%%d\\n\", %s);\n" n
+ ) (snd style);
+ pr " /* Java changes stdout line buffering so we need this: */\n";
+ pr " fflush (stdout);\n";
+ pr " return 0;\n";
+ pr "}\n";
+ pr "\n" in
-(* Generate the client-side dispatch stubs. *)
-and generate_client_actions () =
- generate_header CStyle LGPLv2;
List.iter (
- fun (shortname, style, _, _, _) ->
- let name = "guestfs_" ^ shortname in
+ fun (name, style, _, _, _, _, _) ->
+ if String.sub name (String.length name - 3) 3 <> "err" then (
+ pr "/* Test normal return. */\n";
+ generate_prototype ~extern:false ~semicolon:false ~newline:true
+ ~handle:"g" ~prefix:"guestfs_" name style;
+ pr "{\n";
+ (match fst style with
+ | RErr ->
+ pr " return 0;\n"
+ | RInt _ ->
+ pr " int r;\n";
+ pr " sscanf (val, \"%%d\", &r);\n";
+ pr " return r;\n"
+ | RInt64 _ ->
+ pr " int64_t r;\n";
+ pr " sscanf (val, \"%%\" SCNi64, &r);\n";
+ pr " return r;\n"
+ | RBool _ ->
+ pr " return strcmp (val, \"true\") == 0;\n"
+ | RConstString _ ->
+ (* Can't return the input string here. Return a static
+ * string so we ensure we get a segfault if the caller
+ * tries to free it.
+ *)
+ pr " return \"static string\";\n"
+ | RString _ ->
+ pr " return strdup (val);\n"
+ | RStringList _ ->
+ pr " char **strs;\n";
+ pr " int n, i;\n";
+ pr " sscanf (val, \"%%d\", &n);\n";
+ pr " strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
+ pr " for (i = 0; i < n; ++i) {\n";
+ pr " strs[i] = safe_malloc (g, 16);\n";
+ pr " snprintf (strs[i], 16, \"%%d\", i);\n";
+ pr " }\n";
+ pr " strs[n] = NULL;\n";
+ pr " return strs;\n"
+ | RStruct (_, typ) ->
+ pr " struct guestfs_%s *r;\n" typ;
+ pr " r = safe_calloc (g, sizeof *r, 1);\n";
+ pr " return r;\n"
+ | RStructList (_, typ) ->
+ pr " struct guestfs_%s_list *r;\n" typ;
+ pr " r = safe_calloc (g, sizeof *r, 1);\n";
+ pr " sscanf (val, \"%%d\", &r->len);\n";
+ pr " r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
+ pr " return r;\n"
+ | RHashtable _ ->
+ pr " char **strs;\n";
+ pr " int n, i;\n";
+ pr " sscanf (val, \"%%d\", &n);\n";
+ pr " strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
+ pr " for (i = 0; i < n; ++i) {\n";
+ pr " strs[i*2] = safe_malloc (g, 16);\n";
+ pr " strs[i*2+1] = safe_malloc (g, 16);\n";
+ pr " snprintf (strs[i*2], 16, \"%%d\", i);\n";
+ pr " snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
+ pr " }\n";
+ pr " strs[n*2] = NULL;\n";
+ pr " return strs;\n"
+ );
+ pr "}\n";
+ pr "\n"
+ ) else (
+ pr "/* Test error return. */\n";
+ generate_prototype ~extern:false ~semicolon:false ~newline:true
+ ~handle:"g" ~prefix:"guestfs_" name style;
+ pr "{\n";
+ pr " error (g, \"error\");\n";
+ (match fst style with
+ | RErr | RInt _ | RInt64 _ | RBool _ ->
+ pr " return -1;\n"
+ | RConstString _
+ | RString _ | RStringList _ | RStruct _
+ | RStructList _
+ | RHashtable _ ->
+ pr " return NULL;\n"
+ );
+ pr "}\n";
+ pr "\n"
+ )
+ ) tests
- (* Generate the return value struct. *)
- pr "struct %s_rv {\n" shortname;
- pr " int cb_done; /* flag to indicate callback was called */\n";
- pr " struct guestfs_message_header hdr;\n";
- pr " struct guestfs_message_error err;\n";
- (match style with
- | (Err, _) -> ()
- (* | _ -> pr " struct %s_ret ret;\n" name; *)
- );
- pr "};\n\n";
+and generate_ocaml_bindtests () =
+ generate_header OCamlStyle GPLv2;
- (* Generate the callback function. *)
- pr "static void %s_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
- pr "{\n";
- pr " struct %s_rv *rv = (struct %s_rv *) data;\n" shortname shortname;
- pr "\n";
- pr " if (!xdr_guestfs_message_header (xdr, &rv->hdr)) {\n";
- pr " error (g, \"%s: failed to parse reply header\");\n" name;
- pr " return;\n";
- pr " }\n";
- pr " if (rv->hdr.status == GUESTFS_STATUS_ERROR) {\n";
- pr " if (!xdr_guestfs_message_error (xdr, &rv->err)) {\n";
- pr " error (g, \"%s: failed to parse reply error\");\n" name;
- pr " return;\n";
- pr " }\n";
- pr " goto done;\n";
- pr " }\n";
+ pr "\
+let () =
+ let g = Guestfs.create () in
+";
- (match style with
- | (Err, _) -> ()
- (* | _ -> pr " if (!xdr_%s_ret (&xdr, &rv->ret)) ..." *)
- );
+ let mkargs args =
+ String.concat " " (
+ List.map (
+ function
+ | CallString s -> "\"" ^ s ^ "\""
+ | CallOptString None -> "None"
+ | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
+ | CallStringList xs ->
+ "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
+ | CallInt i when i >= 0 -> string_of_int i
+ | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
+ | CallBool b -> string_of_bool b
+ ) args
+ )
+ in
- pr " done:\n";
- pr " rv->cb_done = 1;\n";
- pr " main_loop.main_loop_quit (g);\n";
- pr "}\n\n";
+ generate_lang_bindtests (
+ fun f args -> pr " Guestfs.%s g %s;\n" f (mkargs args)
+ );
- (* Generate the action stub. *)
- generate_prototype ~extern:false ~semicolon:false ~newline:true
- ~handle:"g" name style;
+ pr "print_endline \"EOF\"\n"
- let error_code =
- match style with
- | (Err, _) -> "-1" in
+and generate_perl_bindtests () =
+ pr "#!/usr/bin/perl -w\n";
+ generate_header HashStyle GPLv2;
- pr "{\n";
+ pr "\
+use strict;
- (match style with
- | (_, P0) -> ()
- | _ -> pr " struct %s_args args;\n" name
- );
+use Sys::Guestfs;
- pr " struct %s_rv rv;\n" shortname;
- pr " int serial;\n";
- pr "\n";
- pr " if (g->state != READY) {\n";
- pr " error (g, \"%s called from the wrong state, %%d != READY\",\n"
- name;
- pr " g->state);\n";
- pr " return %s;\n" error_code;
- pr " }\n";
- pr "\n";
- pr " memset (&rv, 0, sizeof rv);\n";
- pr "\n";
+my $g = Sys::Guestfs->new ();
+";
- (match style with
- | (_, P0) ->
- pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
- (String.uppercase shortname)
- | (_, args) ->
- pr "\n";
- iter_args (
- function
- | String name -> pr " args.%s = (char *) %s;\n" name name
- ) args;
- pr " serial = dispatch (g, GUESTFS_PROC_%s,\n"
- (String.uppercase shortname);
- pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
- name;
- );
- pr " if (serial == -1)\n";
- pr " return %s;\n" error_code;
- pr "\n";
+ let mkargs args =
+ String.concat ", " (
+ List.map (
+ function
+ | CallString s -> "\"" ^ s ^ "\""
+ | CallOptString None -> "undef"
+ | CallOptString (Some s) -> sprintf "\"%s\"" s
+ | CallStringList xs ->
+ "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
+ | CallInt i -> string_of_int i
+ | CallBool b -> if b then "1" else "0"
+ ) args
+ )
+ in
- pr " rv.cb_done = 0;\n";
- pr " g->reply_cb_internal = %s_cb;\n" shortname;
- pr " g->reply_cb_internal_data = &rv;\n";
- pr " main_loop.main_loop_run (g);\n";
- pr " g->reply_cb_internal = NULL;\n";
- pr " g->reply_cb_internal_data = NULL;\n";
- pr " if (!rv.cb_done) {\n";
- pr " error (g, \"%s failed, see earlier error messages\");\n" name;
- pr " return %s;\n" error_code;
- pr " }\n";
- pr "\n";
+ generate_lang_bindtests (
+ fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
+ );
- pr " if (check_reply_header (g, &rv.hdr, GUESTFS_PROC_%s, serial) == -1)\n"
- (String.uppercase shortname);
- pr " return %s;\n" error_code;
- pr "\n";
+ pr "print \"EOF\\n\"\n"
- pr " if (rv.hdr.status == GUESTFS_STATUS_ERROR) {\n";
- pr " error (g, \"%%s\", rv.err.error);\n";
- pr " return %s;\n" error_code;
- pr " }\n";
- pr "\n";
+and generate_python_bindtests () =
+ generate_header HashStyle GPLv2;
- (match style with
- | (Err, _) -> pr " return 0;\n"
- );
+ pr "\
+import guestfs
- pr "}\n\n"
- ) functions
+g = guestfs.GuestFS ()
+";
-(* Generate daemon/actions.h. *)
-and generate_daemon_actions_h () =
- generate_header CStyle GPLv2;
- List.iter (
- fun (name, style, _, _, _) ->
- generate_prototype ~single_line:true ~newline:true ("do_" ^ name) style;
- ) functions
+ let mkargs args =
+ String.concat ", " (
+ List.map (
+ function
+ | CallString s -> "\"" ^ s ^ "\""
+ | CallOptString None -> "None"
+ | CallOptString (Some s) -> sprintf "\"%s\"" s
+ | CallStringList xs ->
+ "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
+ | CallInt i -> string_of_int i
+ | CallBool b -> if b then "1" else "0"
+ ) args
+ )
+ in
-(* Generate the server-side stubs. *)
-and generate_daemon_actions () =
- generate_header CStyle GPLv2;
+ generate_lang_bindtests (
+ fun f args -> pr "g.%s (%s)\n" f (mkargs args)
+ );
- pr "#include <rpc/types.h>\n";
- pr "#include <rpc/xdr.h>\n";
- pr "#include \"daemon.h\"\n";
- pr "#include \"../src/guestfs_protocol.h\"\n";
- pr "#include \"actions.h\"\n";
- pr "\n";
+ pr "print \"EOF\"\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 style with
- | (Err, _) -> pr " int r;\n"; "-1" in
- (match style with
- | (_, P0) -> ()
- | (_, args) ->
- pr " struct guestfs_%s_args args;\n" name;
- iter_args (
- function
- | String name -> pr " const char *%s;\n" name
- ) args
- );
- pr "\n";
+and generate_ruby_bindtests () =
+ generate_header HashStyle GPLv2;
- (match style with
- | (_, P0) -> ()
- | (_, args) ->
- pr " memset (&args, 0, sizeof args);\n";
- pr "\n";
- pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
- pr " reply_with_error (\"%s: daemon failed to decode procedure arguments\");\n" name;
- pr " return;\n";
- pr " }\n";
- iter_args (
- function
- | String name -> pr " %s = args.%s;\n" name name
- ) args;
- pr "\n"
- );
+ pr "\
+require 'guestfs'
- pr " r = do_%s " name;
- generate_call_args style;
- pr ";\n";
+g = Guestfs::create()
+";
- pr " if (r == %s)\n" error_code;
- pr " /* do_%s has already called reply_with_error, so just return */\n" name;
- pr " return;\n";
- pr "\n";
+ let mkargs args =
+ String.concat ", " (
+ List.map (
+ function
+ | CallString s -> "\"" ^ s ^ "\""
+ | CallOptString None -> "nil"
+ | CallOptString (Some s) -> sprintf "\"%s\"" s
+ | CallStringList xs ->
+ "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
+ | CallInt i -> string_of_int i
+ | CallBool b -> string_of_bool b
+ ) args
+ )
+ in
- (match style with
- | (Err, _) -> pr " reply (NULL, NULL);\n"
- );
+ generate_lang_bindtests (
+ fun f args -> pr "g.%s(%s)\n" f (mkargs args)
+ );
- pr "}\n\n";
- ) functions;
+ pr "print \"EOF\\n\"\n"
- (* Dispatch function. *)
- pr "void dispatch_incoming_message (XDR *xdr_in)\n";
- pr "{\n";
- pr " switch (proc_nr) {\n";
+and generate_java_bindtests () =
+ generate_header CStyle GPLv2;
- List.iter (
- fun (name, style, _, _, _) ->
- pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
- pr " %s_stub (xdr_in);\n" name;
- pr " break;\n"
- ) functions;
+ pr "\
+import com.redhat.et.libguestfs.*;
- pr " default:\n";
- pr " reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
- pr " }\n";
- pr "}\n";
+public class Bindtests {
+ public static void main (String[] argv)
+ {
+ try {
+ GuestFS g = new GuestFS ();
+";
-(* Generate a C function prototype. *)
-and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
- ?(single_line = false) ?(newline = false)
- ?handle name style =
- if extern then pr "extern ";
- if static then pr "static ";
- (match style with
- | (Err, _) -> pr "int "
- );
- pr "%s (" name;
- let comma = ref false in
- (match handle with
- | None -> ()
- | Some handle -> pr "guestfs_h *%s" handle; comma := true
+ let mkargs args =
+ String.concat ", " (
+ List.map (
+ function
+ | CallString s -> "\"" ^ s ^ "\""
+ | CallOptString None -> "null"
+ | CallOptString (Some s) -> sprintf "\"%s\"" s
+ | CallStringList xs ->
+ "new String[]{" ^
+ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
+ | CallInt i -> string_of_int i
+ | CallBool b -> string_of_bool b
+ ) args
+ )
+ in
+
+ generate_lang_bindtests (
+ fun f args -> pr " g.%s (%s);\n" f (mkargs args)
);
- let next () =
- if !comma then (
- if single_line then pr ", " else pr ",\n\t\t"
- );
- comma := true
+
+ pr "
+ System.out.println (\"EOF\");
+ }
+ catch (Exception exn) {
+ System.err.println (exn);
+ System.exit (1);
+ }
+ }
+}
+"
+
+and generate_haskell_bindtests () =
+ generate_header HaskellStyle GPLv2;
+
+ pr "\
+module Bindtests where
+import qualified Guestfs
+
+main = do
+ g <- Guestfs.create
+";
+
+ let mkargs args =
+ String.concat " " (
+ List.map (
+ function
+ | CallString s -> "\"" ^ s ^ "\""
+ | CallOptString None -> "Nothing"
+ | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
+ | CallStringList xs ->
+ "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
+ | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
+ | CallInt i -> string_of_int i
+ | CallBool true -> "True"
+ | CallBool false -> "False"
+ ) args
+ )
in
- iter_args (
- function
- | String name -> next (); pr "const char *%s" name
- ) (snd style);
- pr ")";
- if semicolon then pr ";";
- if newline then pr "\n"
-(* Generate C call arguments, eg "(handle, foo, bar)" *)
-and generate_call_args ?handle style =
- pr "(";
- let comma = ref false in
- (match handle with
- | None -> ()
- | Some handle -> pr "%s" handle; comma := true
+ generate_lang_bindtests (
+ fun f args -> pr " Guestfs.%s g %s\n" f (mkargs args)
);
- iter_args (
- fun arg ->
- if !comma then pr ", ";
- comma := true;
- match arg with
- | String name -> pr "%s" name
- ) (snd style);
- pr ")"
+
+ pr " putStrLn \"EOF\"\n"
+
+(* Language-independent bindings tests - we do it this way to
+ * ensure there is parity in testing bindings across all languages.
+ *)
+and generate_lang_bindtests call =
+ call "test0" [CallString "abc"; CallOptString (Some "def");
+ CallStringList []; CallBool false;
+ CallInt 0; CallString "123"; CallString "456"];
+ call "test0" [CallString "abc"; CallOptString None;
+ CallStringList []; CallBool false;
+ CallInt 0; CallString "123"; CallString "456"];
+ call "test0" [CallString ""; CallOptString (Some "def");
+ CallStringList []; CallBool false;
+ CallInt 0; CallString "123"; CallString "456"];
+ call "test0" [CallString ""; CallOptString (Some "");
+ CallStringList []; CallBool false;
+ CallInt 0; CallString "123"; CallString "456"];
+ call "test0" [CallString "abc"; CallOptString (Some "def");
+ CallStringList ["1"]; CallBool false;
+ CallInt 0; CallString "123"; CallString "456"];
+ call "test0" [CallString "abc"; CallOptString (Some "def");
+ CallStringList ["1"; "2"]; CallBool false;
+ CallInt 0; CallString "123"; CallString "456"];
+ call "test0" [CallString "abc"; CallOptString (Some "def");
+ CallStringList ["1"]; CallBool true;
+ CallInt 0; CallString "123"; CallString "456"];
+ call "test0" [CallString "abc"; CallOptString (Some "def");
+ CallStringList ["1"]; CallBool false;
+ CallInt (-1); CallString "123"; CallString "456"];
+ call "test0" [CallString "abc"; CallOptString (Some "def");
+ CallStringList ["1"]; CallBool false;
+ CallInt (-2); CallString "123"; CallString "456"];
+ call "test0" [CallString "abc"; CallOptString (Some "def");
+ CallStringList ["1"]; CallBool false;
+ CallInt 1; CallString "123"; CallString "456"];
+ call "test0" [CallString "abc"; CallOptString (Some "def");
+ CallStringList ["1"]; CallBool false;
+ CallInt 2; CallString "123"; CallString "456"];
+ call "test0" [CallString "abc"; CallOptString (Some "def");
+ CallStringList ["1"]; CallBool false;
+ CallInt 4095; CallString "123"; CallString "456"];
+ call "test0" [CallString "abc"; CallOptString (Some "def");
+ CallStringList ["1"]; CallBool false;
+ CallInt 0; CallString ""; CallString ""]
+
+(* XXX Add here tests of the return and error functions. *)
+
+(* This is used to generate the src/MAX_PROC_NR file which
+ * contains the maximum procedure number, a surrogate for the
+ * ABI version number. See src/Makefile.am for the details.
+ *)
+and generate_max_proc_nr () =
+ let proc_nrs = List.map (
+ fun (_, _, proc_nr, _, _, _, _) -> proc_nr
+ ) daemon_functions in
+
+ let max_proc_nr = List.fold_left max 0 proc_nrs in
+
+ pr "%d\n" max_proc_nr
let output_to filename =
let filename_new = filename ^ ".new" in
let close () =
close_out !chan;
chan := stdout;
- Unix.rename filename_new filename;
- printf "written %s\n%!" filename;
+
+ (* Is the new file different from the current file? *)
+ if Sys.file_exists filename && files_equal filename filename_new then
+ Unix.unlink filename_new (* same, so skip it *)
+ else (
+ (* different, overwrite old one *)
+ (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ());
+ Unix.rename filename_new filename;
+ Unix.chmod filename 0o444;
+ printf "written %s\n%!" filename;
+ )
in
close
(* Main program. *)
let () =
+ check_functions ();
+
+ if not (Sys.file_exists "config.status") then (
+ eprintf "\
+You are probably running this from the wrong directory.
+Run it from the top source directory using the command
+ src/generator.ml
+";
+ exit 1
+ );
+
let close = output_to "src/guestfs_protocol.x" in
generate_xdr ();
close ();
+ let close = output_to "src/guestfs-structs.h" in
+ generate_structs_h ();
+ close ();
+
let close = output_to "src/guestfs-actions.h" in
generate_actions_h ();
close ();
generate_daemon_actions ();
close ();
+ let close = output_to "daemon/names.c" in
+ generate_daemon_names ();
+ close ();
+
+ let close = output_to "capitests/tests.c" in
+ generate_tests ();
+ close ();
+
+ let close = output_to "src/guestfs-bindtests.c" in
+ generate_bindtests ();
+ close ();
+
+ let close = output_to "fish/cmds.c" in
+ generate_fish_cmds ();
+ close ();
+
+ let close = output_to "fish/completion.c" in
+ generate_fish_completion ();
+ close ();
+
+ let close = output_to "guestfs-structs.pod" in
+ generate_structs_pod ();
+ close ();
+
let close = output_to "guestfs-actions.pod" in
- generate_pod ();
- close ()
+ generate_actions_pod ();
+ close ();
+
+ let close = output_to "guestfish-actions.pod" in
+ generate_fish_actions_pod ();
+ close ();
+
+ let close = output_to "ocaml/guestfs.mli" in
+ generate_ocaml_mli ();
+ close ();
+
+ let close = output_to "ocaml/guestfs.ml" in
+ generate_ocaml_ml ();
+ close ();
+
+ let close = output_to "ocaml/guestfs_c_actions.c" in
+ generate_ocaml_c ();
+ close ();
+
+ let close = output_to "ocaml/bindtests.ml" in
+ generate_ocaml_bindtests ();
+ close ();
+
+ let close = output_to "perl/Guestfs.xs" in
+ generate_perl_xs ();
+ close ();
+
+ let close = output_to "perl/lib/Sys/Guestfs.pm" in
+ generate_perl_pm ();
+ close ();
+
+ let close = output_to "perl/bindtests.pl" in
+ generate_perl_bindtests ();
+ close ();
+
+ let close = output_to "python/guestfs-py.c" in
+ generate_python_c ();
+ close ();
+
+ let close = output_to "python/guestfs.py" in
+ generate_python_py ();
+ close ();
+
+ let close = output_to "python/bindtests.py" in
+ generate_python_bindtests ();
+ close ();
+
+ let close = output_to "ruby/ext/guestfs/_guestfs.c" in
+ generate_ruby_c ();
+ close ();
+
+ let close = output_to "ruby/bindtests.rb" in
+ generate_ruby_bindtests ();
+ close ();
+
+ let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in
+ generate_java_java ();
+ close ();
+
+ List.iter (
+ fun (typ, jtyp) ->
+ let cols = cols_of_struct typ in
+ let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
+ let close = output_to filename in
+ generate_java_struct jtyp cols;
+ close ();
+ ) java_structs;
+
+ let close = output_to "java/Makefile.inc" in
+ pr "java_built_sources =";
+ List.iter (
+ fun (typ, jtyp) ->
+ pr " com/redhat/et/libguestfs/%s.java" jtyp;
+ ) java_structs;
+ pr " com/redhat/et/libguestfs/GuestFS.java\n";
+ close ();
+
+ let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in
+ generate_java_c ();
+ close ();
+
+ let close = output_to "java/Bindtests.java" in
+ generate_java_bindtests ();
+ close ();
+
+ let close = output_to "haskell/Guestfs.hs" in
+ generate_haskell_hs ();
+ close ();
+
+ let close = output_to "haskell/Bindtests.hs" in
+ generate_haskell_bindtests ();
+ close ();
+
+ let close = output_to "src/MAX_PROC_NR" in
+ generate_max_proc_nr ();
+ close ();
+
+ (* Always generate this file last, and unconditionally. It's used
+ * by the Makefile to know when we must re-run the generator.
+ *)
+ let chan = open_out "src/stamp-generator" in
+ fprintf chan "1\n";
+ close_out chan