* To return an arbitrary buffer, use RBufferOut.
*)
| BufferIn of string
+ (* Key material / passphrase. Eventually we should treat this
+ * as sensitive and mlock it into physical RAM. However this
+ * is highly complex because of all the places that XDR-encoded
+ * strings can end up. So currently the only difference from
+ * 'String' is the way that guestfish requests these parameters
+ * from the user.
+ *)
+ | Key of string
type flags =
| ProtocolLimitWarning (* display warning about protocol size limits *)
| 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 *)
(* As for 'If' but the test runs _unless_ the code returns true. *)
| Unless of string
+ (* Run the test only if 'string' is available in the daemon. *)
+ | IfAvailable of string
+
(* Some initial scenarios for testing. *)
and test_init =
(* Do nothing, block devices could contain random stuff including
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
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).
+number. From C code you can use dynamic linker functions
+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
To construct the original version string:
C<$major.$minor.$release$extra>
+See also: L<guestfs(3)/LIBGUESTFS VERSION NUMBERS>.
+
I<Note:> Don't use this call to test for availability
-of features. Distro backports makes this unreliable. Use
-C<guestfs_available> instead.");
+of features. In enterprise distributions we backport
+features from later versions into earlier versions,
+making this an unreliable way to test for features.
+Use C<guestfs_available> instead.");
("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
[InitNone, Always, TestOutputTrue (
"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
"\
Touch acts like the L<touch(1)> command. It can be used to
update the timestamps on a file, or, if the file does not exist,
-to create a new zero-length file.");
+to create a new zero-length file.
+
+This command only works on regular files, and will fail on other
+file types such as directories, symbolic links, block special etc.");
("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
[InitISOFS, Always, TestOutput (
C<guestfs_part_init>");
("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning; DeprecatedBy "write"],
- [],
+ (* Regression test for RHBZ#597135. *)
+ [InitBasicFS, Always, TestLastFail
+ [["write_file"; "/new"; "abc"; "10000"]]],
"create a file",
"\
This call creates a file called C<path>. The contents of the
InitISOFS, Always, TestOutput (
[["file"; "/known-1"]], "ASCII text");
InitISOFS, Always, TestLastFail (
- [["file"; "/notexists"]])],
+ [["file"; "/notexists"]]);
+ InitISOFS, Always, TestOutput (
+ [["file"; "/abssymlink"]], "symbolic link");
+ InitISOFS, Always, TestOutput (
+ [["file"; "/directory"]], "directory")],
"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 type or contents of the file.
This call will also transparently look inside various types
of compressed file.
-The exact command which runs is C<file -zbsL path>. Note in
+The exact command which runs is C<file -zb path>. Note in
particular that the filename is not prepended to the output
-(the C<-b> option).");
+(the C<-b> option).
+
+This command can also be used on C</dev/> devices
+(and partitions, LV names). You can for example use this
+to determine if a device contains a filesystem, although
+it's usually better to use C<guestfs_vfs_type>.
+
+If the C<path> does not begin with C</dev/> then
+this command only works for the content of regular files.
+For other file types (directory, symbolic link etc) it
+will just return the string C<directory> etc.");
("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
[InitBasicFS, Always, TestOutput (
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"];
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", [Device "device"]), 81, [],
+ ("get_e2label", (RString "label", [Device "device"]), 81, [DeprecatedBy "vfs_label"],
[],
"get the ext2/3/4 filesystem label",
"\
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", [Device "device"]), 83, [],
- [],
+ ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [DeprecatedBy "vfs_uuid"],
+ (* Regression test for RHBZ#597112. *)
+ (let uuid = uuidgen () in
+ [InitBasicFS, Always, TestOutput (
+ [["mke2journal"; "1024"; "/dev/sdb"];
+ ["set_e2uuid"; "/dev/sdb"; uuid];
+ ["get_e2uuid"; "/dev/sdb"]], uuid)]),
"get the ext2/3/4 filesystem UUID",
"\
This returns the ext2/3/4 filesystem UUID of the filesystem on
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"];
See also: C<guestfs_zero_device>, C<guestfs_scrub_device>.");
("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
- (* Test disabled because grub-install incompatible with virtio-blk driver.
- * See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760
+ (* See:
+ * https://bugzilla.redhat.com/show_bug.cgi?id=484986
+ * https://bugzilla.redhat.com/show_bug.cgi?id=479760
*)
- [InitBasicFS, Disabled, TestOutputTrue (
- [["grub_install"; "/"; "/dev/sda1"];
+ [InitBasicFS, Always, TestOutputTrue (
+ [["mkdir_p"; "/boot/grub"];
+ ["write"; "/boot/grub/device.map"; "(hd0) /dev/vda"];
+ ["grub_install"; "/"; "/dev/vda"];
["is_dir"; "/boot"]])],
"install GRUB",
"\
This command installs GRUB (the Grand Unified Bootloader) on
-C<device>, with the root directory being C<root>.");
+C<device>, with the root directory being C<root>.
+
+Note: If grub-install reports the error
+\"No suitable drive was found in the generated device map.\"
+it may be that you need to create a C</boot/grub/device.map>
+file first that contains the mapping between grub device names
+and Linux device names. It is usually sufficient to create
+a file containing:
+
+ (hd0) /dev/vda
+
+replacing C</dev/vda> with the name of the installation device.");
("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
[InitBasicFS, Always, TestOutput (
("resize2fs", (RErr, [Device "device"]), 106, [],
[], (* lvresize tests this *)
- "resize an ext2/ext3 filesystem",
+ "resize an ext2, ext3 or ext4 filesystem",
"\
-This resizes an ext2 or ext3 filesystem to match the size of
+This resizes an ext2, ext3 or ext4 filesystem to match the size of
the underlying device.
I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
=item '?'
-The L<readdir(3)> returned a C<d_type> field with an
+The L<readdir(3)> call returned a C<d_type> field with an
unexpected value
=back
"\
This command reads the target of a symbolic link.");
- ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [],
+ ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [DeprecatedBy "fallocate64"],
[InitBasicFS, Always, TestOutputStruct (
[["fallocate"; "/a"; "1000000"];
["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
["mount_options"; ""; "/dev/sda1"; "/"];
["write"; "/new"; "new file contents"];
- ["cat"; "/new"]], "new file contents")],
+ ["cat"; "/new"]], "new file contents");
+ InitEmpty, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "mbr"];
+ ["mkfs_b"; "vfat"; "32768"; "/dev/sda1"]]);
+ InitEmpty, Always, TestLastFail (
+ [["part_disk"; "/dev/sda"; "mbr"];
+ ["mkfs_b"; "vfat"; "32769"; "/dev/sda1"]]);
+ InitEmpty, Always, TestLastFail (
+ [["part_disk"; "/dev/sda"; "mbr"];
+ ["mkfs_b"; "vfat"; "33280"; "/dev/sda1"]]);
+ InitEmpty, IfAvailable "ntfsprogs", TestRun (
+ [["part_disk"; "/dev/sda"; "mbr"];
+ ["mkfs_b"; "ntfs"; "32768"; "/dev/sda1"]])],
"make a filesystem with block size",
"\
This call is similar to C<guestfs_mkfs>, but it allows you to
control the block size of the resulting filesystem. Supported
block sizes depend on the filesystem type, but typically they
-are C<1024>, C<2048> or C<4096> only.");
+are C<1024>, C<2048> or C<4096> only.
+
+For VFAT and NTFS the C<blocksize> parameter is treated as
+the requested cluster size.");
("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
[InitEmpty, Always, TestOutput (
)],
"echo arguments back to the client",
"\
-This command concatenate the list of C<words> passed with single spaces between
-them and returns the resulting string.
+This command concatenates the list of C<words> passed with single spaces
+between them and returns the resulting string.
You can use this command to test the connection through to the daemon.
[["vfs_type"; "/dev/sda1"]], "ext2")],
"get the Linux VFS type corresponding to a mounted device",
"\
-This command gets the block device type corresponding to
-a mounted device called C<device>.
+This command gets the filesystem type corresponding to
+the filesystem on C<device>.
-Usually the result is the name of the Linux VFS module that
-is used to mount this device (probably determined automatically
-if you used the C<guestfs_mount> call).");
+For most filesystems, the result is the name of the Linux
+VFS module which would be used to mount this filesystem
+if you mounted it without specifying the filesystem type.
+For example a string such as C<ext3> or C<ntfs>.");
("truncate", (RErr, [Pathname "path"]), 199, [],
[InitBasicFS, Always, TestOutputStruct (
"truncate a file to a particular size",
"\
This command truncates C<path> to size C<size> bytes. The file
-must exist already. If the file is smaller than C<size> then
-the file is extended to the required size with null bytes.");
+must exist already.
+
+If the current file size is less than C<size> then
+the file is extended to the required size with zero bytes.
+This creates a sparse file (ie. disk blocks are not allocated
+for the file until you write to it). To create a non-sparse
+file of zeroes, use C<guestfs_fallocate64> instead.");
("utimens", (RErr, [Pathname "path"; Int64 "atsecs"; Int64 "atnsecs"; Int64 "mtsecs"; Int64 "mtnsecs"]), 201, [],
[InitBasicFS, Always, TestOutputStruct (
On return you get a list of strings, with a one-to-one
correspondence to the C<names> list. Each string is the
-value of the symbol link.
+value of the symbolic link.
If the C<readlink(2)> operation fails on any name, then
the corresponding result string is the empty string C<\"\">.
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")],
The libguestfs groups, and the functions that those
groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
+You can also fetch this list at runtime by calling
+C<guestfs_available_all_groups>.
The argument C<groups> is a list of group names, eg:
C<[\"inotify\", \"augeas\"]> would check for the availability of
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")],
See also C<guestfs_pread>.");
+ ("resize2fs_size", (RErr, [Device "device"; Int64 "size"]), 248, [],
+ [],
+ "resize an ext2, ext3 or ext4 filesystem (with size)",
+ "\
+This command is the same as C<guestfs_resize2fs> except that it
+allows you to specify the new size (in bytes) explicitly.");
+
+ ("pvresize_size", (RErr, [Device "device"; Int64 "size"]), 249, [Optional "lvm2"],
+ [],
+ "resize an LVM physical volume (with size)",
+ "\
+This command is the same as C<guestfs_pvresize> except that it
+allows you to specify the new size (in bytes) explicitly.");
+
+ ("ntfsresize_size", (RErr, [Device "device"; Int64 "size"]), 250, [Optional "ntfsprogs"],
+ [],
+ "resize an NTFS filesystem (with size)",
+ "\
+This command is the same as C<guestfs_ntfsresize> except that it
+allows you to specify the new size (in bytes) explicitly.");
+
+ ("available_all_groups", (RStringList "groups", []), 251, [],
+ [InitNone, Always, TestRun [["available_all_groups"]]],
+ "return a list of all optional groups",
+ "\
+This command returns a list of all optional groups that this
+daemon knows about. Note this returns both supported and unsupported
+groups. To find out which ones the daemon can actually support
+you have to call C<guestfs_available> on each member of the
+returned list.
+
+See also C<guestfs_available> and L<guestfs(3)/AVAILABILITY>.");
+
+ ("fallocate64", (RErr, [Pathname "path"; Int64 "len"]), 252, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["fallocate64"; "/a"; "1000000"];
+ ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
+ "preallocate a file in the guest filesystem",
+ "\
+This command preallocates a file (containing zero bytes) named
+C<path> of size C<len> bytes. If the file exists already, it
+is overwritten.
+
+Note that this call allocates disk blocks for the file.
+To create a sparse file use C<guestfs_truncate_size> instead.
+
+The deprecated call C<guestfs_fallocate> does the same,
+but owing to an oversight it only allowed 30 bit lengths
+to be specified, effectively limiting the maximum size
+of files created through that call to 1GB.
+
+Do not confuse this with the guestfish-specific
+C<alloc> and C<sparse> commands which create
+a file in the host and attach it as a device.");
+
+ ("vfs_label", (RString "label", [Device "device"]), 253, [],
+ [InitBasicFS, Always, TestOutput (
+ [["set_e2label"; "/dev/sda1"; "LTEST"];
+ ["vfs_label"; "/dev/sda1"]], "LTEST")],
+ "get the filesystem label",
+ "\
+This returns the filesystem label of the filesystem on
+C<device>.
+
+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
+ [InitBasicFS, Always, TestOutput (
+ [["set_e2uuid"; "/dev/sda1"; uuid];
+ ["vfs_uuid"; "/dev/sda1"]], uuid)]),
+ "get the filesystem UUID",
+ "\
+This returns the filesystem UUID of the filesystem on
+C<device>.
+
+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
+ * the VG is being used by the mounted filesystem, so
+ * the vgchange -an command we do first will fail.
+ *)
+ [],
+ "set LVM device filter",
+ "\
+This sets the LVM device filter so that LVM will only be
+able to \"see\" the block devices in the list C<devices>,
+and will ignore all other attached block devices.
+
+Where disk image(s) contain duplicate PVs or VGs, this
+command is useful to get LVM to ignore the duplicates, otherwise
+LVM can get confused. Note also there are two types
+of duplication possible: either cloned PVs/VGs which have
+identical UUIDs; or VGs that are not cloned but just happen
+to have the same name. In normal operation you cannot
+create this situation, but you can do it outside LVM, eg.
+by cloning disk images or by bit twiddling inside the LVM
+metadata.
+
+This command also clears the LVM cache and performs a volume
+group scan.
+
+You can filter whole block devices or individual partitions.
+
+You cannot use this if any VG is currently in use (eg.
+contains a mounted filesystem), even if you are not
+filtering out that VG.");
+
+ ("lvm_clear_filter", (RErr, []), 256, [],
+ [], (* see note on lvm_set_filter *)
+ "clear LVM device filter",
+ "\
+This undoes the effect of C<guestfs_lvm_set_filter>. LVM
+will be able to see every block device.
+
+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
let name_of_argt = function
| Pathname n | Device n | Dev_or_Path n | String n | OptString n
| StringList n | DeviceList n | Bool n | Int n | Int64 n
- | FileIn n | FileOut n | BufferIn n -> n
+ | FileIn n | FileOut n | BufferIn n | Key n -> n
let java_name_of_struct typ =
try List.assoc typ java_structs
| 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
pr "%s\n\n" danger_will_robinson;
+ if List.exists (function Key _ -> true | _ -> false) (snd style) then
+ pr "This function takes a key or passphrase parameter which
+could contain sensitive material. Read the section
+L</KEYS AND PASSPHRASES> for more information.\n\n";
match deprecation_notice flags with
| None -> ()
| Some txt -> pr "%s\n\n" txt
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. *)
pr "struct %s_args {\n" name;
List.iter (
function
- | Pathname n | Device n | Dev_or_Path n | String n ->
+ | 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. *)
#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,
| FileOut n
| BufferIn n
| StringList n
- | DeviceList n ->
+ | DeviceList n
+ | Key n ->
pr " if (%s == NULL) {\n" n;
pr " error (g, \"%%s: %%s: parameter cannot be NULL\",\n";
pr " \"%s\", \"%s\");\n" shortname n;
| StringList _ | DeviceList _ -> true
| _ -> false) (snd style) in
if needs_i then (
- pr " int i;\n";
+ pr " size_t i;\n";
pr "\n"
);
- pr " printf (\"%s\");\n" shortname;
+ pr " fprintf (stderr, \"%s\");\n" shortname;
List.iter (
function
| String n (* strings *)
| Dev_or_Path n
| FileIn n
| FileOut n
- | BufferIn n ->
+ | 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
| args ->
List.iter (
function
- | Pathname n | Device n | Dev_or_Path n | String n ->
+ | Pathname n | Device n | Dev_or_Path n | String n | Key n ->
pr " args.%s = (char *) %s;\n" n n
| OptString n ->
pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
"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
*)
"guestfs_safe_calloc";
"guestfs_safe_malloc";
+ "guestfs_safe_strdup";
+ "guestfs_safe_memdup";
] in
let functions =
List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
function
| Device n | Dev_or_Path n
| Pathname n
- | String n -> ()
+ | String n
+ | Key n -> ()
| OptString n -> pr " char *%s;\n" n
| StringList n | DeviceList n -> pr " char **%s;\n" n
| Bool n -> pr " int %s;\n" n
pr_args n;
pr " REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, %s, goto done);\n"
n (if is_filein then "cancel_receive ()" else "0");
- | String n -> pr_args n
+ | String n | Key n -> pr_args n
| OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
| StringList n ->
pr_list_handling_code n;
| DeviceList n ->
pr_list_handling_code n;
pr " /* Ensure that each is a device,\n";
- pr " * and perform device name translation. */\n";
- pr " { int pvi; for (pvi = 0; physvols[pvi] != NULL; ++pvi)\n";
- pr " RESOLVE_DEVICE (physvols[pvi], %s, goto done);\n"
+ pr " * and perform device name translation.\n";
+ pr " */\n";
+ pr " {\n";
+ pr " size_t i;\n";
+ pr " for (i = 0; %s[i] != NULL; ++i)\n" n;
+ pr " RESOLVE_DEVICE (%s[i], %s, goto done);\n" n
(if is_filein then "cancel_receive ()" else "0");
pr " }\n";
| Bool n -> pr " %s = args.%s;\n" n 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 " size_t i, j;\n";
pr "\n";
(*
pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
/* FIXME: nearly identical code appears in fish.c */
static void print_strings (char *const *argv)
{
- int argc;
+ size_t argc;
for (argc = 0; argv[argc] != NULL; ++argc)
printf (\"\\t%%s\\n\", argv[argc]);
/*
static void print_table (char const *const *argv)
{
- int i;
+ size_t i;
for (i = 0; argv[i] != NULL; i += 2)
printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
}
*/
+static int
+is_available (const char *group)
+{
+ const char *groups[] = { group, NULL };
+ int r;
+
+ suppress_error = 1;
+ r = guestfs_available (g, (char **) groups);
+ suppress_error = 0;
+
+ return r == 0;
+}
+
+static void
+incr (guestfs_h *g, void *iv)
+{
+ int *i = (int *) iv;
+ (*i)++;
+}
+
";
(* Generate a list of commands which are not tested anywhere. *)
fun (_, _, _, _, tests, _, _) ->
let tests = filter_map (
function
- | (_, (Always|If _|Unless _), test) -> Some test
+ | (_, (Always|If _|Unless _|IfAvailable _), test) -> Some test
| (_, Disabled, _) -> None
) tests in
let seq = List.concat (List.map seq_of_test tests) in
) 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 " /* Check close callback is called. */
+ int close_sentinel = 1;
+ guestfs_set_close_callback (g, incr, &close_sentinel);
+
+ guestfs_close (g);
+
+ if (close_sentinel != 2) {
+ fprintf (stderr, \"close callback was not called\\n\");
+ exit (EXIT_FAILURE);
+ }
+
+ unlink (\"test1.img\");
+ unlink (\"test2.img\");
+ unlink (\"test3.img\");
+
+";
pr " if (n_failed > 0) {\n";
pr " printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
" test_name name (String.uppercase test_name) (String.uppercase name);
(match prereq with
- | Disabled | Always -> ()
+ | Disabled | Always | IfAvailable _ -> ()
| If code | Unless code ->
pr "static int %s_prereq (void)\n" test_name;
pr "{\n";
List.iter (
function
| Optional group ->
- pr " {\n";
- pr " const char *groups[] = { \"%s\", NULL };\n" group;
- pr " int r;\n";
- pr " suppress_error = 1;\n";
- pr " r = guestfs_available (g, (char **) groups);\n";
- pr " suppress_error = 0;\n";
- pr " if (r == -1) {\n";
- pr " printf (\" %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", groups[0]);\n" test_name;
- pr " return 0;\n";
- pr " }\n";
+ pr " if (!is_available (\"%s\")) {\n" group;
+ pr " printf (\" %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", \"%s\");\n" test_name group;
+ pr " return 0;\n";
pr " }\n";
| _ -> ()
) flags;
pr " }\n";
pr "\n";
generate_one_test_body name i test_name init test;
+ | IfAvailable group ->
+ pr " if (!is_available (\"%s\")) {\n" group;
+ pr " printf (\" %%s skipped (reason: %%s not available)\\n\", \"%s\", \"%s\");\n" test_name group;
+ 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
);
| Device n, arg
| Dev_or_Path n, arg
| String n, arg
- | OptString n, arg ->
+ | OptString n, arg
+ | Key n, arg ->
pr " const char *%s = \"%s\";\n" n (c_quote arg);
| BufferIn n, arg ->
pr " const char *%s = \"%s\";\n" n (c_quote arg);
| RString _ -> pr " char *r;\n"; "NULL"
| RStringList _ | RHashtable _ ->
pr " char **r;\n";
- pr " int i;\n";
+ pr " size_t i;\n";
"NULL"
| RStruct (_, typ) ->
pr " struct guestfs_%s *r;\n" typ; "NULL"
| Pathname n, _
| Device n, _ | Dev_or_Path n, _
| String n, _
- | OptString n, _ ->
+ | OptString n, _
+ | Key n, _ ->
pr ", %s" n
| BufferIn n, _ ->
pr ", %s, %s_size" n n
pr "#include \"xstrtol.h\"\n";
pr "#include \"fish.h\"\n";
pr "\n";
+ pr "/* Valid suffixes allowed for numbers. See Gnulib xstrtol function. */\n";
+ pr "static const char *xstrtol_suffixes = \"0kKMGTPEZY\";\n";
+ pr "\n";
(* list_commands function, which implements guestfish -h *)
pr "void list_commands (void)\n";
pr "\n";
(* display_command function, which implements guestfish -h cmd *)
- pr "void display_command (const char *cmd)\n";
+ pr "int display_command (const char *cmd)\n";
pr "{\n";
List.iter (
fun (name, style, _, flags, _, shortdesc, longdesc) ->
match snd style with
| [] -> name2
| args ->
+ let args = List.filter (function Key _ -> false | _ -> true) args in
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)
+ 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
pr " || STRCASEEQ (cmd, \"%s\")" name2;
if name <> alias then
pr " || STRCASEEQ (cmd, \"%s\")" alias;
- pr ")\n";
+ pr ") {\n";
pr " pod2text (\"%s\", _(\"%s\"), %S);\n"
name2 shortdesc
("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
"=head1 DESCRIPTION\n\n" ^
longdesc ^ warnings ^ describe_alias);
+ pr " return 0;\n";
+ pr " }\n";
pr " else\n"
) all_functions;
- pr " display_builtin_command (cmd);\n";
+ pr " return display_builtin_command (cmd);\n";
pr "}\n";
pr "\n";
| Pathname n
| Dev_or_Path n
| FileIn n
- | FileOut n -> pr " char *%s;\n" n
+ | FileOut n
+ | Key n -> pr " char *%s;\n" n
| BufferIn n ->
pr " const char *%s;\n" n;
pr " size_t %s_size;\n" n
) (snd style);
(* Check and convert parameters. *)
- let argc_expected = List.length (snd style) in
+ let argc_expected =
+ let args_no_keys =
+ List.filter (function Key _ -> false | _ -> true) (snd style) in
+ List.length args_no_keys in
pr " if (argc != %d) {\n" argc_expected;
pr " fprintf (stderr, _(\"%%s should have %%d parameter(s)\\n\"), cmd, %d);\n"
argc_expected;
pr " return -1;\n";
pr " }\n";
- let parse_integer fn fntyp rtyp range name i =
+ let parse_integer fn fntyp rtyp range name =
pr " {\n";
pr " strtol_error xerr;\n";
pr " %s r;\n" fntyp;
pr "\n";
- pr " xerr = %s (argv[%d], NULL, 0, &r, \"\");\n" fn i;
+ pr " xerr = %s (argv[i++], NULL, 0, &r, xstrtol_suffixes);\n" fn;
pr " if (xerr != LONGINT_OK) {\n";
pr " fprintf (stderr,\n";
pr " _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n";
pr " }\n";
in
- iteri (
- fun i ->
- function
- | Device name
- | String name ->
- pr " %s = argv[%d];\n" name i
- | Pathname name
- | Dev_or_Path name ->
- pr " %s = resolve_win_path (argv[%d]);\n" name i;
- pr " if (%s == NULL) return -1;\n" name
- | OptString name ->
- pr " %s = STRNEQ (argv[%d], \"\") ? argv[%d] : NULL;\n"
- name i i
- | BufferIn name ->
- pr " %s = argv[%d];\n" name i;
- pr " %s_size = strlen (argv[%d]);\n" name i
- | FileIn name ->
- pr " %s = file_in (argv[%d]);\n" name i;
- pr " if (%s == NULL) return -1;\n" name
- | FileOut name ->
- pr " %s = file_out (argv[%d]);\n" name i;
- pr " if (%s == NULL) return -1;\n" name
- | StringList name | DeviceList name ->
- pr " %s = parse_string_list (argv[%d]);\n" name i;
- pr " if (%s == NULL) return -1;\n" name;
- | Bool name ->
- pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
- | Int name ->
- let range =
- let min = "(-(2LL<<30))"
- and max = "((2LL<<30)-1)"
- and comment =
- "The Int type in the generator is a signed 31 bit int." in
- Some (min, max, comment) in
- parse_integer "xstrtoll" "long long" "int" range name i
- | Int64 name ->
- parse_integer "xstrtoll" "long long" "int64_t" None name i
+ if snd style <> [] then
+ pr " size_t i = 0;\n";
+
+ List.iter (
+ function
+ | Device name
+ | String name ->
+ pr " %s = argv[i++];\n" name
+ | Pathname name
+ | Dev_or_Path name ->
+ pr " %s = resolve_win_path (argv[i++]);\n" name;
+ pr " if (%s == NULL) return -1;\n" name
+ | OptString name ->
+ pr " %s = STRNEQ (argv[i], \"\") ? argv[i] : NULL;\n" name;
+ pr " i++;\n"
+ | BufferIn name ->
+ pr " %s = argv[i];\n" name;
+ pr " %s_size = strlen (argv[i]);\n" name;
+ pr " i++;\n"
+ | FileIn name ->
+ pr " %s = file_in (argv[i++]);\n" name;
+ pr " if (%s == NULL) return -1;\n" name
+ | FileOut name ->
+ pr " %s = file_out (argv[i++]);\n" name;
+ pr " if (%s == NULL) return -1;\n" name
+ | StringList name | DeviceList name ->
+ pr " %s = parse_string_list (argv[i++]);\n" name;
+ pr " if (%s == NULL) return -1;\n" name
+ | Key name ->
+ pr " %s = read_key (\"%s\");\n" name name;
+ pr " if (%s == NULL) return -1;\n" name
+ | Bool name ->
+ pr " %s = is_true (argv[i++]) ? 1 : 0;\n" name
+ | Int name ->
+ let range =
+ let min = "(-(2LL<<30))"
+ and max = "((2LL<<30)-1)"
+ and comment =
+ "The Int type in the generator is a signed 31 bit int." in
+ Some (min, max, comment) in
+ parse_integer "xstrtoll" "long long" "int" range name
+ | Int64 name ->
+ parse_integer "xstrtoll" "long long" "int64_t" None name
) (snd style);
(* Call C API function. *)
List.iter (
function
- | Device name | String name
- | OptString name | Bool name
- | Int name | Int64 name
- | BufferIn name -> ()
- | Pathname name | Dev_or_Path name | FileOut name ->
+ | Device _ | String _
+ | OptString _ | Bool _
+ | Int _ | Int64 _
+ | BufferIn _ -> ()
+ | Pathname name | Dev_or_Path name | FileOut name
+ | Key name ->
pr " free (%s);\n" name
| FileIn name ->
pr " free_file_in (%s);\n" name
static char *
generator (const char *text, int state)
{
- static int index, len;
+ static size_t index, len;
const char *name;
if (!state) {
pr " %s" name;
List.iter (
function
- | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
+ | Pathname n | Device n | Dev_or_Path n | String n ->
+ pr " %s" n
| OptString n -> pr " %s" n
| StringList n | DeviceList n -> pr " '%s ...'" n
| Bool _ -> pr " true|false"
| Int64 n -> pr " %s" n
| FileIn n | FileOut n -> pr " (%s|-)" n
| BufferIn n -> pr " %s" n
+ | Key _ -> () (* keys are entered at a prompt *)
) (snd style);
pr "\n";
pr "\n";
| _ -> false) (snd style) then
pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
+ if List.exists (function Key _ -> true | _ -> false) (snd style) then
+ pr "This command has one or more key or passphrase parameters.
+Guestfish will prompt for these separately.\n\n";
+
if List.mem ProtocolLimitWarning flags then
pr "%s\n\n" protocol_limit_warning;
| Pathname n
| Device n | Dev_or_Path n
| String n
- | OptString n ->
+ | OptString n
+ | Key n ->
next ();
pr "const char *%s" n
| StringList n | DeviceList n ->
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 \"\");
#include <caml/mlvalues.h>
#include <caml/signals.h>
-#include <guestfs.h>
+#include \"guestfs.h\"
#include \"guestfs_c.h\"
{
CAMLparam0 ();
CAMLlocal5 (rv, pairv, kv, vv, cons);
- int i;
+ size_t i;
rv = Val_int (0);
for (i = 0; argv[i] != NULL; i += 2) {
| Device n | Dev_or_Path n
| String n
| FileIn n
- | FileOut n ->
- pr " const char *%s = String_val (%sv);\n" n n
+ | FileOut n
+ | Key n ->
+ (* Copy strings in case the GC moves them: RHBZ#604691 *)
+ pr " char *%s = guestfs_safe_strdup (g, 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
+ pr " char *%s =\n" n;
+ pr " %sv != Val_int (0) ?" n;
+ pr " guestfs_safe_strdup (g, String_val (Field (%sv, 0))) : NULL;\n" n
| BufferIn n ->
- pr " const char *%s = String_val (%sv);\n" n n;
- pr " size_t %s_size = caml_string_length (%sv);\n" n n
+ pr " size_t %s_size = caml_string_length (%sv);\n" n n;
+ pr " char *%s = guestfs_safe_memdup (g, String_val (%sv), %s_size);\n" n n n
| StringList n | DeviceList n ->
pr " char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
| Bool n ->
pr " const char *r;\n"; "NULL"
| RString _ -> pr " char *r;\n"; "NULL"
| RStringList _ ->
- pr " int i;\n";
+ pr " size_t i;\n";
pr " char **r;\n";
"NULL"
| RStruct (_, typ) ->
| RStructList (_, typ) ->
pr " struct guestfs_%s_list *r;\n" typ; "NULL"
| RHashtable _ ->
- pr " int i;\n";
+ pr " size_t i;\n";
pr " char **r;\n";
"NULL"
| RBufferOut _ ->
pr ";\n";
pr " caml_leave_blocking_section ();\n";
+ (* Free strings if we copied them above. *)
List.iter (
function
+ | Pathname n | Device n | Dev_or_Path n | String n | OptString n
+ | FileIn n | FileOut n | BufferIn n | Key n ->
+ pr " free (%s);\n" n
| StringList n | DeviceList n ->
pr " ocaml_guestfs_free_strings (%s);\n" n;
- | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
- | Bool _ | Int _ | Int64 _
- | FileIn _ | FileOut _ | BufferIn _ -> ()
+ | Bool _ | Int _ | Int64 _ -> ()
) (snd style);
pr " if (r == %s)\n" error_code;
List.iter (
function
| Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _
- | BufferIn _ -> pr "string -> "
+ | BufferIn _ | Key _ -> pr "string -> "
| OptString _ -> pr "string option -> "
| StringList _ | DeviceList _ -> pr "string array -> "
| Bool _ -> pr "bool -> "
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
RETVAL
void
-DESTROY (g)
+DESTROY (sv)
+ SV *sv;
+ PPCODE:
+ /* For the 'g' argument above we do the conversion explicitly and
+ * don't rely on the typemap, because if the handle has been
+ * explicitly closed we don't want the typemap conversion to
+ * display an error.
+ */
+ HV *hv = (HV *) SvRV (sv);
+ SV **svp = hv_fetch (hv, \"_g\", 2, 0);
+ if (svp != NULL) {
+ guestfs_h *g = (guestfs_h *) SvIV (*svp);
+ _close_handle (g);
+ }
+
+void
+close (g)
+ guestfs_h *g;
+ PPCODE:
+ _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:
- guestfs_close (g);
+ _clear_progress_callback (g);
";
fun i ->
function
| Pathname n | Device n | Dev_or_Path n | String n
- | FileIn n | FileOut n ->
+ | FileIn n | FileOut n | Key n ->
pr " char *%s;\n" n
| BufferIn n ->
pr " char *%s;\n" n;
| Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
| Bool _ | Int _ | Int64 _
| FileIn _ | FileOut _
- | BufferIn _ -> ()
+ | BufferIn _ | Key _ -> ()
| StringList n | DeviceList n -> pr " free (%s);\n" n
) (snd style)
in
| RStringList n | RHashtable n ->
pr "PREINIT:\n";
pr " char **%s;\n" n;
- pr " int i, n;\n";
+ pr " size_t i, n;\n";
pr " PPCODE:\n";
pr " %s = guestfs_%s " n name;
generate_c_call_args ~handle:"g" style;
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 " size_t i;\n";
pr " HV *hv;\n";
pr " PPCODE:\n";
pr " %s = guestfs_%s " n name;
my $proto = shift;
my $class = ref ($proto) || $proto;
- my $self = Sys::Guestfs::_create ();
+ my $g = Sys::Guestfs::_create ();
+ my $self = { _g => $g };
bless $self, $class;
return $self;
}
+=item $h->close ();
+
+Explicitly close the guestfs handle.
+
+B<Note:> You should not usually call this function. The handle will
+be closed implicitly when its reference count goes to zero (eg.
+when it goes out of scope or the program ends). This call is
+only required in some exceptional cases, such as where the program
+may contain cached references to the handle 'somewhere' and you
+really have to have the close happen right away. After calling
+C<close> the program must not call any method (including C<close>)
+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;
(* Actions. We only need to print documentation for these as
=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.
match arg with
| Pathname n | Device n | Dev_or_Path n | String n
| OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n
- | BufferIn n ->
+ | BufferIn n | Key n ->
pr "$%s" n
| StringList n | DeviceList n ->
pr "\\@%s" n
#define PY_SSIZE_T_CLEAN 1
#include <Python.h>
+#if PY_VERSION_HEX < 0x02050000
+typedef int Py_ssize_t;
+#define PY_SSIZE_T_MAX INT_MAX
+#define PY_SSIZE_T_MIN INT_MIN
+#endif
+
#include <stdio.h>
#include <stdlib.h>
#include <assert.h>
#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. */
static char **
get_string_list (PyObject *obj)
{
- int i, len;
+ size_t i, len;
char **r;
assert (obj);
return NULL;
}
- len = PyList_Size (obj);
+ Py_ssize_t slen = PyList_Size (obj);
+ if (slen == -1) {
+ PyErr_SetString (PyExc_RuntimeError, \"get_string_list: PyList_Size failure\");
+ return NULL;
+ }
+ len = (size_t) slen;
r = malloc (sizeof (char *) * (len+1));
if (r == NULL) {
PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
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);
}
pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
pr "{\n";
pr " PyObject *list;\n";
- pr " int i;\n";
+ pr " size_t i;\n";
pr "\n";
pr " list = PyList_New (%ss->len);\n" typ;
pr " for (i = 0; i < %ss->len; ++i)\n" typ;
List.iter (
function
- | Pathname n | Device n | Dev_or_Path n | String n
+ | Pathname n | Device n | Dev_or_Path n | String n | Key n
| FileIn n | FileOut n ->
pr " const char *%s;\n" n
| OptString n -> pr " const char *%s;\n" n
pr " if (!PyArg_ParseTuple (args, (char *) \"O";
List.iter (
function
- | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | Key _
+ | FileIn _ | FileOut _ -> pr "s"
| OptString _ -> pr "z"
| StringList _ | DeviceList _ -> pr "O"
| Bool _ -> pr "i" (* XXX Python has booleans? *)
pr " &py_g";
List.iter (
function
- | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
+ | Pathname n | Device n | Dev_or_Path n | String n | Key n
+ | FileIn n | FileOut n -> pr ", &%s" n
| OptString n -> pr ", &%s" n
| StringList n | DeviceList n -> pr ", &py_%s" n
| Bool n -> pr ", &%s" n
pr " g = get_handle (py_g);\n";
List.iter (
function
- | Pathname _ | Device _ | Dev_or_Path _ | String _
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | Key _
| FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _
| BufferIn _ -> ()
| StringList n | DeviceList n ->
List.iter (
function
- | Pathname _ | Device _ | Dev_or_Path _ | String _
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | Key _
| FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _
| BufferIn _ -> ()
| StringList n | DeviceList n ->
List.iter (
function
- | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
+ | Pathname n | Device n | Dev_or_Path n | String n | Key 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 " char **%s;\n" n;
pr " Check_Type (%sv, T_ARRAY);\n" n;
pr " {\n";
- pr " int i, len;\n";
+ pr " size_t i, len;\n";
pr " len = RARRAY_LEN (%sv);\n" n;
pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
n;
List.iter (
function
- | Pathname _ | Device _ | Dev_or_Path _ | String _
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | Key _
| FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _
| BufferIn _ -> ()
| StringList n | DeviceList n ->
pr " free (r);\n";
pr " return rv;\n";
| RStringList _ ->
- pr " int i, len = 0;\n";
+ pr " size_t 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";
generate_ruby_struct_list_code typ cols
| RHashtable _ ->
pr " VALUE rv = rb_hash_new ();\n";
- pr " int i;\n";
+ pr " size_t 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";
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);
(* 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 " size_t i;\n";
pr " for (i = 0; i < r->len; ++i) {\n";
pr " VALUE hv = rb_hash_new ();\n";
List.iter (
| String n
| OptString n
| FileIn n
- | FileOut n ->
+ | FileOut n
+ | Key n ->
pr "String %s" n
| BufferIn n ->
pr "byte[] %s" n
| String n
| OptString n
| FileIn n
- | FileOut n ->
+ | FileOut n
+ | Key n ->
pr ", jstring j%s" n
| BufferIn n ->
pr ", jbyteArray j%s" n
| String n
| OptString n
| FileIn n
- | FileOut n ->
+ | FileOut n
+ | Key n ->
pr " const char *%s;\n" n
| BufferIn n ->
pr " jbyte *%s;\n" n;
| DeviceList _ -> true
| _ -> false) (snd style) in
if needs_i then
- pr " int i;\n";
+ pr " size_t i;\n";
pr "\n";
| Device n | Dev_or_Path n
| String n
| FileIn n
- | FileOut n ->
+ | FileOut n
+ | Key n ->
pr " %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
| OptString n ->
(* This is completely undocumented, but Java null becomes
| Device n | Dev_or_Path n
| String n
| FileIn n
- | FileOut n ->
+ | FileOut n
+ | Key n ->
pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
| OptString n ->
pr " if (j%s)\n" n;
function
| FileIn n
| FileOut n
- | Pathname n | Device n | Dev_or_Path n | String n ->
+ | Pathname n | Device n | Dev_or_Path n | String n | Key n ->
pr "withCString %s $ \\%s -> " n n
| BufferIn n ->
pr "withCStringLen %s $ \\(%s, %s_size) -> " n n n
| Int n -> sprintf "(fromIntegral %s)" n
| Int64 n -> sprintf "(fromIntegral %s)" n
| FileIn n | FileOut n
- | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
+ | Pathname n | Device n | Dev_or_Path n
+ | String n | OptString n
+ | StringList n | DeviceList n
+ | Key n -> n
| BufferIn n -> sprintf "%s (fromIntegral %s_size)" n n
) (snd style) in
pr "withForeignPtr h (\\p -> c_%s %s)\n" name
List.iter (
fun arg ->
(match arg with
- | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | Key _ ->
+ pr "%s" string
| BufferIn _ ->
if hs then pr "String"
else pr "CString -> CInt"
function
| Pathname n | Device n | Dev_or_Path n | String n | OptString n
| FileIn n | FileOut n
+ | Key n
| BufferIn n ->
pr ", [In] string %s" n
| StringList n | DeviceList n ->
function
| Pathname n | Device n | Dev_or_Path n | String n | OptString n
| FileIn n | FileOut n
+ | Key n
| BufferIn n ->
next (); pr "string %s" n
| StringList n | DeviceList n ->
pr " return r != 0 ? true : false;\n"
| RHashtable _ ->
pr " Hashtable rr = new Hashtable ();\n";
- pr " for (int i = 0; i < r.Length; i += 2)\n";
+ pr " for (size_t i = 0; i < r.Length; i += 2)\n";
pr " rr.Add (r[i], r[i+1]);\n";
pr " return rr;\n"
| RInt _ | RInt64 _ | RConstString _ | RConstOptString _
static void
print_strings (char *const *argv)
{
- int argc;
+ size_t argc;
printf (\"[\");
for (argc = 0; argv[argc] != NULL; ++argc) {
| Device n | Dev_or_Path n
| String n
| FileIn n
- | FileOut n -> pr " printf (\"%%s\\n\", %s);\n" n
+ | FileOut n
+ | Key n -> pr " printf (\"%%s\\n\", %s);\n" n
| BufferIn n ->
- pr " for (size_t i = 0; i < %s_size; ++i)\n" n;
- pr " printf (\"<%%02x>\", %s[i]);\n" n;
- pr " printf (\"\\n\");\n"
+ pr " {\n";
+ pr " size_t i;\n";
+ pr " for (i = 0; i < %s_size; ++i)\n" n;
+ pr " printf (\"<%%02x>\", %s[i]);\n" n;
+ pr " printf (\"\\n\");\n";
+ pr " }\n";
| OptString n -> pr " printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
| StringList n | DeviceList n -> pr " print_strings (%s);\n" n
| Bool n -> pr " printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
(* 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 "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;
git.annexia.org / libguestfs.git / blobdiff