#!/usr/bin/env ocaml
(* libguestfs
- * Copyright (C) 2009 Red Hat Inc.
+ * Copyright (C) 2009-2010 Red Hat Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* all the daemon actions.
*
* To add a new action there are only two files you need to change,
- * this one to describe the interface (see the big table below), and
- * daemon/<somefile>.c to write the implementation.
+ * this one to describe the interface (see the big table of
+ * 'daemon_functions' below), and daemon/<somefile>.c to write the
+ * implementation.
*
- * After editing this file, run it (./src/generator.ml) to regenerate all the
- * output files. Note that if you are using a separate build directory you
- * must run generator.ml from the _source_ directory.
+ * After editing this file, run it (./src/generator.ml) to regenerate
+ * all the output files. 'make' will rerun this automatically when
+ * necessary. Note that if you are using a separate build directory
+ * you must run generator.ml from the _source_ directory.
*
* IMPORTANT: This script should NOT print any warnings. If it prints
* warnings, you should treat them as errors.
+ *
+ * OCaml tips:
+ * (1) In emacs, install tuareg-mode to display and format OCaml code
+ * correctly. 'vim' comes with a good OCaml editing mode by default.
+ * (2) Read the resources at http://ocaml-tutorial.org/
*)
#load "unix.cma";;
#load "str.cma";;
+#directory "+xml-light";;
+#directory "+../pkg-lib/xml-light";; (* for GODI users *)
+#load "xml-light.cma";;
+open Unix
open Printf
type style = ret * args
| DangerWillRobinson (* flags particularly dangerous commands *)
| FishAlias of string (* provide an alias for this cmd in guestfish *)
| FishAction of string (* call this function in guestfish *)
+ | FishOutput of fish_output_t (* how to display output in guestfish *)
| NotInFish (* do not export via guestfish *)
| 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 *)
+
+and fish_output_t =
+ | FishOutputOctal (* for int return, print in octal *)
+ | FishOutputHexadecimal (* for int return, print in hex *)
(* You can supply zero or as many tests as you want per API call.
*
(* Generate a random UUID (used in tests). *)
let uuidgen () =
- let chan = Unix.open_process_in "uuidgen" in
+ let chan = open_process_in "uuidgen" in
let uuid = input_line chan in
- (match Unix.close_process_in chan with
- | Unix.WEXITED 0 -> ()
- | Unix.WEXITED _ ->
+ (match close_process_in chan with
+ | WEXITED 0 -> ()
+ | WEXITED _ ->
failwith "uuidgen: process exited with non-zero status"
- | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
+ | WSIGNALED _ | WSTOPPED _ ->
failwith "uuidgen: process signalled or stopped by signal"
);
uuid
This is equivalent to the qemu parameter
C<-drive file=filename,cache=off,if=...>.
+
C<cache=off> is omitted in cases where it is not supported by
the underlying filesystem.
+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>.
+
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 is equivalent to the qemu parameter C<-cdrom filename>.
-Note that this call checks for the existence of C<filename>. This
+Notes:
+
+=over 4
+
+=item *
+
+This call checks for the existence of C<filename>. This
stops you from specifying other types of drive which are supported
by qemu such as C<nbd:> and C<http:> URLs. To specify those, use
-the general C<guestfs_config> call instead.");
+the general C<guestfs_config> call instead.
+
+=item *
+
+If you just want to add an ISO file (often you use this as an
+efficient way to transfer large files into the guest), then you
+should probably use C<guestfs_add_drive_ro> instead.
+
+=back");
("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"],
[],
changes to be committed, although qemu can support this.
This is equivalent to the qemu parameter
-C<-drive file=filename,snapshot=on,if=...>.
+C<-drive file=filename,snapshot=on,readonly=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
You can also override this by setting the C<LIBGUESTFS_QEMU>
environment variable.
-Setting C<qemu> to C<NULL> restores the default qemu binary.");
+Setting C<qemu> to C<NULL> restores the default qemu binary.
+
+Note that you should call this function as early as possible
+after creating the handle. This is because some pre-launch
+operations depend on testing qemu features (by running C<qemu -help>).
+If the qemu binary changes, we don't retest features, and
+so you might see inconsistent results. Using the environment
+variable C<LIBGUESTFS_QEMU> is safest of all since that picks
+the qemu binary at the same time as the handle is created.");
("get_qemu", (RConstString "qemu", []), -1, [],
[InitNone, Always, TestRun (
C<$major.$minor.$release$extra>
I<Note:> Don't use this call to test for availability
-of features. Distro backports makes this unreliable.");
+of features. Distro backports makes this unreliable. Use
+C<guestfs_available> instead.");
("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
[InitNone, Always, TestOutputTrue (
"\
Return the recovery process enabled flag.");
+ ("add_drive_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
+ [],
+ "add a drive specifying the QEMU block emulation to use",
+ "\
+This is the same as C<guestfs_add_drive> but it allows you
+to specify the QEMU interface emulation to use at run time.");
+
+ ("add_drive_ro_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
+ [],
+ "add a drive read-only specifying the QEMU block emulation to use",
+ "\
+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.");
+
]
(* daemon_functions are any functions which cause some action
let daemon_functions = [
("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [],
[InitEmpty, Always, TestOutput (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext2"; "/dev/sda1"];
["mount"; "/dev/sda1"; "/"];
["write_file"; "/new"; "new file contents"; "0"];
This does not return logical volumes. For that you will need to
call C<guestfs_lvs>.");
- ("pvs", (RStringList "physvols", []), 9, [],
+ ("pvs", (RStringList "physvols", []), 9, [Optional "lvm2"],
[InitBasicFSonLVM, Always, TestOutputListOfDevices (
[["pvs"]], ["/dev/sda1"]);
InitEmpty, Always, TestOutputListOfDevices (
See also C<guestfs_pvs_full>.");
- ("vgs", (RStringList "volgroups", []), 10, [],
+ ("vgs", (RStringList "volgroups", []), 10, [Optional "lvm2"],
[InitBasicFSonLVM, Always, TestOutputList (
[["vgs"]], ["VG"]);
InitEmpty, Always, TestOutputList (
See also C<guestfs_vgs_full>.");
- ("lvs", (RStringList "logvols", []), 11, [],
+ ("lvs", (RStringList "logvols", []), 11, [Optional "lvm2"],
[InitBasicFSonLVM, Always, TestOutputList (
[["lvs"]], ["/dev/VG/LV"]);
InitEmpty, Always, TestOutputList (
See also C<guestfs_lvs_full>.");
- ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [],
+ ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [Optional "lvm2"],
[], (* XXX how to test? *)
"list the LVM physical volumes (PVs)",
"\
List all the physical volumes detected. This is the equivalent
of the L<pvs(8)> command. The \"full\" version includes all fields.");
- ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [],
+ ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [Optional "lvm2"],
[], (* XXX how to test? *)
"list the LVM volume groups (VGs)",
"\
List all the volumes groups detected. This is the equivalent
of the L<vgs(8)> command. The \"full\" version includes all fields.");
- ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [],
+ ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [Optional "lvm2"],
[], (* XXX how to test? *)
"list the LVM logical volumes (LVs)",
"\
as end of line). For those you need to use the C<guestfs_read_file>
function which has a more complex interface.");
- ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [],
+ ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"create a new Augeas handle",
"\
To find out more about Augeas, see L<http://augeas.net/>.");
- ("aug_close", (RErr, []), 26, [],
+ ("aug_close", (RErr, []), 26, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"close the current Augeas handle",
"\
C<guestfs_aug_init> again before you can use any other
Augeas functions.");
- ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
+ ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"define an Augeas variable",
"\
On success this returns the number of nodes in C<expr>, or
C<0> if C<expr> evaluates to something which is not a nodeset.");
- ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [],
+ ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"define an Augeas node",
"\
number of nodes in the nodeset, and a boolean flag
if a node was created.");
- ("aug_get", (RString "val", [String "augpath"]), 19, [],
+ ("aug_get", (RString "val", [String "augpath"]), 19, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"look up the value of an Augeas path",
"\
Look up the value associated with C<path>. If C<path>
matches exactly one node, the C<value> is returned.");
- ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [],
+ ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"set Augeas path to value",
"\
-Set the value associated with C<path> to C<value>.");
+Set the value associated with C<path> to C<val>.
+
+In the Augeas API, it is possible to clear a node by setting
+the value to NULL. Due to an oversight in the libguestfs API
+you cannot do that with this call. Instead you must use the
+C<guestfs_aug_clear> call.");
- ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [],
+ ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"insert a sibling Augeas node",
"\
C<label> must be a label, ie. not contain C</>, C<*> or end
with a bracketed index C<[N]>.");
- ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [],
+ ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"remove an Augeas path",
"\
On success this returns the number of entries which were removed.");
- ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
+ ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"move Augeas node",
"\
Move the node C<src> to C<dest>. C<src> must match exactly
one node. C<dest> is overwritten if it exists.");
- ("aug_match", (RStringList "matches", [String "augpath"]), 24, [],
+ ("aug_match", (RStringList "matches", [String "augpath"]), 24, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"return Augeas nodes which match augpath",
"\
The returned paths are sufficiently qualified so that they match
exactly one node in the current tree.");
- ("aug_save", (RErr, []), 25, [],
+ ("aug_save", (RErr, []), 25, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"write all pending Augeas changes to disk",
"\
The flags which were passed to C<guestfs_aug_init> affect exactly
how files are saved.");
- ("aug_load", (RErr, []), 27, [],
+ ("aug_load", (RErr, []), 27, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"load files into the tree",
"\
See C<aug_load> in the Augeas documentation for the full gory
details.");
- ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [],
+ ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"list Augeas nodes under augpath",
"\
"change file mode",
"\
Change the mode (permissions) of C<path> to C<mode>. Only
-numeric modes are supported.");
+numeric modes are supported.
+
+I<Note>: When using this command from guestfish, C<mode>
+by default would be decimal, unless you prefix it with
+C<0> to get octal, ie. use C<0700> not C<700>.
+
+The mode actually set is affected by the umask.");
("chown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 35, [],
[], (* XXX Need stat command to test *)
See also C<guestfs_stat>.");
- ("pvcreate", (RErr, [Device "device"]), 39, [],
+ ("pvcreate", (RErr, [Device "device"]), 39, [Optional "lvm2"],
[InitEmpty, Always, TestOutputListOfDevices (
[["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
["pvcreate"; "/dev/sda1"];
where C<device> should usually be a partition name such
as C</dev/sda1>.");
- ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [],
+ ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [Optional "lvm2"],
[InitEmpty, Always, TestOutputList (
[["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
["pvcreate"; "/dev/sda1"];
This creates an LVM volume group called C<volgroup>
from the non-empty list of physical volumes C<physvols>.");
- ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
+ ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [Optional "lvm2"],
[InitEmpty, Always, TestOutputList (
[["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
["pvcreate"; "/dev/sda1"];
["lvs"]],
["/dev/VG1/LV1"; "/dev/VG1/LV2";
"/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
- "create an LVM volume group",
+ "create an LVM logical volume",
"\
-This creates an LVM volume group called C<logvol>
+This creates an LVM logical volume called C<logvol>
on the volume group C<volgroup>, with C<size> megabytes.");
("mkfs", (RErr, [String "fstype"; Device "device"]), 42, [],
[InitEmpty, Always, TestOutput (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext2"; "/dev/sda1"];
- ["mount"; "/dev/sda1"; "/"];
+ ["mount_options"; ""; "/dev/sda1"; "/"];
["write_file"; "/new"; "new file contents"; "0"];
["cat"; "/new"]], "new file contents")],
"make a filesystem",
pass C<lines> as a single element list, when the single element being
the string C<,> (comma).
-See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>");
+See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>,
+C<guestfs_part_init>");
("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
[InitBasicFS, Always, TestOutput (
("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
[InitEmpty, Always, TestOutputListOfDevices (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext2"; "/dev/sda1"];
- ["mount"; "/dev/sda1"; "/"];
+ ["mount_options"; ""; "/dev/sda1"; "/"];
["mounts"]], ["/dev/sda1"]);
InitEmpty, Always, TestOutputList (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext2"; "/dev/sda1"];
- ["mount"; "/dev/sda1"; "/"];
+ ["mount_options"; ""; "/dev/sda1"; "/"];
["umount"; "/"];
["mounts"]], [])],
"unmount a filesystem",
["mkfs"; "ext2"; "/dev/sda1"];
["mkfs"; "ext2"; "/dev/sda2"];
["mkfs"; "ext2"; "/dev/sda3"];
- ["mount"; "/dev/sda1"; "/"];
+ ["mount_options"; ""; "/dev/sda1"; "/"];
["mkdir"; "/mp1"];
- ["mount"; "/dev/sda2"; "/mp1"];
+ ["mount_options"; ""; "/dev/sda2"; "/mp1"];
["mkdir"; "/mp1/mp2"];
- ["mount"; "/dev/sda3"; "/mp1/mp2"];
+ ["mount_options"; ""; "/dev/sda3"; "/mp1/mp2"];
["mkdir"; "/mp1/mp2/mp3"];
["umount_all"];
["mounts"]], [])],
Some internal mounts are not unmounted by this call.");
- ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
+ ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson; Optional "lvm2"],
[],
"remove all LVM LVs, VGs and PVs",
"\
This uses the L<blockdev(8)> command.");
- ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
+ ("upload", (RErr, [FileIn "filename"; Dev_or_Path "remotefilename"]), 66, [],
[InitBasicFS, Always, TestOutput (
(* Pick a file from cwd which isn't likely to change. *)
[["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
["checksum"; "md5"; "/COPYING.LIB"]],
- Digest.to_hex (Digest.file "COPYING.LIB"))],
+ Digest.to_hex (Digest.file "COPYING.LIB"))],
"upload a file from the local machine",
"\
Upload local file C<filename> to C<remotefilename> on the
["download"; "/COPYING.LIB"; "testdownload.tmp"];
["upload"; "testdownload.tmp"; "/upload"];
["checksum"; "md5"; "/upload"]],
- Digest.to_hex (Digest.file "COPYING.LIB"))],
+ Digest.to_hex (Digest.file "COPYING.LIB"))],
"download a file to the local machine",
"\
Download file C<remotefilename> and save it as C<filename>
This command uploads and unpacks local file C<tarfile> (an
I<uncompressed> tar file) into C<directory>.
-To upload a compressed tarball, use C<guestfs_tgz_in>.");
+To upload a compressed tarball, use C<guestfs_tgz_in>
+or C<guestfs_txz_in>.");
("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
[],
This command packs the contents of C<directory> and downloads
it to local file C<tarfile>.
-To download a compressed tarball, use C<guestfs_tgz_out>.");
+To download a compressed tarball, use C<guestfs_tgz_out>
+or C<guestfs_txz_out>.");
("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
[InitBasicFS, Always, TestOutput (
to look at the file C<daemon/debug.c> in the libguestfs source
to find out what you can do.");
- ("lvremove", (RErr, [Device "device"]), 77, [],
+ ("lvremove", (RErr, [Device "device"]), 77, [Optional "lvm2"],
[InitEmpty, Always, TestOutputList (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV1"; "VG"; "50"];
["lvremove"; "/dev/VG/LV1"];
["lvs"]], ["/dev/VG/LV2"]);
InitEmpty, Always, TestOutputList (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV1"; "VG"; "50"];
["lvremove"; "/dev/VG"];
["lvs"]], []);
InitEmpty, Always, TestOutputList (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV1"; "VG"; "50"];
You can also remove all LVs in a volume group by specifying
the VG name, C</dev/VG>.");
- ("vgremove", (RErr, [String "vgname"]), 78, [],
+ ("vgremove", (RErr, [String "vgname"]), 78, [Optional "lvm2"],
[InitEmpty, Always, TestOutputList (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV1"; "VG"; "50"];
["vgremove"; "VG"];
["lvs"]], []);
InitEmpty, Always, TestOutputList (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV1"; "VG"; "50"];
This also forcibly removes all logical volumes in the volume
group (if any).");
- ("pvremove", (RErr, [Device "device"]), 79, [],
+ ("pvremove", (RErr, [Device "device"]), 79, [Optional "lvm2"],
[InitEmpty, Always, TestOutputListOfDevices (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV1"; "VG"; "50"];
["pvremove"; "/dev/sda1"];
["lvs"]], []);
InitEmpty, Always, TestOutputListOfDevices (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV1"; "VG"; "50"];
["pvremove"; "/dev/sda1"];
["vgs"]], []);
InitEmpty, Always, TestOutputListOfDevices (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV1"; "VG"; "50"];
This returns the ext2/3/4 filesystem UUID of the filesystem on
C<device>.");
- ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [],
+ ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [FishOutput FishOutputHexadecimal],
[InitBasicFS, Always, TestOutputInt (
[["umount"; "/dev/sda1"];
["fsck"; "ext2"; "/dev/sda1"]], 0);
to securely wipe the device). It should be sufficient to remove
any partition tables, filesystem superblocks and so on.
-See also: C<guestfs_scrub_device>.");
+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.
This runs C<hexdump -C> on the given C<path>. The result is
the human-readable, canonical hex dump of the file.");
- ("zerofree", (RErr, [Device "device"]), 97, [],
+ ("zerofree", (RErr, [Device "device"]), 97, [Optional "zerofree"],
[InitNone, Always, TestOutput (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext3"; "/dev/sda1"];
- ["mount"; "/dev/sda1"; "/"];
+ ["mount_options"; ""; "/dev/sda1"; "/"];
["write_file"; "/new"; "test file"; "0"];
["umount"; "/dev/sda1"];
["zerofree"; "/dev/sda1"];
- ["mount"; "/dev/sda1"; "/"];
+ ["mount_options"; ""; "/dev/sda1"; "/"];
["cat"; "/new"]], "test file")],
"zero unused inodes and disk blocks on ext2/3 filesystem",
"\
It is possible that using this program can damage the filesystem
or data on the filesystem.");
- ("pvresize", (RErr, [Device "device"]), 98, [],
+ ("pvresize", (RErr, [Device "device"]), 98, [Optional "lvm2"],
[],
"resize an LVM physical volume",
"\
partition C<n> (note: C<n> counts from 1).
For other parameters, see C<guestfs_sfdisk>. You should usually
-pass C<0> for the cyls/heads/sectors parameters.");
+pass C<0> for the cyls/heads/sectors parameters.
+
+See also: C<guestfs_part_add>");
("sfdisk_l", (RString "partitions", [Device "device"]), 100, [],
[],
"\
This displays the partition table on C<device>, in the
human-readable output of the L<sfdisk(8)> command. It is
-not intended to be parsed.");
+not intended to be parsed.
+
+See also: C<guestfs_part_list>");
("sfdisk_kernel_geometry", (RString "partitions", [Device "device"]), 101, [],
[],
The result is in human-readable format, and not designed to
be parsed.");
- ("vg_activate_all", (RErr, [Bool "activate"]), 103, [],
+ ("vg_activate_all", (RErr, [Bool "activate"]), 103, [Optional "lvm2"],
[],
"activate or deactivate all volume groups",
"\
This command is the same as running C<vgchange -a y|n>");
- ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [],
+ ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [Optional "lvm2"],
[],
"activate or deactivate some volume groups",
"\
Note that if C<volgroups> is an empty list then B<all> volume groups
are activated or deactivated.");
- ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [],
+ ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [Optional "lvm2"],
[InitNone, Always, TestOutput (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV"; "VG"; "10"];
["mkfs"; "ext2"; "/dev/VG/LV"];
- ["mount"; "/dev/VG/LV"; "/"];
+ ["mount_options"; ""; "/dev/VG/LV"; "/"];
["write_file"; "/new"; "test content"; "0"];
["umount"; "/"];
["lvresize"; "/dev/VG/LV"; "20"];
["e2fsck_f"; "/dev/VG/LV"];
["resize2fs"; "/dev/VG/LV"];
- ["mount"; "/dev/VG/LV"; "/"];
+ ["mount_options"; ""; "/dev/VG/LV"; "/"];
["cat"; "/new"]], "test content")],
"resize an LVM logical volume",
"\
"\
Sleep for C<secs> seconds.");
- ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [],
+ ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [Optional "ntfs3g"],
[InitNone, Always, TestOutputInt (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ntfs"; "/dev/sda1"];
["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0);
InitNone, Always, TestOutputInt (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext2"; "/dev/sda1"];
["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)],
"probe NTFS volume",
with flags C<GLOB_MARK|GLOB_BRACE>.
See that manual page for more details.");
- ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson],
+ ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson; Optional "scrub"],
[InitNone, Always, TestRun ( (* use /dev/sdc because it's smaller *)
[["scrub_device"; "/dev/sdc"]])],
"scrub (securely wipe) a device",
It is an interface to the L<scrub(1)> program. See that
manual page for more details.");
- ("scrub_file", (RErr, [Pathname "file"]), 115, [],
+ ("scrub_file", (RErr, [Pathname "file"]), 115, [Optional "scrub"],
[InitBasicFS, Always, TestRun (
[["write_file"; "/file"; "content"; "0"];
["scrub_file"; "/file"]])],
It is an interface to the L<scrub(1)> program. See that
manual page for more details.");
- ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [],
+ ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [Optional "scrub"],
[], (* XXX needs testing *)
"scrub (securely wipe) free space",
"\
("mkswap", (RErr, [Device "device"]), 130, [],
[InitEmpty, Always, TestRun (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkswap"; "/dev/sda1"]])],
"create a swap partition",
"\
("mkswap_L", (RErr, [String "label"; Device "device"]), 131, [],
[InitEmpty, Always, TestRun (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkswap_L"; "hello"; "/dev/sda1"]])],
"create a swap partition with a label",
"\
(eg. C</dev/sda>), just to a partition. This appears to be
a limitation of the kernel or swap tools.");
- ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [],
+ ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [Optional "linuxfsuuid"],
(let uuid = uuidgen () in
[InitEmpty, Always, TestRun (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkswap_U"; uuid; "/dev/sda1"]])]),
"create a swap partition with an explicit UUID",
"\
Create a swap partition on C<device> with UUID C<uuid>.");
- ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [],
+ ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [Optional "mknod"],
[InitBasicFS, Always, TestOutputStruct (
[["mknod"; "0o10777"; "0"; "0"; "/node"];
(* NB: default umask 022 means 0777 -> 0755 in these tests *)
The C<mode> parameter should be the mode, using the standard
constants. C<devmajor> and C<devminor> are the
device major and minor numbers, only used when creating block
-and character special devices.");
+and character special devices.
- ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [],
+The mode actually set is affected by the umask.");
+
+ ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [Optional "mknod"],
[InitBasicFS, Always, TestOutputStruct (
[["mkfifo"; "0o777"; "/node"];
["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
"\
This call creates a FIFO (named pipe) called C<path> with
mode C<mode>. It is just a convenient wrapper around
-C<guestfs_mknod>.");
+C<guestfs_mknod>.
+
+The mode actually set is affected by the umask.");
- ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [],
+ ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [Optional "mknod"],
[InitBasicFS, Always, TestOutputStruct (
[["mknod_b"; "0o777"; "99"; "66"; "/node"];
["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
"\
This call creates a block device node called C<path> with
mode C<mode> and device major/minor C<devmajor> and C<devminor>.
-It is just a convenient wrapper around C<guestfs_mknod>.");
+It is just a convenient wrapper around C<guestfs_mknod>.
- ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [],
+The mode actually set is affected by the umask.");
+
+ ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [Optional "mknod"],
[InitBasicFS, Always, TestOutputStruct (
[["mknod_c"; "0o777"; "99"; "66"; "/node"];
["stat"; "/node"]], [CompareWithInt ("mode", 0o20755)])],
"\
This call creates a char device node called C<path> with
mode C<mode> and device major/minor C<devmajor> and C<devminor>.
-It is just a convenient wrapper around C<guestfs_mknod>.");
+It is just a convenient wrapper around C<guestfs_mknod>.
- ("umask", (RInt "oldmask", [Int "mask"]), 137, [],
- [], (* XXX umask is one of those stateful things that we should
- * reset between each test.
- *)
+The mode actually set is affected by the umask.");
+
+ ("umask", (RInt "oldmask", [Int "mask"]), 137, [FishOutput FishOutputOctal],
+ [InitEmpty, Always, TestOutputInt (
+ [["umask"; "0o22"]], 0o22)],
"set file mode creation mask (umask)",
"\
This function sets the mask used for creating new files and
means that directories and device nodes will be created with
C<0644> or C<0755> mode even if you specify C<0777>.
-See also L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
+See also C<guestfs_get_umask>,
+L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
This call returns the previous umask.");
to specify the cyls, heads and sectors parameters which
were rarely if ever used anyway.
-See also C<guestfs_sfdisk> and the L<sfdisk(8)> manpage.");
+See also: C<guestfs_sfdisk>, the L<sfdisk(8)> manpage
+and C<guestfs_part_disk>");
("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
[],
Since 1.0.63, use C<guestfs_file> instead which can now
process compressed files.");
- ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [],
+ ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [Optional "linuxxattrs"],
[],
"list extended attributes of a file or directory",
"\
See also: C<guestfs_lgetxattrs>, L<attr(5)>.");
- ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [],
+ ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [Optional "linuxxattrs"],
[],
"list extended attributes of a file or directory",
"\
("setxattr", (RErr, [String "xattr";
String "val"; Int "vallen"; (* will be BufferIn *)
- Pathname "path"]), 143, [],
+ Pathname "path"]), 143, [Optional "linuxxattrs"],
[],
"set extended attribute of a file or directory",
"\
("lsetxattr", (RErr, [String "xattr";
String "val"; Int "vallen"; (* will be BufferIn *)
- Pathname "path"]), 144, [],
+ Pathname "path"]), 144, [Optional "linuxxattrs"],
[],
"set extended attribute of a file or directory",
"\
is a symbolic link, then it sets an extended attribute
of the link itself.");
- ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [],
+ ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [Optional "linuxxattrs"],
[],
"remove extended attribute of a file or directory",
"\
See also: C<guestfs_lremovexattr>, L<attr(5)>.");
- ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [],
+ ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [Optional "linuxxattrs"],
[],
"remove extended attribute of a file or directory",
"\
device name to directory where the device is mounted.");
("mkmountpoint", (RErr, [String "exemptpath"]), 148, [],
- (* This is a special case: while you would expect a parameter
- * of type "Pathname", that doesn't work, because it implies
- * NEED_ROOT in the generated calling code in stubs.c, and
- * this function cannot use NEED_ROOT.
- *)
+ (* This is a special case: while you would expect a parameter
+ * of type "Pathname", that doesn't work, because it implies
+ * NEED_ROOT in the generated calling code in stubs.c, and
+ * this function cannot use NEED_ROOT.
+ *)
[],
"create a mountpoint",
"\
This calls the external C<zfgrep -i> program and returns the
matching lines.");
- ("realpath", (RString "rpath", [Pathname "path"]), 163, [],
+ ("realpath", (RString "rpath", [Pathname "path"]), 163, [Optional "realpath"],
[InitISOFS, Always, TestOutput (
[["realpath"; "/../directory"]], "/directory")],
"canonicalized absolute pathname",
("swapon_label", (RErr, [String "label"]), 174, [],
[InitEmpty, Always, TestRun (
- [["sfdiskM"; "/dev/sdb"; ","];
+ [["part_disk"; "/dev/sdb"; "mbr"];
["mkswap_L"; "swapit"; "/dev/sdb1"];
["swapon_label"; "swapit"];
["swapoff_label"; "swapit"];
This command disables the libguestfs appliance swap on
labeled swap partition.");
- ("swapon_uuid", (RErr, [String "uuid"]), 176, [],
+ ("swapon_uuid", (RErr, [String "uuid"]), 176, [Optional "linuxfsuuid"],
(let uuid = uuidgen () in
[InitEmpty, Always, TestRun (
[["mkswap_U"; uuid; "/dev/sdb"];
This command enables swap to a swap partition with the given UUID.
See C<guestfs_swapon_device> for other notes.");
- ("swapoff_uuid", (RErr, [String "uuid"]), 177, [],
+ ("swapoff_uuid", (RErr, [String "uuid"]), 177, [Optional "linuxfsuuid"],
[], (* XXX tested by swapon_uuid *)
"disable swap on swap partition by UUID",
"\
This command just writes a swap file signature to an existing
file. To create the file itself, use something like C<guestfs_fallocate>.");
- ("inotify_init", (RErr, [Int "maxevents"]), 179, [],
+ ("inotify_init", (RErr, [Int "maxevents"]), 179, [Optional "inotify"],
[InitISOFS, Always, TestRun (
[["inotify_init"; "0"]])],
"create an inotify handle",
via libguestfs. Note that there is one global inotify handle
per libguestfs instance.");
- ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [],
+ ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [Optional "inotify"],
[InitBasicFS, Always, TestOutputList (
[["inotify_init"; "0"];
["inotify_add_watch"; "/"; "1073741823"];
defined by the Linux kernel ABI and are listed in
C</usr/include/sys/inotify.h>.");
- ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [],
+ ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [Optional "inotify"],
[],
"remove an inotify watch",
"\
Remove a previously defined inotify watch.
See C<guestfs_inotify_add_watch>.");
- ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [],
+ ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [Optional "inotify"],
[],
"return list of inotify events",
"\
read events up to the maximum appliance-to-host message
size and leave remaining events in the queue.");
- ("inotify_files", (RStringList "paths", []), 183, [],
+ ("inotify_files", (RStringList "paths", []), 183, [Optional "inotify"],
[],
"return list of watched files that had events",
"\
which just returns a list of pathnames of objects that were
touched. The returned pathnames are sorted and deduplicated.");
- ("inotify_close", (RErr, []), 184, [],
+ ("inotify_close", (RErr, []), 184, [Optional "inotify"],
[],
"close the inotify handle",
"\
opened by inotify_init. It removes all watches, throws
away any pending events, and deallocates all resources.");
- ("setcon", (RErr, [String "context"]), 185, [],
+ ("setcon", (RErr, [String "context"]), 185, [Optional "selinux"],
[],
"set SELinux security context",
"\
See the documentation about SELINUX in L<guestfs(3)>.");
- ("getcon", (RString "context", []), 186, [],
+ ("getcon", (RString "context", []), 186, [Optional "selinux"],
[],
"get SELinux security context",
"\
("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
[InitEmpty, Always, TestOutput (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
- ["mount"; "/dev/sda1"; "/"];
+ ["mount_options"; ""; "/dev/sda1"; "/"];
["write_file"; "/new"; "new file contents"; "0"];
["cat"; "/new"]], "new file contents")],
"make a filesystem with block size",
[["sfdiskM"; "/dev/sda"; ",100 ,"];
["mke2journal"; "4096"; "/dev/sda1"];
["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
- ["mount"; "/dev/sda2"; "/"];
+ ["mount_options"; ""; "/dev/sda2"; "/"];
["write_file"; "/new"; "new file contents"; "0"];
["cat"; "/new"]], "new file contents")],
"make ext2/3/4 external journal",
[["sfdiskM"; "/dev/sda"; ",100 ,"];
["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
- ["mount"; "/dev/sda2"; "/"];
+ ["mount_options"; ""; "/dev/sda2"; "/"];
["write_file"; "/new"; "new file contents"; "0"];
["cat"; "/new"]], "new file contents")],
"make ext2/3/4 external journal with label",
"\
This creates an ext2 external journal on C<device> with label C<label>.");
- ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [],
+ ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [Optional "linuxfsuuid"],
(let uuid = uuidgen () in
[InitEmpty, Always, TestOutput (
[["sfdiskM"; "/dev/sda"; ",100 ,"];
["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
- ["mount"; "/dev/sda2"; "/"];
+ ["mount_options"; ""; "/dev/sda2"; "/"];
["write_file"; "/new"; "new file contents"; "0"];
["cat"; "/new"]], "new file contents")]),
"make ext2/3/4 external journal with UUID",
See also C<guestfs_mke2journal_L>.");
- ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [],
+ ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [Optional "linuxfsuuid"],
[],
"make ext2/3/4 filesystem with external journal",
"\
See also C<guestfs_mke2journal_U>.");
- ("modprobe", (RErr, [String "modulename"]), 194, [],
+ ("modprobe", (RErr, [String "modulename"]), 194, [Optional "linuxmodules"],
[InitNone, Always, TestRun [["modprobe"; "fat"]]],
"load a kernel module",
"\
("echo_daemon", (RString "output", [StringList "words"]), 195, [],
[InitNone, Always, TestOutput (
- [["echo_daemon"; "This is a test"]], "This is a test"
- )],
+ [["echo_daemon"; "This is a test"]], "This is a test"
+ )],
"echo arguments back to the client",
"\
This command concatenate the list of C<words> passed with single spaces between
"create a directory with a particular mode",
"\
This command creates a directory, setting the initial permissions
-of the directory to C<mode>. See also C<guestfs_mkdir>.");
+of the directory to C<mode>.
+
+For common Linux filesystems, the actual mode which is set will
+be C<mode & ~umask & 01777>. Non-native-Linux filesystems may
+interpret the mode in other ways.
+
+See also C<guestfs_mkdir>, C<guestfs_umask>");
("lchown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 203, [],
[], (* XXX *)
this call to fail. The caller must split up such requests
into smaller groups of names.");
- ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [],
+ ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [Optional "linuxxattrs"],
[], (* XXX *)
"lgetxattr on multiple files",
"\
("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning],
[InitISOFS, Always, TestOutputBuffer (
- [["pread"; "/known-4"; "1"; "3"]], "\n")],
+ [["pread"; "/known-4"; "1"; "3"]], "\n");
+ InitISOFS, Always, TestOutputBuffer (
+ [["pread"; "/empty"; "0"; "100"]], "")],
"read part of a file",
"\
This command lets you read part of a file. It reads C<count>
This may read fewer bytes than requested. For further details
see the L<pread(2)> system call.");
+ ("part_init", (RErr, [Device "device"; String "parttype"]), 208, [],
+ [InitEmpty, Always, TestRun (
+ [["part_init"; "/dev/sda"; "gpt"]])],
+ "create an empty partition table",
+ "\
+This creates an empty partition table on C<device> of one of the
+partition types listed below. Usually C<parttype> should be
+either C<msdos> or C<gpt> (for large disks).
+
+Initially there are no partitions. Following this, you should
+call C<guestfs_part_add> for each partition required.
+
+Possible values for C<parttype> are:
+
+=over 4
+
+=item B<efi> | B<gpt>
+
+Intel EFI / GPT partition table.
+
+This is recommended for >= 2 TB partitions that will be accessed
+from Linux and Intel-based Mac OS X. It also has limited backwards
+compatibility with the C<mbr> format.
+
+=item B<mbr> | B<msdos>
+
+The standard PC \"Master Boot Record\" (MBR) format used
+by MS-DOS and Windows. This partition type will B<only> work
+for device sizes up to 2 TB. For large disks we recommend
+using C<gpt>.
+
+=back
+
+Other partition table types that may work but are not
+supported include:
+
+=over 4
+
+=item B<aix>
+
+AIX disk labels.
+
+=item B<amiga> | B<rdb>
+
+Amiga \"Rigid Disk Block\" format.
+
+=item B<bsd>
+
+BSD disk labels.
+
+=item B<dasd>
+
+DASD, used on IBM mainframes.
+
+=item B<dvh>
+
+MIPS/SGI volumes.
+
+=item B<mac>
+
+Old Mac partition format. Modern Macs use C<gpt>.
+
+=item B<pc98>
+
+NEC PC-98 format, common in Japan apparently.
+
+=item B<sun>
+
+Sun disk labels.
+
+=back");
+
+ ("part_add", (RErr, [Device "device"; String "prlogex"; Int64 "startsect"; Int64 "endsect"]), 209, [],
+ [InitEmpty, Always, TestRun (
+ [["part_init"; "/dev/sda"; "mbr"];
+ ["part_add"; "/dev/sda"; "primary"; "1"; "-1"]]);
+ InitEmpty, Always, TestRun (
+ [["part_init"; "/dev/sda"; "gpt"];
+ ["part_add"; "/dev/sda"; "primary"; "34"; "127"];
+ ["part_add"; "/dev/sda"; "primary"; "128"; "-34"]]);
+ InitEmpty, Always, TestRun (
+ [["part_init"; "/dev/sda"; "mbr"];
+ ["part_add"; "/dev/sda"; "primary"; "32"; "127"];
+ ["part_add"; "/dev/sda"; "primary"; "128"; "255"];
+ ["part_add"; "/dev/sda"; "primary"; "256"; "511"];
+ ["part_add"; "/dev/sda"; "primary"; "512"; "-1"]])],
+ "add a partition to the device",
+ "\
+This command adds a partition to C<device>. If there is no partition
+table on the device, call C<guestfs_part_init> first.
+
+The C<prlogex> parameter is the type of partition. Normally you
+should pass C<p> or C<primary> here, but MBR partition tables also
+support C<l> (or C<logical>) and C<e> (or C<extended>) partition
+types.
+
+C<startsect> and C<endsect> are the start and end of the partition
+in I<sectors>. C<endsect> may be negative, which means it counts
+backwards from the end of the disk (C<-1> is the last sector).
+
+Creating a partition which covers the whole disk is not so easy.
+Use C<guestfs_part_disk> to do that.");
+
+ ("part_disk", (RErr, [Device "device"; String "parttype"]), 210, [DangerWillRobinson],
+ [InitEmpty, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "mbr"]]);
+ InitEmpty, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "gpt"]])],
+ "partition whole disk with a single primary partition",
+ "\
+This command is simply a combination of C<guestfs_part_init>
+followed by C<guestfs_part_add> to create a single primary partition
+covering the whole disk.
+
+C<parttype> is the partition table type, usually C<mbr> or C<gpt>,
+but other possible values are described in C<guestfs_part_init>.");
+
+ ("part_set_bootable", (RErr, [Device "device"; Int "partnum"; Bool "bootable"]), 211, [],
+ [InitEmpty, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "mbr"];
+ ["part_set_bootable"; "/dev/sda"; "1"; "true"]])],
+ "make a partition bootable",
+ "\
+This sets the bootable flag on partition numbered C<partnum> on
+device C<device>. Note that partitions are numbered from 1.
+
+The bootable flag is used by some operating systems (notably
+Windows) to determine which partition to boot from. It is by
+no means universally recognized.");
+
+ ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [],
+ [InitEmpty, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "gpt"];
+ ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])],
+ "set partition name",
+ "\
+This sets the partition name on partition numbered C<partnum> on
+device C<device>. Note that partitions are numbered from 1.
+
+The partition name can only be set on certain types of partition
+table. This works on C<gpt> but not on C<mbr> partitions.");
+
+ ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [],
+ [], (* XXX Add a regression test for this. *)
+ "list partitions on a device",
+ "\
+This command parses the partition table on C<device> and
+returns the list of partitions found.
+
+The fields in the returned structure are:
+
+=over 4
+
+=item B<part_num>
+
+Partition number, counting from 1.
+
+=item B<part_start>
+
+Start of the partition I<in bytes>. To get sectors you have to
+divide by the device's sector size, see C<guestfs_blockdev_getss>.
+
+=item B<part_end>
+
+End of the partition in bytes.
+
+=item B<part_size>
+
+Size of the partition in bytes.
+
+=back");
+
+ ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [],
+ [InitEmpty, Always, TestOutput (
+ [["part_disk"; "/dev/sda"; "gpt"];
+ ["part_get_parttype"; "/dev/sda"]], "gpt")],
+ "get the partition table type",
+ "\
+This command examines the partition table on C<device> and
+returns the partition table type (format) being used.
+
+Common return values include: C<msdos> (a DOS/Windows style MBR
+partition table), C<gpt> (a GPT/EFI-style partition table). Other
+values are possible, although unusual. See C<guestfs_part_init>
+for a full list.");
+
+ ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
+ [InitBasicFS, Always, TestOutputBuffer (
+ [["fill"; "0x63"; "10"; "/test"];
+ ["read_file"; "/test"]], "cccccccccc")],
+ "fill a file with octets",
+ "\
+This command creates a new file called C<path>. The initial
+content of the file is C<len> octets of C<c>, where C<c>
+must be a number in the range C<[0..255]>.
+
+To fill a file with zero bytes (sparsely), it is
+much more efficient to use C<guestfs_truncate_size>.");
+
+ ("available", (RErr, [StringList "groups"]), 216, [],
+ [InitNone, Always, TestRun [["available"; ""]]],
+ "test availability of some parts of the API",
+ "\
+This command is used to check the availability of some
+groups of functionality in the appliance, which not all builds of
+the libguestfs appliance will be able to provide.
+
+The libguestfs groups, and the functions that those
+groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
+
+The argument C<groups> is a list of group names, eg:
+C<[\"inotify\", \"augeas\"]> would check for the availability of
+the Linux inotify functions and Augeas (configuration file
+editing) functions.
+
+The command returns no error if I<all> requested groups are available.
+
+It fails with an error if one or more of the requested
+groups is unavailable in the appliance.
+
+If an unknown group name is included in the
+list of groups then an error is always returned.
+
+I<Notes:>
+
+=over 4
+
+=item *
+
+You must call C<guestfs_launch> before calling this function.
+
+The reason is because we don't know what groups are
+supported by the appliance/daemon until it is running and can
+be queried.
+
+=item *
+
+If a group of functions is available, this does not necessarily
+mean that they will work. You still have to check for errors
+when calling individual API functions even if they are
+available.
+
+=item *
+
+It is usually the job of distro packagers to build
+complete functionality into the libguestfs appliance.
+Upstream libguestfs, if built from source with all
+requirements satisfied, will support everything.
+
+=item *
+
+This call was added in version C<1.0.80>. In previous
+versions of libguestfs all you could do would be to speculatively
+execute a command to find out if the daemon implemented it.
+See also C<guestfs_version>.
+
+=back");
+
+ ("dd", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"]), 217, [],
+ [InitBasicFS, Always, TestOutputBuffer (
+ [["write_file"; "/src"; "hello, world"; "0"];
+ ["dd"; "/src"; "/dest"];
+ ["read_file"; "/dest"]], "hello, world")],
+ "copy from source to destination using dd",
+ "\
+This command copies from one source device or file C<src>
+to another destination device or file C<dest>. Normally you
+would use this to copy to or from a device or partition, for
+example to duplicate a filesystem.
+
+If the destination is a device, it must be as large or larger
+than the source file or device, otherwise the copy will fail.
+This command cannot do partial copies (see C<guestfs_copy_size>).");
+
+ ("filesize", (RInt64 "size", [Pathname "file"]), 218, [],
+ [InitBasicFS, Always, TestOutputInt (
+ [["write_file"; "/file"; "hello, world"; "0"];
+ ["filesize"; "/file"]], 12)],
+ "return the size of the file in bytes",
+ "\
+This command returns the size of C<file> in bytes.
+
+To get other stats about a file, use C<guestfs_stat>, C<guestfs_lstat>,
+C<guestfs_is_dir>, C<guestfs_is_file> etc.
+To get the size of block devices, use C<guestfs_blockdev_getsize64>.");
+
+ ("lvrename", (RErr, [String "logvol"; String "newlogvol"]), 219, [],
+ [InitBasicFSonLVM, Always, TestOutputList (
+ [["lvrename"; "/dev/VG/LV"; "/dev/VG/LV2"];
+ ["lvs"]], ["/dev/VG/LV2"])],
+ "rename an LVM logical volume",
+ "\
+Rename a logical volume C<logvol> with the new name C<newlogvol>.");
+
+ ("vgrename", (RErr, [String "volgroup"; String "newvolgroup"]), 220, [],
+ [InitBasicFSonLVM, Always, TestOutputList (
+ [["umount"; "/"];
+ ["vg_activate"; "false"; "VG"];
+ ["vgrename"; "VG"; "VG2"];
+ ["vg_activate"; "true"; "VG2"];
+ ["mount_options"; ""; "/dev/VG2/LV"; "/"];
+ ["vgs"]], ["VG2"])],
+ "rename an LVM volume group",
+ "\
+Rename a volume group C<volgroup> with the new name C<newvolgroup>.");
+
+ ("initrd_cat", (RBufferOut "content", [Pathname "initrdpath"; String "filename"]), 221, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputBuffer (
+ [["initrd_cat"; "/initrd"; "known-4"]], "abc\ndef\nghi")],
+ "list the contents of a single file in an initrd",
+ "\
+This command unpacks the file C<filename> from the initrd file
+called C<initrdpath>. The filename must be given I<without> the
+initial C</> character.
+
+For example, in guestfish you could use the following command
+to examine the boot script (usually called C</init>)
+contained in a Linux initrd or initramfs image:
+
+ initrd-cat /boot/initrd-<version>.img init
+
+See also C<guestfs_initrd_list>.");
+
+ ("pvuuid", (RString "uuid", [Device "device"]), 222, [],
+ [],
+ "get the UUID of a physical volume",
+ "\
+This command returns the UUID of the LVM PV C<device>.");
+
+ ("vguuid", (RString "uuid", [String "vgname"]), 223, [],
+ [],
+ "get the UUID of a volume group",
+ "\
+This command returns the UUID of the LVM VG named C<vgname>.");
+
+ ("lvuuid", (RString "uuid", [Device "device"]), 224, [],
+ [],
+ "get the UUID of a logical volume",
+ "\
+This command returns the UUID of the LVM LV C<device>.");
+
+ ("vgpvuuids", (RStringList "uuids", [String "vgname"]), 225, [],
+ [],
+ "get the PV UUIDs containing the volume group",
+ "\
+Given a VG called C<vgname>, this returns the UUIDs of all
+the physical volumes that this volume group resides on.
+
+You can use this along with C<guestfs_pvs> and C<guestfs_pvuuid>
+calls to associate physical volumes and volume groups.
+
+See also C<guestfs_vglvuuids>.");
+
+ ("vglvuuids", (RStringList "uuids", [String "vgname"]), 226, [],
+ [],
+ "get the LV UUIDs of all LVs in the volume group",
+ "\
+Given a VG called C<vgname>, this returns the UUIDs of all
+the logical volumes created in this volume group.
+
+You can use this along with C<guestfs_lvs> and C<guestfs_lvuuid>
+calls to associate logical volumes and volume groups.
+
+See also C<guestfs_vgpvuuids>.");
+
+ ("copy_size", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"; Int64 "size"]), 227, [],
+ [InitBasicFS, Always, TestOutputBuffer (
+ [["write_file"; "/src"; "hello, world"; "0"];
+ ["copy_size"; "/src"; "/dest"; "5"];
+ ["read_file"; "/dest"]], "hello")],
+ "copy size bytes from source to destination using dd",
+ "\
+This command copies exactly C<size> bytes from one source device
+or file C<src> to another destination device or file C<dest>.
+
+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],
+ [InitBasicFSonLVM, Always, TestRun (
+ [["zero_device"; "/dev/VG/LV"]])],
+ "write zeroes to an entire device",
+ "\
+This command writes zeroes over the entire C<device>. Compare
+with C<guestfs_zero> which just zeroes the first few blocks of
+a device.");
+
+ ("txz_in", (RErr, [FileIn "tarball"; String "directory"]), 229, [],
+ [InitBasicFS, Always, TestOutput (
+ [["txz_in"; "../images/helloworld.tar.xz"; "/"];
+ ["cat"; "/hello"]], "hello\n")],
+ "unpack compressed tarball to directory",
+ "\
+This command uploads and unpacks local file C<tarball> (an
+I<xz compressed> tar file) into C<directory>.");
+
+ ("txz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 230, [],
+ [],
+ "pack directory into compressed tarball",
+ "\
+This command packs the contents of C<directory> and downloads
+it to local file C<tarball> (as an xz compressed tar archive).");
+
+ ("ntfsresize", (RErr, [Device "device"]), 231, [Optional "ntfsprogs"],
+ [],
+ "resize an NTFS filesystem",
+ "\
+This command resizes an NTFS filesystem, expanding or
+shrinking it to the size of the underlying device.
+See also L<ntfsresize(8)>.");
+
+ ("vgscan", (RErr, []), 232, [],
+ [InitEmpty, Always, TestRun (
+ [["vgscan"]])],
+ "rescan for LVM physical volumes, volume groups and logical volumes",
+ "\
+This rescans all block devices and rebuilds the list of LVM
+physical volumes, volume groups and logical volumes.");
+
+ ("part_del", (RErr, [Device "device"; Int "partnum"]), 233, [],
+ [InitEmpty, Always, TestRun (
+ [["part_init"; "/dev/sda"; "mbr"];
+ ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
+ ["part_del"; "/dev/sda"; "1"]])],
+ "delete a partition",
+ "\
+This command deletes the partition numbered C<partnum> on C<device>.
+
+Note that in the case of MBR partitioning, deleting an
+extended partition also deletes any logical partitions
+it contains.");
+
+ ("part_get_bootable", (RBool "bootable", [Device "device"; Int "partnum"]), 234, [],
+ [InitEmpty, Always, TestOutputTrue (
+ [["part_init"; "/dev/sda"; "mbr"];
+ ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
+ ["part_set_bootable"; "/dev/sda"; "1"; "true"];
+ ["part_get_bootable"; "/dev/sda"; "1"]])],
+ "return true if a partition is bootable",
+ "\
+This command returns true if the partition C<partnum> on
+C<device> has the bootable flag set.
+
+See also C<guestfs_part_set_bootable>.");
+
+ ("part_get_mbr_id", (RInt "idbyte", [Device "device"; Int "partnum"]), 235, [FishOutput FishOutputHexadecimal],
+ [InitEmpty, Always, TestOutputInt (
+ [["part_init"; "/dev/sda"; "mbr"];
+ ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
+ ["part_set_mbr_id"; "/dev/sda"; "1"; "0x7f"];
+ ["part_get_mbr_id"; "/dev/sda"; "1"]], 0x7f)],
+ "get the MBR type byte (ID byte) from a partition",
+ "\
+Returns the MBR type byte (also known as the ID byte) from
+the numbered partition C<partnum>.
+
+Note that only MBR (old DOS-style) partitions have type bytes.
+You will get undefined results for other partition table
+types (see C<guestfs_part_get_parttype>).");
+
+ ("part_set_mbr_id", (RErr, [Device "device"; Int "partnum"; Int "idbyte"]), 236, [],
+ [], (* tested by part_get_mbr_id *)
+ "set the MBR type byte (ID byte) of a partition",
+ "\
+Sets the MBR type byte (also known as the ID byte) of
+the numbered partition C<partnum> to C<idbyte>. Note
+that the type bytes quoted in most documentation are
+in fact hexadecimal numbers, but usually documented
+without any leading \"0x\" which might be confusing.
+
+Note that only MBR (old DOS-style) partitions have type bytes.
+You will get undefined results for other partition table
+types (see C<guestfs_part_get_parttype>).");
+
+ ("checksum_device", (RString "checksum", [String "csumtype"; Device "device"]), 237, [],
+ [InitISOFS, Always, TestOutput (
+ [["checksum_device"; "md5"; "/dev/sdd"]],
+ (Digest.to_hex (Digest.file "images/test.iso")))],
+ "compute MD5, SHAx or CRC checksum of the contents of a device",
+ "\
+This call computes the MD5, SHAx or CRC checksum of the
+contents of the device named C<device>. For the types of
+checksums supported see the C<guestfs_checksum> command.");
+
+ ("lvresize_free", (RErr, [Device "lv"; Int "percent"]), 238, [Optional "lvm2"],
+ [InitNone, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "mbr"];
+ ["pvcreate"; "/dev/sda1"];
+ ["vgcreate"; "VG"; "/dev/sda1"];
+ ["lvcreate"; "LV"; "VG"; "10"];
+ ["lvresize_free"; "/dev/VG/LV"; "100"]])],
+ "expand an LV to fill free space",
+ "\
+This expands an existing logical volume C<lv> so that it fills
+C<pc>% of the remaining free space in the volume group. Commonly
+you would call this with pc = 100 which expands the logical volume
+as much as possible, using all remaining free space in the volume
+group.");
+
+ ("aug_clear", (RErr, [String "augpath"]), 239, [Optional "augeas"],
+ [], (* XXX Augeas code needs tests. *)
+ "clear Augeas path",
+ "\
+Set the value associated with C<path> to C<NULL>. This
+is the same as the L<augtool(1)> C<clear> command.");
+
+ ("get_umask", (RInt "mask", []), 240, [FishOutput FishOutputOctal],
+ [InitEmpty, Always, TestOutputInt (
+ [["get_umask"]], 0o22)],
+ "get the current umask",
+ "\
+Return the current umask. By default the umask is C<022>
+unless it has been set by calling C<guestfs_umask>.");
+
]
let all_functions = non_daemon_functions @ daemon_functions
"in_cookie", FUInt32;
"in_name", FString;
];
+
+ (* Partition table entry. *)
+ "partition", [
+ "part_num", FInt32;
+ "part_start", FBytes;
+ "part_end", FBytes;
+ "part_size", FBytes;
+ ];
] (* end of structs *)
(* Ugh, Java has to be different ..
"version", "Version";
"xattr", "XAttr";
"inotify_event", "INotifyEvent";
+ "partition", "Partition";
]
(* What structs are actually returned. *)
* Note we don't want to use any external OCaml libraries which
* makes this a bit harder than it should be.
*)
+module StringMap = Map.Make (String)
+
let failwithf fs = ksprintf failwith fs
+let unique = let i = ref 0 in fun () -> incr i; !i
+
let replace_char s c1 c2 =
let s2 = String.copy s in
let r = ref false in
in
loop 0 xs
+let count_chars c str =
+ let count = ref 0 in
+ for i = 0 to String.length str - 1 do
+ if c = String.unsafe_get str i then incr count
+ done;
+ !count
+
let name_of_argt = function
| Pathname n | Device n | Dev_or_Path n | String n | OptString n
| StringList n | DeviceList n | Bool n | Int n | Int64 n
(* Handling for function flags. *)
let protocol_limit_warning =
"Because of the message protocol, there is a transfer limit
-of somewhere between 2MB and 4MB. To transfer large files you should use
-FTP."
+of somewhere between 2MB and 4MB. See L<guestfs(3)/PROTOCOL LIMITS>."
let danger_will_robinson =
"B<This command is dangerous. Without careful use you
with
Not_found -> None
+(* Create list of optional groups. *)
+let optgroups =
+ let h = Hashtbl.create 13 in
+ List.iter (
+ fun (name, _, _, flags, _, _, _) ->
+ List.iter (
+ function
+ | Optional group ->
+ let names = try Hashtbl.find h group with Not_found -> [] in
+ Hashtbl.replace h group (name :: names)
+ | _ -> ()
+ ) flags
+ ) daemon_functions;
+ let groups = Hashtbl.fold (fun k _ ks -> k :: ks) h [] in
+ let groups =
+ List.map (
+ fun group -> group, List.sort compare (Hashtbl.find h group)
+ ) groups in
+ List.sort (fun x y -> compare (fst x) (fst y)) groups
+
(* Check function names etc. for consistency. *)
let check_functions () =
let contains_uppercase str =
"for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
"hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
"infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
+ "interface";
"land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
"match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
"newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
) all_functions
(* 'pr' prints to the current output file. *)
-let chan = ref stdout
-let pr fs = ksprintf (output_string !chan) fs
+let chan = ref Pervasives.stdout
+let lines = ref 0
+let pr fs =
+ ksprintf
+ (fun str ->
+ let i = count_chars '\n' str in
+ lines := !lines + i;
+ output_string !chan str
+ ) fs
+
+let copyright_years =
+ let this_year = 1900 + (localtime (time ())).tm_year in
+ if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
(* Generate a header block in a number of standard styles. *)
-type comment_style = CStyle | HashStyle | OCamlStyle | HaskellStyle
-type license = GPLv2 | LGPLv2
+type comment_style =
+ CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
+type license = GPLv2plus | LGPLv2plus
-let generate_header comment license =
+let generate_header ?(extra_inputs = []) comment license =
+ let inputs = "src/generator.ml" :: extra_inputs in
let c = match comment with
- | CStyle -> pr "/* "; " *"
- | HashStyle -> pr "# "; "#"
- | OCamlStyle -> pr "(* "; " *"
- | HaskellStyle -> pr "{- "; " " in
+ | CStyle -> pr "/* "; " *"
+ | CPlusPlusStyle -> pr "// "; "//"
+ | HashStyle -> pr "# "; "#"
+ | OCamlStyle -> pr "(* "; " *"
+ | HaskellStyle -> pr "{- "; " " in
pr "libguestfs generated file\n";
- pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
+ pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
+ List.iter (pr "%s %s\n" c) inputs;
pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
pr "%s\n" c;
- pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
+ pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
pr "%s\n" c;
(match license with
- | GPLv2 ->
+ | GPLv2plus ->
pr "%s This program is free software; you can redistribute it and/or modify\n" c;
pr "%s it under the terms of the GNU General Public License as published by\n" c;
pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
- | LGPLv2 ->
+ | LGPLv2plus ->
pr "%s This library is free software; you can redistribute it and/or\n" c;
pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
pr "%s License as published by the Free Software Foundation; either\n" c;
);
(match comment with
| CStyle -> pr " */\n"
+ | CPlusPlusStyle
| HashStyle -> ()
| OCamlStyle -> pr " *)\n"
| HaskellStyle -> pr "-}\n"
pr "\n"
) structs
+and generate_availability_pod () =
+ (* Availability documentation. *)
+ pr "=over 4\n";
+ pr "\n";
+ List.iter (
+ fun (group, functions) ->
+ pr "=item B<%s>\n" group;
+ pr "\n";
+ pr "The following functions:\n";
+ List.iter (pr "L</guestfs_%s>\n") functions;
+ pr "\n"
+ ) optgroups;
+ pr "=back\n";
+ pr "\n"
+
(* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
* indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
*
* This header is NOT exported to clients, but see also generate_structs_h.
*)
and generate_xdr () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
(* This has to be defined to get around a limitation in Sun's rpcgen. *)
pr "typedef string str<>;\n";
(* Having to choose a maximum message size is annoying for several
* reasons (it limits what we can do in the API), but it (a) makes
* the protocol a lot simpler, and (b) provides a bound on the size
- * of the daemon which operates in limited memory space. For large
- * file transfers you should use FTP.
+ * of the daemon which operates in limited memory space.
*)
pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
pr "\n";
(* Generate the guestfs-structs.h file. *)
and generate_structs_h () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
(* This is a public exported header file containing various
* structures. The structures are carefully written to have
(* Generate the guestfs-actions.h file. *)
and generate_actions_h () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
List.iter (
fun (shortname, style, _, _, _, _, _) ->
let name = "guestfs_" ^ shortname in
(* Generate the guestfs-internal-actions.h file. *)
and generate_internal_actions_h () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
List.iter (
fun (shortname, style, _, _, _, _, _) ->
let name = "guestfs__" ^ shortname in
(* Generate the client-side dispatch stubs. *)
and generate_client_actions () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>
+#include <string.h>
#include <inttypes.h>
#include \"guestfs.h\"
+#include \"guestfs-internal.h\"
#include \"guestfs-internal-actions.h\"
#include \"guestfs_protocol.h\"
#define error guestfs_error
//#define perrorf guestfs_perrorf
-//#define safe_malloc guestfs_safe_malloc
+#define safe_malloc guestfs_safe_malloc
#define safe_realloc guestfs_safe_realloc
//#define safe_strdup guestfs_safe_strdup
#define safe_memdup guestfs_safe_memdup
pr " /* caller will free this */\n";
pr " return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
| RBufferOut n ->
- pr " *size_r = ret.%s.%s_len;\n" n n;
- pr " return ret.%s.%s_val; /* caller will free */\n" n n
+ pr " /* RBufferOut is tricky: If the buffer is zero-length, then\n";
+ pr " * _val might be NULL here. To make the API saner for\n";
+ pr " * callers, we turn this case into a unique pointer (using\n";
+ pr " * malloc(1)).\n";
+ pr " */\n";
+ pr " if (ret.%s.%s_len > 0) {\n" n n;
+ pr " *size_r = ret.%s.%s_len;\n" n n;
+ pr " return ret.%s.%s_val; /* caller will free */\n" n n;
+ pr " } else {\n";
+ pr " free (ret.%s.%s_val);\n" n n;
+ pr " char *p = safe_malloc (g, 1);\n";
+ pr " *size_r = ret.%s.%s_len;\n" n n;
+ pr " return p;\n";
+ pr " }\n";
);
pr "}\n\n"
(* Generate daemon/actions.h. *)
and generate_daemon_actions_h () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
pr "#include \"../src/guestfs_protocol.h\"\n";
pr "\n";
name style;
) daemon_functions
+(* Generate the linker script which controls the visibility of
+ * symbols in the public ABI and ensures no other symbols get
+ * exported accidentally.
+ *)
+and generate_linker_script () =
+ generate_header HashStyle GPLv2plus;
+
+ let globals = [
+ "guestfs_create";
+ "guestfs_close";
+ "guestfs_get_error_handler";
+ "guestfs_get_out_of_memory_handler";
+ "guestfs_last_error";
+ "guestfs_set_error_handler";
+ "guestfs_set_launch_done_callback";
+ "guestfs_set_log_message_callback";
+ "guestfs_set_out_of_memory_handler";
+ "guestfs_set_subprocess_quit_callback";
+
+ (* Unofficial parts of the API: the bindings code use these
+ * functions, so it is useful to export them.
+ *)
+ "guestfs_safe_calloc";
+ "guestfs_safe_malloc";
+ ] in
+ let functions =
+ List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
+ all_functions in
+ let structs =
+ List.concat (
+ List.map (fun (typ, _) ->
+ ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
+ structs
+ ) in
+ let globals = List.sort compare (globals @ functions @ structs) in
+
+ pr "{\n";
+ pr " global:\n";
+ List.iter (pr " %s;\n") globals;
+ pr "\n";
+
+ pr " local:\n";
+ pr " *;\n";
+ pr "};\n"
+
(* Generate the server-side stubs. *)
and generate_daemon_actions () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
pr "#include <config.h>\n";
pr "\n";
| RStruct (_, typ) -> pr " guestfs_int_%s *r;\n" typ; "NULL"
| RStructList (_, typ) -> pr " guestfs_int_%s_list *r;\n" typ; "NULL"
| RBufferOut _ ->
- pr " size_t size;\n";
+ pr " size_t size = 1;\n";
pr " char *r;\n";
"NULL" in
pr " memset (&args, 0, sizeof args);\n";
pr "\n";
pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
- pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
+ pr " reply_with_error (\"daemon failed to decode procedure arguments\");\n";
pr " return;\n";
pr " }\n";
let pr_args n =
generate_c_call_args (fst style, args');
pr ";\n";
- pr " if (r == %s)\n" error_code;
- pr " /* do_%s has already called reply_with_error */\n" name;
- pr " goto done;\n";
- pr "\n";
+ (match fst style with
+ | RErr | RInt _ | RInt64 _ | RBool _
+ | RConstString _ | RConstOptString _
+ | RString _ | RStringList _ | RHashtable _
+ | RStruct (_, _) | RStructList (_, _) ->
+ pr " if (r == %s)\n" error_code;
+ pr " /* do_%s has already called reply_with_error */\n" name;
+ pr " goto done;\n";
+ pr "\n"
+ | RBufferOut _ ->
+ pr " /* size == 0 && r == NULL could be a non-error case (just\n";
+ pr " * an ordinary zero-length buffer), so be careful ...\n";
+ pr " */\n";
+ pr " if (size == 1 && r == %s)\n" error_code;
+ pr " /* do_%s has already called reply_with_error */\n" name;
+ pr " goto done;\n";
+ pr "\n"
+ );
(* If there are any FileOut parameters, then the impl must
* send its own reply.
pr " ret->guestfs_int_lvm_%s_list_val = NULL;\n" typ;
pr "\n";
pr " r = command (&out, &err,\n";
- pr " \"/sbin/lvm\", \"%ss\",\n" typ;
+ pr " \"lvm\", \"%ss\",\n" typ;
pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
pr " if (r == -1) {\n";
(* Generate a list of function names, for debugging in the daemon.. *)
and generate_daemon_names () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
pr "#include <config.h>\n";
pr "\n";
) daemon_functions;
pr "};\n";
+(* Generate the optional groups for the daemon to implement
+ * guestfs_available.
+ *)
+and generate_daemon_optgroups_c () =
+ generate_header CStyle GPLv2plus;
+
+ pr "#include <config.h>\n";
+ pr "\n";
+ pr "#include \"daemon.h\"\n";
+ pr "#include \"optgroups.h\"\n";
+ pr "\n";
+
+ pr "struct optgroup optgroups[] = {\n";
+ List.iter (
+ fun (group, _) ->
+ pr " { \"%s\", optgroup_%s_available },\n" group group
+ ) optgroups;
+ pr " { NULL, NULL }\n";
+ pr "};\n"
+
+and generate_daemon_optgroups_h () =
+ generate_header CStyle GPLv2plus;
+
+ List.iter (
+ fun (group, _) ->
+ pr "extern int optgroup_%s_available (void);\n" group
+ ) optgroups
+
(* Generate the tests. *)
and generate_tests () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
pr "\
#include <stdio.h>
#include <fcntl.h>
#include \"guestfs.h\"
+#include \"guestfs-internal.h\"
static guestfs_h *g;
static int suppress_error = 0;
*)
let test_names =
List.map (
- fun (name, _, _, _, tests, _, _) ->
- mapi (generate_one_test name) tests
+ fun (name, _, _, flags, tests, _, _) ->
+ mapi (generate_one_test name flags) tests
) (List.rev all_functions) in
let test_names = List.concat test_names in
let nr_tests = List.length test_names in
g = guestfs_create ();
if (g == NULL) {
printf (\"guestfs_create FAILED\\n\");
- exit (1);
+ exit (EXIT_FAILURE);
}
guestfs_set_error_handler (g, print_error, NULL);
fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
if (fd == -1) {
perror (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (lseek (fd, %d, SEEK_SET) == -1) {
perror (\"lseek\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (write (fd, &c, 1) == -1) {
perror (\"write\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (close (fd) == -1) {
perror (filename);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (guestfs_add_drive (g, filename) == -1) {
printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
filename = \"test2.img\";
fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
if (fd == -1) {
perror (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (lseek (fd, %d, SEEK_SET) == -1) {
perror (\"lseek\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (write (fd, &c, 1) == -1) {
perror (\"write\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (close (fd) == -1) {
perror (filename);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (guestfs_add_drive (g, filename) == -1) {
printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
filename = \"test3.img\";
fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
if (fd == -1) {
perror (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (lseek (fd, %d, SEEK_SET) == -1) {
perror (\"lseek\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (write (fd, &c, 1) == -1) {
perror (\"write\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (close (fd) == -1) {
perror (filename);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (guestfs_add_drive (g, filename) == -1) {
printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
- exit (1);
+ exit (EXIT_FAILURE);
}
+ /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
+ alarm (600);
+
if (guestfs_launch (g) == -1) {
printf (\"guestfs_launch FAILED\\n\");
- exit (1);
+ exit (EXIT_FAILURE);
}
- /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
- alarm (600);
-
/* Cancel previous alarm. */
alarm (0);
pr " if (n_failed > 0) {\n";
pr " printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
- pr " exit (1);\n";
+ pr " exit (EXIT_FAILURE);\n";
pr " }\n";
pr "\n";
- pr " exit (0);\n";
+ pr " exit (EXIT_SUCCESS);\n";
pr "}\n"
-and generate_one_test name i (init, prereq, test) =
+and generate_one_test name flags i (init, prereq, test) =
let test_name = sprintf "test_%s_%d" name i in
pr "\
if (str)
return strstr (str, \"%s\") == NULL;
str = getenv (\"SKIP_%s\");
- if (str && strcmp (str, \"1\") == 0) return 1;
+ if (str && STREQ (str, \"1\")) return 1;
str = getenv (\"SKIP_TEST_%s\");
- if (str && strcmp (str, \"1\") == 0) return 1;
+ if (str && STREQ (str, \"1\")) return 1;
return 0;
}
" test_name test_name test_name;
+ (* Optional functions should only be tested if the relevant
+ * support is available in the daemon.
+ *)
+ 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 " }\n";
+ | _ -> ()
+ ) flags;
+
(match prereq with
| Disabled ->
pr " printf (\" %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
[["blockdev_setrw"; "/dev/sda"];
["umount_all"];
["lvm_remove_all"];
- ["sfdiskM"; "/dev/sda"; ","]]
+ ["part_disk"; "/dev/sda"; "mbr"]]
| InitBasicFS ->
pr " /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
List.iter (generate_test_command_call test_name)
[["blockdev_setrw"; "/dev/sda"];
["umount_all"];
["lvm_remove_all"];
- ["sfdiskM"; "/dev/sda"; ","];
+ ["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext2"; "/dev/sda1"];
- ["mount"; "/dev/sda1"; "/"]]
+ ["mount_options"; ""; "/dev/sda1"; "/"]]
| InitBasicFSonLVM ->
pr " /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
test_name;
[["blockdev_setrw"; "/dev/sda"];
["umount_all"];
["lvm_remove_all"];
- ["sfdiskM"; "/dev/sda"; ","];
+ ["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV"; "VG"; "8"];
["mkfs"; "ext2"; "/dev/VG/LV"];
- ["mount"; "/dev/VG/LV"; "/"]]
+ ["mount_options"; ""; "/dev/VG/LV"; "/"]]
| InitISOFS ->
pr " /* InitISOFS for %s */\n" test_name;
List.iter (generate_test_command_call test_name)
pr " const char *expected = \"%s\";\n" (c_quote expected);
let seq, last = get_seq_last seq in
let test () =
- pr " if (strcmp (r, expected) != 0) {\n";
+ pr " if (STRNEQ (r, expected)) {\n";
pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
pr " return -1;\n";
pr " }\n"
pr " }\n";
pr " {\n";
pr " const char *expected = \"%s\";\n" (c_quote str);
- pr " if (strcmp (r[%d], expected) != 0) {\n" i;
+ pr " if (STRNEQ (r[%d], expected)) {\n" i;
pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
pr " return -1;\n";
pr " }\n";
pr " {\n";
pr " const char *expected = \"%s\";\n" (c_quote str);
pr " r[%d][5] = 's';\n" i;
- pr " if (strcmp (r[%d], expected) != 0) {\n" i;
+ pr " if (STRNEQ (r[%d], expected)) {\n" i;
pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
pr " return -1;\n";
pr " }\n";
pr " return -1;\n";
pr " }\n"
| CompareWithString (field, expected) ->
- pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
+ pr " if (STRNEQ (r->%s, \"%s\")) {\n" field expected;
pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
test_name field expected;
pr " r->%s);\n" field;
pr " return -1;\n";
pr " }\n"
| CompareFieldsStrEq (field1, field2) ->
- pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
+ pr " if (STRNEQ (r->%s, r->%s)) {\n" field1 field2;
pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
test_name field1 field2;
pr " r->%s, r->%s);\n" field1 field2;
| Int64 _, _
| Bool _, _
| FileIn _, _ | FileOut _, _ -> ()
+ | StringList n, "" | DeviceList n, "" ->
+ pr " const char *const %s[1] = { NULL };\n" n
| StringList n, arg | DeviceList n, arg ->
let strs = string_split " " arg in
iteri (
(* Generate a lot of different functions for guestfish. *)
and generate_fish_cmds () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
let all_functions =
List.filter (
fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
) all_functions_sorted in
+ pr "#include <config.h>\n";
+ pr "\n";
pr "#include <stdio.h>\n";
pr "#include <stdlib.h>\n";
pr "#include <string.h>\n";
pr "\n";
pr "#include <guestfs.h>\n";
pr "#include \"c-ctype.h\"\n";
+ pr "#include \"full-write.h\"\n";
+ pr "#include \"xstrtol.h\"\n";
pr "#include \"fish.h\"\n";
pr "\n";
match snd style with
| [] -> name2
| args ->
- sprintf "%s <%s>"
- name2 (String.concat "> <" (List.map name_of_argt args)) in
+ sprintf "%s %s"
+ name2 (String.concat " " (List.map name_of_argt args)) in
let warnings =
if List.mem ProtocolLimitWarning flags then
pr ")\n";
pr " pod2text (\"%s\", _(\"%s\"), %S);\n"
name2 shortdesc
- (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
+ ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
+ "=head1 DESCRIPTION\n\n" ^
+ longdesc ^ warnings ^ describe_alias);
pr " else\n"
) all_functions;
pr " display_builtin_command (cmd);\n";
pr " fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n";
pr " return -1;\n";
pr " }\n";
+
+ let parse_integer fn fntyp rtyp range name i =
+ 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 " if (xerr != LONGINT_OK) {\n";
+ pr " fprintf (stderr,\n";
+ pr " _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n";
+ pr " cmd, \"%s\", \"%s\", xerr);\n" name fn;
+ pr " return -1;\n";
+ pr " }\n";
+ (match range with
+ | None -> ()
+ | Some (min, max, comment) ->
+ pr " /* %s */\n" comment;
+ pr " if (r < %s || r > %s) {\n" min max;
+ pr " fprintf (stderr, _(\"%%s: %%s: integer out of range\\n\"), cmd, \"%s\");\n"
+ name;
+ pr " return -1;\n";
+ pr " }\n";
+ pr " /* The check above should ensure this assignment does not overflow. */\n";
+ );
+ pr " %s = r;\n" name;
+ pr " }\n";
+ in
+
iteri (
fun i ->
function
pr " %s = resolve_win_path (argv[%d]);\n" name i;
pr " if (%s == NULL) return -1;\n" name
| OptString name ->
- pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
+ pr " %s = STRNEQ (argv[%d], \"\") ? argv[%d] : NULL;\n"
name i i
| FileIn name ->
- pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
+ pr " %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdin\";\n"
name i i
| FileOut name ->
- pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
+ pr " %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdout\";\n"
name i i
| StringList name | DeviceList name ->
pr " %s = parse_string_list (argv[%d]);\n" name i;
| Bool name ->
pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
| Int name ->
- pr " %s = atoi (argv[%d]);\n" name i
+ 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 ->
- pr " %s = atoll (argv[%d]);\n" name i
+ parse_integer "xstrtoll" "long long" "int64_t" None name i
) (snd style);
(* Call C API function. *)
pr " free_strings (%s);\n" name
) (snd style);
+ (* Any output flags? *)
+ let fish_output =
+ let flags = filter_map (
+ function FishOutput flag -> Some flag | _ -> None
+ ) flags in
+ match flags with
+ | [] -> None
+ | [f] -> Some f
+ | _ ->
+ failwithf "%s: more than one FishOutput flag is not allowed" name in
+
(* Check return value for errors and display command results. *)
(match fst style with
| RErr -> pr " return r;\n"
| RInt _ ->
pr " if (r == -1) return -1;\n";
- pr " printf (\"%%d\\n\", r);\n";
+ (match fish_output with
+ | None ->
+ pr " printf (\"%%d\\n\", r);\n";
+ | Some FishOutputOctal ->
+ pr " printf (\"%%s%%o\\n\", r != 0 ? \"0\" : \"\", r);\n";
+ | Some FishOutputHexadecimal ->
+ pr " printf (\"%%s%%x\\n\", r != 0 ? \"0x\" : \"\", r);\n");
pr " return 0;\n"
| RInt64 _ ->
pr " if (r == -1) return -1;\n";
- pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
+ (match fish_output with
+ | None ->
+ pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
+ | Some FishOutputOctal ->
+ pr " printf (\"%%s%%\" PRIo64 \"\\n\", r != 0 ? \"0\" : \"\", r);\n";
+ | Some FishOutputHexadecimal ->
+ pr " printf (\"%%s%%\" PRIx64 \"\\n\", r != 0 ? \"0x\" : \"\", r);\n");
pr " return 0;\n"
| RBool _ ->
pr " if (r == -1) return -1;\n";
pr " return 0;\n"
| RBufferOut _ ->
pr " if (r == NULL) return -1;\n";
- pr " fwrite (r, size, 1, stdout);\n";
+ pr " if (full_write (1, r, size) != size) {\n";
+ pr " perror (\"write\");\n";
+ pr " free (r);\n";
+ pr " return -1;\n";
+ pr " }\n";
pr " free (r);\n";
pr " return 0;\n"
);
) all_functions;
pr " {\n";
pr " fprintf (stderr, _(\"%%s: unknown command\\n\"), cmd);\n";
+ pr " if (command_num == 1)\n";
+ pr " extended_help_message ();\n";
pr " return -1;\n";
pr " }\n";
pr " return 0;\n";
(* Readline completion for guestfish. *)
and generate_fish_completion () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
let all_functions =
List.filter (
while ((name = commands[index]) != NULL) {
index++;
- if (strncasecmp (name, text, len) == 0)
+ if (STRCASEEQLEN (name, text, len))
return strdup (name);
}
#endif /* HAVE_LIBREADLINE */
-char **do_completion (const char *text, int start, int end)
+#ifdef HAVE_RL_COMPLETION_MATCHES
+#define RL_COMPLETION_MATCHES rl_completion_matches
+#else
+#ifdef HAVE_COMPLETION_MATCHES
+#define RL_COMPLETION_MATCHES completion_matches
+#endif
+#endif /* else just fail if we don't have either symbol */
+
+char **
+do_completion (const char *text, int start, int end)
{
char **matches = NULL;
rl_completion_append_character = ' ';
if (start == 0)
- matches = rl_completion_matches (text, generator);
+ matches = RL_COMPLETION_MATCHES (text, generator);
else if (complete_dest_paths)
- matches = rl_completion_matches (text, complete_dest_paths_generator);
+ matches = RL_COMPLETION_MATCHES (text, complete_dest_paths_generator);
#endif
return matches;
(* Generate the OCaml bindings interface. *)
and generate_ocaml_mli () =
- generate_header OCamlStyle LGPLv2;
+ generate_header OCamlStyle LGPLv2plus;
pr "\
(** For API documentation you should refer to the C API
(* Generate the OCaml bindings implementation. *)
and generate_ocaml_ml () =
- generate_header OCamlStyle LGPLv2;
+ generate_header OCamlStyle LGPLv2plus;
pr "\
type t
(* Generate the OCaml bindings C implementation. *)
and generate_ocaml_c () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
#include <stdio.h>
(* Generate Perl xs code, a sort of crazy variation of C with macros. *)
and generate_perl_xs () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
#include \"EXTERN.h\"
pr ";\n";
do_cleanups ();
pr " if (r == -1)\n";
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
| RInt n
| RBool n ->
pr "PREINIT:\n";
pr ";\n";
do_cleanups ();
pr " if (%s == -1)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
pr " RETVAL = newSViv (%s);\n" n;
pr " OUTPUT:\n";
pr " RETVAL\n"
pr ";\n";
do_cleanups ();
pr " if (%s == -1)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
pr " RETVAL = my_newSVll (%s);\n" n;
pr " OUTPUT:\n";
pr " RETVAL\n"
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
pr " RETVAL = newSVpv (%s, 0);\n" n;
pr " OUTPUT:\n";
pr " RETVAL\n"
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
pr " RETVAL = newSVpv (%s, 0);\n" n;
pr " free (%s);\n" n;
pr " OUTPUT:\n";
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
pr " EXTEND (SP, n);\n";
pr " for (i = 0; i < n; ++i) {\n";
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
- pr " RETVAL = newSVpv (%s, size);\n" n;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
+ pr " RETVAL = newSVpvn (%s, size);\n" n;
pr " free (%s);\n" n;
pr " OUTPUT:\n";
pr " RETVAL\n"
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
pr " EXTEND (SP, %s->len);\n" n;
pr " for (i = 0; i < %s->len; ++i) {\n" n;
pr " hv = newHV ();\n";
pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
name (String.length name) n name
| name, FBuffer ->
- pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
name (String.length name) n name n name
| name, (FBytes|FUInt64) ->
pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
pr " EXTEND (SP, 2 * %d);\n" (List.length cols);
List.iter (
fun ((name, _) as col) ->
pr " PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
n name
| name, FBuffer ->
- pr " PUSHs (sv_2mortal (newSVpv (%s->%s, %s->%s_len)));\n"
+ pr " PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
n name n name
| name, FUUID ->
pr " PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
(* Generate Sys/Guestfs.pm. *)
and generate_perl_pm () =
- generate_header HashStyle LGPLv2;
+ generate_header HashStyle LGPLv2plus;
pr "\
=pod
Libguestfs provides ways to enumerate guest storage (eg. partitions,
LVs, what filesystem is in each LV, etc.). It can also run commands
-in the context of the guest. Also you can access filesystems over FTP.
+in the context of the guest. Also you can access filesystems over
+FUSE.
See also L<Sys::Guestfs::Lib(3)> for a set of useful library
functions for using libguestfs from Perl, including integration
=head1 COPYRIGHT
-Copyright (C) 2009 Red Hat Inc.
+Copyright (C) %s Red Hat Inc.
=head1 LICENSE
L<Sys::Guestfs::Lib(3)>.
=cut
-"
+" copyright_years
and generate_perl_prototype name style =
(match fst style with
(* Generate Python C module. *)
and generate_python_c () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
#include <Python.h>
(* Generate Python module. *)
and generate_python_py () =
- generate_header HashStyle LGPLv2;
+ generate_header HashStyle LGPLv2plus;
pr "\
u\"\"\"Python bindings for libguestfs
Libguestfs provides ways to enumerate guest storage (eg. partitions,
LVs, what filesystem is in each LV, etc.). It can also run commands
-in the context of the guest. Also you can access filesystems over FTP.
+in the context of the guest. Also you can access filesystems over
+FUSE.
Errors which happen while using the API are turned into Python
RuntimeError exceptions.
fprintf chan "=head1 %s\n\n%s\n" name longdesc;
close_out chan;
let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
- let chan = Unix.open_process_in cmd in
+ let chan = open_process_in cmd in
let lines = ref [] in
let rec loop i =
let line = input_line chan in
loop (i+1)
) in
let lines = try loop 1 with End_of_file -> List.rev !lines in
- Unix.unlink filename;
- (match Unix.close_process_in chan with
- | Unix.WEXITED 0 -> ()
- | Unix.WEXITED i ->
+ unlink filename;
+ (match close_process_in chan with
+ | WEXITED 0 -> ()
+ | WEXITED i ->
failwithf "pod2text: process exited with non-zero status (%d)" i
- | Unix.WSIGNALED i | Unix.WSTOPPED i ->
+ | WSIGNALED i | WSTOPPED i ->
failwithf "pod2text: process signalled or stopped by signal %d" i
);
Hashtbl.add pod2text_memo key lines;
(* Generate ruby bindings. *)
and generate_ruby_c () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
#include <stdio.h>
(* Generate Java bindings GuestFS.java file. *)
and generate_java_java () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
package com.redhat.et.libguestfs;
pr " throws LibGuestFSException";
if semicolon then pr ";"
-and generate_java_struct jtyp cols =
- generate_header CStyle LGPLv2;
+and generate_java_struct jtyp cols () =
+ generate_header CStyle LGPLv2plus;
pr "\
package com.redhat.et.libguestfs;
pr "}\n"
and generate_java_c () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
#include <stdio.h>
pr " return jr;\n"
and generate_java_makefile_inc () =
- generate_header HashStyle GPLv2;
+ generate_header HashStyle GPLv2plus;
pr "java_built_sources = \\\n";
List.iter (
pr "\tcom/redhat/et/libguestfs/GuestFS.java\n"
and generate_haskell_hs () =
- generate_header HaskellStyle LGPLv2;
+ generate_header HaskellStyle LGPLv2plus;
(* XXX We only know how to generate partial FFI for Haskell
* at the moment. Please help out!
);
pr ")"
+and generate_csharp () =
+ generate_header CPlusPlusStyle LGPLv2plus;
+
+ (* XXX Make this configurable by the C# assembly users. *)
+ let library = "libguestfs.so.0" in
+
+ pr "\
+// These C# bindings are highly experimental at present.
+//
+// Firstly they only work on Linux (ie. Mono). In order to get them
+// to work on Windows (ie. .Net) you would need to port the library
+// itself to Windows first.
+//
+// The second issue is that some calls are known to be incorrect and
+// can cause Mono to segfault. Particularly: calls which pass or
+// return string[], or return any structure value. This is because
+// we haven't worked out the correct way to do this from C#.
+//
+// The third issue is that when compiling you get a lot of warnings.
+// We are not sure whether the warnings are important or not.
+//
+// Fourthly we do not routinely build or test these bindings as part
+// of the make && make check cycle, which means that regressions might
+// go unnoticed.
+//
+// Suggestions and patches are welcome.
+
+// To compile:
+//
+// gmcs Libguestfs.cs
+// mono Libguestfs.exe
+//
+// (You'll probably want to add a Test class / static main function
+// otherwise this won't do anything useful).
+
+using System;
+using System.IO;
+using System.Runtime.InteropServices;
+using System.Runtime.Serialization;
+using System.Collections;
+
+namespace Guestfs
+{
+ class Error : System.ApplicationException
+ {
+ public Error (string message) : base (message) {}
+ protected Error (SerializationInfo info, StreamingContext context) {}
+ }
+
+ class Guestfs
+ {
+ IntPtr _handle;
+
+ [DllImport (\"%s\")]
+ static extern IntPtr guestfs_create ();
+
+ public Guestfs ()
+ {
+ _handle = guestfs_create ();
+ if (_handle == IntPtr.Zero)
+ throw new Error (\"could not create guestfs handle\");
+ }
+
+ [DllImport (\"%s\")]
+ static extern void guestfs_close (IntPtr h);
+
+ ~Guestfs ()
+ {
+ guestfs_close (_handle);
+ }
+
+ [DllImport (\"%s\")]
+ static extern string guestfs_last_error (IntPtr h);
+
+" library library library;
+
+ (* Generate C# structure bindings. We prefix struct names with
+ * underscore because C# cannot have conflicting struct names and
+ * method names (eg. "class stat" and "stat").
+ *)
+ List.iter (
+ fun (typ, cols) ->
+ pr " [StructLayout (LayoutKind.Sequential)]\n";
+ pr " public class _%s {\n" typ;
+ List.iter (
+ function
+ | name, FChar -> pr " char %s;\n" name
+ | name, FString -> pr " string %s;\n" name
+ | name, FBuffer ->
+ pr " uint %s_len;\n" name;
+ pr " string %s;\n" name
+ | name, FUUID ->
+ pr " [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
+ pr " string %s;\n" name
+ | name, FUInt32 -> pr " uint %s;\n" name
+ | name, FInt32 -> pr " int %s;\n" name
+ | name, (FUInt64|FBytes) -> pr " ulong %s;\n" name
+ | name, FInt64 -> pr " long %s;\n" name
+ | name, FOptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
+ ) cols;
+ pr " }\n";
+ pr "\n"
+ ) structs;
+
+ (* Generate C# function bindings. *)
+ List.iter (
+ fun (name, style, _, _, _, shortdesc, _) ->
+ let rec csharp_return_type () =
+ match fst style with
+ | RErr -> "void"
+ | RBool n -> "bool"
+ | RInt n -> "int"
+ | RInt64 n -> "long"
+ | RConstString n
+ | RConstOptString n
+ | RString n
+ | RBufferOut n -> "string"
+ | RStruct (_,n) -> "_" ^ n
+ | RHashtable n -> "Hashtable"
+ | RStringList n -> "string[]"
+ | RStructList (_,n) -> sprintf "_%s[]" n
+
+ and c_return_type () =
+ match fst style with
+ | RErr
+ | RBool _
+ | RInt _ -> "int"
+ | RInt64 _ -> "long"
+ | RConstString _
+ | RConstOptString _
+ | RString _
+ | RBufferOut _ -> "string"
+ | RStruct (_,n) -> "_" ^ n
+ | RHashtable _
+ | RStringList _ -> "string[]"
+ | RStructList (_,n) -> sprintf "_%s[]" n
+
+ and c_error_comparison () =
+ match fst style with
+ | RErr
+ | RBool _
+ | RInt _
+ | RInt64 _ -> "== -1"
+ | RConstString _
+ | RConstOptString _
+ | RString _
+ | RBufferOut _
+ | RStruct (_,_)
+ | RHashtable _
+ | RStringList _
+ | RStructList (_,_) -> "== null"
+
+ and generate_extern_prototype () =
+ pr " static extern %s guestfs_%s (IntPtr h"
+ (c_return_type ()) name;
+ List.iter (
+ function
+ | Pathname n | Device n | Dev_or_Path n | String n | OptString n
+ | FileIn n | FileOut n ->
+ pr ", [In] string %s" n
+ | StringList n | DeviceList n ->
+ pr ", [In] string[] %s" n
+ | Bool n ->
+ pr ", bool %s" n
+ | Int n ->
+ pr ", int %s" n
+ | Int64 n ->
+ pr ", long %s" n
+ ) (snd style);
+ pr ");\n"
+
+ and generate_public_prototype () =
+ pr " public %s %s (" (csharp_return_type ()) name;
+ let comma = ref false in
+ let next () =
+ if !comma then pr ", ";
+ comma := true
+ in
+ List.iter (
+ function
+ | Pathname n | Device n | Dev_or_Path n | String n | OptString n
+ | FileIn n | FileOut n ->
+ next (); pr "string %s" n
+ | StringList n | DeviceList n ->
+ next (); pr "string[] %s" n
+ | Bool n ->
+ next (); pr "bool %s" n
+ | Int n ->
+ next (); pr "int %s" n
+ | Int64 n ->
+ next (); pr "long %s" n
+ ) (snd style);
+ pr ")\n"
+
+ and generate_call () =
+ pr "guestfs_%s (_handle" name;
+ List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
+ pr ");\n";
+ in
+
+ pr " [DllImport (\"%s\")]\n" library;
+ generate_extern_prototype ();
+ pr "\n";
+ pr " /// <summary>\n";
+ pr " /// %s\n" shortdesc;
+ pr " /// </summary>\n";
+ generate_public_prototype ();
+ pr " {\n";
+ pr " %s r;\n" (c_return_type ());
+ pr " r = ";
+ generate_call ();
+ pr " if (r %s)\n" (c_error_comparison ());
+ pr " throw new Error (guestfs_last_error (_handle));\n";
+ (match fst style with
+ | RErr -> ()
+ | RBool _ ->
+ 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 " rr.Add (r[i], r[i+1]);\n";
+ pr " return rr;\n"
+ | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
+ | RString _ | RBufferOut _ | RStruct _ | RStringList _
+ | RStructList _ ->
+ pr " return r;\n"
+ );
+ pr " }\n";
+ pr "\n";
+ ) all_functions_sorted;
+
+ pr " }
+}
+"
+
and generate_bindtests () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
#include <stdio.h>
#include <string.h>
#include \"guestfs.h\"
+#include \"guestfs-internal.h\"
#include \"guestfs-internal-actions.h\"
#include \"guestfs_protocol.h\"
pr " sscanf (val, \"%%\" SCNi64, &r);\n";
pr " return r;\n"
| RBool _ ->
- pr " return strcmp (val, \"true\") == 0;\n"
+ pr " return STREQ (val, \"true\");\n"
| RConstString _
| RConstOptString _ ->
(* Can't return the input string here. Return a static
) tests
and generate_ocaml_bindtests () =
- generate_header OCamlStyle GPLv2;
+ generate_header OCamlStyle GPLv2plus;
pr "\
let () =
and generate_perl_bindtests () =
pr "#!/usr/bin/perl -w\n";
- generate_header HashStyle GPLv2;
+ generate_header HashStyle GPLv2plus;
pr "\
use strict;
pr "print \"EOF\\n\"\n"
and generate_python_bindtests () =
- generate_header HashStyle GPLv2;
+ generate_header HashStyle GPLv2plus;
pr "\
import guestfs
pr "print \"EOF\"\n"
and generate_ruby_bindtests () =
- generate_header HashStyle GPLv2;
+ generate_header HashStyle GPLv2plus;
pr "\
require 'guestfs'
pr "print \"EOF\\n\"\n"
and generate_java_bindtests () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
pr "\
import com.redhat.et.libguestfs.*;
"
and generate_haskell_bindtests () =
- generate_header HaskellStyle GPLv2;
+ generate_header HaskellStyle GPLv2plus;
pr "\
module Bindtests where
(* XXX Add here tests of the return and error functions. *)
-(* This is used to generate the src/MAX_PROC_NR file which
- * contains the maximum procedure number, a surrogate for the
- * ABI version number. See src/Makefile.am for the details.
+(* Code to generator bindings for virt-inspector. Currently only
+ * implemented for OCaml code (for virt-p2v 2.0).
*)
-and generate_max_proc_nr () =
- let proc_nrs = List.map (
- fun (_, _, proc_nr, _, _, _, _) -> proc_nr
- ) daemon_functions in
+let rng_input = "inspector/virt-inspector.rng"
- let max_proc_nr = List.fold_left max 0 proc_nrs in
-
- pr "%d\n" max_proc_nr
+(* 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
-let output_to filename =
- let filename_new = filename ^ ".new" in
- chan := open_out filename_new;
- let close () =
- close_out !chan;
- chan := stdout;
-
- (* Is the new file different from the current file? *)
- if Sys.file_exists filename && files_equal filename filename_new then
- Unix.unlink filename_new (* same, so skip it *)
- else (
- (* different, overwrite old one *)
- (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ());
- Unix.rename filename_new filename;
- Unix.chmod filename 0o444;
- printf "written %s\n%!" filename;
- )
+ (* 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
- close
-(* Main program. *)
-let () =
- check_functions ();
+ generate_types xs
- if not (Sys.file_exists "HACKING") then (
- eprintf "\
-You are probably running this from the wrong directory.
-Run it from the top source directory using the command
- src/generator.ml
-";
- exit 1
- );
-
- let close = output_to "src/guestfs_protocol.x" in
- generate_xdr ();
- close ();
-
- let close = output_to "src/guestfs-structs.h" in
- generate_structs_h ();
- close ();
+let 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
- let close = output_to "src/guestfs-actions.h" in
- generate_actions_h ();
- close ();
+ (* 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
- let close = output_to "src/guestfs-internal-actions.h" in
- generate_internal_actions_h ();
- close ();
+ generate_parsers xs
- let close = output_to "src/guestfs-actions.c" in
- generate_client_actions ();
- close ();
+(* Generate ocaml/guestfs_inspector.mli. *)
+let generate_ocaml_inspector_mli () =
+ generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
- let close = output_to "daemon/actions.h" in
- generate_daemon_actions_h ();
- close ();
+ pr "\
+(** This is an OCaml language binding to the external [virt-inspector]
+ program.
- let close = output_to "daemon/stubs.c" in
- generate_daemon_actions ();
- close ();
+ For more information, please read the man page [virt-inspector(1)].
+*)
- let close = output_to "daemon/names.c" in
- generate_daemon_names ();
- close ();
+";
- let close = output_to "capitests/tests.c" in
- generate_tests ();
- close ();
+ generate_types grammar;
+ pr "(** The nested information returned from the {!inspect} function. *)\n";
+ pr "\n";
- let close = output_to "src/guestfs-bindtests.c" in
- generate_bindtests ();
- close ();
+ 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.
+*)
+"
- let close = output_to "fish/cmds.c" in
- generate_fish_cmds ();
- close ();
+(* Generate ocaml/guestfs_inspector.ml. *)
+let generate_ocaml_inspector_ml () =
+ generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
- let close = output_to "fish/completion.c" in
- generate_fish_completion ();
- close ();
+ pr "open Unix\n";
+ pr "\n";
- let close = output_to "guestfs-structs.pod" in
- generate_structs_pod ();
- close ();
+ generate_types grammar;
+ pr "\n";
- let close = output_to "guestfs-actions.pod" in
- generate_actions_pod ();
- close ();
+ 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 close = output_to "guestfish-actions.pod" in
- generate_fish_actions_pod ();
- close ();
+let child name xml =
+ match optional_child name xml with
+ | Some c -> c
+ | None ->
+ failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
- let close = output_to "ocaml/guestfs.mli" in
- generate_ocaml_mli ();
- close ();
+let attribute name xml =
+ try Xml.attrib xml name
+ with Xml.No_attribute _ ->
+ failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
- let close = output_to "ocaml/guestfs.ml" in
- generate_ocaml_ml ();
- close ();
+";
- let close = output_to "ocaml/guestfs_c_actions.c" in
- generate_ocaml_c ();
- close ();
+ generate_parsers grammar;
+ pr "\n";
- let close = output_to "ocaml/bindtests.ml" in
- generate_ocaml_bindtests ();
- close ();
+ 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
+"
- let close = output_to "perl/Guestfs.xs" in
- generate_perl_xs ();
- close ();
+(* This is used to generate the src/MAX_PROC_NR file which
+ * contains the maximum procedure number, a surrogate for the
+ * ABI version number. See src/Makefile.am for the details.
+ *)
+and generate_max_proc_nr () =
+ let proc_nrs = List.map (
+ fun (_, _, proc_nr, _, _, _, _) -> proc_nr
+ ) daemon_functions in
- let close = output_to "perl/lib/Sys/Guestfs.pm" in
- generate_perl_pm ();
- close ();
+ let max_proc_nr = List.fold_left max 0 proc_nrs in
- let close = output_to "perl/bindtests.pl" in
- generate_perl_bindtests ();
- close ();
+ pr "%d\n" max_proc_nr
- let close = output_to "python/guestfs-py.c" in
- generate_python_c ();
- close ();
+let output_to filename k =
+ let filename_new = filename ^ ".new" in
+ chan := open_out filename_new;
+ k ();
+ close_out !chan;
+ chan := Pervasives.stdout;
- let close = output_to "python/guestfs.py" in
- generate_python_py ();
- close ();
+ (* Is the new file different from the current file? *)
+ if Sys.file_exists filename && files_equal filename filename_new then
+ unlink filename_new (* same, so skip it *)
+ else (
+ (* different, overwrite old one *)
+ (try chmod filename 0o644 with Unix_error _ -> ());
+ rename filename_new filename;
+ chmod filename 0o444;
+ printf "written %s\n%!" filename;
+ )
- let close = output_to "python/bindtests.py" in
- generate_python_bindtests ();
- close ();
+let perror msg = function
+ | Unix_error (err, _, _) ->
+ eprintf "%s: %s\n" msg (error_message err)
+ | exn ->
+ eprintf "%s: %s\n" msg (Printexc.to_string exn)
- let close = output_to "ruby/ext/guestfs/_guestfs.c" in
- generate_ruby_c ();
- close ();
+(* Main program. *)
+let () =
+ let lock_fd =
+ try openfile "HACKING" [O_RDWR] 0
+ with
+ | Unix_error (ENOENT, _, _) ->
+ eprintf "\
+You are probably running this from the wrong directory.
+Run it from the top source directory using the command
+ src/generator.ml
+";
+ exit 1
+ | exn ->
+ perror "open: HACKING" exn;
+ exit 1 in
+
+ (* Acquire a lock so parallel builds won't try to run the generator
+ * twice at the same time. Subsequent builds will wait for the first
+ * one to finish. Note the lock is released implicitly when the
+ * program exits.
+ *)
+ (try lockf lock_fd F_LOCK 1
+ with exn ->
+ perror "lock: HACKING" exn;
+ exit 1);
- let close = output_to "ruby/bindtests.rb" in
- generate_ruby_bindtests ();
- close ();
+ check_functions ();
- let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in
- generate_java_java ();
- close ();
+ output_to "src/guestfs_protocol.x" generate_xdr;
+ 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/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 "src/MAX_PROC_NR" generate_max_proc_nr;
+ output_to "src/libguestfs.syms" generate_linker_script;
+ output_to "daemon/actions.h" generate_daemon_actions_h;
+ output_to "daemon/stubs.c" generate_daemon_actions;
+ output_to "daemon/names.c" generate_daemon_names;
+ output_to "daemon/optgroups.c" generate_daemon_optgroups_c;
+ output_to "daemon/optgroups.h" generate_daemon_optgroups_h;
+ output_to "capitests/tests.c" generate_tests;
+ 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 "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 "python/guestfs-py.c" generate_python_c;
+ output_to "python/guestfs.py" generate_python_py;
+ output_to "python/bindtests.py" generate_python_bindtests;
+ output_to "ruby/ext/guestfs/_guestfs.c" generate_ruby_c;
+ output_to "ruby/bindtests.rb" generate_ruby_bindtests;
+ output_to "java/com/redhat/et/libguestfs/GuestFS.java" generate_java_java;
List.iter (
fun (typ, jtyp) ->
let cols = cols_of_struct typ in
let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
- let close = output_to filename in
- generate_java_struct jtyp cols;
- close ();
+ output_to filename (generate_java_struct jtyp cols);
) java_structs;
- let close = output_to "java/Makefile.inc" in
- generate_java_makefile_inc ();
- close ();
-
- let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in
- generate_java_c ();
- close ();
-
- let close = output_to "java/Bindtests.java" in
- generate_java_bindtests ();
- close ();
-
- let close = output_to "haskell/Guestfs.hs" in
- generate_haskell_hs ();
- close ();
-
- let close = output_to "haskell/Bindtests.hs" in
- generate_haskell_bindtests ();
- close ();
-
- let close = output_to "src/MAX_PROC_NR" in
- generate_max_proc_nr ();
- close ();
+ output_to "java/Makefile.inc" generate_java_makefile_inc;
+ output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c;
+ output_to "java/Bindtests.java" generate_java_bindtests;
+ output_to "haskell/Guestfs.hs" generate_haskell_hs;
+ output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
+ output_to "csharp/Libguestfs.cs" generate_csharp;
(* Always generate this file last, and unconditionally. It's used
* by the Makefile to know when we must re-run the generator.
*)
let chan = open_out "src/stamp-generator" in
fprintf chan "1\n";
- close_out chan
+ close_out chan;
+
+ printf "generated %d lines of code\n" !lines
git.annexia.org / libguestfs.git / blobdiff