#!/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
| 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.
*
* Note that the test environment has 3 block devices, of size 500MB,
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 (
"\
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
[], (* 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, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"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 *)
["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 (
[["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",
[InitEmpty, Always, TestOutputListOfDevices (
[["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext2"; "/dev/sda1"];
- ["mount"; "/dev/sda1"; "/"];
+ ["mount_options"; ""; "/dev/sda1"; "/"];
["mounts"]], ["/dev/sda1"]);
InitEmpty, Always, TestOutputList (
[["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"]], [])],
(* 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>
The checksum is returned as a printable string.");
- ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
+ ("tar_in", (RErr, [FileIn "tarfile"; Pathname "directory"]), 69, [],
[InitBasicFS, Always, TestOutput (
[["tar_in"; "../images/helloworld.tar"; "/"];
["cat"; "/hello"]], "hello\n")],
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, [],
+ ("tgz_in", (RErr, [FileIn "tarball"; Pathname "directory"]), 71, [],
[InitBasicFS, Always, TestOutput (
[["tgz_in"; "../images/helloworld.tar.gz"; "/"];
["cat"; "/hello"]], "hello\n")],
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.
[InitNone, Always, TestOutput (
[["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",
"\
["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",
"\
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.
+
+The mode actually set is affected by the umask.");
("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [Optional "mknod"],
[InitBasicFS, Always, TestOutputStruct (
"\
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, [Optional "mknod"],
[InitBasicFS, Always, TestOutputStruct (
"\
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>.
+
+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 (
"\
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.");
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",
[InitEmpty, Always, TestOutput (
[["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",
[["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",
("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 sets the bootable flag on partition numbered C<partnum> on
device C<device>. Note that partitions are numbered from 1.
-The bootable flag is used by some PC BIOSes to determine which
-partition to boot from. It is by no means universally recognized,
-and in any case if your operating system installed a boot
-sector on the device itself, then that takes precedence.");
+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 (
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 libguestfs functions which not all builds of
-libguestfs will be able to provide.
+groups of functionality in the appliance, which not all builds of
+the libguestfs appliance will be able to provide.
-The precise libguestfs function groups that may be checked by this
-command are listed in L<guestfs(3)/AVAILABILITY>.
+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 API group names, eg:
+The argument C<groups> is a list of group names, eg:
C<[\"inotify\", \"augeas\"]> would check for the availability of
-the C<guestfs_inotify_*> functions and C<guestfs_aug_*>
-(partition editing) functions.
+the Linux inotify functions and Augeas (configuration file
+editing) functions.
The command returns no error if I<all> requested groups are available.
-It returns an error if one or more of the requested
-groups is unavailable.
+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 C<groups> then an error is always returned.
+list of groups then an error is always returned.
I<Notes:>
=item *
You must call C<guestfs_launch> before calling this function.
-The reason is because we don't know what function groups are
+
+The reason is because we don't know what groups are
supported by the appliance/daemon until it is running and can
be queried.
=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"; Pathname "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>.");
+
+ ("debug_upload", (RErr, [FileIn "filename"; String "tmpname"; Int "mode"]), 241, [],
+ [],
+ "upload a file to the appliance (internal use only)",
+ "\
+The C<guestfs_debug_upload> command uploads a file to
+the libguestfs appliance.
+
+There is no comprehensive help for this command. You have
+to look at the file C<daemon/debug.c> in the libguestfs source
+to find out what it is for.");
+
+ ("base64_in", (RErr, [FileIn "base64file"; Pathname "filename"]), 242, [],
+ [InitBasicFS, Always, TestOutput (
+ [["base64_in"; "../images/hello.b64"; "/hello"];
+ ["cat"; "/hello"]], "hello\n")],
+ "upload base64-encoded data to file",
+ "\
+This command uploads base64-encoded data from C<base64file>
+to C<filename>.");
+
+ ("base64_out", (RErr, [Pathname "filename"; FileOut "base64file"]), 243, [],
+ [],
+ "download file and encode as base64",
+ "\
+This command downloads the contents of C<filename>, writing
+it out to local file C<base64file> encoded as base64.");
+
]
let all_functions = non_daemon_functions @ daemon_functions
* Note we don't want to use any external OCaml libraries which
* makes this a bit harder than it should be.
*)
+module StringMap = Map.Make (String)
+
let failwithf fs = ksprintf failwith fs
+let unique = let i = ref 0 in fun () -> incr i; !i
+
let replace_char s c1 c2 =
let s2 = String.copy s in
let r = ref false in
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
"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";
failwithf "short description of %s should not end with . or \\n." name
) all_functions;
- (* Check long dscriptions. *)
+ (* Check long descriptions. *)
List.iter (
fun (name, _, _, _, _, _, longdesc) ->
if longdesc.[String.length longdesc-1] = '\n' then
(* 'pr' prints to the current output file. *)
let chan = ref Pervasives.stdout
-let pr fs = ksprintf (output_string !chan) fs
+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"
let name = "guestfs_" ^ shortname in
pr "=head2 %s\n\n" name;
pr " ";
- generate_prototype ~extern:false ~handle:"handle" name style;
+ generate_prototype ~extern:false ~handle:"g" name style;
pr "\n\n";
pr "%s\n\n" longdesc;
(match fst style with
* 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_prototype ~single_line:true ~newline:true ~handle:"handle"
+ generate_prototype ~single_line:true ~newline:true ~handle:"g"
name style
) all_functions
(* 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_prototype ~single_line:true ~newline:true ~handle:"handle"
+ generate_prototype ~single_line:true ~newline:true ~handle:"g"
name style
) non_daemon_functions
(* 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\"
pr " int r;\n";
pr "\n";
trace_call shortname style;
- pr " if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
+ pr " if (check_state (g, \"%s\") == -1) return %s;\n"
+ shortname error_code;
pr " guestfs___set_busy (g);\n";
pr "\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";
);
pr "\n";
+ let is_filein =
+ List.exists (function FileIn _ -> true | _ -> false) (snd style) in
+
(match snd style with
| [] -> ()
| args ->
pr " memset (&args, 0, sizeof args);\n";
pr "\n";
pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
- pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
- pr " return;\n";
+ if is_filein then
+ pr " cancel_receive ();\n";
+ pr " reply_with_error (\"daemon failed to decode procedure arguments\");\n";
+ pr " goto done;\n";
pr " }\n";
let pr_args n =
pr " char *%s = args.%s;\n" n n
pr " %s = realloc (args.%s.%s_val,\n" n n n;
pr " sizeof (char *) * (args.%s.%s_len+1));\n" n n;
pr " if (%s == NULL) {\n" n;
+ if is_filein then
+ pr " cancel_receive ();\n";
pr " reply_with_perror (\"realloc\");\n";
pr " goto done;\n";
pr " }\n";
function
| Pathname n ->
pr_args n;
- pr " ABS_PATH (%s, goto done);\n" n;
+ pr " ABS_PATH (%s, %s, goto done);\n"
+ n (if is_filein then "cancel_receive ()" else "");
| Device n ->
pr_args n;
- pr " RESOLVE_DEVICE (%s, goto done);\n" n;
+ pr " RESOLVE_DEVICE (%s, %s, goto done);\n"
+ n (if is_filein then "cancel_receive ()" else "");
| Dev_or_Path n ->
pr_args n;
- pr " REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);\n" n;
+ pr " REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, %s, goto done);\n"
+ n (if is_filein then "cancel_receive ()" else "");
| String n -> pr_args n
| OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
| StringList n ->
pr " /* Ensure that each is a device,\n";
pr " * and perform device name translation. */\n";
pr " { int pvi; for (pvi = 0; physvols[pvi] != NULL; ++pvi)\n";
- pr " RESOLVE_DEVICE (physvols[pvi], goto done);\n";
+ pr " RESOLVE_DEVICE (physvols[pvi], %s, goto done);\n"
+ (if is_filein then "cancel_receive ()" else "");
pr " }\n";
| Bool n -> pr " %s = args.%s;\n" n n
| Int n -> pr " %s = args.%s;\n" n n
if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
(* Emit NEED_ROOT just once, even when there are two or
more Pathname args *)
- pr " NEED_ROOT (goto done);\n";
+ pr " NEED_ROOT (%s, goto done);\n"
+ (if is_filein then "cancel_receive ()" else "");
);
(* Don't want to call the impl with any FileIn or FileOut
);
(* Free the args. *)
+ pr "done:\n";
(match snd style with
- | [] ->
- pr "done: ;\n";
+ | [] -> ()
| _ ->
- pr "done:\n";
pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
name
);
-
+ pr " return;\n";
pr "}\n\n";
) daemon_functions;
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";
* guestfs_available.
*)
and generate_daemon_optgroups_c () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
pr "#include <config.h>\n";
pr "\n";
pr "};\n"
and generate_daemon_optgroups_h () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
List.iter (
fun (group, _) ->
(* Generate the tests. *)
and generate_tests () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
pr "\
#include <stdio.h>
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 (EXIT_FAILURE);
}
- /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
- alarm (600);
-
/* Cancel previous alarm. */
alarm (0);
["lvm_remove_all"];
["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;
["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)
| 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";
function
| Device n
| String n
- | OptString n
- | FileIn n
- | FileOut n -> pr " const char *%s;\n" n
+ | OptString n -> pr " const char *%s;\n" n
| Pathname n
- | Dev_or_Path n -> pr " char *%s;\n" n
+ | Dev_or_Path n
+ | FileIn n
+ | FileOut n -> pr " char *%s;\n" n
| StringList n | DeviceList n -> pr " char **%s;\n" n
| Bool n -> pr " int %s;\n" n
| Int n -> pr " int %s;\n" n
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 = STRNEQ (argv[%d], \"\") ? argv[%d] : NULL;\n"
name i i
| FileIn name ->
- pr " %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdin\";\n"
- name i i
+ pr " %s = file_in (argv[%d]);\n" name i;
+ pr " if (%s == NULL) return -1;\n" name
| FileOut name ->
- pr " %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdout\";\n"
- name i i
+ pr " %s = file_out (argv[%d]);\n" name i;
+ pr " if (%s == NULL) return -1;\n" name
| StringList name | DeviceList name ->
pr " %s = parse_string_list (argv[%d]);\n" name i;
pr " if (%s == NULL) return -1;\n" name;
| Bool name ->
pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
| Int name ->
- 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. *)
List.iter (
function
| Device name | String name
- | OptString name | FileIn name | FileOut name | Bool name
+ | OptString name | Bool name
| Int name | Int64 name -> ()
- | Pathname name | Dev_or_Path name ->
+ | Pathname name | Dev_or_Path name | FileOut name ->
pr " free (%s);\n" name
+ | FileIn name ->
+ pr " free_file_in (%s);\n" name
| StringList name | DeviceList name ->
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 (
#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.
(* 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>
) 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. *)
+(* Code to generator bindings for virt-inspector. Currently only
+ * implemented for OCaml code (for virt-p2v 2.0).
+ *)
+let rng_input = "inspector/virt-inspector.rng"
+
+(* Read the input file and parse it into internal structures. This is
+ * by no means a complete RELAX NG parser, but is just enough to be
+ * able to parse the specific input file.
+ *)
+type rng =
+ | Element of string * rng list (* <element name=name/> *)
+ | Attribute of string * rng list (* <attribute name=name/> *)
+ | Interleave of rng list (* <interleave/> *)
+ | ZeroOrMore of rng (* <zeroOrMore/> *)
+ | OneOrMore of rng (* <oneOrMore/> *)
+ | Optional of rng (* <optional/> *)
+ | Choice of string list (* <choice><value/>*</choice> *)
+ | Value of string (* <value>str</value> *)
+ | Text (* <text/> *)
+
+let rec string_of_rng = function
+ | Element (name, xs) ->
+ "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
+ | Attribute (name, xs) ->
+ "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
+ | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")"
+ | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")"
+ | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")"
+ | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")"
+ | Choice values -> "Choice [" ^ String.concat ", " values ^ "]"
+ | Value value -> "Value \"" ^ value ^ "\""
+ | Text -> "Text"
+
+and string_of_rng_list xs =
+ String.concat ", " (List.map string_of_rng xs)
+
+let rec parse_rng ?defines context = function
+ | [] -> []
+ | Xml.Element ("element", ["name", name], children) :: rest ->
+ Element (name, parse_rng ?defines context children)
+ :: parse_rng ?defines context rest
+ | Xml.Element ("attribute", ["name", name], children) :: rest ->
+ Attribute (name, parse_rng ?defines context children)
+ :: parse_rng ?defines context rest
+ | Xml.Element ("interleave", [], children) :: rest ->
+ Interleave (parse_rng ?defines context children)
+ :: parse_rng ?defines context rest
+ | Xml.Element ("zeroOrMore", [], [child]) :: rest ->
+ let rng = parse_rng ?defines context [child] in
+ (match rng with
+ | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
+ | _ ->
+ failwithf "%s: <zeroOrMore> contains more than one child element"
+ context
+ )
+ | Xml.Element ("oneOrMore", [], [child]) :: rest ->
+ let rng = parse_rng ?defines context [child] in
+ (match rng with
+ | [child] -> OneOrMore child :: parse_rng ?defines context rest
+ | _ ->
+ failwithf "%s: <oneOrMore> contains more than one child element"
+ context
+ )
+ | Xml.Element ("optional", [], [child]) :: rest ->
+ let rng = parse_rng ?defines context [child] in
+ (match rng with
+ | [child] -> Optional child :: parse_rng ?defines context rest
+ | _ ->
+ failwithf "%s: <optional> contains more than one child element"
+ context
+ )
+ | Xml.Element ("choice", [], children) :: rest ->
+ let values = List.map (
+ function Xml.Element ("value", [], [Xml.PCData value]) -> value
+ | _ ->
+ failwithf "%s: can't handle anything except <value> in <choice>"
+ context
+ ) children in
+ Choice values
+ :: parse_rng ?defines context rest
+ | Xml.Element ("value", [], [Xml.PCData value]) :: rest ->
+ Value value :: parse_rng ?defines context rest
+ | Xml.Element ("text", [], []) :: rest ->
+ Text :: parse_rng ?defines context rest
+ | Xml.Element ("ref", ["name", name], []) :: rest ->
+ (* Look up the reference. Because of limitations in this parser,
+ * we can't handle arbitrarily nested <ref> yet. You can only
+ * use <ref> from inside <start>.
+ *)
+ (match defines with
+ | None ->
+ failwithf "%s: contains <ref>, but no refs are defined yet" context
+ | Some map ->
+ let rng = StringMap.find name map in
+ rng @ parse_rng ?defines context rest
+ )
+ | x :: _ ->
+ failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
+
+let grammar =
+ let xml = Xml.parse_file rng_input in
+ match xml with
+ | Xml.Element ("grammar", _,
+ Xml.Element ("start", _, gram) :: defines) ->
+ (* The <define/> elements are referenced in the <start> section,
+ * so build a map of those first.
+ *)
+ let defines = List.fold_left (
+ fun map ->
+ function Xml.Element ("define", ["name", name], defn) ->
+ StringMap.add name defn map
+ | _ ->
+ failwithf "%s: expected <define name=name/>" rng_input
+ ) StringMap.empty defines in
+ let defines = StringMap.mapi parse_rng defines in
+
+ (* Parse the <start> clause, passing the defines. *)
+ parse_rng ~defines "<start>" gram
+ | _ ->
+ failwithf "%s: input is not <grammar><start/><define>*</grammar>"
+ rng_input
+
+let name_of_field = function
+ | Element (name, _) | Attribute (name, _)
+ | ZeroOrMore (Element (name, _))
+ | OneOrMore (Element (name, _))
+ | Optional (Element (name, _)) -> name
+ | Optional (Attribute (name, _)) -> name
+ | Text -> (* an unnamed field in an element *)
+ "data"
+ | rng ->
+ failwithf "name_of_field failed at: %s" (string_of_rng rng)
+
+(* At the moment this function only generates OCaml types. However we
+ * should parameterize it later so it can generate types/structs in a
+ * variety of languages.
+ *)
+let generate_types xs =
+ (* A simple type is one that can be printed out directly, eg.
+ * "string option". A complex type is one which has a name and has
+ * to be defined via another toplevel definition, eg. a struct.
+ *
+ * generate_type generates code for either simple or complex types.
+ * In the simple case, it returns the string ("string option"). In
+ * the complex case, it returns the name ("mountpoint"). In the
+ * complex case it has to print out the definition before returning,
+ * so it should only be called when we are at the beginning of a
+ * new line (BOL context).
+ *)
+ let rec generate_type = function
+ | Text -> (* string *)
+ "string", true
+ | Choice values -> (* [`val1|`val2|...] *)
+ "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
+ | ZeroOrMore rng -> (* <rng> list *)
+ let t, is_simple = generate_type rng in
+ t ^ " list (* 0 or more *)", is_simple
+ | OneOrMore rng -> (* <rng> list *)
+ let t, is_simple = generate_type rng in
+ t ^ " list (* 1 or more *)", is_simple
+ (* virt-inspector hack: bool *)
+ | Optional (Attribute (name, [Value "1"])) ->
+ "bool", true
+ | Optional rng -> (* <rng> list *)
+ let t, is_simple = generate_type rng in
+ t ^ " option", is_simple
+ (* type name = { fields ... } *)
+ | Element (name, fields) when is_attrs_interleave fields ->
+ generate_type_struct name (get_attrs_interleave fields)
+ | Element (name, [field]) (* type name = field *)
+ | Attribute (name, [field]) ->
+ let t, is_simple = generate_type field in
+ if is_simple then (t, true)
+ else (
+ pr "type %s = %s\n" name t;
+ name, false
+ )
+ | Element (name, fields) -> (* type name = { fields ... } *)
+ generate_type_struct name fields
+ | rng ->
+ failwithf "generate_type failed at: %s" (string_of_rng rng)
+
+ and is_attrs_interleave = function
+ | [Interleave _] -> true
+ | Attribute _ :: fields -> is_attrs_interleave fields
+ | Optional (Attribute _) :: fields -> is_attrs_interleave fields
+ | _ -> false
+
+ and get_attrs_interleave = function
+ | [Interleave fields] -> fields
+ | ((Attribute _) as field) :: fields
+ | ((Optional (Attribute _)) as field) :: fields ->
+ field :: get_attrs_interleave fields
+ | _ -> assert false
+
+ and generate_types xs =
+ List.iter (fun x -> ignore (generate_type x)) xs
+
+ and generate_type_struct name fields =
+ (* Calculate the types of the fields first. We have to do this
+ * before printing anything so we are still in BOL context.
+ *)
+ let types = List.map fst (List.map generate_type fields) in
+
+ (* Special case of a struct containing just a string and another
+ * field. Turn it into an assoc list.
+ *)
+ match types with
+ | ["string"; other] ->
+ let fname1, fname2 =
+ match fields with
+ | [f1; f2] -> name_of_field f1, name_of_field f2
+ | _ -> assert false in
+ pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
+ name, false
+
+ | types ->
+ pr "type %s = {\n" name;
+ List.iter (
+ fun (field, ftype) ->
+ let fname = name_of_field field in
+ pr " %s_%s : %s;\n" name fname ftype
+ ) (List.combine fields types);
+ pr "}\n";
+ (* Return the name of this type, and
+ * false because it's not a simple type.
+ *)
+ name, false
+ in
+
+ generate_types xs
+
+let generate_parsers xs =
+ (* As for generate_type above, generate_parser makes a parser for
+ * some type, and returns the name of the parser it has generated.
+ * Because it (may) need to print something, it should always be
+ * called in BOL context.
+ *)
+ let rec generate_parser = function
+ | Text -> (* string *)
+ "string_child_or_empty"
+ | Choice values -> (* [`val1|`val2|...] *)
+ sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
+ (String.concat "|"
+ (List.map (fun v -> sprintf "%S -> `%s" v v) values))
+ | ZeroOrMore rng -> (* <rng> list *)
+ let pa = generate_parser rng in
+ sprintf "(fun x -> List.map %s (Xml.children x))" pa
+ | OneOrMore rng -> (* <rng> list *)
+ let pa = generate_parser rng in
+ sprintf "(fun x -> List.map %s (Xml.children x))" pa
+ (* virt-inspector hack: bool *)
+ | Optional (Attribute (name, [Value "1"])) ->
+ sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
+ | Optional rng -> (* <rng> list *)
+ let pa = generate_parser rng in
+ sprintf "(function None -> None | Some x -> Some (%s x))" pa
+ (* type name = { fields ... } *)
+ | Element (name, fields) when is_attrs_interleave fields ->
+ generate_parser_struct name (get_attrs_interleave fields)
+ | Element (name, [field]) -> (* type name = field *)
+ let pa = generate_parser field in
+ let parser_name = sprintf "parse_%s_%d" name (unique ()) in
+ pr "let %s =\n" parser_name;
+ pr " %s\n" pa;
+ pr "let parse_%s = %s\n" name parser_name;
+ parser_name
+ | Attribute (name, [field]) ->
+ let pa = generate_parser field in
+ let parser_name = sprintf "parse_%s_%d" name (unique ()) in
+ pr "let %s =\n" parser_name;
+ pr " %s\n" pa;
+ pr "let parse_%s = %s\n" name parser_name;
+ parser_name
+ | Element (name, fields) -> (* type name = { fields ... } *)
+ generate_parser_struct name ([], fields)
+ | rng ->
+ failwithf "generate_parser failed at: %s" (string_of_rng rng)
+
+ and is_attrs_interleave = function
+ | [Interleave _] -> true
+ | Attribute _ :: fields -> is_attrs_interleave fields
+ | Optional (Attribute _) :: fields -> is_attrs_interleave fields
+ | _ -> false
+
+ and get_attrs_interleave = function
+ | [Interleave fields] -> [], fields
+ | ((Attribute _) as field) :: fields
+ | ((Optional (Attribute _)) as field) :: fields ->
+ let attrs, interleaves = get_attrs_interleave fields in
+ (field :: attrs), interleaves
+ | _ -> assert false
+
+ and generate_parsers xs =
+ List.iter (fun x -> ignore (generate_parser x)) xs
+
+ and generate_parser_struct name (attrs, interleaves) =
+ (* Generate parsers for the fields first. We have to do this
+ * before printing anything so we are still in BOL context.
+ *)
+ let fields = attrs @ interleaves in
+ let pas = List.map generate_parser fields in
+
+ (* Generate an intermediate tuple from all the fields first.
+ * If the type is just a string + another field, then we will
+ * return this directly, otherwise it is turned into a record.
+ *
+ * RELAX NG note: This code treats <interleave> and plain lists of
+ * fields the same. In other words, it doesn't bother enforcing
+ * any ordering of fields in the XML.
+ *)
+ pr "let parse_%s x =\n" name;
+ pr " let t = (\n ";
+ let comma = ref false in
+ List.iter (
+ fun x ->
+ if !comma then pr ",\n ";
+ comma := true;
+ match x with
+ | Optional (Attribute (fname, [field])), pa ->
+ pr "%s x" pa
+ | Optional (Element (fname, [field])), pa ->
+ pr "%s (optional_child %S x)" pa fname
+ | Attribute (fname, [Text]), _ ->
+ pr "attribute %S x" fname
+ | (ZeroOrMore _ | OneOrMore _), pa ->
+ pr "%s x" pa
+ | Text, pa ->
+ pr "%s x" pa
+ | (field, pa) ->
+ let fname = name_of_field field in
+ pr "%s (child %S x)" pa fname
+ ) (List.combine fields pas);
+ pr "\n ) in\n";
+
+ (match fields with
+ | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
+ pr " t\n"
+
+ | _ ->
+ pr " (Obj.magic t : %s)\n" name
+(*
+ List.iter (
+ function
+ | (Optional (Attribute (fname, [field])), pa) ->
+ pr " %s_%s =\n" name fname;
+ pr " %s x;\n" pa
+ | (Optional (Element (fname, [field])), pa) ->
+ pr " %s_%s =\n" name fname;
+ pr " (let x = optional_child %S x in\n" fname;
+ pr " %s x);\n" pa
+ | (field, pa) ->
+ let fname = name_of_field field in
+ pr " %s_%s =\n" name fname;
+ pr " (let x = child %S x in\n" fname;
+ pr " %s x);\n" pa
+ ) (List.combine fields pas);
+ pr "}\n"
+*)
+ );
+ sprintf "parse_%s" name
+ in
+
+ generate_parsers xs
+
+(* Generate ocaml/guestfs_inspector.mli. *)
+let generate_ocaml_inspector_mli () =
+ generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
+
+ pr "\
+(** This is an OCaml language binding to the external [virt-inspector]
+ program.
+
+ For more information, please read the man page [virt-inspector(1)].
+*)
+
+";
+
+ generate_types grammar;
+ pr "(** The nested information returned from the {!inspect} function. *)\n";
+ pr "\n";
+
+ pr "\
+val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems
+(** To inspect a libvirt domain called [name], pass a singleton
+ list: [inspect [name]]. When using libvirt only, you may
+ optionally pass a libvirt URI using [inspect ~connect:uri ...].
+
+ To inspect a disk image or images, pass a list of the filenames
+ of the disk images: [inspect filenames]
+
+ This function inspects the given guest or disk images and
+ returns a list of operating system(s) found and a large amount
+ of information about them. In the vast majority of cases,
+ a virtual machine only contains a single operating system.
+
+ If the optional [~xml] parameter is given, then this function
+ skips running the external virt-inspector program and just
+ parses the given XML directly (which is expected to be XML
+ produced from a previous run of virt-inspector). The list of
+ names and connect URI are ignored in this case.
+
+ This function can throw a wide variety of exceptions, for example
+ if the external virt-inspector program cannot be found, or if
+ it doesn't generate valid XML.
+*)
+"
+
+(* Generate ocaml/guestfs_inspector.ml. *)
+let generate_ocaml_inspector_ml () =
+ generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
+
+ pr "open Unix\n";
+ pr "\n";
+
+ generate_types grammar;
+ pr "\n";
+
+ pr "\
+(* Misc functions which are used by the parser code below. *)
+let first_child = function
+ | Xml.Element (_, _, c::_) -> c
+ | Xml.Element (name, _, []) ->
+ failwith (\"expected <\" ^ name ^ \"/> to have a child node\")
+ | Xml.PCData str ->
+ failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
+
+let string_child_or_empty = function
+ | Xml.Element (_, _, [Xml.PCData s]) -> s
+ | Xml.Element (_, _, []) -> \"\"
+ | Xml.Element (x, _, _) ->
+ failwith (\"expected XML tag with a single PCDATA child, but got \" ^
+ x ^ \" instead\")
+ | Xml.PCData str ->
+ failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
+
+let optional_child name xml =
+ let children = Xml.children xml in
+ try
+ Some (List.find (function
+ | Xml.Element (n, _, _) when n = name -> true
+ | _ -> false) children)
+ with
+ Not_found -> None
+
+let child name xml =
+ match optional_child name xml with
+ | Some c -> c
+ | None ->
+ failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
+
+let attribute name xml =
+ try Xml.attrib xml name
+ with Xml.No_attribute _ ->
+ failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
+
+";
+
+ generate_parsers grammar;
+ pr "\n";
+
+ pr "\
+(* Run external virt-inspector, then use parser to parse the XML. *)
+let inspect ?connect ?xml names =
+ let xml =
+ match xml with
+ | None ->
+ if names = [] then invalid_arg \"inspect: no names given\";
+ let cmd = [ \"virt-inspector\"; \"--xml\" ] @
+ (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @
+ names in
+ let cmd = List.map Filename.quote cmd in
+ let cmd = String.concat \" \" cmd in
+ let chan = open_process_in cmd in
+ let xml = Xml.parse_in chan in
+ (match close_process_in chan with
+ | WEXITED 0 -> ()
+ | WEXITED _ -> failwith \"external virt-inspector command failed\"
+ | WSIGNALED i | WSTOPPED i ->
+ failwith (\"external virt-inspector command died or stopped on sig \" ^
+ string_of_int i)
+ );
+ xml
+ | Some doc ->
+ Xml.parse_string doc in
+ parse_operatingsystems xml
+"
+
(* 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.
pr "%d\n" max_proc_nr
-let output_to filename =
+let output_to filename k =
let filename_new = filename ^ ".new" in
chan := open_out filename_new;
- let close () =
- close_out !chan;
- chan := Pervasives.stdout;
-
- (* 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;
- )
- in
- close
+ k ();
+ close_out !chan;
+ chan := Pervasives.stdout;
+
+ (* 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 perror msg = function
| Unix_error (err, _, _) ->
check_functions ();
- let close = output_to "src/guestfs_protocol.x" in
- generate_xdr ();
- close ();
-
- let close = output_to "src/guestfs-structs.h" in
- generate_structs_h ();
- close ();
-
- let close = output_to "src/guestfs-actions.h" in
- generate_actions_h ();
- close ();
-
- let close = output_to "src/guestfs-internal-actions.h" in
- generate_internal_actions_h ();
- close ();
-
- let close = output_to "src/guestfs-actions.c" in
- generate_client_actions ();
- close ();
-
- let close = output_to "daemon/actions.h" in
- generate_daemon_actions_h ();
- close ();
-
- let close = output_to "daemon/stubs.c" in
- generate_daemon_actions ();
- close ();
-
- let close = output_to "daemon/names.c" in
- generate_daemon_names ();
- close ();
-
- let close = output_to "daemon/optgroups.c" in
- generate_daemon_optgroups_c ();
- close ();
-
- let close = output_to "daemon/optgroups.h" in
- generate_daemon_optgroups_h ();
- close ();
-
- let close = output_to "capitests/tests.c" in
- generate_tests ();
- close ();
-
- let close = output_to "src/guestfs-bindtests.c" in
- generate_bindtests ();
- close ();
-
- let close = output_to "fish/cmds.c" in
- generate_fish_cmds ();
- close ();
-
- let close = output_to "fish/completion.c" in
- generate_fish_completion ();
- close ();
-
- let close = output_to "guestfs-structs.pod" in
- generate_structs_pod ();
- close ();
-
- let close = output_to "guestfs-actions.pod" in
- generate_actions_pod ();
- close ();
-
- let close = output_to "guestfs-availability.pod" in
- generate_availability_pod ();
- close ();
-
- let close = output_to "guestfish-actions.pod" in
- generate_fish_actions_pod ();
- close ();
-
- let close = output_to "ocaml/guestfs.mli" in
- generate_ocaml_mli ();
- close ();
-
- let close = output_to "ocaml/guestfs.ml" in
- generate_ocaml_ml ();
- close ();
-
- let close = output_to "ocaml/guestfs_c_actions.c" in
- generate_ocaml_c ();
- close ();
-
- let close = output_to "ocaml/bindtests.ml" in
- generate_ocaml_bindtests ();
- close ();
-
- let close = output_to "perl/Guestfs.xs" in
- generate_perl_xs ();
- close ();
-
- let close = output_to "perl/lib/Sys/Guestfs.pm" in
- generate_perl_pm ();
- close ();
-
- let close = output_to "perl/bindtests.pl" in
- generate_perl_bindtests ();
- close ();
-
- let close = output_to "python/guestfs-py.c" in
- generate_python_c ();
- close ();
-
- let close = output_to "python/guestfs.py" in
- generate_python_py ();
- close ();
-
- let close = output_to "python/bindtests.py" in
- generate_python_bindtests ();
- close ();
-
- let close = output_to "ruby/ext/guestfs/_guestfs.c" in
- generate_ruby_c ();
- close ();
-
- let close = output_to "ruby/bindtests.rb" in
- generate_ruby_bindtests ();
- close ();
-
- let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in
- generate_java_java ();
- close ();
+ 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