* this one to describe the interface (see the big table below), and
* daemon/<somefile>.c to write the implementation.
*
- * After editing this file, run it (./src/generator.ml) to regenerate
- * all the output files.
+ * 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.
*
* IMPORTANT: This script should NOT print any warnings. If it prints
* warnings, you should treat them as errors.
(* "RString" and "RStringList" are caller-frees. *)
| RString of string
| RStringList of string
- (* Some limited tuples are possible: *)
- | RIntBool of string * string
- (* LVM PVs, VGs and LVs. *)
- | RPVList of string
- | RVGList of string
- | RLVList of string
- (* Stat buffers. *)
- | RStat of string
- | RStatVFS of string
+ (* "RStruct" is a function which returns a single named structure
+ * or an error indication (in C, a struct, and in other languages
+ * with varying representations, but usually very efficient). See
+ * after the function list below for the structures.
+ *)
+ | RStruct of string * string (* name of retval, name of struct *)
+ (* "RStructList" is a function which returns either a list/array
+ * of structures (could be zero-length), or an error indication.
+ *)
+ | RStructList of string * string (* name of retval, name of struct *)
(* Key-value pairs of untyped strings. Turns into a hashtable or
* dictionary in languages which support it. DON'T use this as a
* general "bucket" for results. Prefer a stronger typed return
* inefficient. Keys should be unique. NULLs are not permitted.
*)
| RHashtable of string
- (* List of directory entries (the result of readdir(3)). *)
- | RDirentList of string
+ (* "RBufferOut" is handled almost exactly like RString, but
+ * it allows the string to contain arbitrary 8 bit data including
+ * ASCII NUL. In the C API this causes an implicit extra parameter
+ * to be added of type <size_t *size_r>. The extra parameter
+ * returns the actual size of the return buffer in bytes.
+ *
+ * Other programming languages support strings with arbitrary 8 bit
+ * data.
+ *
+ * At the RPC layer we have to use the opaque<> type instead of
+ * string<>. Returned data is still limited to the max message
+ * size (ie. ~ 2 MB).
+ *)
+ | RBufferOut of string
and args = argt list (* Function parameters, guestfs handle is implicit. *)
*)
| FileIn of string
| FileOut of string
+(* Not implemented:
+ (* Opaque buffer which can contain arbitrary 8 bit data.
+ * In the C API, this is expressed as <char *, int> pair.
+ * Most other languages have a string type which can contain
+ * ASCII NUL. We use whatever type is appropriate for each
+ * language.
+ * Buffers are limited by the total message size. To transfer
+ * large blocks of data, use FileIn/FileOut parameters instead.
+ * To return an arbitrary buffer, use RBufferOut.
+ *)
+ | BufferIn of string
+*)
type flags =
| ProtocolLimitWarning (* display warning about protocol size limits *)
| NotInDocs (* do not add this function to documentation *)
let protocol_limit_warning =
- "Because of the message protocol, there is a transfer limit
+ "Because of the message protocol, there is a transfer limit
of somewhere between 2MB and 4MB. To transfer large files you should use
FTP."
*)
| TestOutputInt of seq * int
(* Run the command sequence and expect the output of the final
+ * command to be <op> <int>, eg. ">=", "1".
+ *)
+ | TestOutputIntOp of seq * string * int
+ (* Run the command sequence and expect the output of the final
* command to be a true value (!= 0 or != NULL).
*)
| TestOutputTrue of seq
and test_field_compare =
| CompareWithInt of string * int
+ | CompareWithIntOp of string * string * int
| CompareWithString of string * string
| CompareFieldsIntEq of string * string
| CompareFieldsStrEq of string * string
"test0rconststring", RConstString "valout";
"test0rstring", RString "valout";
"test0rstringlist", RStringList "valout";
- "test0rintbool", RIntBool ("valout", "valout");
- "test0rpvlist", RPVList "valout";
- "test0rvglist", RVGList "valout";
- "test0rlvlist", RLVList "valout";
- "test0rstat", RStat "valout";
- "test0rstatvfs", RStatVFS "valout";
+ "test0rstruct", RStruct ("valout", "lvm_pv");
+ "test0rstructlist", RStructList ("valout", "lvm_pv");
"test0rhashtable", RHashtable "valout";
]
Setting C<qemu> to C<NULL> restores the default qemu binary.");
("get_qemu", (RConstString "qemu", []), -1, [],
- [],
+ [InitNone, Always, TestRun (
+ [["get_qemu"]])],
"get the qemu binary",
"\
Return the current qemu binary.
Setting C<path> to C<NULL> restores the default path.");
("get_path", (RConstString "path", []), -1, [],
- [],
+ [InitNone, Always, TestRun (
+ [["get_path"]])],
"get the search path",
"\
Return the current search path.
This is always non-NULL. If it wasn't set already, then this will
return the default path.");
- ("set_append", (RErr, [String "append"]), -1, [FishAlias "append"],
+ ("set_append", (RErr, [OptString "append"]), -1, [FishAlias "append"],
[],
"add options to kernel command line",
"\
are passed (libguestfs always adds a few of its own).");
("get_append", (RConstString "append", []), -1, [],
+ (* This cannot be tested with the current framework. The
+ * function can return NULL in normal operations, which the
+ * test framework interprets as an error.
+ *)
[],
"get the additional kernel options",
"\
enabled by default).");
("get_autosync", (RBool "autosync", []), -1, [],
- [],
+ [InitNone, Always, TestRun (
+ [["get_autosync"]])],
"get autosync mode",
"\
Get the autosync flag.");
This returns the verbose messages flag.");
("is_ready", (RBool "ready", []), -1, [],
- [],
+ [InitNone, Always, TestOutputTrue (
+ [["is_ready"]])],
"is ready to accept commands",
"\
This returns true iff this handle is ready to accept commands
For more information on states, see L<guestfs(3)>.");
("is_config", (RBool "config", []), -1, [],
- [],
+ [InitNone, Always, TestOutputFalse (
+ [["is_config"]])],
"is in configuration state",
"\
This returns true iff this handle is being configured
For more information on states, see L<guestfs(3)>.");
("is_launching", (RBool "launching", []), -1, [],
- [],
+ [InitNone, Always, TestOutputFalse (
+ [["is_launching"]])],
"is launching subprocess",
"\
This returns true iff this handle is launching the subprocess
For more information on states, see L<guestfs(3)>.");
("is_busy", (RBool "busy", []), -1, [],
- [],
+ [InitNone, Always, TestOutputFalse (
+ [["is_busy"]])],
"is busy processing a command",
"\
This returns true iff this handle is busy processing a command
For more information on states, see L<guestfs(3)>.");
("set_memsize", (RErr, [Int "memsize"]), -1, [FishAlias "memsize"],
- [],
+ [InitNone, Always, TestOutputInt (
+ [["set_memsize"; "500"];
+ ["get_memsize"]], 500)],
"set memory allocated to the qemu subprocess",
"\
This sets the memory size in megabytes allocated to the
see L<guestfs(3)>.");
("get_memsize", (RInt "memsize", []), -1, [],
- [],
+ [InitNone, Always, TestOutputIntOp (
+ [["get_memsize"]], ">=", 256)],
"get memory allocated to the qemu subprocess",
"\
This gets the memory size in megabytes allocated to the
For more information on the architecture of libguestfs,
see L<guestfs(3)>.");
+ ("get_pid", (RInt "pid", []), -1, [FishAlias "pid"],
+ [InitNone, Always, TestOutputIntOp (
+ [["get_pid"]], ">=", 1)],
+ "get PID of qemu subprocess",
+ "\
+Return the process ID of the qemu subprocess. If there is no
+qemu subprocess, then this will return an error.
+
+This is an internal call used for debugging and testing.");
+
+ ("version", (RStruct ("version", "version"), []), -1, [],
+ [InitNone, Always, TestOutputStruct (
+ [["version"]], [CompareWithInt ("major", 1)])],
+ "get the library version number",
+ "\
+Return the libguestfs version number that the program is linked
+against.
+
+Note that because of dynamic linking this is not necessarily
+the version of libguestfs that you compiled against. You can
+compile the program, and then at runtime dynamically link
+against a completely different C<libguestfs.so> library.
+
+This call was added in version C<1.0.58>. In previous
+versions of libguestfs there was no way to get the version
+number. From C code you can use ELF weak linking tricks to find out if
+this symbol exists (if it doesn't, then it's an earlier version).
+
+The call returns a structure with four elements. The first
+three (C<major>, C<minor> and C<release>) are numbers and
+correspond to the usual version triplet. The fourth element
+(C<extra>) is a string and is normally empty, but may be
+used for distro-specific information.
+
+To construct the original version string:
+C<$major.$minor.$release$extra>
+
+I<Note:> Don't use this call to test for availability
+of features. Distro backports makes this unreliable.");
+
]
(* daemon_functions are any functions which cause some action
Note that this function cannot correctly handle binary files
(specifically, files containing C<\\0> character which is treated
-as end of string). For those you need to use the C<guestfs_download>
-function which has a more complex interface.");
+as end of string). For those you need to use the C<guestfs_read_file>
+or C<guestfs_download> functions which have a more complex interface.");
("ll", (RString "listing", [String "directory"]), 5, [],
[], (* XXX Tricky to test because it depends on the exact format
See also C<guestfs_lvs_full>.");
- ("pvs_full", (RPVList "physvols", []), 12, [],
+ ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [],
[], (* XXX how to test? *)
"list the LVM physical volumes (PVs)",
"\
List all the physical volumes detected. This is the equivalent
of the L<pvs(8)> command. The \"full\" version includes all fields.");
- ("vgs_full", (RVGList "volgroups", []), 13, [],
+ ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [],
[], (* XXX how to test? *)
"list the LVM volume groups (VGs)",
"\
List all the volumes groups detected. This is the equivalent
of the L<vgs(8)> command. The \"full\" version includes all fields.");
- ("lvs_full", (RLVList "logvols", []), 14, [],
+ ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [],
[], (* XXX how to test? *)
"list the LVM logical volumes (LVs)",
"\
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", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
+ ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [],
[], (* XXX Augeas code needs tests. *)
"define an Augeas node",
"\
This returns the list of currently mounted filesystems. It returns
the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
-Some internal mounts are not shown.");
+Some internal mounts are not shown.
+
+See also: C<guestfs_mountpoints>");
("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
[InitBasicFS, Always, TestOutputList (
See also: C<guestfs_sh_lines>");
- ("stat", (RStat "statbuf", [String "path"]), 52, [],
+ ("stat", (RStruct ("statbuf", "stat"), [String "path"]), 52, [],
[InitBasicFS, Always, TestOutputStruct (
[["touch"; "/new"];
["stat"; "/new"]], [CompareWithInt ("size", 0)])],
This is the same as the C<stat(2)> system call.");
- ("lstat", (RStat "statbuf", [String "path"]), 53, [],
+ ("lstat", (RStruct ("statbuf", "stat"), [String "path"]), 53, [],
[InitBasicFS, Always, TestOutputStruct (
[["touch"; "/new"];
["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
This is the same as the C<lstat(2)> system call.");
- ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
+ ("statvfs", (RStruct ("statbuf", "statvfs"), [String "path"]), 54, [],
[InitBasicFS, Always, TestOutputStruct (
[["statvfs"; "/"]], [CompareWithInt ("namemax", 255);
CompareWithInt ("bsize", 1024)])],
("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
[InitBasicFS, Always, TestOutput (
(* Pick a file from cwd which isn't likely to change. *)
- [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
- ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
+ [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
+ ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
"upload a file from the local machine",
"\
Upload local file C<filename> to C<remotefilename> on the
("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
[InitBasicFS, Always, TestOutput (
(* Pick a file from cwd which isn't likely to change. *)
- [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
- ["download"; "/COPYING.LIB"; "testdownload.tmp"];
- ["upload"; "testdownload.tmp"; "/upload"];
- ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
+ [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
+ ["download"; "/COPYING.LIB"; "testdownload.tmp"];
+ ["upload"; "testdownload.tmp"; "/upload"];
+ ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
"download a file to the local machine",
"\
Download file C<remotefilename> and save it as C<filename>
("lvresize", (RErr, [String "device"; Int "mbytes"]), 105, [],
[InitNone, Always, TestOutput (
- [["sfdiskM"; "/dev/sda"; ","];
- ["pvcreate"; "/dev/sda1"];
- ["vgcreate"; "VG"; "/dev/sda1"];
- ["lvcreate"; "LV"; "VG"; "10"];
- ["mkfs"; "ext2"; "/dev/VG/LV"];
- ["mount"; "/dev/VG/LV"; "/"];
- ["write_file"; "/new"; "test content"; "0"];
- ["umount"; "/"];
- ["lvresize"; "/dev/VG/LV"; "20"];
- ["e2fsck_f"; "/dev/VG/LV"];
- ["resize2fs"; "/dev/VG/LV"];
- ["mount"; "/dev/VG/LV"; "/"];
- ["cat"; "/new"]], "test content")],
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["pvcreate"; "/dev/sda1"];
+ ["vgcreate"; "VG"; "/dev/sda1"];
+ ["lvcreate"; "LV"; "VG"; "10"];
+ ["mkfs"; "ext2"; "/dev/VG/LV"];
+ ["mount"; "/dev/VG/LV"; "/"];
+ ["write_file"; "/new"; "test content"; "0"];
+ ["umount"; "/"];
+ ["lvresize"; "/dev/VG/LV"; "20"];
+ ["e2fsck_f"; "/dev/VG/LV"];
+ ["resize2fs"; "/dev/VG/LV"];
+ ["mount"; "/dev/VG/LV"; "/"];
+ ["cat"; "/new"]], "test content")],
"resize an LVM logical volume",
"\
This resizes (expands or shrinks) an existing LVM logical
("sleep", (RErr, [Int "secs"]), 109, [],
[InitNone, Always, TestRun (
- [["sleep"; "1"]])],
+ [["sleep"; "1"]])],
"sleep for some seconds",
"\
Sleep for C<secs> seconds.");
This call returns the previous umask.");
- ("readdir", (RDirentList "entries", [String "dir"]), 138, [],
+ ("readdir", (RStructList ("entries", "dirent"), [String "dir"]), 138, [],
[],
"read directories entries",
"\
C<..>. The entries are I<not> sorted, but returned in the same
order as the underlying filesystem.
+Also this call returns basic file type information about each
+file. The C<ftyp> field will contain one of the following characters:
+
+=over 4
+
+=item 'b'
+
+Block special
+
+=item 'c'
+
+Char special
+
+=item 'd'
+
+Directory
+
+=item 'f'
+
+FIFO (named pipe)
+
+=item 'l'
+
+Symbolic link
+
+=item 'r'
+
+Regular file
+
+=item 's'
+
+Socket
+
+=item 'u'
+
+Unknown file type
+
+=item '?'
+
+The L<readdir(3)> returned a C<d_type> field with an
+unexpected value
+
+=back
+
This function is primarily intended for use by programs. To
get a simple list of names, use C<guestfs_ls>. To get a printable
directory for human consumption, use C<guestfs_ll>.");
See also C<guestfs_sfdisk> and the L<sfdisk(8)> manpage.");
+ ("zfile", (RString "description", [String "method"; String "path"]), 140, [],
+ [],
+ "determine file type inside a compressed file",
+ "\
+This command runs C<file> after first decompressing C<path>
+using C<method>.
+
+C<method> must be one of C<gzip>, C<compress> or C<bzip2>.
+
+See also: C<guestfs_file>");
+
+ ("getxattrs", (RStructList ("xattrs", "xattr"), [String "path"]), 141, [],
+ [],
+ "list extended attributes of a file or directory",
+ "\
+This call lists the extended attributes of the file or directory
+C<path>.
+
+At the system call level, this is a combination of the
+L<listxattr(2)> and L<getxattr(2)> calls.
+
+See also: C<guestfs_lgetxattrs>, L<attr(5)>.");
+
+ ("lgetxattrs", (RStructList ("xattrs", "xattr"), [String "path"]), 142, [],
+ [],
+ "list extended attributes of a file or directory",
+ "\
+This is the same as C<guestfs_getxattrs>, but if C<path>
+is a symbolic link, then it returns the extended attributes
+of the link itself.");
+
+ ("setxattr", (RErr, [String "xattr";
+ String "val"; Int "vallen"; (* will be BufferIn *)
+ String "path"]), 143, [],
+ [],
+ "set extended attribute of a file or directory",
+ "\
+This call sets the extended attribute named C<xattr>
+of the file C<path> to the value C<val> (of length C<vallen>).
+The value is arbitrary 8 bit data.
+
+See also: C<guestfs_lsetxattr>, L<attr(5)>.");
+
+ ("lsetxattr", (RErr, [String "xattr";
+ String "val"; Int "vallen"; (* will be BufferIn *)
+ String "path"]), 144, [],
+ [],
+ "set extended attribute of a file or directory",
+ "\
+This is the same as C<guestfs_setxattr>, but if C<path>
+is a symbolic link, then it sets an extended attribute
+of the link itself.");
+
+ ("removexattr", (RErr, [String "xattr"; String "path"]), 145, [],
+ [],
+ "remove extended attribute of a file or directory",
+ "\
+This call removes the extended attribute named C<xattr>
+of the file C<path>.
+
+See also: C<guestfs_lremovexattr>, L<attr(5)>.");
+
+ ("lremovexattr", (RErr, [String "xattr"; String "path"]), 146, [],
+ [],
+ "remove extended attribute of a file or directory",
+ "\
+This is the same as C<guestfs_removexattr>, but if C<path>
+is a symbolic link, then it removes an extended attribute
+of the link itself.");
+
+ ("mountpoints", (RHashtable "mps", []), 147, [],
+ [],
+ "show mountpoints",
+ "\
+This call is similar to C<guestfs_mounts>. That call returns
+a list of devices. This one returns a hash table (map) of
+device name to directory where the device is mounted.");
+
+ ("mkmountpoint", (RErr, [String "path"]), 148, [],
+ [],
+ "create a mountpoint",
+ "\
+C<guestfs_mkmountpoint> and C<guestfs_rmmountpoint> are
+specialized calls that can be used to create extra mountpoints
+before mounting the first filesystem.
+
+These calls are I<only> necessary in some very limited circumstances,
+mainly the case where you want to mount a mix of unrelated and/or
+read-only filesystems together.
+
+For example, live CDs often contain a \"Russian doll\" nest of
+filesystems, an ISO outer layer, with a squashfs image inside, with
+an ext2/3 image inside that. You can unpack this as follows
+in guestfish:
+
+ add-ro Fedora-11-i686-Live.iso
+ run
+ mkmountpoint /cd
+ mkmountpoint /squash
+ mkmountpoint /ext3
+ mount /dev/sda /cd
+ mount-loop /cd/LiveOS/squashfs.img /squash
+ mount-loop /squash/LiveOS/ext3fs.img /ext3
+
+The inner filesystem is now unpacked under the /ext3 mountpoint.");
+
+ ("rmmountpoint", (RErr, [String "path"]), 149, [],
+ [],
+ "remove a mountpoint",
+ "\
+This calls removes a mountpoint that was previously created
+with C<guestfs_mkmountpoint>. See C<guestfs_mkmountpoint>
+for full details.");
+
+ ("read_file", (RBufferOut "content", [String "path"]), 150, [ProtocolLimitWarning],
+ [InitBasicFS, Always, TestOutput (
+ [["write_file"; "/new"; "new file contents"; "0"];
+ ["read_file"; "/new"]], "new file contents")],
+ "read a file",
+ "\
+This calls returns the contents of the file C<path> as a
+buffer.
+
+Unlike C<guestfs_cat>, this function can correctly
+handle files that contain embedded ASCII NUL characters.
+However unlike C<guestfs_download>, this function is limited
+in the total size of file that can be handled.");
+
]
let all_functions = non_daemon_functions @ daemon_functions
List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
compare n1 n2) all_functions
-(* Column names and types from LVM PVs/VGs/LVs. *)
-let pv_cols = [
- "pv_name", `String;
- "pv_uuid", `UUID;
- "pv_fmt", `String;
- "pv_size", `Bytes;
- "dev_size", `Bytes;
- "pv_free", `Bytes;
- "pv_used", `Bytes;
- "pv_attr", `String (* XXX *);
- "pv_pe_count", `Int;
- "pv_pe_alloc_count", `Int;
- "pv_tags", `String;
- "pe_start", `Bytes;
- "pv_mda_count", `Int;
- "pv_mda_free", `Bytes;
-(* Not in Fedora 10:
- "pv_mda_size", `Bytes;
-*)
+(* Field types for structures. *)
+type field =
+ | FChar (* C 'char' (really, a 7 bit byte). *)
+ | FString (* nul-terminated ASCII string. *)
+ | FBuffer (* opaque buffer of bytes, (char *, int) pair *)
+ | FUInt32
+ | FInt32
+ | FUInt64
+ | FInt64
+ | FBytes (* Any int measure that counts bytes. *)
+ | FUUID (* 32 bytes long, NOT nul-terminated. *)
+ | FOptPercent (* [0..100], or -1 meaning "not present". *)
+
+(* Because we generate extra parsing code for LVM command line tools,
+ * we have to pull out the LVM columns separately here.
+ *)
+let lvm_pv_cols = [
+ "pv_name", FString;
+ "pv_uuid", FUUID;
+ "pv_fmt", FString;
+ "pv_size", FBytes;
+ "dev_size", FBytes;
+ "pv_free", FBytes;
+ "pv_used", FBytes;
+ "pv_attr", FString (* XXX *);
+ "pv_pe_count", FInt64;
+ "pv_pe_alloc_count", FInt64;
+ "pv_tags", FString;
+ "pe_start", FBytes;
+ "pv_mda_count", FInt64;
+ "pv_mda_free", FBytes;
+ (* Not in Fedora 10:
+ "pv_mda_size", FBytes;
+ *)
]
-let vg_cols = [
- "vg_name", `String;
- "vg_uuid", `UUID;
- "vg_fmt", `String;
- "vg_attr", `String (* XXX *);
- "vg_size", `Bytes;
- "vg_free", `Bytes;
- "vg_sysid", `String;
- "vg_extent_size", `Bytes;
- "vg_extent_count", `Int;
- "vg_free_count", `Int;
- "max_lv", `Int;
- "max_pv", `Int;
- "pv_count", `Int;
- "lv_count", `Int;
- "snap_count", `Int;
- "vg_seqno", `Int;
- "vg_tags", `String;
- "vg_mda_count", `Int;
- "vg_mda_free", `Bytes;
-(* Not in Fedora 10:
- "vg_mda_size", `Bytes;
-*)
+let lvm_vg_cols = [
+ "vg_name", FString;
+ "vg_uuid", FUUID;
+ "vg_fmt", FString;
+ "vg_attr", FString (* XXX *);
+ "vg_size", FBytes;
+ "vg_free", FBytes;
+ "vg_sysid", FString;
+ "vg_extent_size", FBytes;
+ "vg_extent_count", FInt64;
+ "vg_free_count", FInt64;
+ "max_lv", FInt64;
+ "max_pv", FInt64;
+ "pv_count", FInt64;
+ "lv_count", FInt64;
+ "snap_count", FInt64;
+ "vg_seqno", FInt64;
+ "vg_tags", FString;
+ "vg_mda_count", FInt64;
+ "vg_mda_free", FBytes;
+ (* Not in Fedora 10:
+ "vg_mda_size", FBytes;
+ *)
]
-let lv_cols = [
- "lv_name", `String;
- "lv_uuid", `UUID;
- "lv_attr", `String (* XXX *);
- "lv_major", `Int;
- "lv_minor", `Int;
- "lv_kernel_major", `Int;
- "lv_kernel_minor", `Int;
- "lv_size", `Bytes;
- "seg_count", `Int;
- "origin", `String;
- "snap_percent", `OptPercent;
- "copy_percent", `OptPercent;
- "move_pv", `String;
- "lv_tags", `String;
- "mirror_log", `String;
- "modules", `String;
+let lvm_lv_cols = [
+ "lv_name", FString;
+ "lv_uuid", FUUID;
+ "lv_attr", FString (* XXX *);
+ "lv_major", FInt64;
+ "lv_minor", FInt64;
+ "lv_kernel_major", FInt64;
+ "lv_kernel_minor", FInt64;
+ "lv_size", FBytes;
+ "seg_count", FInt64;
+ "origin", FString;
+ "snap_percent", FOptPercent;
+ "copy_percent", FOptPercent;
+ "move_pv", FString;
+ "lv_tags", FString;
+ "mirror_log", FString;
+ "modules", FString;
]
-(* Column names and types from stat structures.
- * NB. Can't use things like 'st_atime' because glibc header files
- * define some of these as macros. Ugh.
+(* Names and fields in all structures (in RStruct and RStructList)
+ * that we support.
*)
-let stat_cols = [
- "dev", `Int;
- "ino", `Int;
- "mode", `Int;
- "nlink", `Int;
- "uid", `Int;
- "gid", `Int;
- "rdev", `Int;
- "size", `Int;
- "blksize", `Int;
- "blocks", `Int;
- "atime", `Int;
- "mtime", `Int;
- "ctime", `Int;
-]
-let statvfs_cols = [
- "bsize", `Int;
- "frsize", `Int;
- "blocks", `Int;
- "bfree", `Int;
- "bavail", `Int;
- "files", `Int;
- "ffree", `Int;
- "favail", `Int;
- "fsid", `Int;
- "flag", `Int;
- "namemax", `Int;
-]
-
-(* Column names in dirent structure. *)
-let dirent_cols = [
- "ino", `Int;
- "ftyp", `Char; (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *)
- "name", `String;
+let structs = [
+ (* The old RIntBool return type, only ever used for aug_defnode. Do
+ * not use this struct in any new code.
+ *)
+ "int_bool", [
+ "i", FInt32; (* for historical compatibility *)
+ "b", FInt32; (* for historical compatibility *)
+ ];
+
+ (* LVM PVs, VGs, LVs. *)
+ "lvm_pv", lvm_pv_cols;
+ "lvm_vg", lvm_vg_cols;
+ "lvm_lv", lvm_lv_cols;
+
+ (* Column names and types from stat structures.
+ * NB. Can't use things like 'st_atime' because glibc header files
+ * define some of these as macros. Ugh.
+ *)
+ "stat", [
+ "dev", FInt64;
+ "ino", FInt64;
+ "mode", FInt64;
+ "nlink", FInt64;
+ "uid", FInt64;
+ "gid", FInt64;
+ "rdev", FInt64;
+ "size", FInt64;
+ "blksize", FInt64;
+ "blocks", FInt64;
+ "atime", FInt64;
+ "mtime", FInt64;
+ "ctime", FInt64;
+ ];
+ "statvfs", [
+ "bsize", FInt64;
+ "frsize", FInt64;
+ "blocks", FInt64;
+ "bfree", FInt64;
+ "bavail", FInt64;
+ "files", FInt64;
+ "ffree", FInt64;
+ "favail", FInt64;
+ "fsid", FInt64;
+ "flag", FInt64;
+ "namemax", FInt64;
+ ];
+
+ (* Column names in dirent structure. *)
+ "dirent", [
+ "ino", FInt64;
+ (* 'b' 'c' 'd' 'f' (FIFO) 'l' 'r' (regular file) 's' 'u' '?' *)
+ "ftyp", FChar;
+ "name", FString;
+ ];
+
+ (* Version numbers. *)
+ "version", [
+ "major", FInt64;
+ "minor", FInt64;
+ "release", FInt64;
+ "extra", FString;
+ ];
+
+ (* Extended attribute. *)
+ "xattr", [
+ "attrname", FString;
+ "attrval", FBuffer;
+ ];
+] (* end of structs *)
+
+(* Ugh, Java has to be different ..
+ * These names are also used by the Haskell bindings.
+ *)
+let java_structs = [
+ "int_bool", "IntBool";
+ "lvm_pv", "PV";
+ "lvm_vg", "VG";
+ "lvm_lv", "LV";
+ "stat", "Stat";
+ "statvfs", "StatVFS";
+ "dirent", "Dirent";
+ "version", "Version";
+ "xattr", "XAttr";
]
(* Used for testing language bindings. *)
| String n | OptString n | StringList n | Bool n | Int n
| FileIn n | FileOut n -> n
+let java_name_of_struct typ =
+ try List.assoc typ java_structs
+ with Not_found ->
+ failwithf
+ "java_name_of_struct: no java_structs entry corresponding to %s" typ
+
+let cols_of_struct typ =
+ try List.assoc typ structs
+ with Not_found ->
+ failwithf "cols_of_struct: unknown struct %s" typ
+
let seq_of_test = function
| TestRun s | TestOutput (s, _) | TestOutputList (s, _)
| TestOutputListOfDevices (s, _)
- | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
+ | TestOutputInt (s, _) | TestOutputIntOp (s, _, _)
+ | TestOutputTrue s | TestOutputFalse s
| TestOutputLength (s, _) | TestOutputStruct (s, _)
| TestLastFail s -> s
(match fst style with
| RErr -> ()
| RInt n | RInt64 n | RBool n | RConstString n | RString n
- | RStringList n | RPVList n | RVGList n | RLVList n
- | RStat n | RStatVFS n
- | RHashtable n
- | RDirentList n ->
+ | RStringList n | RStruct (n, _) | RStructList (n, _)
+ | RHashtable n | RBufferOut n ->
check_arg_ret_name n
- | RIntBool (n,m) ->
- check_arg_ret_name n;
- check_arg_ret_name m
);
List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
) all_functions;
pr "This function returns a NULL-terminated array of strings
(like L<environ(3)>), or NULL if there was an error.
I<The caller must free the strings and the array after use>.\n\n"
- | RIntBool _ ->
- pr "This function returns a C<struct guestfs_int_bool *>,
-or NULL if there was an error.
-I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
- | RPVList _ ->
- pr "This function returns a C<struct guestfs_lvm_pv_list *>
-(see E<lt>guestfs-structs.hE<gt>),
+ | RStruct (_, typ) ->
+ pr "This function returns a C<struct guestfs_%s *>,
or NULL if there was an error.
-I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
- | RVGList _ ->
- pr "This function returns a C<struct guestfs_lvm_vg_list *>
+I<The caller must call C<guestfs_free_%s> after use>.\n\n" typ typ
+ | RStructList (_, typ) ->
+ pr "This function returns a C<struct guestfs_%s_list *>
(see E<lt>guestfs-structs.hE<gt>),
or NULL if there was an error.
-I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
- | RLVList _ ->
- pr "This function returns a C<struct guestfs_lvm_lv_list *>
-(see E<lt>guestfs-structs.hE<gt>),
-or NULL if there was an error.
-I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
- | RStat _ ->
- pr "This function returns a C<struct guestfs_stat *>
-(see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
-or NULL if there was an error.
-I<The caller must call C<free> after use>.\n\n"
- | RStatVFS _ ->
- pr "This function returns a C<struct guestfs_statvfs *>
-(see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
-or NULL if there was an error.
-I<The caller must call C<free> after use>.\n\n"
+I<The caller must call C<guestfs_free_%s_list> after use>.\n\n" typ typ
| RHashtable _ ->
pr "This function returns a NULL-terminated array of
strings, or NULL if there was an error.
The array of strings will always have length C<2n+1>, where
C<n> keys and values alternate, followed by the trailing NULL entry.
I<The caller must free the strings and the array after use>.\n\n"
- | RDirentList _ ->
- pr "This function returns a C<struct guestfs_dirent_list *>
-(see E<lt>guestfs-structs.hE<gt>),
-or NULL if there was an error.
-I<The caller must call C<guestfs_free_dirent_list> after use>.\n\n"
+ | RBufferOut _ ->
+ pr "This function returns a buffer, or NULL on error.
+The size of the returned buffer is written to C<*size_r>.
+I<The caller must free the returned buffer after use>.\n\n"
);
if List.mem ProtocolLimitWarning flags then
pr "%s\n\n" protocol_limit_warning;
) all_functions_sorted
and generate_structs_pod () =
- (* LVM structs documentation. *)
+ (* Structs documentation. *)
List.iter (
fun (typ, cols) ->
- pr "=head2 guestfs_lvm_%s\n" typ;
+ pr "=head2 guestfs_%s\n" typ;
pr "\n";
- pr " struct guestfs_lvm_%s {\n" typ;
+ pr " struct guestfs_%s {\n" typ;
List.iter (
function
- | name, `String -> pr " char *%s;\n" name
- | name, `UUID ->
- pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
- pr " char %s[32];\n" name
- | name, `Bytes -> pr " uint64_t %s;\n" name
- | name, `Int -> pr " int64_t %s;\n" name
- | name, `OptPercent ->
- pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
- pr " float %s;\n" name
+ | name, FChar -> pr " char %s;\n" name
+ | name, FUInt32 -> pr " uint32_t %s;\n" name
+ | name, FInt32 -> pr " int32_t %s;\n" name
+ | name, (FUInt64|FBytes) -> pr " uint64_t %s;\n" name
+ | name, FInt64 -> pr " int64_t %s;\n" name
+ | name, FString -> pr " char *%s;\n" name
+ | name, FBuffer ->
+ pr " /* The next two fields describe a byte array. */\n";
+ pr " uint32_t %s_len;\n" name;
+ pr " char *%s;\n" name
+ | name, FUUID ->
+ pr " /* The next field is NOT nul-terminated, be careful when printing it: */\n";
+ pr " char %s[32];\n" name
+ | name, FOptPercent ->
+ pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
+ pr " float %s;\n" name
) cols;
+ pr " };\n";
pr " \n";
- pr " struct guestfs_lvm_%s_list {\n" typ;
+ pr " struct guestfs_%s_list {\n" typ;
pr " uint32_t len; /* Number of elements in list. */\n";
- pr " struct guestfs_lvm_%s *val; /* Elements. */\n" typ;
+ pr " struct guestfs_%s *val; /* Elements. */\n" typ;
pr " };\n";
pr " \n";
- pr " void guestfs_free_lvm_%s_list (struct guestfs_free_lvm_%s_list *);\n"
+ pr " void guestfs_free_%s (struct guestfs_free_%s *);\n" typ typ;
+ pr " void guestfs_free_%s_list (struct guestfs_free_%s_list *);\n"
typ typ;
pr "\n"
- ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
-
- (* Stat *)
- List.iter (
- fun (typ, cols) ->
- pr "=head2 guestfs_%s\n" typ;
- pr "\n";
- pr " struct guestfs_%s {\n" typ;
- List.iter (
- function
- | name, `Int -> pr " int64_t %s;\n" name
- ) cols;
- pr " };\n";
- pr "\n";
- ) [ "stat", stat_cols; "statvfs", statvfs_cols ];
-
- (* DirentList *)
- pr "=head2 guestfs_dirent\n";
- pr "\n";
- pr " struct guestfs_dirent {\n";
- List.iter (
- function
- | name, `String -> pr " char *%s;\n" name
- | name, `Int -> pr " int64_t %s;\n" name
- | name, `Char -> pr " char %s;\n" name
- ) dirent_cols;
- pr " };\n";
- pr "\n";
- pr " struct guestfs_dirent_list {\n";
- pr " uint32_t len; /* Number of elements in list. */\n";
- pr " struct guestfs_dirent *val; /* Elements. */\n";
- pr " };\n";
- pr " \n";
- pr " void guestfs_free_dirent_list (struct guestfs_free_dirent_list *);\n";
- pr "\n"
+ ) structs
(* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
* indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
pr "typedef string str<>;\n";
pr "\n";
- (* LVM internal structures. *)
- List.iter (
- function
- | typ, cols ->
- pr "struct guestfs_lvm_int_%s {\n" typ;
- List.iter (function
- | name, `String -> pr " string %s<>;\n" name
- | name, `UUID -> pr " opaque %s[32];\n" name
- | name, `Bytes -> pr " hyper %s;\n" name
- | name, `Int -> pr " hyper %s;\n" name
- | name, `OptPercent -> pr " float %s;\n" name
- ) cols;
- pr "};\n";
- pr "\n";
- pr "typedef struct guestfs_lvm_int_%s guestfs_lvm_int_%s_list<>;\n" typ typ;
- pr "\n";
- ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
-
- (* Stat internal structures. *)
+ (* Internal structures. *)
List.iter (
function
| typ, cols ->
pr "struct guestfs_int_%s {\n" typ;
List.iter (function
- | name, `Int -> pr " hyper %s;\n" name
+ | name, FChar -> pr " char %s;\n" name
+ | name, FString -> pr " string %s<>;\n" name
+ | name, FBuffer -> pr " opaque %s<>;\n" name
+ | name, FUUID -> pr " opaque %s[32];\n" name
+ | name, (FInt32|FUInt32) -> pr " int %s;\n" name
+ | name, (FInt64|FUInt64|FBytes) -> pr " hyper %s;\n" name
+ | name, FOptPercent -> pr " float %s;\n" name
) cols;
pr "};\n";
pr "\n";
- ) ["stat", stat_cols; "statvfs", statvfs_cols];
-
- (* Dirent structures. *)
- pr "struct guestfs_int_dirent {\n";
- List.iter (function
- | name, `Int -> pr " hyper %s;\n" name
- | name, `Char -> pr " char %s;\n" name
- | name, `String -> pr " string %s<>;\n" name
- ) dirent_cols;
- pr "};\n";
- pr "\n";
- pr "typedef struct guestfs_int_dirent guestfs_int_dirent_list<>;\n";
- pr "\n";
+ pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
+ pr "\n";
+ ) structs;
List.iter (
fun (shortname, style, _, _, _, _, _) ->
pr "struct %s_ret {\n" name;
pr " str %s<>;\n" n;
pr "};\n\n"
- | RIntBool (n,m) ->
- pr "struct %s_ret {\n" name;
- pr " int %s;\n" n;
- pr " bool %s;\n" m;
- pr "};\n\n"
- | RPVList n ->
- pr "struct %s_ret {\n" name;
- pr " guestfs_lvm_int_pv_list %s;\n" n;
- pr "};\n\n"
- | RVGList n ->
- pr "struct %s_ret {\n" name;
- pr " guestfs_lvm_int_vg_list %s;\n" n;
- pr "};\n\n"
- | RLVList n ->
- pr "struct %s_ret {\n" name;
- pr " guestfs_lvm_int_lv_list %s;\n" n;
- pr "};\n\n"
- | RStat n ->
+ | RStruct (n, typ) ->
pr "struct %s_ret {\n" name;
- pr " guestfs_int_stat %s;\n" n;
+ pr " guestfs_int_%s %s;\n" typ n;
pr "};\n\n"
- | RStatVFS n ->
+ | RStructList (n, typ) ->
pr "struct %s_ret {\n" name;
- pr " guestfs_int_statvfs %s;\n" n;
+ pr " guestfs_int_%s_list %s;\n" typ n;
pr "};\n\n"
| RHashtable n ->
pr "struct %s_ret {\n" name;
pr " str %s<>;\n" n;
pr "};\n\n"
- | RDirentList n ->
+ | RBufferOut n ->
pr "struct %s_ret {\n" name;
- pr " guestfs_int_dirent_list %s;\n" n;
+ pr " opaque %s<>;\n" n;
pr "};\n\n"
);
) daemon_functions;
* must be identical to what rpcgen / the RFC defines.
*)
- (* guestfs_int_bool structure. *)
- pr "struct guestfs_int_bool {\n";
- pr " int32_t i;\n";
- pr " int32_t b;\n";
- pr "};\n";
- pr "\n";
-
- (* LVM public structures. *)
- List.iter (
- function
- | typ, cols ->
- pr "struct guestfs_lvm_%s {\n" typ;
- List.iter (
- function
- | name, `String -> pr " char *%s;\n" name
- | name, `UUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
- | name, `Bytes -> pr " uint64_t %s;\n" name
- | name, `Int -> pr " int64_t %s;\n" name
- | name, `OptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
- ) cols;
- pr "};\n";
- pr "\n";
- pr "struct guestfs_lvm_%s_list {\n" typ;
- pr " uint32_t len;\n";
- pr " struct guestfs_lvm_%s *val;\n" typ;
- pr "};\n";
- pr "\n"
- ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
-
- (* Stat structures. *)
- List.iter (
- function
- | typ, cols ->
- pr "struct guestfs_%s {\n" typ;
- List.iter (
- function
- | name, `Int -> pr " int64_t %s;\n" name
- ) cols;
- pr "};\n";
- pr "\n"
- ) ["stat", stat_cols; "statvfs", statvfs_cols];
-
- (* Dirent structures. *)
- pr "struct guestfs_dirent {\n";
+ (* Public structures. *)
List.iter (
- function
- | name, `Int -> pr " int64_t %s;\n" name
- | name, `Char -> pr " char %s;\n" name
- | name, `String -> pr " char *%s;\n" name
- ) dirent_cols;
- pr "};\n";
- pr "\n";
- pr "struct guestfs_dirent_list {\n";
- pr " uint32_t len;\n";
- pr " struct guestfs_dirent *val;\n";
- pr "};\n";
- pr "\n"
+ fun (typ, cols) ->
+ pr "struct guestfs_%s {\n" typ;
+ List.iter (
+ function
+ | name, FChar -> pr " char %s;\n" name
+ | name, FString -> pr " char *%s;\n" name
+ | name, FBuffer ->
+ pr " uint32_t %s_len;\n" name;
+ pr " char *%s;\n" name
+ | name, FUUID -> pr " char %s[32]; /* this is NOT nul-terminated, be careful when printing */\n" name
+ | name, FUInt32 -> pr " uint32_t %s;\n" name
+ | name, FInt32 -> pr " int32_t %s;\n" name
+ | name, (FUInt64|FBytes) -> pr " uint64_t %s;\n" name
+ | name, FInt64 -> pr " int64_t %s;\n" name
+ | name, FOptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
+ ) cols;
+ pr "};\n";
+ pr "\n";
+ pr "struct guestfs_%s_list {\n" typ;
+ pr " uint32_t len;\n";
+ pr " struct guestfs_%s *val;\n" typ;
+ pr "};\n";
+ pr "\n";
+ pr "extern void guestfs_free_%s (struct guestfs_%s *);\n" typ typ;
+ pr "extern void guestfs_free_%s_list (struct guestfs_%s_list *);\n" typ typ;
+ pr "\n"
+ ) structs
(* Generate the guestfs-actions.h file. *)
and generate_actions_h () =
{
if (!guestfs_is_ready (g)) {
if (guestfs_is_config (g))
- error (g, \"%%s: call launch() before using this function\",
+ error (g, \"%%s: call launch before using this function\\n(in guestfish, don't forget to use the 'run' command)\",
caller);
else if (guestfs_is_launching (g))
error (g, \"%%s: call wait_ready() before using this function\",
failwithf "RConstString cannot be returned from a daemon function"
| RInt _ | RInt64 _
| RBool _ | RString _ | RStringList _
- | RIntBool _
- | RPVList _ | RVGList _ | RLVList _
- | RStat _ | RStatVFS _
- | RHashtable _
- | RDirentList _ ->
+ | RStruct _ | RStructList _
+ | RHashtable _ | RBufferOut _ ->
pr " struct %s_ret ret;\n" name
);
pr "};\n";
failwithf "RConstString cannot be returned from a daemon function"
| RInt _ | RInt64 _
| RBool _ | RString _ | RStringList _
- | RIntBool _
- | RPVList _ | RVGList _ | RLVList _
- | RStat _ | RStatVFS _
- | RHashtable _
- | RDirentList _ ->
- pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
- pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
- pr " return;\n";
- pr " }\n";
+ | RStruct _ | RStructList _
+ | RHashtable _ | RBufferOut _ ->
+ pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
+ pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
+ pr " return;\n";
+ pr " }\n";
);
pr " done:\n";
| RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
| RConstString _ ->
failwithf "RConstString cannot be returned from a daemon function"
- | RString _ | RStringList _ | RIntBool _
- | RPVList _ | RVGList _ | RLVList _
- | RStat _ | RStatVFS _
- | RHashtable _
- | RDirentList _ ->
+ | RString _ | RStringList _
+ | RStruct _ | RStructList _
+ | RHashtable _ | RBufferOut _ ->
"NULL" in
pr "{\n";
n n;
pr " ctx.ret.%s.%s_val[ctx.ret.%s.%s_len] = NULL;\n" n n n n;
pr " return ctx.ret.%s.%s_val;\n" n n
- | RIntBool _ ->
- pr " /* caller with free this */\n";
- pr " return safe_memdup (g, &ctx.ret, sizeof (ctx.ret));\n"
- | RPVList n | RVGList n | RLVList n
- | RStat n | RStatVFS n
- | RDirentList n ->
+ | RStruct (n, _) ->
pr " /* caller will free this */\n";
pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
+ | RStructList (n, _) ->
+ pr " /* caller will free this */\n";
+ pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n n
+ | RBufferOut n ->
+ pr " *size_r = ctx.ret.%s.%s_len;\n" n n;
+ pr " return ctx.ret.%s.%s_val; /* caller will free */\n" n n
);
pr "}\n\n"
- ) daemon_functions
+ ) daemon_functions;
+
+ (* Functions to free structures. *)
+ pr "/* Structure-freeing functions. These rely on the fact that the\n";
+ pr " * structure format is identical to the XDR format. See note in\n";
+ pr " * generator.ml.\n";
+ pr " */\n";
+ pr "\n";
+
+ List.iter (
+ fun (typ, _) ->
+ pr "void\n";
+ pr "guestfs_free_%s (struct guestfs_%s *x)\n" typ typ;
+ pr "{\n";
+ pr " xdr_free ((xdrproc_t) xdr_guestfs_int_%s, (char *) x);\n" typ;
+ pr " free (x);\n";
+ pr "}\n";
+ pr "\n";
+
+ pr "void\n";
+ pr "guestfs_free_%s_list (struct guestfs_%s_list *x)\n" typ typ;
+ pr "{\n";
+ pr " xdr_free ((xdrproc_t) xdr_guestfs_int_%s_list, (char *) x);\n" typ;
+ pr " free (x);\n";
+ pr "}\n";
+ pr "\n";
+
+ ) structs;
(* Generate daemon/actions.h. *)
and generate_daemon_actions_h () =
List.iter (
fun (name, style, _, _, _, _, _) ->
- generate_prototype
- ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
- name style;
+ generate_prototype
+ ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
+ name style;
) daemon_functions
(* Generate the server-side stubs. *)
failwithf "RConstString cannot be returned from a daemon function"
| RString _ -> pr " char *r;\n"; "NULL"
| RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
- | RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
- | RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
- | RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
- | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL"
- | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL"
- | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL"
- | RDirentList _ -> pr " guestfs_int_dirent_list *r;\n"; "NULL" in
+ | 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 " char *r;\n";
+ "NULL" in
(match snd style with
| [] -> ()
(* Don't want to call the impl with any FileIn or FileOut
* parameters, since these go "outside" the RPC protocol.
*)
- let argsnofile =
+ let args' =
List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
(snd style) in
pr " r = do_%s " name;
- generate_call_args argsnofile;
+ generate_c_call_args (fst style, args');
pr ";\n";
pr " if (r == %s)\n" error_code;
pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
name;
pr " free_strings (r);\n"
- | RIntBool _ ->
- pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n"
+ | RStruct (n, _) ->
+ pr " struct guestfs_%s_ret ret;\n" name;
+ pr " ret.%s = *r;\n" n;
+ pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
name;
- pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
- | RPVList n | RVGList n | RLVList n
- | RStat n | RStatVFS n
- | RDirentList n ->
+ pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
+ name
+ | RStructList (n, _) ->
pr " struct guestfs_%s_ret ret;\n" name;
pr " ret.%s = *r;\n" n;
pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
name;
pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n"
name
+ | RBufferOut n ->
+ pr " struct guestfs_%s_ret ret;\n" name;
+ pr " ret.%s.%s_val = r;\n" n n;
+ pr " ret.%s.%s_len = size;\n" n n;
+ pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
+ name;
+ pr " free (r);\n"
);
(* Free the args. *)
List.iter (
fun (name, style, _, _, _, _, _) ->
- pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
- pr " %s_stub (xdr_in);\n" name;
- pr " break;\n"
+ pr " case GUESTFS_PROC_%s:\n" (String.uppercase name);
+ pr " %s_stub (xdr_in);\n" name;
+ pr " break;\n"
) daemon_functions;
pr " default:\n";
typ (String.concat "," (List.map fst cols));
pr "\n";
- pr "static int lvm_tokenize_%s (char *str, struct guestfs_lvm_int_%s *r)\n" typ typ;
+ pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
pr "{\n";
pr " char *tok, *p, *next;\n";
pr " int i, j;\n";
pr "\n";
(*
- pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
- pr "\n";
+ pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
+ pr "\n";
*)
pr " if (!str) {\n";
pr " fprintf (stderr, \"%%s: failed: passed a NULL string\\n\", __func__);\n";
pr " if (*p) next = p+1; else next = NULL;\n";
pr " *p = '\\0';\n";
(match coltype with
- | `String ->
+ | FString ->
pr " r->%s = strdup (tok);\n" name;
pr " if (r->%s == NULL) {\n" name;
pr " perror (\"strdup\");\n";
pr " return -1;\n";
pr " }\n"
- | `UUID ->
+ | FUUID ->
pr " for (i = j = 0; i < 32; ++j) {\n";
pr " if (tok[j] == '\\0') {\n";
pr " fprintf (stderr, \"%%s: failed to parse UUID from '%%s'\\n\", __func__, tok);\n";
pr " } else if (tok[j] != '-')\n";
pr " r->%s[i++] = tok[j];\n" name;
pr " }\n";
- | `Bytes ->
+ | FBytes ->
pr " if (sscanf (tok, \"%%\"SCNu64, &r->%s) != 1) {\n" name;
pr " fprintf (stderr, \"%%s: failed to parse size '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
pr " return -1;\n";
pr " }\n";
- | `Int ->
+ | FInt64 ->
pr " if (sscanf (tok, \"%%\"SCNi64, &r->%s) != 1) {\n" name;
pr " fprintf (stderr, \"%%s: failed to parse int '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
pr " return -1;\n";
pr " }\n";
- | `OptPercent ->
+ | FOptPercent ->
pr " if (tok[0] == '\\0')\n";
pr " r->%s = -1;\n" name;
pr " else if (sscanf (tok, \"%%f\", &r->%s) != 1) {\n" name;
pr " fprintf (stderr, \"%%s: failed to parse float '%%s' from token %%s\\n\", __func__, tok, \"%s\");\n" name;
pr " return -1;\n";
pr " }\n";
+ | FBuffer | FInt32 | FUInt32 | FUInt64 | FChar ->
+ assert false (* can never be an LVM column *)
);
pr " tok = next;\n";
) cols;
pr "}\n";
pr "\n";
- pr "guestfs_lvm_int_%s_list *\n" typ;
+ pr "guestfs_int_lvm_%s_list *\n" typ;
pr "parse_command_line_%ss (void)\n" typ;
pr "{\n";
pr " char *out, *err;\n";
pr " char *p, *pend;\n";
pr " int r, i;\n";
- pr " guestfs_lvm_int_%s_list *ret;\n" typ;
+ pr " guestfs_int_lvm_%s_list *ret;\n" typ;
pr " void *newp;\n";
pr "\n";
pr " ret = malloc (sizeof *ret);\n";
pr " return NULL;\n";
pr " }\n";
pr "\n";
- pr " ret->guestfs_lvm_int_%s_list_len = 0;\n" typ;
- pr " ret->guestfs_lvm_int_%s_list_val = NULL;\n" typ;
+ pr " ret->guestfs_int_lvm_%s_list_len = 0;\n" typ;
+ pr " ret->guestfs_int_lvm_%s_list_val = NULL;\n" typ;
pr "\n";
pr " r = command (&out, &err,\n";
pr " \"/sbin/lvm\", \"%ss\",\n" typ;
pr " }\n";
pr "\n";
pr " /* Allocate some space to store this next entry. */\n";
- pr " newp = realloc (ret->guestfs_lvm_int_%s_list_val,\n" typ;
- pr " sizeof (guestfs_lvm_int_%s) * (i+1));\n" typ;
+ pr " newp = realloc (ret->guestfs_int_lvm_%s_list_val,\n" typ;
+ pr " sizeof (guestfs_int_lvm_%s) * (i+1));\n" typ;
pr " if (newp == NULL) {\n";
pr " reply_with_perror (\"realloc\");\n";
- pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
+ pr " free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
pr " free (ret);\n";
pr " free (out);\n";
pr " return NULL;\n";
pr " }\n";
- pr " ret->guestfs_lvm_int_%s_list_val = newp;\n" typ;
+ pr " ret->guestfs_int_lvm_%s_list_val = newp;\n" typ;
pr "\n";
pr " /* Tokenize the next entry. */\n";
- pr " r = lvm_tokenize_%s (p, &ret->guestfs_lvm_int_%s_list_val[i]);\n" typ typ;
+ pr " r = lvm_tokenize_%s (p, &ret->guestfs_int_lvm_%s_list_val[i]);\n" typ typ;
pr " if (r == -1) {\n";
pr " reply_with_error (\"failed to parse output of '%ss' command\");\n" typ;
- pr " free (ret->guestfs_lvm_int_%s_list_val);\n" typ;
+ pr " free (ret->guestfs_int_lvm_%s_list_val);\n" typ;
pr " free (ret);\n";
pr " free (out);\n";
pr " return NULL;\n";
pr " p = pend;\n";
pr " }\n";
pr "\n";
- pr " ret->guestfs_lvm_int_%s_list_len = i;\n" typ;
+ pr " ret->guestfs_int_lvm_%s_list_len = i;\n" typ;
pr "\n";
pr " free (out);\n";
pr " return ret;\n";
pr "}\n"
- ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
+ ) ["pv", lvm_pv_cols; "vg", lvm_vg_cols; "lv", lvm_lv_cols]
(* Generate a list of function names, for debugging in the daemon.. *)
and generate_daemon_names () =
and generate_one_test_body name i test_name init test =
(match init with
- | InitNone
+ | InitNone (* XXX at some point, InitNone and InitEmpty became
+ * folded together as the same thing. Really we should
+ * make InitNone do nothing at all, but the tests may
+ * need to be checked to make sure this is OK.
+ *)
| InitEmpty ->
pr " /* InitNone|InitEmpty for %s */\n" test_name;
List.iter (generate_test_command_call test_name)
List.iter (generate_test_command_call test_name) seq
| TestOutput (seq, expected) ->
pr " /* TestOutput for %s (%d) */\n" name i;
- pr " char expected[] = \"%s\";\n" (c_quote expected);
+ 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 " return -1;\n";
pr " }\n";
pr " {\n";
- pr " char expected[] = \"%s\";\n" (c_quote str);
+ pr " const char *expected = \"%s\";\n" (c_quote str);
pr " if (strcmp (r[%d], expected) != 0) {\n" i;
pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
pr " return -1;\n";
pr " return -1;\n";
pr " }\n";
pr " {\n";
- pr " char expected[] = \"%s\";\n" (c_quote str);
+ pr " const char *expected = \"%s\";\n" (c_quote str);
pr " r[%d][5] = 's';\n" i;
pr " if (strcmp (r[%d], expected) != 0) {\n" i;
pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
in
List.iter (generate_test_command_call test_name) seq;
generate_test_command_call ~test test_name last
+ | TestOutputIntOp (seq, op, expected) ->
+ pr " /* TestOutputIntOp for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ let test () =
+ pr " if (! (r %s %d)) {\n" op expected;
+ pr " fprintf (stderr, \"%s: expected %s %d but got %%d\\n\","
+ test_name op expected;
+ pr " (int) r);\n";
+ pr " return -1;\n";
+ pr " }\n"
+ in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call ~test test_name last
| TestOutputTrue seq ->
pr " /* TestOutputTrue for %s (%d) */\n" name i;
let seq, last = get_seq_last seq in
pr " (int) r->%s);\n" field;
pr " return -1;\n";
pr " }\n"
+ | CompareWithIntOp (field, op, expected) ->
+ pr " if (!(r->%s %s %d)) {\n" field op expected;
+ pr " fprintf (stderr, \"%s: %s was %%d, expected %s %d\\n\",\n"
+ test_name field op expected;
+ pr " (int) r->%s);\n" field;
+ pr " return -1;\n";
+ pr " }\n"
| CompareWithString (field, expected) ->
pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
| OptString n, "NULL" -> ()
| String n, arg
| OptString n, arg ->
- pr " char %s[] = \"%s\";\n" n (c_quote arg);
+ pr " const char *%s = \"%s\";\n" n (c_quote arg);
| Int _, _
| Bool _, _
| FileIn _, _ | FileOut _, _ -> ()
let strs = string_split " " arg in
iteri (
fun i str ->
- pr " char %s_%d[] = \"%s\";\n" n i (c_quote str);
+ pr " const char *%s_%d = \"%s\";\n" n i (c_quote str);
) strs;
- pr " char *%s[] = {\n" n;
+ pr " const char *%s[] = {\n" n;
iteri (
fun i _ -> pr " %s_%d,\n" n i
) strs;
pr " char **r;\n";
pr " int i;\n";
"NULL"
- | RIntBool _ ->
- pr " struct guestfs_int_bool *r;\n"; "NULL"
- | RPVList _ ->
- pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
- | RVGList _ ->
- pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
- | RLVList _ ->
- pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
- | RStat _ ->
- pr " struct guestfs_stat *r;\n"; "NULL"
- | RStatVFS _ ->
- pr " struct guestfs_statvfs *r;\n"; "NULL"
- | RDirentList _ ->
- pr " struct guestfs_dirent_list *r;\n"; "NULL" in
+ | RStruct (_, typ) ->
+ pr " struct guestfs_%s *r;\n" typ; "NULL"
+ | RStructList (_, typ) ->
+ pr " struct guestfs_%s_list *r;\n" typ; "NULL"
+ | RBufferOut _ ->
+ pr " char *r;\n";
+ pr " size_t size;\n";
+ "NULL" in
pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
pr " r = guestfs_%s (g" name;
let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
) (List.combine (snd style) args);
+ (match fst style with
+ | RBufferOut _ -> pr ", &size"
+ | _ -> ()
+ );
+
pr ");\n";
+
if not expect_error then
pr " if (r == %s)\n" error_code
else
(match fst style with
| RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
- | RString _ -> pr " free (r);\n"
+ | RString _ | RBufferOut _ -> pr " free (r);\n"
| RStringList _ | RHashtable _ ->
pr " for (i = 0; r[i] != NULL; ++i)\n";
pr " free (r[i]);\n";
pr " free (r);\n"
- | RIntBool _ ->
- pr " guestfs_free_int_bool (r);\n"
- | RPVList _ ->
- pr " guestfs_free_lvm_pv_list (r);\n"
- | RVGList _ ->
- pr " guestfs_free_lvm_vg_list (r);\n"
- | RLVList _ ->
- pr " guestfs_free_lvm_lv_list (r);\n"
- | RStat _ | RStatVFS _ ->
- pr " free (r);\n"
- | RDirentList _ ->
- pr " guestfs_free_dirent_list (r);\n"
+ | RStruct (_, typ) ->
+ pr " guestfs_free_%s (r);\n" typ
+ | RStructList (_, typ) ->
+ pr " guestfs_free_%s_list (r);\n" typ
);
pr " }\n"
pr "#include <stdlib.h>\n";
pr "#include <string.h>\n";
pr "#include <inttypes.h>\n";
+ pr "#include <ctype.h>\n";
pr "\n";
pr "#include <guestfs.h>\n";
pr "#include \"fish.h\"\n";
pr "}\n";
pr "\n";
- (* print_{pv,vg,lv}_list functions *)
+ (* print_* functions *)
List.iter (
- function
- | typ, cols ->
- pr "static void print_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
- pr "{\n";
- pr " int i;\n";
- pr "\n";
- List.iter (
- function
- | name, `String ->
- pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
- | name, `UUID ->
- pr " printf (\"%s: \");\n" name;
- pr " for (i = 0; i < 32; ++i)\n";
- pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
- pr " printf (\"\\n\");\n"
- | name, `Bytes ->
- pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
- | name, `Int ->
- pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
- | name, `OptPercent ->
- pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
- typ name name typ name;
- pr " else printf (\"%s: \\n\");\n" name
- ) cols;
- pr "}\n";
- pr "\n";
- pr "static void print_%s_list (struct guestfs_lvm_%s_list *%ss)\n"
- typ typ typ;
- pr "{\n";
- pr " int i;\n";
- pr "\n";
- pr " for (i = 0; i < %ss->len; ++i)\n" typ;
- pr " print_%s (&%ss->val[i]);\n" typ typ;
- pr "}\n";
- pr "\n";
- ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
-
- (* print_{stat,statvfs} functions *)
- List.iter (
- function
- | typ, cols ->
- pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
- pr "{\n";
- List.iter (
- function
- | name, `Int ->
- pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
- ) cols;
- pr "}\n";
- pr "\n";
- ) ["stat", stat_cols; "statvfs", statvfs_cols];
+ fun (typ, cols) ->
+ let needs_i =
+ List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in
- (* print_dirent_list function *)
- pr "static void print_dirent (struct guestfs_dirent *dirent)\n";
- pr "{\n";
- List.iter (
- function
- | name, `String ->
- pr " printf (\"%s: %%s\\n\", dirent->%s);\n" name name
- | name, `Int ->
- pr " printf (\"%s: %%\" PRIi64 \"\\n\", dirent->%s);\n" name name
- | name, `Char ->
- pr " printf (\"%s: %%c\\n\", dirent->%s);\n" name name
- ) dirent_cols;
- pr "}\n";
- pr "\n";
- pr "static void print_dirent_list (struct guestfs_dirent_list *dirents)\n";
- pr "{\n";
- pr " int i;\n";
- pr "\n";
- pr " for (i = 0; i < dirents->len; ++i)\n";
- pr " print_dirent (&dirents->val[i]);\n";
- pr "}\n";
- pr "\n";
+ pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
+ pr "{\n";
+ if needs_i then (
+ pr " int i;\n";
+ pr "\n"
+ );
+ List.iter (
+ function
+ | name, FString ->
+ pr " printf (\"%s: %%s\\n\", %s->%s);\n" name typ name
+ | name, FUUID ->
+ pr " printf (\"%s: \");\n" name;
+ pr " for (i = 0; i < 32; ++i)\n";
+ pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
+ pr " printf (\"\\n\");\n"
+ | name, FBuffer ->
+ pr " printf (\"%s: \");\n" name;
+ pr " for (i = 0; i < %s->%s_len; ++i)\n" typ name;
+ pr " if (isprint (%s->%s[i]))\n" typ name;
+ pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
+ pr " else\n";
+ pr " printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name;
+ pr " printf (\"\\n\");\n"
+ | name, (FUInt64|FBytes) ->
+ pr " printf (\"%s: %%\" PRIu64 \"\\n\", %s->%s);\n" name typ name
+ | name, FInt64 ->
+ pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
+ | name, FUInt32 ->
+ pr " printf (\"%s: %%\" PRIu32 \"\\n\", %s->%s);\n" name typ name
+ | name, FInt32 ->
+ pr " printf (\"%s: %%\" PRIi32 \"\\n\", %s->%s);\n" name typ name
+ | name, FChar ->
+ pr " printf (\"%s: %%c\\n\", %s->%s);\n" name typ name
+ | name, FOptPercent ->
+ pr " if (%s->%s >= 0) printf (\"%s: %%g %%%%\\n\", %s->%s);\n"
+ typ name name typ name;
+ pr " else printf (\"%s: \\n\");\n" name
+ ) cols;
+ pr "}\n";
+ pr "\n";
+ pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
+ typ typ typ;
+ pr "{\n";
+ pr " int i;\n";
+ pr "\n";
+ pr " for (i = 0; i < %ss->len; ++i)\n" typ;
+ pr " print_%s (&%ss->val[i]);\n" typ typ;
+ pr "}\n";
+ pr "\n";
+ ) structs;
(* run_<action> actions *)
List.iter (
| RConstString _ -> pr " const char *r;\n"
| RString _ -> pr " char *r;\n"
| RStringList _ | RHashtable _ -> pr " char **r;\n"
- | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
- | RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
- | RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
- | RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
- | RStat _ -> pr " struct guestfs_stat *r;\n"
- | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n"
- | RDirentList _ -> pr " struct guestfs_dirent_list *r;\n"
+ | RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ
+ | RStructList (_, typ) -> pr " struct guestfs_%s_list *r;\n" typ
+ | RBufferOut _ ->
+ pr " char *r;\n";
+ pr " size_t size;\n";
);
List.iter (
function
try find_map (function FishAction n -> Some n | _ -> None) flags
with Not_found -> sprintf "guestfs_%s" name in
pr " r = %s " fn;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
(* Check return value for errors and display command results. *)
pr " print_strings (r);\n";
pr " free_strings (r);\n";
pr " return 0;\n"
- | RIntBool _ ->
+ | RStruct (_, typ) ->
pr " if (r == NULL) return -1;\n";
- pr " printf (\"%%d, %%s\\n\", r->i,\n";
- pr " r->b ? \"true\" : \"false\");\n";
- pr " guestfs_free_int_bool (r);\n";
+ pr " print_%s (r);\n" typ;
+ pr " guestfs_free_%s (r);\n" typ;
pr " return 0;\n"
- | RPVList _ ->
+ | RStructList (_, typ) ->
pr " if (r == NULL) return -1;\n";
- pr " print_pv_list (r);\n";
- pr " guestfs_free_lvm_pv_list (r);\n";
- pr " return 0;\n"
- | RVGList _ ->
- pr " if (r == NULL) return -1;\n";
- pr " print_vg_list (r);\n";
- pr " guestfs_free_lvm_vg_list (r);\n";
- pr " return 0;\n"
- | RLVList _ ->
- pr " if (r == NULL) return -1;\n";
- pr " print_lv_list (r);\n";
- pr " guestfs_free_lvm_lv_list (r);\n";
- pr " return 0;\n"
- | RStat _ ->
- pr " if (r == NULL) return -1;\n";
- pr " print_stat (r);\n";
- pr " free (r);\n";
- pr " return 0;\n"
- | RStatVFS _ ->
- pr " if (r == NULL) return -1;\n";
- pr " print_statvfs (r);\n";
- pr " free (r);\n";
+ pr " print_%s_list (r);\n" typ;
+ pr " guestfs_free_%s_list (r);\n" typ;
pr " return 0;\n"
| RHashtable _ ->
pr " if (r == NULL) return -1;\n";
pr " print_table (r);\n";
pr " free_strings (r);\n";
pr " return 0;\n"
- | RDirentList _ ->
+ | RBufferOut _ ->
pr " if (r == NULL) return -1;\n";
- pr " print_dirent_list (r);\n";
- pr " guestfs_free_dirent_list (r);\n";
+ pr " fwrite (r, size, 1, stdout);\n";
+ pr " free (r);\n";
pr " return 0;\n"
);
pr "}\n";
| RInt64 _ -> pr "int64_t "
| RBool _ -> pr "int "
| RConstString _ -> pr "const char *"
- | RString _ -> pr "char *"
+ | RString _ | RBufferOut _ -> pr "char *"
| RStringList _ | RHashtable _ -> pr "char **"
- | RIntBool _ ->
- if not in_daemon then pr "struct guestfs_int_bool *"
- else pr "guestfs_%s_ret *" name
- | RPVList _ ->
- if not in_daemon then pr "struct guestfs_lvm_pv_list *"
- else pr "guestfs_lvm_int_pv_list *"
- | RVGList _ ->
- if not in_daemon then pr "struct guestfs_lvm_vg_list *"
- else pr "guestfs_lvm_int_vg_list *"
- | RLVList _ ->
- if not in_daemon then pr "struct guestfs_lvm_lv_list *"
- else pr "guestfs_lvm_int_lv_list *"
- | RStat _ ->
- if not in_daemon then pr "struct guestfs_stat *"
- else pr "guestfs_int_stat *"
- | RStatVFS _ ->
- if not in_daemon then pr "struct guestfs_statvfs *"
- else pr "guestfs_int_statvfs *"
- | RDirentList _ ->
- if not in_daemon then pr "struct guestfs_dirent_list *"
- else pr "guestfs_int_dirent_list *"
+ | RStruct (_, typ) ->
+ if not in_daemon then pr "struct guestfs_%s *" typ
+ else pr "guestfs_int_%s *" typ
+ | RStructList (_, typ) ->
+ if not in_daemon then pr "struct guestfs_%s_list *" typ
+ else pr "guestfs_int_%s_list *" typ
);
+ let is_RBufferOut = match fst style with RBufferOut _ -> true | _ -> false in
pr "%s%s (" prefix name;
- if handle = None && List.length (snd style) = 0 then
+ if handle = None && List.length (snd style) = 0 && not is_RBufferOut then
pr "void"
else (
let comma = ref false in
| FileOut n ->
if not in_daemon then (next (); pr "const char *%s" n)
) (snd style);
+ if is_RBufferOut then (next (); pr "size_t *size_r");
);
pr ")";
if semicolon then pr ";";
if newline then pr "\n"
(* Generate C call arguments, eg "(handle, foo, bar)" *)
-and generate_call_args ?handle args =
+and generate_c_call_args ?handle ?(decl = false) style =
pr "(";
let comma = ref false in
+ let next () =
+ if !comma then pr ", ";
+ comma := true
+ in
(match handle with
| None -> ()
| Some handle -> pr "%s" handle; comma := true
);
List.iter (
fun arg ->
- if !comma then pr ", ";
- comma := true;
+ next ();
pr "%s" (name_of_argt arg)
- ) args;
+ ) (snd style);
+ (* For RBufferOut calls, add implicit &size parameter. *)
+ if not decl then (
+ match fst style with
+ | RBufferOut _ ->
+ next ();
+ pr "&size"
+ | _ -> ()
+ );
pr ")"
(* Generate the OCaml bindings interface. *)
provide predictable cleanup. *)
";
- generate_ocaml_lvm_structure_decls ();
-
- generate_ocaml_stat_structure_decls ();
-
- generate_ocaml_dirent_structure_decls ();
+ generate_ocaml_structure_decls ();
(* The actions. *)
List.iter (
";
- generate_ocaml_lvm_structure_decls ();
-
- generate_ocaml_stat_structure_decls ();
-
- generate_ocaml_dirent_structure_decls ();
+ generate_ocaml_structure_decls ();
(* The actions. *)
List.iter (
";
- (* LVM struct copy functions. *)
+ (* Struct copy functions. *)
List.iter (
fun (typ, cols) ->
let has_optpercent_col =
- List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
+ List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
pr "static CAMLprim value\n";
- pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
+ pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
pr "{\n";
pr " CAMLparam0 ();\n";
if has_optpercent_col then
iteri (
fun i col ->
(match col with
- | name, `String ->
+ | name, FString ->
pr " v = caml_copy_string (%s->%s);\n" typ name
- | name, `UUID ->
+ | name, FBuffer ->
+ pr " v = caml_alloc_string (%s->%s_len);\n" typ name;
+ pr " memcpy (String_val (v), %s->%s, %s->%s_len);\n"
+ typ name typ name
+ | name, FUUID ->
pr " v = caml_alloc_string (32);\n";
pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
- | name, `Bytes
- | name, `Int ->
+ | name, (FBytes|FInt64|FUInt64) ->
pr " v = caml_copy_int64 (%s->%s);\n" typ name
- | name, `OptPercent ->
+ | name, (FInt32|FUInt32) ->
+ pr " v = caml_copy_int32 (%s->%s);\n" typ name
+ | name, FOptPercent ->
pr " if (%s->%s >= 0) { /* Some %s */\n" typ name name;
pr " v2 = caml_copy_double (%s->%s);\n" typ name;
pr " v = caml_alloc (1, 0);\n";
pr " Store_field (v, 0, v2);\n";
pr " } else /* None */\n";
pr " v = Val_int (0);\n";
+ | name, FChar ->
+ pr " v = Val_int (%s->%s);\n" typ name
);
pr " Store_field (rv, %d, v);\n" i
) cols;
pr "\n";
pr "static CAMLprim value\n";
- pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
+ pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n"
typ typ typ;
pr "{\n";
pr " CAMLparam0 ();\n";
pr " else {\n";
pr " rv = caml_alloc (%ss->len, 0);\n" typ;
pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
- pr " v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
+ pr " v = copy_%s (&%ss->val[i]);\n" typ typ;
pr " caml_modify (&Field (rv, i), v);\n";
pr " }\n";
pr " CAMLreturn (rv);\n";
pr " }\n";
pr "}\n";
pr "\n";
- ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
-
- (* Stat copy functions. *)
- List.iter (
- fun (typ, cols) ->
- pr "static CAMLprim value\n";
- pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
- pr "{\n";
- pr " CAMLparam0 ();\n";
- pr " CAMLlocal2 (rv, v);\n";
- pr "\n";
- pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
- iteri (
- fun i col ->
- (match col with
- | name, `Int ->
- pr " v = caml_copy_int64 (%s->%s);\n" typ name
- );
- pr " Store_field (rv, %d, v);\n" i
- ) cols;
- pr " CAMLreturn (rv);\n";
- pr "}\n";
- pr "\n";
- ) ["stat", stat_cols; "statvfs", statvfs_cols];
-
- (* Dirent copy functions. *)
- pr "static CAMLprim value\n";
- pr "copy_dirent (const struct guestfs_dirent *dirent)\n";
- pr "{\n";
- pr " CAMLparam0 ();\n";
- pr " CAMLlocal2 (rv, v);\n";
- pr "\n";
- pr " rv = caml_alloc (%d, 0);\n" (List.length dirent_cols);
- iteri (
- fun i col ->
- (match col with
- | name, `String ->
- pr " v = caml_copy_string (dirent->%s);\n" name
- | name, `Int ->
- pr " v = caml_copy_int64 (dirent->%s);\n" name
- | name, `Char ->
- pr " v = Val_int (dirent->%s);\n" name
- );
- pr " Store_field (rv, %d, v);\n" i
- ) dirent_cols;
- pr " CAMLreturn (rv);\n";
- pr "}\n";
- pr "\n";
-
- pr "static CAMLprim value\n";
- pr "copy_dirent_list (const struct guestfs_dirent_list *dirents)\n";
- pr "{\n";
- pr " CAMLparam0 ();\n";
- pr " CAMLlocal2 (rv, v);\n";
- pr " int i;\n";
- pr "\n";
- pr " if (dirents->len == 0)\n";
- pr " CAMLreturn (Atom (0));\n";
- pr " else {\n";
- pr " rv = caml_alloc (dirents->len, 0);\n";
- pr " for (i = 0; i < dirents->len; ++i) {\n";
- pr " v = copy_dirent (&dirents->val[i]);\n";
- pr " caml_modify (&Field (rv, i), v);\n";
- pr " }\n";
- pr " CAMLreturn (rv);\n";
- pr " }\n";
- pr "}\n";
- pr "\n";
+ ) structs;
(* The wrappers. *)
List.iter (
pr " int i;\n";
pr " char **r;\n";
"NULL"
- | RIntBool _ ->
- pr " struct guestfs_int_bool *r;\n"; "NULL"
- | RPVList _ ->
- pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
- | RVGList _ ->
- pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
- | RLVList _ ->
- pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
- | RStat _ ->
- pr " struct guestfs_stat *r;\n"; "NULL"
- | RStatVFS _ ->
- pr " struct guestfs_statvfs *r;\n"; "NULL"
+ | RStruct (_, typ) ->
+ pr " struct guestfs_%s *r;\n" typ; "NULL"
+ | RStructList (_, typ) ->
+ pr " struct guestfs_%s_list *r;\n" typ; "NULL"
| RHashtable _ ->
pr " int i;\n";
pr " char **r;\n";
"NULL"
- | RDirentList _ ->
- pr " struct guestfs_dirent_list *r;\n"; "NULL" in
+ | RBufferOut _ ->
+ pr " char *r;\n";
+ pr " size_t size;\n";
+ "NULL" in
pr "\n";
pr " caml_enter_blocking_section ();\n";
pr " r = guestfs_%s " name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
pr " caml_leave_blocking_section ();\n";
pr " rv = caml_copy_string_array ((const char **) r);\n";
pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
pr " free (r);\n"
- | RIntBool _ ->
- pr " rv = caml_alloc (2, 0);\n";
- pr " Store_field (rv, 0, Val_int (r->i));\n";
- pr " Store_field (rv, 1, Val_bool (r->b));\n";
- pr " guestfs_free_int_bool (r);\n";
- | RPVList _ ->
- pr " rv = copy_lvm_pv_list (r);\n";
- pr " guestfs_free_lvm_pv_list (r);\n";
- | RVGList _ ->
- pr " rv = copy_lvm_vg_list (r);\n";
- pr " guestfs_free_lvm_vg_list (r);\n";
- | RLVList _ ->
- pr " rv = copy_lvm_lv_list (r);\n";
- pr " guestfs_free_lvm_lv_list (r);\n";
- | RStat _ ->
- pr " rv = copy_stat (r);\n";
- pr " free (r);\n";
- | RStatVFS _ ->
- pr " rv = copy_statvfs (r);\n";
- pr " free (r);\n";
+ | RStruct (_, typ) ->
+ pr " rv = copy_%s (r);\n" typ;
+ pr " guestfs_free_%s (r);\n" typ;
+ | RStructList (_, typ) ->
+ pr " rv = copy_%s_list (r);\n" typ;
+ pr " guestfs_free_%s_list (r);\n" typ;
| RHashtable _ ->
pr " rv = copy_table (r);\n";
pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
pr " free (r);\n";
- | RDirentList _ ->
- pr " rv = copy_dirent_list (r);\n";
- pr " guestfs_free_dirent_list (r);\n";
+ | RBufferOut _ ->
+ pr " rv = caml_alloc_string (size);\n";
+ pr " memcpy (String_val (rv), r, size);\n";
);
pr " CAMLreturn (rv);\n";
)
) all_functions
-and generate_ocaml_lvm_structure_decls () =
- List.iter (
- fun (typ, cols) ->
- pr "type lvm_%s = {\n" typ;
- List.iter (
- function
- | name, `String -> pr " %s : string;\n" name
- | name, `UUID -> pr " %s : string;\n" name
- | name, `Bytes -> pr " %s : int64;\n" name
- | name, `Int -> pr " %s : int64;\n" name
- | name, `OptPercent -> pr " %s : float option;\n" name
- ) cols;
- pr "}\n";
- pr "\n"
- ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
-
-and generate_ocaml_stat_structure_decls () =
+and generate_ocaml_structure_decls () =
List.iter (
fun (typ, cols) ->
pr "type %s = {\n" typ;
List.iter (
function
- | name, `Int -> pr " %s : int64;\n" name
+ | name, FString -> pr " %s : string;\n" name
+ | name, FBuffer -> pr " %s : string;\n" name
+ | name, FUUID -> pr " %s : string;\n" name
+ | name, (FBytes|FInt64|FUInt64) -> pr " %s : int64;\n" name
+ | name, (FInt32|FUInt32) -> pr " %s : int32;\n" name
+ | name, FChar -> pr " %s : char;\n" name
+ | name, FOptPercent -> pr " %s : float option;\n" name
) cols;
pr "}\n";
pr "\n"
- ) ["stat", stat_cols; "statvfs", statvfs_cols]
-
-and generate_ocaml_dirent_structure_decls () =
- pr "type dirent = {\n";
- List.iter (
- function
- | name, `Int -> pr " %s : int64;\n" name
- | name, `Char -> pr " %s : char;\n" name
- | name, `String -> pr " %s : string;\n" name
- ) dirent_cols;
- pr "}\n";
- pr "\n"
+ ) structs
and generate_ocaml_prototype ?(is_external = false) name style =
if is_external then pr "external " else pr "val ";
| RInt64 _ -> pr "int64"
| RBool _ -> pr "bool"
| RConstString _ -> pr "string"
- | RString _ -> pr "string"
+ | RString _ | RBufferOut _ -> pr "string"
| RStringList _ -> pr "string array"
- | RIntBool _ -> pr "int * bool"
- | RPVList _ -> pr "lvm_pv array"
- | RVGList _ -> pr "lvm_vg array"
- | RLVList _ -> pr "lvm_lv array"
- | RStat _ -> pr "stat"
- | RStatVFS _ -> pr "statvfs"
+ | RStruct (_, typ) -> pr "%s" typ
+ | RStructList (_, typ) -> pr "%s array" typ
| RHashtable _ -> pr "(string * string) list"
- | RDirentList _ -> pr "dirent array"
);
if is_external then (
pr " = ";
| RBool _ -> pr "SV *\n"
| RConstString _ -> pr "SV *\n"
| RString _ -> pr "SV *\n"
+ | RBufferOut _ -> pr "SV *\n"
| RStringList _
- | RIntBool _
- | RPVList _ | RVGList _ | RLVList _
- | RStat _ | RStatVFS _
- | RHashtable _
- | RDirentList _ ->
+ | RStruct _ | RStructList _
+ | RHashtable _ ->
pr "void\n" (* all lists returned implictly on the stack *)
);
(* Call and arguments. *)
pr "%s " name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" ~decl:true style;
pr "\n";
pr " guestfs_h *g;\n";
iteri (
pr " int r;\n";
pr " PPCODE:\n";
pr " r = guestfs_%s " name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (r == -1)\n";
pr " int %s;\n" n;
pr " CODE:\n";
pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (%s == -1)\n" n;
pr " int64_t %s;\n" n;
pr " CODE:\n";
pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (%s == -1)\n" n;
pr " const char *%s;\n" n;
pr " CODE:\n";
pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
pr " char *%s;\n" n;
pr " CODE:\n";
pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
pr " int i, n;\n";
pr " PPCODE:\n";
pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
pr " free (%s[i]);\n" n;
pr " }\n";
pr " free (%s);\n" n;
- | RIntBool _ ->
+ | RStruct (n, typ) ->
+ let cols = cols_of_struct typ in
+ generate_perl_struct_code typ cols name style n do_cleanups
+ | RStructList (n, typ) ->
+ let cols = cols_of_struct typ in
+ generate_perl_struct_list_code typ cols name style n do_cleanups
+ | RBufferOut n ->
pr "PREINIT:\n";
- pr " struct guestfs_int_bool *r;\n";
- pr " PPCODE:\n";
- pr " r = guestfs_%s " name;
- generate_call_args ~handle:"g" (snd style);
+ pr " char *%s;\n" n;
+ pr " size_t size;\n";
+ pr " CODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
- pr " if (r == NULL)\n";
+ pr " if (%s == NULL)\n" n;
pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
- pr " EXTEND (SP, 2);\n";
- pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
- pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
- pr " guestfs_free_int_bool (r);\n";
- | RPVList n ->
- generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
- | RVGList n ->
- generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
- | RLVList n ->
- generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
- | RStat n ->
- generate_perl_stat_code "stat" stat_cols name style n do_cleanups
- | RStatVFS n ->
- generate_perl_stat_code
- "statvfs" statvfs_cols name style n do_cleanups
- | RDirentList n ->
- generate_perl_dirent_code
- "dirent" dirent_cols name style n do_cleanups
+ pr " RETVAL = newSVpv (%s, size);\n" n;
+ pr " free (%s);\n" n;
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
);
pr "\n"
) all_functions
-and generate_perl_lvm_code typ cols name style n do_cleanups =
+and generate_perl_struct_list_code typ cols name style n do_cleanups =
pr "PREINIT:\n";
- pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
+ pr " struct guestfs_%s_list *%s;\n" typ n;
pr " int i;\n";
pr " HV *hv;\n";
pr " PPCODE:\n";
pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
pr " hv = newHV ();\n";
List.iter (
function
- | name, `String ->
+ | name, FString ->
pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
name (String.length name) n name
- | name, `UUID ->
+ | name, FUUID ->
pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
name (String.length name) n name
- | name, `Bytes ->
+ | name, FBuffer ->
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%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"
name (String.length name) n name
- | name, `Int ->
+ | name, FInt64 ->
pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
name (String.length name) n name
- | name, `OptPercent ->
+ | name, (FInt32|FUInt32) ->
+ pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
+ name (String.length name) n name
+ | name, FChar ->
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
+ name (String.length name) n name
+ | name, FOptPercent ->
pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
name (String.length name) n name
) cols;
pr " PUSHs (sv_2mortal (newRV ((SV *) hv)));\n";
pr " }\n";
- pr " guestfs_free_lvm_%s_list (%s);\n" typ n
+ pr " guestfs_free_%s_list (%s);\n" typ n
-and generate_perl_stat_code typ cols name style n do_cleanups =
+and generate_perl_struct_code typ cols name style n do_cleanups =
pr "PREINIT:\n";
pr " struct guestfs_%s *%s;\n" typ n;
pr " PPCODE:\n";
pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
- pr " EXTEND (SP, %d);\n" (List.length cols);
+ pr " EXTEND (SP, 2 * %d);\n" (List.length cols);
List.iter (
- function
- | name, `Int ->
- pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
+ fun ((name, _) as col) ->
+ pr " PUSHs (sv_2mortal (newSVpv (\"%s\", 0)));\n" name;
+
+ match col with
+ | name, FString ->
+ pr " PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
+ n name
+ | name, FBuffer ->
+ pr " PUSHs (sv_2mortal (newSVpv (%s->%s, %s->%s_len)));\n"
+ n name n name
+ | name, FUUID ->
+ pr " PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
+ n name
+ | name, (FBytes|FUInt64) ->
+ pr " PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
+ n name
+ | name, FInt64 ->
+ pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
+ n name
+ | name, (FInt32|FUInt32) ->
+ pr " PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
+ n name
+ | name, FChar ->
+ pr " PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
+ n name
+ | name, FOptPercent ->
+ pr " PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
+ n name
) cols;
pr " free (%s);\n" n
-and generate_perl_dirent_code typ cols name style n do_cleanups =
- pr "PREINIT:\n";
- pr " struct guestfs_%s_list *%s;\n" typ n;
- pr " int i;\n";
- pr " HV *hv;\n";
- pr " PPCODE:\n";
- pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
- pr ";\n";
- do_cleanups ();
- pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
- pr " EXTEND (SP, %s->len);\n" n;
- pr " for (i = 0; i < %s->len; ++i) {\n" n;
- pr " hv = newHV ();\n";
- List.iter (
- function
- | name, `String ->
- pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
- name (String.length name) n name
- | name, `Int ->
- pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
- name (String.length name) n name
- | name, `Char ->
- pr " (void) hv_store (hv, \"%s\", %d, newSVpv (&%s->val[i].%s, 1), 0);\n"
- name (String.length name) n name
- ) cols;
- pr " PUSHs (newRV (sv_2mortal ((SV *) hv)));\n";
- pr " }\n";
- pr " guestfs_free_%s_list (%s);\n" typ n
-
(* Generate Sys/Guestfs.pm. *)
and generate_perl_pm () =
generate_header HashStyle LGPLv2;
=head1 SYNOPSIS
use Sys::Guestfs;
-
+
my $h = Sys::Guestfs->new ();
$h->add_drive ('guest.img');
$h->launch ();
LVs, what filesystem is in each LV, etc.). It can also run commands
in the context of the guest. Also you can access filesystems over FTP.
+See also L<Sys::Guestfs::Lib(3)> for a set of useful library
+functions for using libguestfs from Perl, including integration
+with libvirt.
+
=head1 ERRORS
All errors turn into calls to C<croak> (see L<Carp(3)>).
=head1 SEE ALSO
-L<guestfs(3)>, L<guestfish(1)>.
+L<guestfs(3)>,
+L<guestfish(1)>,
+L<http://libguestfs.org>,
+L<Sys::Guestfs::Lib(3)>.
=cut
"
| RInt n
| RInt64 n
| RConstString n
- | RString n -> pr "$%s = " n
- | RIntBool (n, m) -> pr "($%s, $%s) = " n m
- | RStringList n
- | RPVList n
- | RVGList n
- | RLVList n
- | RDirentList n -> pr "@%s = " n
- | RStat n
- | RStatVFS n
+ | RString n
+ | RBufferOut n -> pr "$%s = " n
+ | RStruct (n,_)
| RHashtable n -> pr "%%%s = " n
+ | RStringList n
+ | RStructList (n,_) -> pr "@%s = " n
);
pr "$h->%s (" name;
let comma = ref false in
";
- (* LVM structures, turned into Python dictionaries. *)
+ (* Structures, turned into Python dictionaries. *)
List.iter (
fun (typ, cols) ->
pr "static PyObject *\n";
- pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
+ pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
pr "{\n";
pr " PyObject *dict;\n";
pr "\n";
pr " dict = PyDict_New ();\n";
List.iter (
function
- | name, `String ->
+ | name, FString ->
pr " PyDict_SetItemString (dict, \"%s\",\n" name;
pr " PyString_FromString (%s->%s));\n"
typ name
- | name, `UUID ->
+ | name, FBuffer ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyString_FromStringAndSize (%s->%s, %s->%s_len));\n"
+ typ name typ name
+ | name, FUUID ->
pr " PyDict_SetItemString (dict, \"%s\",\n" name;
pr " PyString_FromStringAndSize (%s->%s, 32));\n"
typ name
- | name, `Bytes ->
+ | name, (FBytes|FUInt64) ->
pr " PyDict_SetItemString (dict, \"%s\",\n" name;
pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
typ name
- | name, `Int ->
+ | name, FInt64 ->
pr " PyDict_SetItemString (dict, \"%s\",\n" name;
pr " PyLong_FromLongLong (%s->%s));\n"
typ name
- | name, `OptPercent ->
+ | name, FUInt32 ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyLong_FromUnsignedLong (%s->%s));\n"
+ typ name
+ | name, FInt32 ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyLong_FromLong (%s->%s));\n"
+ typ name
+ | name, FOptPercent ->
pr " if (%s->%s >= 0)\n" typ name;
pr " PyDict_SetItemString (dict, \"%s\",\n" name;
pr " PyFloat_FromDouble ((double) %s->%s));\n"
pr " Py_INCREF (Py_None);\n";
pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
pr " }\n"
+ | name, FChar ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyString_FromStringAndSize (&dirent->%s, 1));\n" name
) cols;
pr " return dict;\n";
pr "};\n";
pr "\n";
pr "static PyObject *\n";
- pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
+ pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
pr "{\n";
pr " PyObject *list;\n";
pr " int i;\n";
pr "\n";
pr " list = PyList_New (%ss->len);\n" typ;
pr " for (i = 0; i < %ss->len; ++i)\n" typ;
- pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
+ pr " PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
pr " return list;\n";
pr "};\n";
pr "\n"
- ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
-
- (* Stat structures, turned into Python dictionaries. *)
- List.iter (
- fun (typ, cols) ->
- pr "static PyObject *\n";
- pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
- pr "{\n";
- pr " PyObject *dict;\n";
- pr "\n";
- pr " dict = PyDict_New ();\n";
- List.iter (
- function
- | name, `Int ->
- pr " PyDict_SetItemString (dict, \"%s\",\n" name;
- pr " PyLong_FromLongLong (%s->%s));\n"
- typ name
- ) cols;
- pr " return dict;\n";
- pr "};\n";
- pr "\n";
- ) ["stat", stat_cols; "statvfs", statvfs_cols];
-
- (* Dirent structures, turned into Python dictionaries. *)
- pr "static PyObject *\n";
- pr "put_dirent (struct guestfs_dirent *dirent)\n";
- pr "{\n";
- pr " PyObject *dict;\n";
- pr "\n";
- pr " dict = PyDict_New ();\n";
- List.iter (
- function
- | name, `Int ->
- pr " PyDict_SetItemString (dict, \"%s\",\n" name;
- pr " PyLong_FromLongLong (dirent->%s));\n" name
- | name, `Char ->
- pr " PyDict_SetItemString (dict, \"%s\",\n" name;
- pr " PyString_FromStringAndSize (&dirent->%s, 1));\n" name
- | name, `String ->
- pr " PyDict_SetItemString (dict, \"%s\",\n" name;
- pr " PyString_FromString (dirent->%s));\n" name
- ) dirent_cols;
- pr " return dict;\n";
- pr "};\n";
- pr "\n";
-
- pr "static PyObject *\n";
- pr "put_dirent_list (struct guestfs_dirent_list *dirents)\n";
- pr "{\n";
- pr " PyObject *list;\n";
- pr " int i;\n";
- pr "\n";
- pr " list = PyList_New (dirents->len);\n";
- pr " for (i = 0; i < dirents->len; ++i)\n";
- pr " PyList_SetItem (list, i, put_dirent (&dirents->val[i]));\n";
- pr " return list;\n";
- pr "};\n";
- pr "\n";
+ ) structs;
(* Python wrapper functions. *)
List.iter (
| RConstString _ -> pr " const char *r;\n"; "NULL"
| RString _ -> pr " char *r;\n"; "NULL"
| RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
- | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
- | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
- | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
- | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
- | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
- | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL"
- | RDirentList n -> pr " struct guestfs_dirent_list *r;\n"; "NULL" in
+ | RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ; "NULL"
+ | RStructList (_, typ) ->
+ pr " struct guestfs_%s_list *r;\n" typ; "NULL"
+ | RBufferOut _ ->
+ pr " char *r;\n";
+ pr " size_t size;\n";
+ "NULL" in
List.iter (
function
pr "\n";
pr " r = guestfs_%s " name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
List.iter (
| RStringList _ ->
pr " py_r = put_string_list (r);\n";
pr " free_strings (r);\n"
- | RIntBool _ ->
- pr " py_r = PyTuple_New (2);\n";
- pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
- pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
- pr " guestfs_free_int_bool (r);\n"
- | RPVList n ->
- pr " py_r = put_lvm_pv_list (r);\n";
- pr " guestfs_free_lvm_pv_list (r);\n"
- | RVGList n ->
- pr " py_r = put_lvm_vg_list (r);\n";
- pr " guestfs_free_lvm_vg_list (r);\n"
- | RLVList n ->
- pr " py_r = put_lvm_lv_list (r);\n";
- pr " guestfs_free_lvm_lv_list (r);\n"
- | RStat n ->
- pr " py_r = put_stat (r);\n";
- pr " free (r);\n"
- | RStatVFS n ->
- pr " py_r = put_statvfs (r);\n";
- pr " free (r);\n"
+ | RStruct (_, typ) ->
+ pr " py_r = put_%s (r);\n" typ;
+ pr " guestfs_free_%s (r);\n" typ
+ | RStructList (_, typ) ->
+ pr " py_r = put_%s_list (r);\n" typ;
+ pr " guestfs_free_%s_list (r);\n" typ
| RHashtable n ->
pr " py_r = put_table (r);\n";
pr " free_strings (r);\n"
- | RDirentList n ->
- pr " py_r = put_dirent_list (r);\n";
- pr " guestfs_free_dirent_list (r);\n"
+ | RBufferOut _ ->
+ pr " py_r = PyString_FromStringAndSize (r, size);\n";
+ pr " free (r);\n"
);
pr " return py_r;\n";
List.iter (
fun (name, style, _, flags, _, _, longdesc) ->
pr " def %s " name;
- generate_call_args ~handle:"self" (snd style);
+ generate_py_call_args ~handle:"self" (snd style);
pr ":\n";
if not (List.mem NotInDocs flags) then (
let doc =
match fst style with
| RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
- | RString _ -> doc
+ | RString _ | RBufferOut _ -> doc
| RStringList _ ->
doc ^ "\n\nThis function returns a list of strings."
- | RIntBool _ ->
- doc ^ "\n\nThis function returns a tuple (int, bool).\n"
- | RPVList _ ->
- doc ^ "\n\nThis function returns a list of PVs. Each PV is represented as a dictionary."
- | RVGList _ ->
- doc ^ "\n\nThis function returns a list of VGs. Each VG is represented as a dictionary."
- | RLVList _ ->
- doc ^ "\n\nThis function returns a list of LVs. Each LV is represented as a dictionary."
- | RStat _ ->
- doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure."
- | RStatVFS _ ->
- doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure."
+ | RStruct (_, typ) ->
+ doc ^ sprintf "\n\nThis function returns a dictionary, with keys matching the various fields in the guestfs_%s structure." typ
+ | RStructList (_, typ) ->
+ doc ^ sprintf "\n\nThis function returns a list of %ss. Each %s is represented as a dictionary." typ typ
| RHashtable _ ->
- doc ^ "\n\nThis function returns a dictionary."
- | RDirentList _ ->
- doc ^ "\n\nThis function returns a list of directory entries. Each directory entry is represented as a dictionary." in
+ doc ^ "\n\nThis function returns a dictionary." in
let doc =
if List.mem ProtocolLimitWarning flags then
doc ^ "\n\n" ^ protocol_limit_warning
pr " u\"\"\"%s\"\"\"\n" doc;
);
pr " return libguestfsmod.%s " name;
- generate_call_args ~handle:"self._o" (snd style);
+ generate_py_call_args ~handle:"self._o" (snd style);
pr "\n";
pr "\n";
) all_functions
+(* Generate Python call arguments, eg "(handle, foo, bar)" *)
+and generate_py_call_args ~handle args =
+ pr "(%s" handle;
+ List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
+ pr ")"
+
(* Useful if you need the longdesc POD text as plain text. Returns a
* list of lines.
*
| RConstString _ -> pr " const char *r;\n"; "NULL"
| RString _ -> pr " char *r;\n"; "NULL"
| RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
- | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
- | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
- | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
- | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
- | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
- | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL"
- | RDirentList n -> pr " struct guestfs_dirent_list *r;\n"; "NULL" in
+ | RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ; "NULL"
+ | RStructList (_, typ) ->
+ pr " struct guestfs_%s_list *r;\n" typ; "NULL"
+ | RBufferOut _ ->
+ pr " char *r;\n";
+ pr " size_t size;\n";
+ "NULL" in
pr "\n";
pr " r = guestfs_%s " name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
List.iter (
pr " }\n";
pr " free (r);\n";
pr " return rv;\n"
- | RIntBool _ ->
- pr " VALUE rv = rb_ary_new2 (2);\n";
- pr " rb_ary_push (rv, INT2NUM (r->i));\n";
- pr " rb_ary_push (rv, INT2NUM (r->b));\n";
- pr " guestfs_free_int_bool (r);\n";
- pr " return rv;\n"
- | RPVList n ->
- generate_ruby_lvm_code "pv" pv_cols
- | RVGList n ->
- generate_ruby_lvm_code "vg" vg_cols
- | RLVList n ->
- generate_ruby_lvm_code "lv" lv_cols
- | RStat n ->
- pr " VALUE rv = rb_hash_new ();\n";
- List.iter (
- function
- | name, `Int ->
- pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
- ) stat_cols;
- pr " free (r);\n";
- pr " return rv;\n"
- | RStatVFS n ->
- pr " VALUE rv = rb_hash_new ();\n";
- List.iter (
- function
- | name, `Int ->
- pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
- ) statvfs_cols;
- pr " free (r);\n";
- pr " return rv;\n"
+ | RStruct (_, typ) ->
+ let cols = cols_of_struct typ in
+ generate_ruby_struct_code typ cols
+ | RStructList (_, typ) ->
+ let cols = cols_of_struct typ in
+ generate_ruby_struct_list_code typ cols
| RHashtable _ ->
pr " VALUE rv = rb_hash_new ();\n";
pr " int i;\n";
pr " }\n";
pr " free (r);\n";
pr " return rv;\n"
- | RDirentList n ->
- generate_ruby_dirent_code "dirent" dirent_cols
+ | RBufferOut _ ->
+ pr " VALUE rv = rb_str_new (r, size);\n";
+ pr " free (r);\n";
+ pr " return rv;\n";
);
pr "}\n";
pr "}\n"
-(* Ruby code to return an LVM struct list. *)
-and generate_ruby_lvm_code typ cols =
- pr " VALUE rv = rb_ary_new2 (r->len);\n";
- pr " int i;\n";
- pr " for (i = 0; i < r->len; ++i) {\n";
- pr " VALUE hv = rb_hash_new ();\n";
+(* Ruby code to return a struct. *)
+and generate_ruby_struct_code typ cols =
+ pr " VALUE rv = rb_hash_new ();\n";
List.iter (
function
- | name, `String ->
- pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
- | name, `UUID ->
- pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
- | name, `Bytes
- | name, `Int ->
- pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
- | name, `OptPercent ->
- pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
+ | name, FString ->
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
+ | name, FBuffer ->
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, r->%s_len));\n" name name name
+ | name, FUUID ->
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new (r->%s, 32));\n" name name
+ | name, (FBytes|FUInt64) ->
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
+ | name, FInt64 ->
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), LL2NUM (r->%s));\n" name name
+ | name, FUInt32 ->
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), UINT2NUM (r->%s));\n" name name
+ | name, FInt32 ->
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), INT2NUM (r->%s));\n" name name
+ | name, FOptPercent ->
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_dbl2big (r->%s));\n" name name
+ | name, FChar -> (* XXX wrong? *)
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
) cols;
- pr " rb_ary_push (rv, hv);\n";
- pr " }\n";
- pr " guestfs_free_lvm_%s_list (r);\n" typ;
+ pr " guestfs_free_%s (r);\n" typ;
pr " return rv;\n"
-(* Ruby code to return a dirent struct list. *)
-and generate_ruby_dirent_code typ cols =
+(* Ruby code to return a struct list. *)
+and generate_ruby_struct_list_code typ cols =
pr " VALUE rv = rb_ary_new2 (r->len);\n";
pr " int i;\n";
pr " for (i = 0; i < r->len; ++i) {\n";
pr " VALUE hv = rb_hash_new ();\n";
List.iter (
function
- | name, `String ->
- pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
- | name, (`Char|`Int) ->
- pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
+ | name, FString ->
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
+ | name, FBuffer ->
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, r->val[i].%s_len));\n" name name name
+ | name, FUUID ->
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new (r->val[i].%s, 32));\n" name name
+ | name, (FBytes|FUInt64) ->
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
+ | name, FInt64 ->
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), LL2NUM (r->val[i].%s));\n" name name
+ | name, FUInt32 ->
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), UINT2NUM (r->val[i].%s));\n" name name
+ | name, FInt32 ->
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), INT2NUM (r->val[i].%s));\n" name name
+ | name, FOptPercent ->
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_dbl2big (r->val[i].%s));\n" name name
+ | name, FChar -> (* XXX wrong? *)
+ pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), ULL2NUM (r->val[i].%s));\n" name name
) cols;
pr " rb_ary_push (rv, hv);\n";
pr " }\n";
pr " ";
if fst style <> RErr then pr "return ";
pr "_%s " name;
- generate_call_args ~handle:"g" (snd style);
+ generate_java_call_args ~handle:"g" (snd style);
pr ";\n";
pr " }\n";
pr " ";
pr "}\n"
+(* Generate Java call arguments, eg "(handle, foo, bar)" *)
+and generate_java_call_args ~handle args =
+ pr "(%s" handle;
+ List.iter (fun arg -> pr ", %s" (name_of_argt arg)) args;
+ pr ")"
+
and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
?(semicolon=true) name style =
if privat then pr "private ";
| RInt _ -> pr "int ";
| RInt64 _ -> pr "long ";
| RBool _ -> pr "boolean ";
- | RConstString _ | RString _ -> pr "String ";
+ | RConstString _ | RString _ | RBufferOut _ -> pr "String ";
| RStringList _ -> pr "String[] ";
- | RIntBool _ -> pr "IntBool ";
- | RPVList _ -> pr "PV[] ";
- | RVGList _ -> pr "VG[] ";
- | RLVList _ -> pr "LV[] ";
- | RStat _ -> pr "Stat ";
- | RStatVFS _ -> pr "StatVFS ";
+ | RStruct (_, typ) ->
+ let name = java_name_of_struct typ in
+ pr "%s " name;
+ | RStructList (_, typ) ->
+ let name = java_name_of_struct typ in
+ pr "%s[] " name;
| RHashtable _ -> pr "HashMap<String,String> ";
- | RDirentList _ -> pr "Dirent[] ";
);
if native then pr "_%s " name else pr "%s " name;
pr " throws LibGuestFSException";
if semicolon then pr ";"
-and generate_java_struct typ cols =
+and generate_java_struct jtyp cols =
generate_header CStyle LGPLv2;
pr "\
* @see GuestFS
*/
public class %s {
-" typ typ;
+" jtyp jtyp;
List.iter (
function
- | name, `String
- | name, `UUID -> pr " public String %s;\n" name
- | name, `Bytes
- | name, `Int -> pr " public long %s;\n" name
- | name, `Char -> pr " public char %s;\n" name
- | name, `OptPercent ->
+ | name, FString
+ | name, FUUID
+ | name, FBuffer -> pr " public String %s;\n" name
+ | name, (FBytes|FUInt64|FInt64) -> pr " public long %s;\n" name
+ | name, (FUInt32|FInt32) -> pr " public int %s;\n" name
+ | name, FChar -> pr " public char %s;\n" name
+ | name, FOptPercent ->
pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
pr " public float %s;\n" name
) cols;
| RInt _ -> pr "jint ";
| RInt64 _ -> pr "jlong ";
| RBool _ -> pr "jboolean ";
- | RConstString _ | RString _ -> pr "jstring ";
- | RIntBool _ | RStat _ | RStatVFS _ | RHashtable _ ->
+ | RConstString _ | RString _ | RBufferOut _ -> pr "jstring ";
+ | RStruct _ | RHashtable _ ->
pr "jobject ";
- | RStringList _ | RPVList _ | RVGList _ | RLVList _ | RDirentList _ ->
+ | RStringList _ | RStructList _ ->
pr "jobjectArray ";
);
pr "JNICALL\n";
pr " jclass cl;\n";
pr " jstring jstr;\n";
pr " char **r;\n"; "NULL", "NULL"
- | RIntBool _ ->
+ | RStruct (_, typ) ->
pr " jobject jr;\n";
pr " jclass cl;\n";
pr " jfieldID fl;\n";
- pr " struct guestfs_int_bool *r;\n"; "NULL", "NULL"
- | RStat _ ->
- pr " jobject jr;\n";
- pr " jclass cl;\n";
- pr " jfieldID fl;\n";
- pr " struct guestfs_stat *r;\n"; "NULL", "NULL"
- | RStatVFS _ ->
- pr " jobject jr;\n";
- pr " jclass cl;\n";
- pr " jfieldID fl;\n";
- pr " struct guestfs_statvfs *r;\n"; "NULL", "NULL"
- | RPVList _ ->
- pr " jobjectArray jr;\n";
- pr " jclass cl;\n";
- pr " jfieldID fl;\n";
- pr " jobject jfl;\n";
- pr " struct guestfs_lvm_pv_list *r;\n"; "NULL", "NULL"
- | RVGList _ ->
+ pr " struct guestfs_%s *r;\n" typ; "NULL", "NULL"
+ | RStructList (_, typ) ->
pr " jobjectArray jr;\n";
pr " jclass cl;\n";
pr " jfieldID fl;\n";
pr " jobject jfl;\n";
- pr " struct guestfs_lvm_vg_list *r;\n"; "NULL", "NULL"
- | RLVList _ ->
- pr " jobjectArray jr;\n";
- pr " jclass cl;\n";
- pr " jfieldID fl;\n";
- pr " jobject jfl;\n";
- pr " struct guestfs_lvm_lv_list *r;\n"; "NULL", "NULL"
+ pr " struct guestfs_%s_list *r;\n" typ; "NULL", "NULL"
| RHashtable _ -> pr " char **r;\n"; "NULL", "NULL"
- | RDirentList _ ->
- pr " jobjectArray jr;\n";
- pr " jclass cl;\n";
- pr " jfieldID fl;\n";
- pr " jobject jfl;\n";
- pr " struct guestfs_dirent_list *r;\n"; "NULL", "NULL" in
+ | RBufferOut _ ->
+ pr " jstring jr;\n";
+ pr " char *r;\n";
+ pr " size_t size;\n";
+ "NULL", "NULL" in
List.iter (
function
| String n
let needs_i =
(match fst style with
- | RStringList _ | RPVList _ | RVGList _ | RLVList _
- | RDirentList _ -> true
+ | RStringList _ | RStructList _ -> true
| RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
- | RString _ | RIntBool _ | RStat _ | RStatVFS _
- | RHashtable _ -> false) ||
- List.exists (function StringList _ -> true | _ -> false) (snd style) in
+ | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
+ List.exists (function StringList _ -> true | _ -> false) (snd style) in
if needs_i then
pr " int i;\n";
(* Make the call. *)
pr " r = guestfs_%s " name;
- generate_call_args ~handle:"g" (snd style);
+ generate_c_call_args ~handle:"g" style;
pr ";\n";
(* Release the parameters. *)
pr " }\n";
pr " free (r);\n";
pr " return jr;\n"
- | RIntBool _ ->
- pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/IntBool\");\n";
- pr " jr = (*env)->AllocObject (env, cl);\n";
- pr " fl = (*env)->GetFieldID (env, cl, \"i\", \"I\");\n";
- pr " (*env)->SetIntField (env, jr, fl, r->i);\n";
- pr " fl = (*env)->GetFieldID (env, cl, \"i\", \"Z\");\n";
- pr " (*env)->SetBooleanField (env, jr, fl, r->b);\n";
- pr " guestfs_free_int_bool (r);\n";
- pr " return jr;\n"
- | RStat _ ->
- pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/Stat\");\n";
- pr " jr = (*env)->AllocObject (env, cl);\n";
- List.iter (
- function
- | name, `Int ->
- pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n"
- name;
- pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
- ) stat_cols;
- pr " free (r);\n";
- pr " return jr;\n"
- | RStatVFS _ ->
- pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/StatVFS\");\n";
- pr " jr = (*env)->AllocObject (env, cl);\n";
- List.iter (
- function
- | name, `Int ->
- pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n"
- name;
- pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
- ) statvfs_cols;
- pr " free (r);\n";
- pr " return jr;\n"
- | RPVList _ ->
- generate_java_lvm_return "pv" "PV" pv_cols
- | RVGList _ ->
- generate_java_lvm_return "vg" "VG" vg_cols
- | RLVList _ ->
- generate_java_lvm_return "lv" "LV" lv_cols
+ | RStruct (_, typ) ->
+ let jtyp = java_name_of_struct typ in
+ let cols = cols_of_struct typ in
+ generate_java_struct_return typ jtyp cols
+ | RStructList (_, typ) ->
+ let jtyp = java_name_of_struct typ in
+ let cols = cols_of_struct typ in
+ generate_java_struct_list_return typ jtyp cols
| RHashtable _ ->
(* XXX *)
pr " throw_exception (env, \"%s: internal error: please let us know how to make a Java HashMap from JNI bindings!\");\n" name;
pr " return NULL;\n"
- | RDirentList _ ->
- generate_java_dirent_return "dirent" "Dirent" dirent_cols
+ | RBufferOut _ ->
+ pr " jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
+ pr " free (r);\n";
+ pr " return jr;\n"
);
pr "}\n";
pr "\n"
) all_functions
-and generate_java_lvm_return typ jtyp cols =
+and generate_java_struct_return typ jtyp cols =
+ pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
+ pr " jr = (*env)->AllocObject (env, cl);\n";
+ List.iter (
+ function
+ | name, FString ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
+ pr " (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, r->%s));\n" name;
+ | name, FUUID ->
+ pr " {\n";
+ pr " char s[33];\n";
+ pr " memcpy (s, r->%s, 32);\n" name;
+ pr " s[32] = 0;\n";
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
+ pr " (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
+ pr " }\n";
+ | name, FBuffer ->
+ pr " {\n";
+ pr " int len = r->%s_len;\n" name;
+ pr " char s[len+1];\n";
+ pr " memcpy (s, r->%s, len);\n" name;
+ pr " s[len] = 0;\n";
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
+ pr " (*env)->SetObjectField (env, jr, fl, (*env)->NewStringUTF (env, s));\n";
+ pr " }\n";
+ | name, (FBytes|FUInt64|FInt64) ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
+ pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
+ | name, (FUInt32|FInt32) ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
+ pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
+ | name, FOptPercent ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
+ pr " (*env)->SetFloatField (env, jr, fl, r->%s);\n" name;
+ | name, FChar ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
+ pr " (*env)->SetLongField (env, jr, fl, r->%s);\n" name;
+ ) cols;
+ pr " free (r);\n";
+ pr " return jr;\n"
+
+and generate_java_struct_list_return typ jtyp cols =
pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
pr " jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
pr " for (i = 0; i < r->len; ++i) {\n";
pr " jfl = (*env)->AllocObject (env, cl);\n";
List.iter (
function
- | name, `String ->
+ | name, FString ->
pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
- | name, `UUID ->
+ | name, FUUID ->
pr " {\n";
pr " char s[33];\n";
pr " memcpy (s, r->val[i].%s, 32);\n" name;
pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
pr " }\n";
- | name, (`Bytes|`Int) ->
+ | name, FBuffer ->
+ pr " {\n";
+ pr " int len = r->val[i].%s_len;\n" name;
+ pr " char s[len+1];\n";
+ pr " memcpy (s, r->val[i].%s, len);\n" name;
+ pr " s[len] = 0;\n";
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
+ pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, s));\n";
+ pr " }\n";
+ | name, (FBytes|FUInt64|FInt64) ->
pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
pr " (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
- | name, `OptPercent ->
+ | name, (FUInt32|FInt32) ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"I\");\n" name;
+ pr " (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
+ | name, FOptPercent ->
pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
pr " (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\n" name;
- ) cols;
- pr " (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
- pr " }\n";
- pr " guestfs_free_lvm_%s_list (r);\n" typ;
- pr " return jr;\n"
-
-and generate_java_dirent_return typ jtyp cols =
- pr " cl = (*env)->FindClass (env, \"com/redhat/et/libguestfs/%s\");\n" jtyp;
- pr " jr = (*env)->NewObjectArray (env, r->len, cl, NULL);\n";
- pr " for (i = 0; i < r->len; ++i) {\n";
- pr " jfl = (*env)->AllocObject (env, cl);\n";
- List.iter (
- function
- | name, `String ->
- pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"Ljava/lang/String;\");\n" name;
- pr " (*env)->SetObjectField (env, jfl, fl, (*env)->NewStringUTF (env, r->val[i].%s));\n" name;
- | name, (`Char|`Int) ->
- pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
+ | name, FChar ->
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"C\");\n" name;
pr " (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
) cols;
pr " (*env)->SetObjectArrayElement (env, jfl, i, jfl);\n";
| RConstString _, _
| RString _, _
| RStringList _, _
- | RIntBool _, _
- | RPVList _, _
- | RVGList _, _
- | RLVList _, _
- | RStat _, _
- | RStatVFS _, _
+ | RStruct _, _
+ | RStructList _, _
| RHashtable _, _
- | RDirentList _, _ -> false in
+ | RBufferOut _, _ -> false in
pr "\
{-# INCLUDE <guestfs.h> #-}
pr " then do\n";
pr " err <- last_error h\n";
pr " fail err\n";
- | RConstString _ | RString _ | RStringList _ | RIntBool _
- | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _
- | RHashtable _ | RDirentList _ ->
+ | RConstString _ | RString _ | RStringList _ | RStruct _
+ | RStructList _ | RHashtable _ | RBufferOut _ ->
pr " if (r == nullPtr)\n";
pr " then do\n";
pr " err <- last_error h\n";
| RConstString _
| RString _
| RStringList _
- | RIntBool _
- | RPVList _
- | RVGList _
- | RLVList _
- | RStat _
- | RStatVFS _
+ | RStruct _
+ | RStructList _
| RHashtable _
- | RDirentList _ ->
+ | RBufferOut _ ->
pr " else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
);
pr "\n";
| RConstString _ -> pr "%s" string
| RString _ -> pr "%s" string
| RStringList _ -> pr "[%s]" string
- | RIntBool _ -> pr "IntBool"
- | RPVList _ -> pr "[PV]"
- | RVGList _ -> pr "[VG]"
- | RLVList _ -> pr "[LV]"
- | RStat _ -> pr "Stat"
- | RStatVFS _ -> pr "StatVFS"
+ | RStruct (_, typ) ->
+ let name = java_name_of_struct typ in
+ pr "%s" name
+ | RStructList (_, typ) ->
+ let name = java_name_of_struct typ in
+ pr "[%s]" name
| RHashtable _ -> pr "Hashtable"
- | RDirentList _ -> pr "[Dirent]"
+ | RBufferOut _ -> pr "%s" string
);
pr ")"
#include \"guestfs_protocol.h\"
#define error guestfs_error
+#define safe_calloc guestfs_safe_calloc
+#define safe_malloc guestfs_safe_malloc
static void
print_strings (char * const* const argv)
pr " char **strs;\n";
pr " int n, i;\n";
pr " sscanf (val, \"%%d\", &n);\n";
- pr " strs = malloc ((n+1) * sizeof (char *));\n";
+ pr " strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
pr " for (i = 0; i < n; ++i) {\n";
- pr " strs[i] = malloc (16);\n";
+ pr " strs[i] = safe_malloc (g, 16);\n";
pr " snprintf (strs[i], 16, \"%%d\", i);\n";
pr " }\n";
pr " strs[n] = NULL;\n";
pr " return strs;\n"
- | RIntBool _ ->
- pr " struct guestfs_int_bool *r;\n";
- pr " r = malloc (sizeof (struct guestfs_int_bool));\n";
- pr " sscanf (val, \"%%\" SCNi32, &r->i);\n";
- pr " r->b = 0;\n";
+ | RStruct (_, typ) ->
+ pr " struct guestfs_%s *r;\n" typ;
+ pr " r = safe_calloc (g, sizeof *r, 1);\n";
pr " return r;\n"
- | RPVList _ ->
- pr " struct guestfs_lvm_pv_list *r;\n";
- pr " int i;\n";
- pr " r = malloc (sizeof (struct guestfs_lvm_pv_list));\n";
+ | RStructList (_, typ) ->
+ pr " struct guestfs_%s_list *r;\n" typ;
+ pr " r = safe_calloc (g, sizeof *r, 1);\n";
pr " sscanf (val, \"%%d\", &r->len);\n";
- pr " r->val = calloc (r->len, sizeof (struct guestfs_lvm_pv));\n";
- pr " for (i = 0; i < r->len; ++i) {\n";
- pr " r->val[i].pv_name = malloc (16);\n";
- pr " snprintf (r->val[i].pv_name, 16, \"%%d\", i);\n";
- pr " }\n";
- pr " return r;\n"
- | RVGList _ ->
- pr " struct guestfs_lvm_vg_list *r;\n";
- pr " int i;\n";
- pr " r = malloc (sizeof (struct guestfs_lvm_vg_list));\n";
- pr " sscanf (val, \"%%d\", &r->len);\n";
- pr " r->val = calloc (r->len, sizeof (struct guestfs_lvm_vg));\n";
- pr " for (i = 0; i < r->len; ++i) {\n";
- pr " r->val[i].vg_name = malloc (16);\n";
- pr " snprintf (r->val[i].vg_name, 16, \"%%d\", i);\n";
- pr " }\n";
- pr " return r;\n"
- | RLVList _ ->
- pr " struct guestfs_lvm_lv_list *r;\n";
- pr " int i;\n";
- pr " r = malloc (sizeof (struct guestfs_lvm_lv_list));\n";
- pr " sscanf (val, \"%%d\", &r->len);\n";
- pr " r->val = calloc (r->len, sizeof (struct guestfs_lvm_lv));\n";
- pr " for (i = 0; i < r->len; ++i) {\n";
- pr " r->val[i].lv_name = malloc (16);\n";
- pr " snprintf (r->val[i].lv_name, 16, \"%%d\", i);\n";
- pr " }\n";
- pr " return r;\n"
- | RStat _ ->
- pr " struct guestfs_stat *r;\n";
- pr " r = calloc (1, sizeof (*r));\n";
- pr " sscanf (val, \"%%\" SCNi64, &r->dev);\n";
- pr " return r;\n"
- | RStatVFS _ ->
- pr " struct guestfs_statvfs *r;\n";
- pr " r = calloc (1, sizeof (*r));\n";
- pr " sscanf (val, \"%%\" SCNi64, &r->bsize);\n";
+ pr " r->val = safe_calloc (g, r->len, sizeof *r->val);\n";
pr " return r;\n"
| RHashtable _ ->
pr " char **strs;\n";
pr " int n, i;\n";
pr " sscanf (val, \"%%d\", &n);\n";
- pr " strs = malloc ((n*2+1) * sizeof (char *));\n";
+ pr " strs = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
pr " for (i = 0; i < n; ++i) {\n";
- pr " strs[i*2] = malloc (16);\n";
- pr " strs[i*2+1] = malloc (16);\n";
+ pr " strs[i*2] = safe_malloc (g, 16);\n";
+ pr " strs[i*2+1] = safe_malloc (g, 16);\n";
pr " snprintf (strs[i*2], 16, \"%%d\", i);\n";
pr " snprintf (strs[i*2+1], 16, \"%%d\", i);\n";
pr " }\n";
pr " strs[n*2] = NULL;\n";
pr " return strs;\n"
- | RDirentList _ ->
- pr " struct guestfs_dirent_list *r;\n";
- pr " int i;\n";
- pr " r = malloc (sizeof (struct guestfs_dirent_list));\n";
- pr " sscanf (val, \"%%d\", &r->len);\n";
- pr " r->val = calloc (r->len, sizeof (struct guestfs_dirent));\n";
- pr " for (i = 0; i < r->len; ++i)\n";
- pr " r->val[i].ino = i;\n";
- pr " return r;\n"
+ | RBufferOut _ ->
+ pr " return strdup (val);\n"
);
pr "}\n";
pr "\n"
| RErr | RInt _ | RInt64 _ | RBool _ ->
pr " return -1;\n"
| RConstString _
- | RString _ | RStringList _ | RIntBool _
- | RPVList _ | RVGList _ | RLVList _ | RStat _ | RStatVFS _
+ | RString _ | RStringList _ | RStruct _
+ | RStructList _
| RHashtable _
- | RDirentList _ ->
+ | RBufferOut _ ->
pr " return NULL;\n"
);
pr "}\n";
CallStringList ["1"]; CallBool false;
CallInt 0; CallString ""; CallString ""]
- (* XXX Add here tests of the return and error functions. *)
+(* 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
let () =
check_functions ();
- if not (Sys.file_exists "configure.ac") then (
+ 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
generate_java_java ();
close ();
- let close = output_to "java/com/redhat/et/libguestfs/PV.java" in
- generate_java_struct "PV" pv_cols;
- close ();
-
- let close = output_to "java/com/redhat/et/libguestfs/VG.java" in
- generate_java_struct "VG" vg_cols;
- close ();
-
- let close = output_to "java/com/redhat/et/libguestfs/LV.java" in
- generate_java_struct "LV" lv_cols;
- close ();
-
- let close = output_to "java/com/redhat/et/libguestfs/Stat.java" in
- generate_java_struct "Stat" stat_cols;
- close ();
-
- let close = output_to "java/com/redhat/et/libguestfs/StatVFS.java" in
- generate_java_struct "StatVFS" statvfs_cols;
- close ();
-
- let close = output_to "java/com/redhat/et/libguestfs/Dirent.java" in
- generate_java_struct "Dirent" dirent_cols;
+ List.iter (
+ fun (typ, jtyp) ->
+ let cols = cols_of_struct typ in
+ let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
+ let close = output_to filename in
+ generate_java_struct jtyp cols;
+ close ();
+ ) java_structs;
+
+ let close = output_to "java/Makefile.inc" in
+ pr "java_built_sources =";
+ List.iter (
+ fun (typ, jtyp) ->
+ pr " com/redhat/et/libguestfs/%s.java" jtyp;
+ ) java_structs;
+ pr " com/redhat/et/libguestfs/GuestFS.java\n";
close ();
let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in
git.annexia.org / libguestfs.git / blobdiff