| NotInDocs (* do not add this function to documentation *)
| DeprecatedBy of string (* function is deprecated, use .. instead *)
| Optional of string (* function is part of an optional group *)
+ | Progress (* function can generate progress messages *)
and fish_output_t =
| FishOutputOctal (* for int return, print in octal *)
changes to be committed, although qemu can support this.
This is equivalent to the qemu parameter
-C<-drive file=filename,snapshot=on,readonly=on,if=...>.
+C<-drive file=filename,snapshot=on,if=...>.
C<if=...> is set at compile time by the configuration option
C<./configure --with-drive-if=...>. In the rare case where you
might need to change this at run time, use C<guestfs_add_drive_with_if>
or C<guestfs_add_drive_ro_with_if>.
-C<readonly=on> is only added where qemu supports this option.
-
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
"enable or disable command traces",
"\
If the command trace flag is set to 1, then commands are
-printed on stdout before they are executed in a format
+printed on stderr before they are executed in a format
which is very similar to the one used by guestfish. In
other words, you can run a program with this enabled, and
you will get out a script which you can feed to guestfish
This is the same as C<guestfs_add_drive_ro> but it allows you
to specify the QEMU interface emulation to use at run time.");
+ ("file_architecture", (RString "arch", [Pathname "filename"]), -1, [],
+ [InitISOFS, Always, TestOutput (
+ [["file_architecture"; "/bin-i586-dynamic"]], "i386");
+ InitISOFS, Always, TestOutput (
+ [["file_architecture"; "/bin-sparc-dynamic"]], "sparc");
+ InitISOFS, Always, TestOutput (
+ [["file_architecture"; "/bin-win32.exe"]], "i386");
+ InitISOFS, Always, TestOutput (
+ [["file_architecture"; "/bin-win64.exe"]], "x86_64");
+ InitISOFS, Always, TestOutput (
+ [["file_architecture"; "/bin-x86_64-dynamic"]], "x86_64");
+ InitISOFS, Always, TestOutput (
+ [["file_architecture"; "/lib-i586.so"]], "i386");
+ InitISOFS, Always, TestOutput (
+ [["file_architecture"; "/lib-sparc.so"]], "sparc");
+ InitISOFS, Always, TestOutput (
+ [["file_architecture"; "/lib-win32.dll"]], "i386");
+ InitISOFS, Always, TestOutput (
+ [["file_architecture"; "/lib-win64.dll"]], "x86_64");
+ InitISOFS, Always, TestOutput (
+ [["file_architecture"; "/lib-x86_64.so"]], "x86_64");
+ InitISOFS, Always, TestOutput (
+ [["file_architecture"; "/initrd-x86_64.img"]], "x86_64");
+ InitISOFS, Always, TestOutput (
+ [["file_architecture"; "/initrd-x86_64.img.gz"]], "x86_64");],
+ "detect the architecture of a binary file",
+ "\
+This detects the architecture of the binary C<filename>,
+and returns it if known.
+
+Currently defined architectures are:
+
+=over 4
+
+=item \"i386\"
+
+This string is returned for all 32 bit i386, i486, i586, i686 binaries
+irrespective of the precise processor requirements of the binary.
+
+=item \"x86_64\"
+
+64 bit x86-64.
+
+=item \"sparc\"
+
+32 bit SPARC.
+
+=item \"sparc64\"
+
+64 bit SPARC V9 and above.
+
+=item \"ia64\"
+
+Intel Itanium.
+
+=item \"ppc\"
+
+32 bit Power PC.
+
+=item \"ppc64\"
+
+64 bit Power PC.
+
+=back
+
+Libguestfs may return other architecture strings in future.
+
+The function works on at least the following types of files:
+
+=over 4
+
+=item *
+
+many types of Un*x and Linux binary
+
+=item *
+
+many types of Un*x and Linux shared library
+
+=item *
+
+Windows Win32 and Win64 binaries
+
+=item *
+
+Windows Win32 and Win64 DLLs
+
+Win32 binaries and DLLs return C<i386>.
+
+Win64 binaries and DLLs return C<x86_64>.
+
+=item *
+
+Linux kernel modules
+
+=item *
+
+Linux new-style initrd images
+
+=item *
+
+some non-x86 Linux vmlinuz kernels
+
+=back
+
+What it can't do currently:
+
+=over 4
+
+=item *
+
+static libraries (libfoo.a)
+
+=item *
+
+Linux old-style initrd as compressed ext2 filesystem (RHEL 3)
+
+=item *
+
+x86 Linux vmlinuz kernels
+
+x86 vmlinuz images (bzImage format) consist of a mix of 16-, 32- and
+compressed code, and are horribly hard to unpack. If you want to find
+the architecture of a kernel, use the architecture of the associated
+initrd or kernel module(s) instead.
+
+=back");
+
+ ("inspect_os", (RStringList "roots", []), -1, [],
+ [],
+ "inspect disk and return list of operating systems found",
+ "\
+This function uses other libguestfs functions and certain
+heuristics to inspect the disk(s) (usually disks belonging to
+a virtual machine), looking for operating systems.
+
+The list returned is empty if no operating systems were found.
+
+If one operating system was found, then this returns a list with
+a single element, which is the name of the root filesystem of
+this operating system. It is also possible for this function
+to return a list containing more than one element, indicating
+a dual-boot or multi-boot virtual machine, with each element being
+the root filesystem of one of the operating systems.
+
+You can pass the root string(s) returned to other
+C<guestfs_inspect_get_*> functions in order to query further
+information about each operating system, such as the name
+and version.
+
+This function uses other libguestfs features such as
+C<guestfs_mount_ro> and C<guestfs_umount_all> in order to mount
+and unmount filesystems and look at the contents. This should
+be called with no disks currently mounted. The function may also
+use Augeas, so any existing Augeas handle will be closed.
+
+This function cannot decrypt encrypted disks. The caller
+must do that first (supplying the necessary keys) if the
+disk is encrypted.
+
+Please read L<guestfs(3)/INSPECTION> for more details.");
+
+ ("inspect_get_type", (RString "name", [Device "root"]), -1, [],
+ [],
+ "get type of inspected operating system",
+ "\
+This function should only be called with a root device string
+as returned by C<guestfs_inspect_os>.
+
+This returns the type of the inspected operating system.
+Currently defined types are:
+
+=over 4
+
+=item \"linux\"
+
+Any Linux-based operating system.
+
+=item \"windows\"
+
+Any Microsoft Windows operating system.
+
+=item \"unknown\"
+
+The operating system type could not be determined.
+
+=back
+
+Future versions of libguestfs may return other strings here.
+The caller should be prepared to handle any string.
+
+Please read L<guestfs(3)/INSPECTION> for more details.");
+
+ ("inspect_get_arch", (RString "arch", [Device "root"]), -1, [],
+ [],
+ "get architecture of inspected operating system",
+ "\
+This function should only be called with a root device string
+as returned by C<guestfs_inspect_os>.
+
+This returns the architecture of the inspected operating system.
+The possible return values are listed under
+C<guestfs_file_architecture>.
+
+If the architecture could not be determined, then the
+string C<unknown> is returned.
+
+Please read L<guestfs(3)/INSPECTION> for more details.");
+
+ ("inspect_get_distro", (RString "distro", [Device "root"]), -1, [],
+ [],
+ "get distro of inspected operating system",
+ "\
+This function should only be called with a root device string
+as returned by C<guestfs_inspect_os>.
+
+This returns the distro (distribution) of the inspected operating
+system.
+
+Currently defined distros are:
+
+=over 4
+
+=item \"debian\"
+
+Debian or a Debian-derived distro such as Ubuntu.
+
+=item \"fedora\"
+
+Fedora.
+
+=item \"redhat-based\"
+
+Some Red Hat-derived distro.
+
+=item \"rhel\"
+
+Red Hat Enterprise Linux and some derivatives.
+
+=item \"windows\"
+
+Windows does not have distributions. This string is
+returned if the OS type is Windows.
+
+=item \"unknown\"
+
+The distro could not be determined.
+
+=back
+
+Future versions of libguestfs may return other strings here.
+The caller should be prepared to handle any string.
+
+Please read L<guestfs(3)/INSPECTION> for more details.");
+
+ ("inspect_get_major_version", (RInt "major", [Device "root"]), -1, [],
+ [],
+ "get major version of inspected operating system",
+ "\
+This function should only be called with a root device string
+as returned by C<guestfs_inspect_os>.
+
+This returns the major version number of the inspected operating
+system.
+
+Windows uses a consistent versioning scheme which is I<not>
+reflected in the popular public names used by the operating system.
+Notably the operating system known as \"Windows 7\" is really
+version 6.1 (ie. major = 6, minor = 1). You can find out the
+real versions corresponding to releases of Windows by consulting
+Wikipedia or MSDN.
+
+If the version could not be determined, then C<0> is returned.
+
+Please read L<guestfs(3)/INSPECTION> for more details.");
+
+ ("inspect_get_minor_version", (RInt "minor", [Device "root"]), -1, [],
+ [],
+ "get minor version of inspected operating system",
+ "\
+This function should only be called with a root device string
+as returned by C<guestfs_inspect_os>.
+
+This returns the minor version number of the inspected operating
+system.
+
+If the version could not be determined, then C<0> is returned.
+
+Please read L<guestfs(3)/INSPECTION> for more details.
+See also C<guestfs_inspect_get_major_version>.");
+
+ ("inspect_get_product_name", (RString "product", [Device "root"]), -1, [],
+ [],
+ "get product name of inspected operating system",
+ "\
+This function should only be called with a root device string
+as returned by C<guestfs_inspect_os>.
+
+This returns the product name of the inspected operating
+system. The product name is generally some freeform string
+which can be displayed to the user, but should not be
+parsed by programs.
+
+If the product name could not be determined, then the
+string C<unknown> is returned.
+
+Please read L<guestfs(3)/INSPECTION> for more details.");
+
+ ("inspect_get_mountpoints", (RHashtable "mountpoints", [Device "root"]), -1, [],
+ [],
+ "get mountpoints of inspected operating system",
+ "\
+This function should only be called with a root device string
+as returned by C<guestfs_inspect_os>.
+
+This returns a hash of where we think the filesystems
+associated with this operating system should be mounted.
+Callers should note that this is at best an educated guess
+made by reading configuration files such as C</etc/fstab>.
+
+Each element in the returned hashtable has a key which
+is the path of the mountpoint (eg. C</boot>) and a value
+which is the filesystem that would be mounted there
+(eg. C</dev/sda1>).
+
+Non-mounted devices such as swap devices are I<not>
+returned in this list.
+
+Please read L<guestfs(3)/INSPECTION> for more details.
+See also C<guestfs_inspect_get_filesystems>.");
+
+ ("inspect_get_filesystems", (RStringList "filesystems", [Device "root"]), -1, [],
+ [],
+ "get filesystems associated with inspected operating system",
+ "\
+This function should only be called with a root device string
+as returned by C<guestfs_inspect_os>.
+
+This returns a list of all the filesystems that we think
+are associated with this operating system. This includes
+the root filesystem, other ordinary filesystems, and
+non-mounted devices like swap partitions.
+
+In the case of a multi-boot virtual machine, it is possible
+for a filesystem to be shared between operating systems.
+
+Please read L<guestfs(3)/INSPECTION> for more details.
+See also C<guestfs_inspect_get_mountpoints>.");
+
+ ("set_network", (RErr, [Bool "network"]), -1, [FishAlias "network"],
+ [],
+ "set enable network flag",
+ "\
+If C<network> is true, then the network is enabled in the
+libguestfs appliance. The default is false.
+
+This affects whether commands are able to access the network
+(see L<guestfs(3)/RUNNING COMMANDS>).
+
+You must call this before calling C<guestfs_launch>, otherwise
+it has no effect.");
+
+ ("get_network", (RBool "network", []), -1, [],
+ [],
+ "get enable network flag",
+ "\
+This returns the enable network flag.");
+
]
(* daemon_functions are any functions which cause some action
See also C<guestfs_download>.");
- ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [],
+ ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [Progress],
[InitBasicFS, Always, TestOutput (
(* Pick a file from cwd which isn't likely to change. *)
[["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
This command is entirely equivalent to running C<fsck -a -t fstype device>.");
- ("zero", (RErr, [Device "device"]), 85, [],
+ ("zero", (RErr, [Device "device"]), 85, [Progress],
[InitBasicFS, Always, TestOutput (
[["umount"; "/dev/sda1"];
["zero"; "/dev/sda1"];
values are possible, although unusual. See C<guestfs_part_init>
for a full list.");
- ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
+ ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [Progress],
[InitBasicFS, Always, TestOutputBuffer (
[["fill"; "0x63"; "10"; "/test"];
["read_file"; "/test"]], "cccccccccc")],
See also C<guestfs_vgpvuuids>.");
- ("copy_size", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"; Int64 "size"]), 227, [],
+ ("copy_size", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"; Int64 "size"]), 227, [Progress],
[InitBasicFS, Always, TestOutputBuffer (
[["write"; "/src"; "hello, world"];
["copy_size"; "/src"; "/dest"; "5"];
Note this will fail if the source is too short or if the destination
is not large enough.");
- ("zero_device", (RErr, [Device "device"]), 228, [DangerWillRobinson],
+ ("zero_device", (RErr, [Device "device"]), 228, [DangerWillRobinson; Progress],
[InitBasicFSonLVM, Always, TestRun (
[["zero_device"; "/dev/VG/LV"]])],
"write zeroes to an entire device",
backslash syntax. For more information, see the GNU
coreutils info file.");
- ("fill_pattern", (RErr, [String "pattern"; Int "len"; Pathname "path"]), 245, [],
+ ("fill_pattern", (RErr, [String "pattern"; Int "len"; Pathname "path"]), 245, [Progress],
[InitBasicFS, Always, TestOutputBuffer (
[["fill_pattern"; "abcdefghijklmnopqrstuvwxyz"; "28"; "/test"];
["read_file"; "/test"]], "abcdefghijklmnopqrstuvwxyzab")],
This returns the filesystem label of the filesystem on
C<device>.
-If the filesystem is unlabeled, this returns the empty string.");
+If the filesystem is unlabeled, this returns the empty string.
+
+To find a filesystem from the label, use C<guestfs_findfs_label>.");
("vfs_uuid", (RString "uuid", [Device "device"]), 254, [],
(let uuid = uuidgen () in
This returns the filesystem UUID of the filesystem on
C<device>.
-If the filesystem does not have a UUID, this returns the empty string.");
+If the filesystem does not have a UUID, this returns the empty string.
+
+To find a filesystem from the UUID, use C<guestfs_findfs_uuid>.");
("lvm_set_filter", (RErr, [DeviceList "devices"]), 255, [Optional "lvm2"],
(* Can't be tested with the current framework because
This command also clears the LVM cache and performs a volume
group scan.");
+ ("luks_open", (RErr, [Device "device"; Key "key"; String "mapname"]), 257, [Optional "luks"],
+ [],
+ "open a LUKS-encrypted block device",
+ "\
+This command opens a block device which has been encrypted
+according to the Linux Unified Key Setup (LUKS) standard.
+
+C<device> is the encrypted block device or partition.
+
+The caller must supply one of the keys associated with the
+LUKS block device, in the C<key> parameter.
+
+This creates a new block device called C</dev/mapper/mapname>.
+Reads and writes to this block device are decrypted from and
+encrypted to the underlying C<device> respectively.
+
+If this block device contains LVM volume groups, then
+calling C<guestfs_vgscan> followed by C<guestfs_vg_activate_all>
+will make them visible.");
+
+ ("luks_open_ro", (RErr, [Device "device"; Key "key"; String "mapname"]), 258, [Optional "luks"],
+ [],
+ "open a LUKS-encrypted block device read-only",
+ "\
+This is the same as C<guestfs_luks_open> except that a read-only
+mapping is created.");
+
+ ("luks_close", (RErr, [Device "device"]), 259, [Optional "luks"],
+ [],
+ "close a LUKS device",
+ "\
+This closes a LUKS device that was created earlier by
+C<guestfs_luks_open> or C<guestfs_luks_open_ro>. The
+C<device> parameter must be the name of the LUKS mapping
+device (ie. C</dev/mapper/mapname>) and I<not> the name
+of the underlying block device.");
+
+ ("luks_format", (RErr, [Device "device"; Key "key"; Int "keyslot"]), 260, [Optional "luks"; DangerWillRobinson],
+ [],
+ "format a block device as a LUKS encrypted device",
+ "\
+This command erases existing data on C<device> and formats
+the device as a LUKS encrypted device. C<key> is the
+initial key, which is added to key slot C<slot>. (LUKS
+supports 8 key slots, numbered 0-7).");
+
+ ("luks_format_cipher", (RErr, [Device "device"; Key "key"; Int "keyslot"; String "cipher"]), 261, [Optional "luks"; DangerWillRobinson],
+ [],
+ "format a block device as a LUKS encrypted device",
+ "\
+This command is the same as C<guestfs_luks_format> but
+it also allows you to set the C<cipher> used.");
+
+ ("luks_add_key", (RErr, [Device "device"; Key "key"; Key "newkey"; Int "keyslot"]), 262, [Optional "luks"],
+ [],
+ "add a key on a LUKS encrypted device",
+ "\
+This command adds a new key on LUKS device C<device>.
+C<key> is any existing key, and is used to access the device.
+C<newkey> is the new key to add. C<keyslot> is the key slot
+that will be replaced.
+
+Note that if C<keyslot> already contains a key, then this
+command will fail. You have to use C<guestfs_luks_kill_slot>
+first to remove that key.");
+
+ ("luks_kill_slot", (RErr, [Device "device"; Key "key"; Int "keyslot"]), 263, [Optional "luks"],
+ [],
+ "remove a key from a LUKS encrypted device",
+ "\
+This command deletes the key in key slot C<keyslot> from the
+encrypted LUKS device C<device>. C<key> must be one of the
+I<other> keys.");
+
+ ("is_lv", (RBool "lvflag", [Device "device"]), 264, [Optional "lvm2"],
+ [InitBasicFSonLVM, IfAvailable "lvm2", TestOutputTrue (
+ [["is_lv"; "/dev/VG/LV"]]);
+ InitBasicFSonLVM, IfAvailable "lvm2", TestOutputFalse (
+ [["is_lv"; "/dev/sda1"]])],
+ "test if device is a logical volume",
+ "\
+This command tests whether C<device> is a logical volume, and
+returns true iff this is the case.");
+
+ ("findfs_uuid", (RString "device", [String "uuid"]), 265, [],
+ [],
+ "find a filesystem by UUID",
+ "\
+This command searches the filesystems and returns the one
+which has the given UUID. An error is returned if no such
+filesystem can be found.
+
+To find the UUID of a filesystem, use C<guestfs_vfs_uuid>.");
+
+ ("findfs_label", (RString "device", [String "label"]), 266, [],
+ [],
+ "find a filesystem by label",
+ "\
+This command searches the filesystems and returns the one
+which has the given label. An error is returned if no such
+filesystem can be found.
+
+To find the label of a filesystem, use C<guestfs_vfs_label>.");
+
]
let all_functions = non_daemon_functions @ daemon_functions
| CallBool of bool
| CallBuffer of string
+(* Used for the guestfish -N (prepared disk images) option.
+ * Note that the longdescs are indented by 2 spaces.
+ *)
+let prepopts = [
+ ("disk",
+ "create a blank disk",
+ [ "size", "100M", "the size of the disk image" ],
+ " Create a blank disk, size 100MB (by default).
+
+ The default size can be changed by supplying an optional parameter.");
+
+ ("part",
+ "create a partitioned disk",
+ [ "size", "100M", "the size of the disk image";
+ "partition", "mbr", "partition table type" ],
+ " Create a disk with a single partition. By default the size of the disk
+ is 100MB (the available space in the partition will be a tiny bit smaller)
+ and the partition table will be MBR (old DOS-style).
+
+ These defaults can be changed by supplying optional parameters.");
+
+ ("fs",
+ "create a filesystem",
+ [ "filesystem", "ext2", "the type of filesystem to use";
+ "size", "100M", "the size of the disk image";
+ "partition", "mbr", "partition table type" ],
+ " Create a disk with a single partition, with the partition containing
+ an empty filesystem. This defaults to creating a 100MB disk (the available
+ space in the filesystem will be a tiny bit smaller) with an MBR (old
+ DOS-style) partition table and an ext2 filesystem.
+
+ These defaults can be changed by supplying optional parameters.");
+
+ ("lv",
+ "create a disk with logical volume",
+ [ "name", "/dev/VG/LV", "the name of the VG and LV to use";
+ "size", "100M", "the size of the disk image";
+ "partition", "mbr", "partition table type" ],
+ " Create a disk with a single partition, set up the partition as an
+ LVM2 physical volume, and place a volume group and logical volume
+ on there. This defaults to creating a 100MB disk with the VG and
+ LV called /dev/VG/LV. You can change the name of the VG and LV
+ by supplying an alternate name as the first optional parameter.");
+
+]
+
(* Used to memoize the result of pod2text. *)
let pod2text_memo_filename = "src/.pod2text.data"
let pod2text_memo : ((int * string * string), string list) Hashtbl.t =
| TestLastFail s -> s
(* Handling for function flags. *)
+let progress_message =
+ "This long-running command can generate progress notification messages
+so that the caller can display a progress bar or indicator.
+To receive these messages, the caller must register a progress
+callback. See L<guestfs(3)/guestfs_set_progress_callback>."
+
let protocol_limit_warning =
"Because of the message protocol, there is a transfer limit
of somewhere between 2MB and 4MB. See L<guestfs(3)/PROTOCOL LIMITS>."
The string is owned by the guest handle and must I<not> be freed.\n\n"
| RConstOptString _ ->
pr "This function returns a string which may be NULL.
-There is way to return an error from this function.
+There is no way to return an error from this function.
The string is owned by the guest handle and must I<not> be freed.\n\n"
| RString _ ->
pr "This function returns a string, or NULL on error.
The size of the returned buffer is written to C<*size_r>.
I<The caller must free the returned buffer after use>.\n\n"
);
+ if List.mem Progress flags then
+ pr "%s\n\n" progress_message;
if List.mem ProtocolLimitWarning flags then
pr "%s\n\n" protocol_limit_warning;
if List.mem DangerWillRobinson flags then
generate_header CStyle LGPLv2plus;
(* This has to be defined to get around a limitation in Sun's rpcgen. *)
- pr "typedef string str<>;\n";
+ pr "typedef string guestfs_str<>;\n";
pr "\n";
(* Internal structures. *)
function
| Pathname n | Device n | Dev_or_Path n | String n | Key n ->
pr " string %s<>;\n" n
- | OptString n -> pr " str *%s;\n" n
- | StringList n | DeviceList n -> pr " str %s<>;\n" n
+ | OptString n -> pr " guestfs_str *%s;\n" n
+ | StringList n | DeviceList n -> pr " guestfs_str %s<>;\n" n
| Bool n -> pr " bool %s;\n" n
| Int n -> pr " int %s;\n" n
| Int64 n -> pr " hyper %s;\n" n
pr "};\n\n"
| RStringList n ->
pr "struct %s_ret {\n" name;
- pr " str %s<>;\n" n;
+ pr " guestfs_str %s<>;\n" n;
pr "};\n\n"
| RStruct (n, typ) ->
pr "struct %s_ret {\n" name;
pr "};\n\n"
| RHashtable n ->
pr "struct %s_ret {\n" name;
- pr " str %s<>;\n" n;
+ pr " guestfs_str %s<>;\n" n;
pr "};\n\n"
| RBufferOut n ->
pr "struct %s_ret {\n" name;
*/
const GUESTFS_PROGRAM = 0x2000F5F5;
-const GUESTFS_PROTOCOL_VERSION = 1;
+const GUESTFS_PROTOCOL_VERSION = 2;
/* These constants must be larger than any possible message length. */
const GUESTFS_LAUNCH_FLAG = 0xf5f55ff5;
const GUESTFS_CANCEL_FLAG = 0xffffeeee;
+const GUESTFS_PROGRESS_FLAG = 0xffff5555;
enum guestfs_message_direction {
GUESTFS_DIRECTION_CALL = 0, /* client -> daemon */
GUESTFS_STATUS_ERROR = 1
};
-const GUESTFS_ERROR_LEN = 256;
+";
+
+ pr "const GUESTFS_ERROR_LEN = %d;\n" (64 * 1024);
+ pr "\n";
+ pr "\
struct guestfs_message_error {
+ int linux_errno; /* Linux errno if available. */
string error_message<GUESTFS_ERROR_LEN>;
};
/* data size is 0 bytes if the transfer has finished successfully */
opaque data<GUESTFS_MAX_CHUNK_SIZE>;
};
+
+/* Progress notifications. Daemon self-limits these messages to
+ * at most one per second. The daemon can send these messages
+ * at any time, and the caller should discard unexpected messages.
+ * 'position' and 'total' have undefined units; however they may
+ * have meaning for some calls.
+ *
+ * NB. guestfs___recv_from_daemon assumes the XDR-encoded
+ * structure is 24 bytes long.
+ */
+struct guestfs_progress {
+ guestfs_procedure proc; /* @0: GUESTFS_PROC_x */
+ unsigned serial; /* @4: message serial number */
+ unsigned hyper position; /* @8: 0 <= position <= total */
+ unsigned hyper total; /* @16: total size of operation */
+ /* @24: size of structure */
+};
"
(* Generate the guestfs-structs.h file. *)
and generate_actions_h () =
generate_header CStyle LGPLv2plus;
List.iter (
- fun (shortname, style, _, _, _, _, _) ->
+ fun (shortname, style, _, flags, _, _, _) ->
let name = "guestfs_" ^ shortname in
+
+ let deprecated =
+ List.exists (function DeprecatedBy _ -> true | _ -> false) flags in
+ let test0 =
+ String.length shortname >= 5 && String.sub shortname 0 5 = "test0" in
+ let debug =
+ String.length shortname >= 5 && String.sub shortname 0 5 = "debug" in
+ if not deprecated && not test0 && not debug then
+ pr "#define LIBGUESTFS_HAVE_%s 1\n" (String.uppercase shortname);
+
generate_prototype ~single_line:true ~newline:true ~handle:"g"
name style
- ) all_functions
+ ) all_functions_sorted
(* Generate the guestfs-internal-actions.h file. *)
and generate_internal_actions_h () =
#include \"guestfs-internal-actions.h\"
#include \"guestfs_protocol.h\"
-#define error guestfs_error
-//#define perrorf guestfs_perrorf
-#define safe_malloc guestfs_safe_malloc
-#define safe_realloc guestfs_safe_realloc
-//#define safe_strdup guestfs_safe_strdup
-#define safe_memdup guestfs_safe_memdup
-
/* Check the return message from a call for validity. */
static int
check_reply_header (guestfs_h *g,
pr "\n"
);
- pr " printf (\"%s\");\n" shortname;
+ pr " fprintf (stderr, \"%s\");\n" shortname;
List.iter (
function
| String n (* strings *)
| BufferIn n
| Key n ->
(* guestfish doesn't support string escaping, so neither do we *)
- pr " printf (\" \\\"%%s\\\"\", %s);\n" n
+ pr " fprintf (stderr, \" \\\"%%s\\\"\", %s);\n" n
| OptString n -> (* string option *)
- pr " if (%s) printf (\" \\\"%%s\\\"\", %s);\n" n n;
- pr " else printf (\" null\");\n"
+ pr " if (%s) fprintf (stderr, \" \\\"%%s\\\"\", %s);\n" n n;
+ pr " else fprintf (stderr, \" null\");\n"
| StringList n
| DeviceList n -> (* string list *)
- pr " putchar (' ');\n";
- pr " putchar ('\"');\n";
+ pr " fputc (' ', stderr);\n";
+ pr " fputc ('\"', stderr);\n";
pr " for (i = 0; %s[i]; ++i) {\n" n;
- pr " if (i > 0) putchar (' ');\n";
- pr " fputs (%s[i], stdout);\n" n;
+ pr " if (i > 0) fputc (' ', stderr);\n";
+ pr " fputs (%s[i], stderr);\n" n;
pr " }\n";
- pr " putchar ('\"');\n";
+ pr " fputc ('\"', stderr);\n";
| Bool n -> (* boolean *)
- pr " fputs (%s ? \" true\" : \" false\", stdout);\n" n
+ pr " fputs (%s ? \" true\" : \" false\", stderr);\n" n
| Int n -> (* int *)
- pr " printf (\" %%d\", %s);\n" n
+ pr " fprintf (stderr, \" %%d\", %s);\n" n
| Int64 n ->
- pr " printf (\" %%\" PRIi64, %s);\n" n
+ pr " fprintf (stderr, \" %%\" PRIi64, %s);\n" n
) (snd style);
- pr " putchar ('\\n');\n";
+ pr " fputc ('\\n', stderr);\n";
pr " }\n";
pr "\n";
in
"guestfs_close";
"guestfs_get_error_handler";
"guestfs_get_out_of_memory_handler";
+ "guestfs_get_private";
"guestfs_last_error";
"guestfs_set_close_callback";
"guestfs_set_error_handler";
"guestfs_set_launch_done_callback";
"guestfs_set_log_message_callback";
"guestfs_set_out_of_memory_handler";
+ "guestfs_set_private";
+ "guestfs_set_progress_callback";
"guestfs_set_subprocess_quit_callback";
(* Unofficial parts of the API: the bindings code use these
name2 (String.concat " " (List.map name_of_argt args)) in
let warnings =
- if List.mem ProtocolLimitWarning flags then
- ("\n\n" ^ protocol_limit_warning)
+ if List.exists (function Key _ -> true | _ -> false) (snd style) then
+ "\n\nThis command has one or more key or passphrase parameters.
+Guestfish will prompt for these separately."
else "" in
+ let warnings =
+ 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
| Some txt -> pr "%s\n\n" txt
) 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 _ | RConstOptString _ -> pr "const char *"
- | RString _ | RBufferOut _ -> pr "char *"
- | RStringList _ | RHashtable _ -> pr "char **"
- | RStruct (_, typ) ->
- if not in_daemon then pr "struct guestfs_%s *" typ
- else pr "guestfs_int_%s *" typ
+and generate_fish_prep_options_h () =
+ generate_header CStyle GPLv2plus;
+
+ pr "#ifndef PREPOPTS_H\n";
+ pr "\n";
+
+ pr "\
+struct prep {
+ const char *name; /* eg. \"fs\" */
+
+ size_t nr_params; /* optional parameters */
+ struct prep_param *params;
+
+ const char *shortdesc; /* short description */
+ const char *longdesc; /* long description */
+
+ /* functions to implement it */
+ void (*prelaunch) (const char *filename, prep_data *);
+ void (*postlaunch) (const char *filename, prep_data *, const char *device);
+};
+
+struct prep_param {
+ const char *pname; /* parameter name */
+ const char *pdefault; /* parameter default */
+ const char *pdesc; /* parameter description */
+};
+
+extern const struct prep preps[];
+#define NR_PREPS %d
+
+" (List.length prepopts);
+
+ List.iter (
+ fun (name, shortdesc, args, longdesc) ->
+ pr "\
+extern void prep_prelaunch_%s (const char *filename, prep_data *data);
+extern void prep_postlaunch_%s (const char *filename, prep_data *data, const char *device);
+
+" name name;
+ ) prepopts;
+
+ pr "\n";
+ pr "#endif /* PREPOPTS_H */\n"
+
+and generate_fish_prep_options_c () =
+ generate_header CStyle GPLv2plus;
+
+ pr "\
+#include \"fish.h\"
+#include \"prepopts.h\"
+
+";
+
+ List.iter (
+ fun (name, shortdesc, args, longdesc) ->
+ pr "static struct prep_param %s_args[] = {\n" name;
+ List.iter (
+ fun (n, default, desc) ->
+ pr " { \"%s\", \"%s\", \"%s\" },\n" n default desc
+ ) args;
+ pr "};\n";
+ pr "\n";
+ ) prepopts;
+
+ pr "const struct prep preps[] = {\n";
+ List.iter (
+ fun (name, shortdesc, args, longdesc) ->
+ pr " { \"%s\", %d, %s_args,
+ \"%s\",
+ \"%s\",
+ prep_prelaunch_%s, prep_postlaunch_%s },
+"
+ name (List.length args) name
+ (c_quote shortdesc) (c_quote longdesc)
+ name name;
+ ) prepopts;
+ pr "};\n"
+
+(* 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 _ | RConstOptString _ -> pr "const char *"
+ | RString _ | RBufferOut _ -> 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
unreferenced, but callers can call this in order to provide
predictable cleanup. *)
+type progress_cb = int -> int -> int64 -> int64 -> unit
+
+val set_progress_callback : t -> progress_cb -> unit
+(** [set_progress_callback g f] sets [f] as the progress callback function.
+ For some long-running functions, [f] will be called repeatedly
+ during the function with progress updates.
+
+ The callback is [f proc_nr serial position total]. See
+ the description of [guestfs_set_progress_callback] in guestfs(3)
+ for the meaning of these four numbers.
+
+ Note that if the closure captures a reference to the handle,
+ this reference will prevent the handle from being
+ automatically closed by the garbage collector. There are
+ three ways to avoid this: be careful not to capture the handle
+ in the closure, or use a weak reference, or call
+ {!Guestfs.clear_progress_callback} to remove the reference. *)
+
+val clear_progress_callback : t -> unit
+(** [clear_progress_callback g] removes any progress callback function
+ associated with the handle. See {!Guestfs.set_progress_callback}. *)
+
";
generate_ocaml_structure_decls ();
external create : unit -> t = \"ocaml_guestfs_create\"
external close : t -> unit = \"ocaml_guestfs_close\"
+type progress_cb = int -> int -> int64 -> int64 -> unit
+
+external set_progress_callback : t -> progress_cb -> unit
+ = \"ocaml_guestfs_set_progress_callback\"
+external clear_progress_callback : t -> unit
+ = \"ocaml_guestfs_clear_progress_callback\"
+
(* Give the exceptions names, so they can be raised from the C code. *)
let () =
Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
return ret;
}
+#define PROGRESS_KEY \"_perl_progress_cb\"
+
+static void
+_clear_progress_callback (guestfs_h *g)
+{
+ guestfs_set_progress_callback (g, NULL, NULL);
+ SV *cb = guestfs_get_private (g, PROGRESS_KEY);
+ if (cb) {
+ guestfs_set_private (g, PROGRESS_KEY, NULL);
+ SvREFCNT_dec (cb);
+ }
+}
+
+/* http://www.perlmonks.org/?node=338857 */
+static void
+_progress_callback (guestfs_h *g, void *cb,
+ int proc_nr, int serial, uint64_t position, uint64_t total)
+{
+ dSP;
+ ENTER;
+ SAVETMPS;
+ PUSHMARK (SP);
+ XPUSHs (sv_2mortal (newSViv (proc_nr)));
+ XPUSHs (sv_2mortal (newSViv (serial)));
+ XPUSHs (sv_2mortal (my_newSVull (position)));
+ XPUSHs (sv_2mortal (my_newSVull (total)));
+ PUTBACK;
+ call_sv ((SV *) cb, G_VOID | G_DISCARD | G_EVAL);
+ FREETMPS;
+ LEAVE;
+}
+
+static void
+_close_handle (guestfs_h *g)
+{
+ assert (g != NULL);
+ _clear_progress_callback (g);
+ guestfs_close (g);
+}
+
MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
PROTOTYPES: ENABLE
SV **svp = hv_fetch (hv, \"_g\", 2, 0);
if (svp != NULL) {
guestfs_h *g = (guestfs_h *) SvIV (*svp);
- assert (g != NULL);
- guestfs_close (g);
+ _close_handle (g);
}
void
close (g)
guestfs_h *g;
PPCODE:
- guestfs_close (g);
+ _close_handle (g);
/* Avoid double-free in DESTROY method. */
HV *hv = (HV *) SvRV (ST(0));
(void) hv_delete (hv, \"_g\", 2, G_DISCARD);
+void
+set_progress_callback (g, cb)
+ guestfs_h *g;
+ SV *cb;
+ PPCODE:
+ _clear_progress_callback (g);
+ SvREFCNT_inc (cb);
+ guestfs_set_private (g, PROGRESS_KEY, cb);
+ guestfs_set_progress_callback (g, _progress_callback, cb);
+
+void
+clear_progress_callback (g)
+ guestfs_h *g;
+ PPCODE:
+ _clear_progress_callback (g);
+
";
List.iter (
on the handle (but the implicit call to C<DESTROY> that happens
when the final reference is cleaned up is OK).
+=item $h->set_progress_callback (\\&cb);
+
+Set the progress notification callback for this handle
+to the Perl closure C<cb>.
+
+C<cb> will be called whenever a long-running operation
+generates a progress notification message. The 4 parameters
+to the function are: C<proc_nr>, C<serial>, C<position>
+and C<total>.
+
+You should carefully read the documentation for
+L<guestfs(3)/guestfs_set_progress_callback> before using
+this function.
+
+=item $h->clear_progress_callback ();
+
+This removes any progress callback function associated with
+the handle.
+
=cut
" max_proc_nr;
=back
+=head1 AVAILABILITY
+
+From time to time we add new libguestfs APIs. Also some libguestfs
+APIs won't be available in all builds of libguestfs (the Fedora
+build is full-featured, but other builds may disable features).
+How do you test whether the APIs that your Perl program needs are
+available in the version of C<Sys::Guestfs> that you are using?
+
+To test if a particular function is available in the C<Sys::Guestfs>
+class, use the ordinary Perl UNIVERSAL method C<can(METHOD)>
+(see L<perlobj(1)>). For example:
+
+ use Sys::Guestfs;
+ if (defined (Sys::Guestfs->can (\"set_verbose\"))) {
+ print \"\\$h->set_verbose is available\\n\";
+ }
+
+To test if particular features are supported by the current
+build, use the L</available> method like the example below. Note
+that the appliance must be launched first.
+
+ $h->available ( [\"augeas\"] );
+
+Since the L</available> method croaks if the feature is not supported,
+you might also want to wrap this in an eval and return a boolean.
+In fact this has already been done for you: use
+L<Sys::Guestfs::Lib(3)/feature_available>.
+
+For further discussion on this topic, refer to
+L<guestfs(3)/AVAILABILITY>.
+
+=head1 STORING DATA IN THE HANDLE
+
+The handle returned from L</new> is a hash reference. The hash
+normally contains a single element:
+
+ {
+ _g => [private data used by libguestfs]
+ }
+
+Callers can add other elements to this hash to store data for their own
+purposes. The data lasts for the lifetime of the handle.
+
+Any fields whose names begin with an underscore are reserved
+for private use by libguestfs. We may add more in future.
+
+It is recommended that callers prefix the name of their field(s)
+with some unique string, to avoid conflicts with other users.
+
=head1 COPYRIGHT
Copyright (C) %s Red Hat Inc.
#include \"guestfs.h\"
+#ifndef HAVE_PYCAPSULE_NEW
typedef struct {
PyObject_HEAD
guestfs_h *g;
} Pyguestfs_Object;
+#endif
static guestfs_h *
get_handle (PyObject *obj)
{
assert (obj);
assert (obj != Py_None);
+#ifndef HAVE_PYCAPSULE_NEW
return ((Pyguestfs_Object *) obj)->g;
+#else
+ return (guestfs_h*) PyCapsule_GetPointer(obj, \"guestfs_h\");
+#endif
}
static PyObject *
put_handle (guestfs_h *g)
{
assert (g);
+#ifndef HAVE_PYCAPSULE_NEW
return
PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
+#else
+ return PyCapsule_New ((void *) g, \"guestfs_h\", NULL);
+#endif
}
/* This list should be freed (but not the strings) after use. */
return NULL;
}
guestfs_set_error_handler (g, NULL, NULL);
+ /* This can return NULL, but in that case put_handle will have
+ * set the Python error string.
+ */
return put_handle (g);
}
c_guestfs = rb_define_class_under (m_guestfs, \"Guestfs\", rb_cObject);
e_Error = rb_define_class_under (m_guestfs, \"Error\", rb_eStandardError);
+#ifdef HAVE_RB_DEFINE_ALLOC_FUNC
+ rb_define_alloc_func (c_guestfs, ruby_guestfs_create);
+#endif
+
rb_define_module_function (m_guestfs, \"create\", ruby_guestfs_create, 0);
rb_define_method (c_guestfs, \"close\", ruby_guestfs_close, 0);
}
"
+and generate_php_h () =
+ generate_header CStyle LGPLv2plus;
+
+ pr "\
+#ifndef PHP_GUESTFS_PHP_H
+#define PHP_GUESTFS_PHP_H 1
+
+#ifdef ZTS
+#include \"TSRM.h\"
+#endif
+
+#define PHP_GUESTFS_PHP_EXTNAME \"guestfs_php\"
+#define PHP_GUESTFS_PHP_VERSION \"1.0\"
+
+PHP_MINIT_FUNCTION (guestfs_php);
+
+#define PHP_GUESTFS_HANDLE_RES_NAME \"guestfs_h\"
+
+PHP_FUNCTION (guestfs_create);
+PHP_FUNCTION (guestfs_last_error);
+";
+
+ List.iter (
+ fun (shortname, style, _, _, _, _, _) ->
+ pr "PHP_FUNCTION (guestfs_%s);\n" shortname
+ ) all_functions_sorted;
+
+ pr "\
+
+extern zend_module_entry guestfs_php_module_entry;
+#define phpext_guestfs_php_ptr &guestfs_php_module_entry
+
+#endif /* PHP_GUESTFS_PHP_H */
+"
+
+and generate_php_c () =
+ generate_header CStyle LGPLv2plus;
+
+ pr "\
+/* NOTE: Be very careful with all macros in PHP header files. The
+ * morons who wrote them aren't good at making them safe for inclusion
+ * in arbitrary places in C code, eg. not using 'do ... while(0)'
+ * or parenthesizing any of the arguments.
+ */
+
+/* NOTE (2): Some parts of the API can't be used on 32 bit platforms.
+ * Any 64 bit numbers will be truncated. There's no easy way around
+ * this in PHP.
+ */
+
+#include <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+
+#include <php.h>
+#include <php_guestfs_php.h>
+
+#include \"guestfs.h\"
+
+static int res_guestfs_h;
+
+static void
+guestfs_php_handle_dtor (zend_rsrc_list_entry *rsrc TSRMLS_DC)
+{
+ guestfs_h *g = (guestfs_h *) rsrc->ptr;
+ if (g != NULL)
+ guestfs_close (g);
+}
+
+PHP_MINIT_FUNCTION (guestfs_php)
+{
+ res_guestfs_h =
+ zend_register_list_destructors_ex (guestfs_php_handle_dtor,
+ NULL, PHP_GUESTFS_HANDLE_RES_NAME, module_number);
+}
+
+static function_entry guestfs_php_functions[] = {
+ PHP_FE (guestfs_create, NULL)
+ PHP_FE (guestfs_last_error, NULL)
+";
+
+ List.iter (
+ fun (shortname, style, _, _, _, _, _) ->
+ pr " PHP_FE (guestfs_%s, NULL)\n" shortname
+ ) all_functions_sorted;
+
+ pr " { NULL, NULL, NULL }
+};
+
+zend_module_entry guestfs_php_module_entry = {
+#if ZEND_MODULE_API_NO >= 20010901
+ STANDARD_MODULE_HEADER,
+#endif
+ PHP_GUESTFS_PHP_EXTNAME,
+ guestfs_php_functions,
+ PHP_MINIT (guestfs_php),
+ NULL,
+ NULL,
+ NULL,
+ NULL,
+#if ZEND_MODULE_API_NO >= 20010901
+ PHP_GUESTFS_PHP_VERSION,
+#endif
+ STANDARD_MODULE_PROPERTIES
+};
+
+#ifdef COMPILE_DL_GUESTFS_PHP
+ZEND_GET_MODULE (guestfs_php)
+#endif
+
+PHP_FUNCTION (guestfs_create)
+{
+ guestfs_h *g = guestfs_create ();
+ if (g == NULL) {
+ RETURN_FALSE;
+ }
+
+ guestfs_set_error_handler (g, NULL, NULL);
+
+ ZEND_REGISTER_RESOURCE (return_value, g, res_guestfs_h);
+}
+
+PHP_FUNCTION (guestfs_last_error)
+{
+ zval *z_g;
+ guestfs_h *g;
+
+ if (zend_parse_parameters (ZEND_NUM_ARGS() TSRMLS_CC, \"r\",
+ &z_g) == FAILURE) {
+ RETURN_FALSE;
+ }
+
+ ZEND_FETCH_RESOURCE (g, guestfs_h *, &z_g, -1, PHP_GUESTFS_HANDLE_RES_NAME,
+ res_guestfs_h);
+ if (g == NULL) {
+ RETURN_FALSE;
+ }
+
+ const char *err = guestfs_last_error (g);
+ if (err) {
+ RETURN_STRING (err, 1);
+ } else {
+ RETURN_NULL ();
+ }
+}
+
+";
+
+ (* Now generate the PHP bindings for each action. *)
+ List.iter (
+ fun (shortname, style, _, _, _, _, _) ->
+ pr "PHP_FUNCTION (guestfs_%s)\n" shortname;
+ pr "{\n";
+ pr " zval *z_g;\n";
+ pr " guestfs_h *g;\n";
+
+ List.iter (
+ function
+ | String n | Device n | Pathname n | Dev_or_Path n
+ | FileIn n | FileOut n | Key n
+ | OptString n
+ | BufferIn n ->
+ pr " char *%s;\n" n;
+ pr " int %s_size;\n" n
+ | StringList n
+ | DeviceList n ->
+ pr " zval *z_%s;\n" n;
+ pr " char **%s;\n" n;
+ | Bool n ->
+ pr " zend_bool %s;\n" n
+ | Int n | Int64 n ->
+ pr " long %s;\n" n
+ ) (snd style);
+
+ pr "\n";
+
+ (* Parse the parameters. *)
+ let param_string = String.concat "" (
+ List.map (
+ function
+ | String n | Device n | Pathname n | Dev_or_Path n
+ | FileIn n | FileOut n | BufferIn n | Key n -> "s"
+ | OptString n -> "s!"
+ | StringList n | DeviceList n -> "a"
+ | Bool n -> "b"
+ | Int n | Int64 n -> "l"
+ ) (snd style)
+ ) in
+
+ pr " if (zend_parse_parameters (ZEND_NUM_ARGS() TSRMLS_CC, \"r%s\",\n"
+ param_string;
+ pr " &z_g";
+ List.iter (
+ function
+ | String n | Device n | Pathname n | Dev_or_Path n
+ | FileIn n | FileOut n | BufferIn n | Key n
+ | OptString n ->
+ pr ", &%s, &%s_size" n n
+ | StringList n | DeviceList n ->
+ pr ", &z_%s" n
+ | Bool n ->
+ pr ", &%s" n
+ | Int n | Int64 n ->
+ pr ", &%s" n
+ ) (snd style);
+ pr ") == FAILURE) {\n";
+ pr " RETURN_FALSE;\n";
+ pr " }\n";
+ pr "\n";
+ pr " ZEND_FETCH_RESOURCE (g, guestfs_h *, &z_g, -1, PHP_GUESTFS_HANDLE_RES_NAME,\n";
+ pr " res_guestfs_h);\n";
+ pr " if (g == NULL) {\n";
+ pr " RETURN_FALSE;\n";
+ pr " }\n";
+ pr "\n";
+
+ List.iter (
+ function
+ | String n | Device n | Pathname n | Dev_or_Path n
+ | FileIn n | FileOut n | Key n
+ | OptString n ->
+ (* Just need to check the string doesn't contain any ASCII
+ * NUL characters, which won't be supported by the C API.
+ *)
+ pr " if (strlen (%s) != %s_size) {\n" n n;
+ pr " fprintf (stderr, \"libguestfs: %s: parameter '%s' contains embedded ASCII NUL.\\n\");\n" shortname n;
+ pr " RETURN_FALSE;\n";
+ pr " }\n";
+ pr "\n"
+ | BufferIn n -> ()
+ | StringList n
+ | DeviceList n ->
+ (* Convert array to list of strings.
+ * http://marc.info/?l=pecl-dev&m=112205192100631&w=2
+ *)
+ pr " {\n";
+ pr " HashTable *a;\n";
+ pr " int n;\n";
+ pr " HashPosition p;\n";
+ pr " zval **d;\n";
+ pr " size_t c = 0;\n";
+ pr "\n";
+ pr " a = Z_ARRVAL_P (z_%s);\n" n;
+ pr " n = zend_hash_num_elements (a);\n";
+ pr " %s = safe_emalloc (n + 1, sizeof (char *), 0);\n" n;
+ pr " for (zend_hash_internal_pointer_reset_ex (a, &p);\n";
+ pr " zend_hash_get_current_data_ex (a, (void **) &d, &p) == SUCCESS;\n";
+ pr " zend_hash_move_forward_ex (a, &p)) {\n";
+ pr " zval t = **d;\n";
+ pr " zval_copy_ctor (&t);\n";
+ pr " convert_to_string (&t);\n";
+ pr " %s[c] = Z_STRVAL (t);\n" n;
+ pr " c++;\n";
+ pr " }\n";
+ pr " %s[c] = NULL;\n" n;
+ pr " }\n";
+ pr "\n"
+ | Bool n | Int n | Int64 n -> ()
+ ) (snd style);
+
+ (* Return value. *)
+ let error_code =
+ match fst style with
+ | RErr -> pr " int r;\n"; "-1"
+ | RBool _
+ | RInt _ -> pr " int r;\n"; "-1"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1"
+ | RConstString _ -> pr " const char *r;\n"; "NULL"
+ | RConstOptString _ -> pr " const char *r;\n"; "NULL"
+ | RString _ ->
+ pr " char *r;\n"; "NULL"
+ | RStringList _ ->
+ 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 " char **r;\n"; "NULL"
+ | RBufferOut _ ->
+ pr " char *r;\n";
+ pr " size_t size;\n";
+ "NULL" in
+
+ (* Call the function. *)
+ pr " r = guestfs_%s " shortname;
+ generate_c_call_args ~handle:"g" style;
+ pr ";\n";
+ pr "\n";
+
+ (* Free up parameters. *)
+ List.iter (
+ function
+ | String n | Device n | Pathname n | Dev_or_Path n
+ | FileIn n | FileOut n | Key n
+ | OptString n -> ()
+ | BufferIn n -> ()
+ | StringList n
+ | DeviceList n ->
+ pr " {\n";
+ pr " size_t c = 0;\n";
+ pr "\n";
+ pr " for (c = 0; %s[c] != NULL; ++c)\n" n;
+ pr " efree (%s[c]);\n" n;
+ pr " efree (%s);\n" n;
+ pr " }\n";
+ pr "\n"
+ | Bool n | Int n | Int64 n -> ()
+ ) (snd style);
+
+ (* Check for errors. *)
+ pr " if (r == %s) {\n" error_code;
+ pr " RETURN_FALSE;\n";
+ pr " }\n";
+ pr "\n";
+
+ (* Convert the return value. *)
+ (match fst style with
+ | RErr ->
+ pr " RETURN_TRUE;\n"
+ | RBool _ ->
+ pr " RETURN_BOOL (r);\n"
+ | RInt _ ->
+ pr " RETURN_LONG (r);\n"
+ | RInt64 _ ->
+ pr " RETURN_LONG (r);\n"
+ | RConstString _ ->
+ pr " RETURN_STRING (r, 1);\n"
+ | RConstOptString _ ->
+ pr " if (r) { RETURN_STRING (r, 1); }\n";
+ pr " else { RETURN_NULL (); }\n"
+ | RString _ ->
+ pr " char *r_copy = estrdup (r);\n";
+ pr " free (r);\n";
+ pr " RETURN_STRING (r_copy, 0);\n"
+ | RBufferOut _ ->
+ pr " char *r_copy = estrndup (r, size);\n";
+ pr " free (r);\n";
+ pr " RETURN_STRING (r_copy, 0);\n"
+ | RStringList _ ->
+ pr " size_t c = 0;\n";
+ pr " array_init (return_value);\n";
+ pr " for (c = 0; r[c] != NULL; ++c) {\n";
+ pr " add_next_index_string (return_value, r[c], 1);\n";
+ pr " free (r[c]);\n";
+ pr " }\n";
+ pr " free (r);\n";
+ | RHashtable _ ->
+ pr " size_t c = 0;\n";
+ pr " array_init (return_value);\n";
+ pr " for (c = 0; r[c] != NULL; c += 2) {\n";
+ pr " add_assoc_string (return_value, r[c], r[c+1], 1);\n";
+ pr " free (r[c]);\n";
+ pr " free (r[c+1]);\n";
+ pr " }\n";
+ pr " free (r);\n";
+ | RStruct (_, typ) ->
+ let cols = cols_of_struct typ in
+ generate_php_struct_code typ cols
+ | RStructList (_, typ) ->
+ let cols = cols_of_struct typ in
+ generate_php_struct_list_code typ cols
+ );
+
+ pr "}\n";
+ pr "\n"
+ ) all_functions_sorted
+
+and generate_php_struct_code typ cols =
+ pr " array_init (return_value);\n";
+ List.iter (
+ function
+ | name, FString ->
+ pr " add_assoc_string (return_value, \"%s\", r->%s, 1);\n" name name
+ | name, FBuffer ->
+ pr " add_assoc_stringl (return_value, \"%s\", r->%s, r->%s_len, 1);\n"
+ name name name
+ | name, FUUID ->
+ pr " add_assoc_stringl (return_value, \"%s\", r->%s, 32, 1);\n"
+ name name
+ | name, (FBytes|FUInt64|FInt64|FInt32|FUInt32) ->
+ pr " add_assoc_long (return_value, \"%s\", r->%s);\n"
+ name name
+ | name, FChar ->
+ pr " add_assoc_stringl (return_value, \"%s\", &r->%s, 1, 1);\n"
+ name name
+ | name, FOptPercent ->
+ pr " add_assoc_double (return_value, \"%s\", r->%s);\n"
+ name name
+ ) cols;
+ pr " guestfs_free_%s (r);\n" typ
+
+and generate_php_struct_list_code typ cols =
+ pr " array_init (return_value);\n";
+ pr " size_t c = 0;\n";
+ pr " for (c = 0; c < r->len; ++c) {\n";
+ pr " zval *z_elem;\n";
+ pr " ALLOC_INIT_ZVAL (z_elem);\n";
+ pr " array_init (z_elem);\n";
+ List.iter (
+ function
+ | name, FString ->
+ pr " add_assoc_string (z_elem, \"%s\", r->val[c].%s, 1);\n"
+ name name
+ | name, FBuffer ->
+ pr " add_assoc_stringl (z_elem, \"%s\", r->val[c].%s, r->val[c].%s_len, 1);\n"
+ name name name
+ | name, FUUID ->
+ pr " add_assoc_stringl (z_elem, \"%s\", r->val[c].%s, 32, 1);\n"
+ name name
+ | name, (FBytes|FUInt64|FInt64|FInt32|FUInt32) ->
+ pr " add_assoc_long (z_elem, \"%s\", r->val[c].%s);\n"
+ name name
+ | name, FChar ->
+ pr " add_assoc_stringl (z_elem, \"%s\", &r->val[c].%s, 1, 1);\n"
+ name name
+ | name, FOptPercent ->
+ pr " add_assoc_double (z_elem, \"%s\", r->val[c].%s);\n"
+ name name
+ ) cols;
+ pr " add_next_index_zval (return_value, z_elem);\n";
+ pr " }\n";
+ pr " guestfs_free_%s_list (r);\n" typ
+
and generate_bindtests () =
generate_header CStyle LGPLv2plus;
(* XXX Add here tests of the return and error functions. *)
-(* Code to generator bindings for virt-inspector. Currently only
- * implemented for OCaml code (for virt-p2v 2.0).
- *)
-let rng_input = "inspector/virt-inspector.rng"
-
-(* Read the input file and parse it into internal structures. This is
- * by no means a complete RELAX NG parser, but is just enough to be
- * able to parse the specific input file.
- *)
-type rng =
- | Element of string * rng list (* <element name=name/> *)
- | Attribute of string * rng list (* <attribute name=name/> *)
- | Interleave of rng list (* <interleave/> *)
- | ZeroOrMore of rng (* <zeroOrMore/> *)
- | OneOrMore of rng (* <oneOrMore/> *)
- | Optional of rng (* <optional/> *)
- | Choice of string list (* <choice><value/>*</choice> *)
- | Value of string (* <value>str</value> *)
- | Text (* <text/> *)
-
-let rec string_of_rng = function
- | Element (name, xs) ->
- "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
- | Attribute (name, xs) ->
- "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
- | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")"
- | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")"
- | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")"
- | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")"
- | Choice values -> "Choice [" ^ String.concat ", " values ^ "]"
- | Value value -> "Value \"" ^ value ^ "\""
- | Text -> "Text"
-
-and string_of_rng_list xs =
- String.concat ", " (List.map string_of_rng xs)
-
-let rec parse_rng ?defines context = function
- | [] -> []
- | Xml.Element ("element", ["name", name], children) :: rest ->
- Element (name, parse_rng ?defines context children)
- :: parse_rng ?defines context rest
- | Xml.Element ("attribute", ["name", name], children) :: rest ->
- Attribute (name, parse_rng ?defines context children)
- :: parse_rng ?defines context rest
- | Xml.Element ("interleave", [], children) :: rest ->
- Interleave (parse_rng ?defines context children)
- :: parse_rng ?defines context rest
- | Xml.Element ("zeroOrMore", [], [child]) :: rest ->
- let rng = parse_rng ?defines context [child] in
- (match rng with
- | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
- | _ ->
- failwithf "%s: <zeroOrMore> contains more than one child element"
- context
- )
- | Xml.Element ("oneOrMore", [], [child]) :: rest ->
- let rng = parse_rng ?defines context [child] in
- (match rng with
- | [child] -> OneOrMore child :: parse_rng ?defines context rest
- | _ ->
- failwithf "%s: <oneOrMore> contains more than one child element"
- context
- )
- | Xml.Element ("optional", [], [child]) :: rest ->
- let rng = parse_rng ?defines context [child] in
- (match rng with
- | [child] -> Optional child :: parse_rng ?defines context rest
- | _ ->
- failwithf "%s: <optional> contains more than one child element"
- context
- )
- | Xml.Element ("choice", [], children) :: rest ->
- let values = List.map (
- function Xml.Element ("value", [], [Xml.PCData value]) -> value
- | _ ->
- failwithf "%s: can't handle anything except <value> in <choice>"
- context
- ) children in
- Choice values
- :: parse_rng ?defines context rest
- | Xml.Element ("value", [], [Xml.PCData value]) :: rest ->
- Value value :: parse_rng ?defines context rest
- | Xml.Element ("text", [], []) :: rest ->
- Text :: parse_rng ?defines context rest
- | Xml.Element ("ref", ["name", name], []) :: rest ->
- (* Look up the reference. Because of limitations in this parser,
- * we can't handle arbitrarily nested <ref> yet. You can only
- * use <ref> from inside <start>.
- *)
- (match defines with
- | None ->
- failwithf "%s: contains <ref>, but no refs are defined yet" context
- | Some map ->
- let rng = StringMap.find name map in
- rng @ parse_rng ?defines context rest
- )
- | x :: _ ->
- failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
-
-let grammar =
- let xml = Xml.parse_file rng_input in
- match xml with
- | Xml.Element ("grammar", _,
- Xml.Element ("start", _, gram) :: defines) ->
- (* The <define/> elements are referenced in the <start> section,
- * so build a map of those first.
- *)
- let defines = List.fold_left (
- fun map ->
- function Xml.Element ("define", ["name", name], defn) ->
- StringMap.add name defn map
- | _ ->
- failwithf "%s: expected <define name=name/>" rng_input
- ) StringMap.empty defines in
- let defines = StringMap.mapi parse_rng defines in
-
- (* Parse the <start> clause, passing the defines. *)
- parse_rng ~defines "<start>" gram
- | _ ->
- failwithf "%s: input is not <grammar><start/><define>*</grammar>"
- rng_input
-
-let name_of_field = function
- | Element (name, _) | Attribute (name, _)
- | ZeroOrMore (Element (name, _))
- | OneOrMore (Element (name, _))
- | Optional (Element (name, _)) -> name
- | Optional (Attribute (name, _)) -> name
- | Text -> (* an unnamed field in an element *)
- "data"
- | rng ->
- failwithf "name_of_field failed at: %s" (string_of_rng rng)
-
-(* At the moment this function only generates OCaml types. However we
- * should parameterize it later so it can generate types/structs in a
- * variety of languages.
- *)
-let generate_types xs =
- (* A simple type is one that can be printed out directly, eg.
- * "string option". A complex type is one which has a name and has
- * to be defined via another toplevel definition, eg. a struct.
- *
- * generate_type generates code for either simple or complex types.
- * In the simple case, it returns the string ("string option"). In
- * the complex case, it returns the name ("mountpoint"). In the
- * complex case it has to print out the definition before returning,
- * so it should only be called when we are at the beginning of a
- * new line (BOL context).
- *)
- let rec generate_type = function
- | Text -> (* string *)
- "string", true
- | Choice values -> (* [`val1|`val2|...] *)
- "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
- | ZeroOrMore rng -> (* <rng> list *)
- let t, is_simple = generate_type rng in
- t ^ " list (* 0 or more *)", is_simple
- | OneOrMore rng -> (* <rng> list *)
- let t, is_simple = generate_type rng in
- t ^ " list (* 1 or more *)", is_simple
- (* virt-inspector hack: bool *)
- | Optional (Attribute (name, [Value "1"])) ->
- "bool", true
- | Optional rng -> (* <rng> list *)
- let t, is_simple = generate_type rng in
- t ^ " option", is_simple
- (* type name = { fields ... } *)
- | Element (name, fields) when is_attrs_interleave fields ->
- generate_type_struct name (get_attrs_interleave fields)
- | Element (name, [field]) (* type name = field *)
- | Attribute (name, [field]) ->
- let t, is_simple = generate_type field in
- if is_simple then (t, true)
- else (
- pr "type %s = %s\n" name t;
- name, false
- )
- | Element (name, fields) -> (* type name = { fields ... } *)
- generate_type_struct name fields
- | rng ->
- failwithf "generate_type failed at: %s" (string_of_rng rng)
-
- and is_attrs_interleave = function
- | [Interleave _] -> true
- | Attribute _ :: fields -> is_attrs_interleave fields
- | Optional (Attribute _) :: fields -> is_attrs_interleave fields
- | _ -> false
-
- and get_attrs_interleave = function
- | [Interleave fields] -> fields
- | ((Attribute _) as field) :: fields
- | ((Optional (Attribute _)) as field) :: fields ->
- field :: get_attrs_interleave fields
- | _ -> assert false
-
- and generate_types xs =
- List.iter (fun x -> ignore (generate_type x)) xs
-
- and generate_type_struct name fields =
- (* Calculate the types of the fields first. We have to do this
- * before printing anything so we are still in BOL context.
- *)
- let types = List.map fst (List.map generate_type fields) in
-
- (* Special case of a struct containing just a string and another
- * field. Turn it into an assoc list.
- *)
- match types with
- | ["string"; other] ->
- let fname1, fname2 =
- match fields with
- | [f1; f2] -> name_of_field f1, name_of_field f2
- | _ -> assert false in
- pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
- name, false
-
- | types ->
- pr "type %s = {\n" name;
- List.iter (
- fun (field, ftype) ->
- let fname = name_of_field field in
- pr " %s_%s : %s;\n" name fname ftype
- ) (List.combine fields types);
- pr "}\n";
- (* Return the name of this type, and
- * false because it's not a simple type.
- *)
- name, false
- in
-
- generate_types xs
-
-let generate_parsers xs =
- (* As for generate_type above, generate_parser makes a parser for
- * some type, and returns the name of the parser it has generated.
- * Because it (may) need to print something, it should always be
- * called in BOL context.
- *)
- let rec generate_parser = function
- | Text -> (* string *)
- "string_child_or_empty"
- | Choice values -> (* [`val1|`val2|...] *)
- sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
- (String.concat "|"
- (List.map (fun v -> sprintf "%S -> `%s" v v) values))
- | ZeroOrMore rng -> (* <rng> list *)
- let pa = generate_parser rng in
- sprintf "(fun x -> List.map %s (Xml.children x))" pa
- | OneOrMore rng -> (* <rng> list *)
- let pa = generate_parser rng in
- sprintf "(fun x -> List.map %s (Xml.children x))" pa
- (* virt-inspector hack: bool *)
- | Optional (Attribute (name, [Value "1"])) ->
- sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
- | Optional rng -> (* <rng> list *)
- let pa = generate_parser rng in
- sprintf "(function None -> None | Some x -> Some (%s x))" pa
- (* type name = { fields ... } *)
- | Element (name, fields) when is_attrs_interleave fields ->
- generate_parser_struct name (get_attrs_interleave fields)
- | Element (name, [field]) -> (* type name = field *)
- let pa = generate_parser field in
- let parser_name = sprintf "parse_%s_%d" name (unique ()) in
- pr "let %s =\n" parser_name;
- pr " %s\n" pa;
- pr "let parse_%s = %s\n" name parser_name;
- parser_name
- | Attribute (name, [field]) ->
- let pa = generate_parser field in
- let parser_name = sprintf "parse_%s_%d" name (unique ()) in
- pr "let %s =\n" parser_name;
- pr " %s\n" pa;
- pr "let parse_%s = %s\n" name parser_name;
- parser_name
- | Element (name, fields) -> (* type name = { fields ... } *)
- generate_parser_struct name ([], fields)
- | rng ->
- failwithf "generate_parser failed at: %s" (string_of_rng rng)
-
- and is_attrs_interleave = function
- | [Interleave _] -> true
- | Attribute _ :: fields -> is_attrs_interleave fields
- | Optional (Attribute _) :: fields -> is_attrs_interleave fields
- | _ -> false
-
- and get_attrs_interleave = function
- | [Interleave fields] -> [], fields
- | ((Attribute _) as field) :: fields
- | ((Optional (Attribute _)) as field) :: fields ->
- let attrs, interleaves = get_attrs_interleave fields in
- (field :: attrs), interleaves
- | _ -> assert false
-
- and generate_parsers xs =
- List.iter (fun x -> ignore (generate_parser x)) xs
-
- and generate_parser_struct name (attrs, interleaves) =
- (* Generate parsers for the fields first. We have to do this
- * before printing anything so we are still in BOL context.
- *)
- let fields = attrs @ interleaves in
- let pas = List.map generate_parser fields in
-
- (* Generate an intermediate tuple from all the fields first.
- * If the type is just a string + another field, then we will
- * return this directly, otherwise it is turned into a record.
- *
- * RELAX NG note: This code treats <interleave> and plain lists of
- * fields the same. In other words, it doesn't bother enforcing
- * any ordering of fields in the XML.
- *)
- pr "let parse_%s x =\n" name;
- pr " let t = (\n ";
- let comma = ref false in
- List.iter (
- fun x ->
- if !comma then pr ",\n ";
- comma := true;
- match x with
- | Optional (Attribute (fname, [field])), pa ->
- pr "%s x" pa
- | Optional (Element (fname, [field])), pa ->
- pr "%s (optional_child %S x)" pa fname
- | Attribute (fname, [Text]), _ ->
- pr "attribute %S x" fname
- | (ZeroOrMore _ | OneOrMore _), pa ->
- pr "%s x" pa
- | Text, pa ->
- pr "%s x" pa
- | (field, pa) ->
- let fname = name_of_field field in
- pr "%s (child %S x)" pa fname
- ) (List.combine fields pas);
- pr "\n ) in\n";
-
- (match fields with
- | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
- pr " t\n"
-
- | _ ->
- pr " (Obj.magic t : %s)\n" name
-(*
- List.iter (
- function
- | (Optional (Attribute (fname, [field])), pa) ->
- pr " %s_%s =\n" name fname;
- pr " %s x;\n" pa
- | (Optional (Element (fname, [field])), pa) ->
- pr " %s_%s =\n" name fname;
- pr " (let x = optional_child %S x in\n" fname;
- pr " %s x);\n" pa
- | (field, pa) ->
- let fname = name_of_field field in
- pr " %s_%s =\n" name fname;
- pr " (let x = child %S x in\n" fname;
- pr " %s x);\n" pa
- ) (List.combine fields pas);
- pr "}\n"
-*)
- );
- sprintf "parse_%s" name
- in
-
- generate_parsers xs
-
-(* Generate ocaml/guestfs_inspector.mli. *)
-let generate_ocaml_inspector_mli () =
- generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
-
- pr "\
-(** This is an OCaml language binding to the external [virt-inspector]
- program.
-
- For more information, please read the man page [virt-inspector(1)].
-*)
-
-";
-
- generate_types grammar;
- pr "(** The nested information returned from the {!inspect} function. *)\n";
- pr "\n";
-
- pr "\
-val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems
-(** To inspect a libvirt domain called [name], pass a singleton
- list: [inspect [name]]. When using libvirt only, you may
- optionally pass a libvirt URI using [inspect ~connect:uri ...].
-
- To inspect a disk image or images, pass a list of the filenames
- of the disk images: [inspect filenames]
-
- This function inspects the given guest or disk images and
- returns a list of operating system(s) found and a large amount
- of information about them. In the vast majority of cases,
- a virtual machine only contains a single operating system.
-
- If the optional [~xml] parameter is given, then this function
- skips running the external virt-inspector program and just
- parses the given XML directly (which is expected to be XML
- produced from a previous run of virt-inspector). The list of
- names and connect URI are ignored in this case.
-
- This function can throw a wide variety of exceptions, for example
- if the external virt-inspector program cannot be found, or if
- it doesn't generate valid XML.
-*)
-"
-
-(* Generate ocaml/guestfs_inspector.ml. *)
-let generate_ocaml_inspector_ml () =
- generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
-
- pr "open Unix\n";
- pr "\n";
-
- generate_types grammar;
- pr "\n";
-
- pr "\
-(* Misc functions which are used by the parser code below. *)
-let first_child = function
- | Xml.Element (_, _, c::_) -> c
- | Xml.Element (name, _, []) ->
- failwith (\"expected <\" ^ name ^ \"/> to have a child node\")
- | Xml.PCData str ->
- failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
-
-let string_child_or_empty = function
- | Xml.Element (_, _, [Xml.PCData s]) -> s
- | Xml.Element (_, _, []) -> \"\"
- | Xml.Element (x, _, _) ->
- failwith (\"expected XML tag with a single PCDATA child, but got \" ^
- x ^ \" instead\")
- | Xml.PCData str ->
- failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
-
-let optional_child name xml =
- let children = Xml.children xml in
- try
- Some (List.find (function
- | Xml.Element (n, _, _) when n = name -> true
- | _ -> false) children)
- with
- Not_found -> None
-
-let child name xml =
- match optional_child name xml with
- | Some c -> c
- | None ->
- failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
-
-let attribute name xml =
- try Xml.attrib xml name
- with Xml.No_attribute _ ->
- failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
-
-";
-
- generate_parsers grammar;
- pr "\n";
-
- pr "\
-(* Run external virt-inspector, then use parser to parse the XML. *)
-let inspect ?connect ?xml names =
- let xml =
- match xml with
- | None ->
- if names = [] then invalid_arg \"inspect: no names given\";
- let cmd = [ \"virt-inspector\"; \"--xml\" ] @
- (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @
- names in
- let cmd = List.map Filename.quote cmd in
- let cmd = String.concat \" \" cmd in
- let chan = open_process_in cmd in
- let xml = Xml.parse_in chan in
- (match close_process_in chan with
- | WEXITED 0 -> ()
- | WEXITED _ -> failwith \"external virt-inspector command failed\"
- | WSIGNALED i | WSTOPPED i ->
- failwith (\"external virt-inspector command died or stopped on sig \" ^
- string_of_int i)
- );
- xml
- | Some doc ->
- Xml.parse_string doc in
- parse_operatingsystems xml
-"
-
and generate_max_proc_nr () =
pr "%d\n" max_proc_nr
output_to "src/guestfs-structs.h" generate_structs_h;
output_to "src/guestfs-actions.h" generate_actions_h;
output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
- output_to "src/guestfs-actions.c" generate_client_actions;
- output_to "src/guestfs-bindtests.c" generate_bindtests;
+ output_to "src/actions.c" generate_client_actions;
+ output_to "src/bindtests.c" generate_bindtests;
output_to "src/guestfs-structs.pod" generate_structs_pod;
output_to "src/guestfs-actions.pod" generate_actions_pod;
output_to "src/guestfs-availability.pod" generate_availability_pod;
output_to "fish/cmds.c" generate_fish_cmds;
output_to "fish/completion.c" generate_fish_completion;
output_to "fish/guestfish-actions.pod" generate_fish_actions_pod;
+ output_to "fish/prepopts.c" generate_fish_prep_options_c;
+ output_to "fish/prepopts.h" generate_fish_prep_options_h;
output_to "ocaml/guestfs.mli" generate_ocaml_mli;
output_to "ocaml/guestfs.ml" generate_ocaml_ml;
output_to "ocaml/guestfs_c_actions.c" generate_ocaml_c;
output_to "ocaml/bindtests.ml" generate_ocaml_bindtests;
- output_to "ocaml/guestfs_inspector.mli" generate_ocaml_inspector_mli;
- output_to "ocaml/guestfs_inspector.ml" generate_ocaml_inspector_ml;
output_to "perl/Guestfs.xs" generate_perl_xs;
output_to "perl/lib/Sys/Guestfs.pm" generate_perl_pm;
output_to "perl/bindtests.pl" generate_perl_bindtests;
output_to "haskell/Guestfs.hs" generate_haskell_hs;
output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
output_to "csharp/Libguestfs.cs" generate_csharp;
+ output_to "php/extension/php_guestfs_php.h" generate_php_h;
+ output_to "php/extension/guestfs_php.c" generate_php_c;
(* Always generate this file last, and unconditionally. It's used
* by the Makefile to know when we must re-run the generator.
git.annexia.org / libguestfs.git / blobdiff