* 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.
- * [Need to add -warn-error to ocaml command line]
*)
#load "unix.cma";;
* indication, ie. 0 or -1.
*)
| RErr
+
(* "RInt" as a return value means an int which is -1 for error
* or any value >= 0 on success. Only use this for smallish
* positive ints (0 <= i < 2^30).
*)
| RInt of string
+
(* "RInt64" is the same as RInt, but is guaranteed to be able
* to return a full 64 bit value, _except_ that -1 means error
* (so -1 cannot be a valid, non-error return value).
*)
| RInt64 of string
+
(* "RBool" is a bool return value which can be true/false or
* -1 for error.
*)
| RBool of string
+
(* "RConstString" is a string that refers to a constant value.
+ * The return value must NOT be NULL (since NULL indicates
+ * an error).
+ *
* Try to avoid using this. In particular you cannot use this
* for values returned from the daemon, because there is no
* thread-safe way to return them in the C API.
*)
| RConstString of string
- (* "RString" and "RStringList" are caller-frees. *)
+
+ (* "RConstOptString" is an even more broken version of
+ * "RConstString". The returned string may be NULL and there
+ * is no way to return an error indication. Avoid using this!
+ *)
+ | RConstOptString of string
+
+ (* "RString" is a returned string. It must NOT be NULL, since
+ * a NULL return indicates an error. The caller frees this.
+ *)
| RString of string
+
+ (* "RStringList" is a list of strings. No string in the list
+ * can be NULL. The caller frees the strings and the array.
+ *)
| RStringList 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.
+ * 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
*)
| RHashtable 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. *)
(* Note in future we should allow a "variable args" parameter as
*)
and argt =
| String of string (* const char *name, cannot be NULL *)
+ | Device of string (* /dev device name, cannot be NULL *)
+ | Pathname of string (* file name, cannot be NULL *)
+ | Dev_or_Path of string (* /dev device name or Pathname, cannot be NULL *)
| OptString of string (* const char *name, may be NULL *)
| StringList of string(* list of strings (each string cannot be NULL) *)
+ | DeviceList of string(* list of Device names (each cannot be NULL) *)
| Bool of string (* boolean *)
| Int of string (* int (smallish ints, signed, <= 31 bits) *)
(* These are treated as filenames (simple string parameters) in
*)
| 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 *)
| FishAction of string (* call this function in guestfish *)
| NotInFish (* do not export via guestfish *)
| NotInDocs (* do not add this function to documentation *)
-
-let protocol_limit_warning =
- "Because of the message protocol, there is a transfer limit
-of somewhere between 2MB and 4MB. To transfer large files you should use
-FTP."
-
-let danger_will_robinson =
- "B<This command is dangerous. Without careful use you
-can easily destroy all your data>."
+ | DeprecatedBy of string (* function is deprecated, use .. instead *)
(* You can supply zero or as many tests as you want per API call.
*
and test =
(* Run the command sequence and just expect nothing to fail. *)
| TestRun of seq
+
(* Run the command sequence and expect the output of the final
* command to be the string.
*)
| TestOutput of seq * string
+
(* Run the command sequence and expect the output of the final
* command to be the list of strings.
*)
| TestOutputList of seq * string list
+
(* Run the command sequence and expect the output of the final
* command to be the list of block devices (could be either
* "/dev/sd.." or "/dev/hd.." form - we don't check the 5th
* character of each string).
*)
| TestOutputListOfDevices of seq * string list
+
(* Run the command sequence and expect the output of the final
* command to be the integer.
*)
| 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
+
(* Run the command sequence and expect the output of the final
* command to be a false value (== 0 or == NULL, but not an error).
*)
| TestOutputFalse of seq
+
(* Run the command sequence and expect the output of the final
* command to be a list of the given length (but don't care about
* content).
*)
| TestOutputLength of seq * int
+
+ (* Run the command sequence and expect the output of the final
+ * command to be a buffer (RBufferOut), ie. string + size.
+ *)
+ | TestOutputBuffer of seq * string
+
(* Run the command sequence and expect the output of the final
* command to be a structure.
*)
| TestOutputStruct of seq * test_field_compare list
+
(* Run the command sequence and expect the final command (only)
* to fail.
*)
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
and test_prereq =
(* Test always runs. *)
| Always
+
(* Test is currently disabled - eg. it fails, or it tests some
* unimplemented feature.
*)
| Disabled
+
(* 'string' is some C code (a function body) that should return
* true or false. The test will run if the code returns true.
*)
| If of string
+
(* As for 'If' but the test runs _unless_ the code returns true. *)
| Unless of string
* a bad idea.
*)
| InitNone
+
(* Block devices are empty and no filesystems are mounted. *)
| InitEmpty
+
+ (* /dev/sda contains a single partition /dev/sda1, with random
+ * content. /dev/sdb and /dev/sdc may have random content.
+ * No LVM.
+ *)
+ | InitPartition
+
(* /dev/sda contains a single partition /dev/sda1, which is formatted
* as ext2, empty [except for lost+found] and mounted on /.
* /dev/sdb and /dev/sdc may have random content.
* No LVM.
*)
| InitBasicFS
+
(* /dev/sda:
* /dev/sda1 (is a PV):
* /dev/VG/LV (size 8MB):
*)
| InitBasicFSonLVM
+ (* /dev/sdd (the squashfs, see images/ directory in source)
+ * is mounted on /
+ *)
+ | InitSquashFS
+
(* Sequence of commands for testing. *)
and seq = cmd list
and cmd = string list
* Apart from that, long descriptions are just perldoc paragraphs.
*)
+(* Generate a random UUID (used in tests). *)
+let uuidgen () =
+ let chan = Unix.open_process_in "uuidgen" in
+ let uuid = input_line chan in
+ (match Unix.close_process_in chan with
+ | Unix.WEXITED 0 -> ()
+ | Unix.WEXITED _ ->
+ failwith "uuidgen: process exited with non-zero status"
+ | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
+ failwith "uuidgen: process signalled or stopped by signal"
+ );
+ uuid
+
(* These test functions are used in the language binding tests. *)
let test_all_args = [
"test0rint64", RInt64 "valout";
"test0rbool", RBool "valout";
"test0rconststring", RConstString "valout";
+ "test0rconstoptstring", RConstOptString "valout";
"test0rstring", RString "valout";
"test0rstringlist", RStringList "valout";
"test0rstruct", RStruct ("valout", "lvm_pv");
List.map (
fun (name, ret) ->
[(name, (ret, [String "val"]), -1, [NotInFish; NotInDocs],
- [],
- "internal test function - do not use",
- "\
+ [],
+ "internal test function - do not use",
+ "\
This is an internal test function which is used to test whether
the automatically generated bindings can handle every possible
return type correctly.
You probably don't want to call this function.");
(name ^ "err", (ret, []), -1, [NotInFish; NotInDocs],
- [],
- "internal test function - do not use",
- "\
+ [],
+ "internal test function - do not use",
+ "\
This is an internal test function which is used to test whether
the automatically generated bindings can handle every possible
return type correctly.
This is equivalent to the qemu parameter
C<-drive file=filename,cache=off,if=...>.
+C<cache=off> is omitted in cases where it is not supported by
+the underlying filesystem.
Note that this call checks for the existence of C<filename>. This
stops you from specifying other types of drive which are supported
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.
This is always non-NULL. If it wasn't set already, then this will
return the default qemu binary name.");
- ("set_path", (RErr, [String "path"]), -1, [FishAlias "path"],
+ ("set_path", (RErr, [String "searchpath"]), -1, [FishAlias "path"],
[],
"set the search path",
"\
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",
"\
Setting C<append> to C<NULL> means I<no> additional options
are passed (libguestfs always adds a few of its own).");
- ("get_append", (RConstString "append", []), -1, [],
+ ("get_append", (RConstOptString "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
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
This is an internal call used for debugging and testing.");
("version", (RStruct ("version", "version"), []), -1, [],
- [InitBasicFS, Always, TestOutputStruct (
+ [InitNone, Always, TestOutputStruct (
[["version"]], [CompareWithInt ("major", 1)])],
"get the library version number",
"\
I<Note:> Don't use this call to test for availability
of features. Distro backports makes this unreliable.");
+ ("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
+ [InitNone, Always, TestOutputTrue (
+ [["set_selinux"; "true"];
+ ["get_selinux"]])],
+ "set SELinux enabled or disabled at appliance boot",
+ "\
+This sets the selinux flag that is passed to the appliance
+at boot time. The default is C<selinux=0> (disabled).
+
+Note that if SELinux is enabled, it is always in
+Permissive mode (C<enforcing=0>).
+
+For more information on the architecture of libguestfs,
+see L<guestfs(3)>.");
+
+ ("get_selinux", (RBool "selinux", []), -1, [],
+ [],
+ "get SELinux enabled flag",
+ "\
+This returns the current setting of the selinux flag which
+is passed to the appliance at boot time. See C<guestfs_set_selinux>.
+
+For more information on the architecture of libguestfs,
+see L<guestfs(3)>.");
+
]
(* daemon_functions are any functions which cause some action
*)
let daemon_functions = [
- ("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
+ ("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [],
[InitEmpty, Always, TestOutput (
[["sfdiskM"; "/dev/sda"; ","];
["mkfs"; "ext2"; "/dev/sda1"];
You should always call this if you have modified a disk image, before
closing the handle.");
- ("touch", (RErr, [String "path"]), 3, [],
+ ("touch", (RErr, [Pathname "path"]), 3, [],
[InitBasicFS, Always, TestOutputTrue (
[["touch"; "/new"];
["exists"; "/new"]])],
update the timestamps on a file, or, if the file does not exist,
to create a new zero-length file.");
- ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
- [InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; "new file contents"; "0"];
- ["cat"; "/new"]], "new file contents")],
+ ("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutput (
+ [["cat"; "/known-2"]], "abcdef\n")],
"list the contents of a file",
"\
Return the contents of the file named C<path>.
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, [],
+ ("ll", (RString "listing", [Pathname "directory"]), 5, [],
[], (* XXX Tricky to test because it depends on the exact format
- * of the 'ls -l' command, which changes between F10 and F11.
- *)
+ * of the 'ls -l' command, which changes between F10 and F11.
+ *)
"list the files in a directory (long format)",
"\
List the files in C<directory> (relative to the root directory,
This command is mostly useful for interactive sessions. It
is I<not> intended that you try to parse the output string.");
- ("ls", (RStringList "listing", [String "directory"]), 6, [],
+ ("ls", (RStringList "listing", [Pathname "directory"]), 6, [],
[InitBasicFS, Always, TestOutputList (
[["touch"; "/new"];
["touch"; "/newer"];
List all the logical volumes detected. This is the equivalent
of the L<lvs(8)> command. The \"full\" version includes all fields.");
- ("read_lines", (RStringList "lines", [String "path"]), 15, [],
- [InitBasicFS, Always, TestOutputList (
- [["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
- ["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
- InitBasicFS, Always, TestOutputList (
- [["write_file"; "/new"; ""; "0"];
- ["read_lines"; "/new"]], [])],
+ ("read_lines", (RStringList "lines", [Pathname "path"]), 15, [],
+ [InitSquashFS, Always, TestOutputList (
+ [["read_lines"; "/known-4"]], ["abc"; "def"; "ghi"]);
+ InitSquashFS, Always, TestOutputList (
+ [["read_lines"; "/empty"]], [])],
"read file as lines",
"\
Return the contents of the file named C<path>.
as end of line). For those you need to use the C<guestfs_read_file>
function which has a more complex interface.");
- ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
+ ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [],
[], (* XXX Augeas code needs tests. *)
"create a new Augeas handle",
"\
number of nodes in the nodeset, and a boolean flag
if a node was created.");
- ("aug_get", (RString "val", [String "path"]), 19, [],
+ ("aug_get", (RString "val", [String "augpath"]), 19, [],
[], (* XXX Augeas code needs tests. *)
"look up the value of an Augeas path",
"\
Look up the value associated with C<path>. If C<path>
matches exactly one node, the C<value> is returned.");
- ("aug_set", (RErr, [String "path"; String "val"]), 20, [],
+ ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [],
[], (* XXX Augeas code needs tests. *)
"set Augeas path to value",
"\
Set the value associated with C<path> to C<value>.");
- ("aug_insert", (RErr, [String "path"; String "label"; Bool "before"]), 21, [],
+ ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [],
[], (* XXX Augeas code needs tests. *)
"insert a sibling Augeas node",
"\
C<label> must be a label, ie. not contain C</>, C<*> or end
with a bracketed index C<[N]>.");
- ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
+ ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [],
[], (* XXX Augeas code needs tests. *)
"remove an Augeas path",
"\
Move the node C<src> to C<dest>. C<src> must match exactly
one node. C<dest> is overwritten if it exists.");
- ("aug_match", (RStringList "matches", [String "path"]), 24, [],
+ ("aug_match", (RStringList "matches", [String "augpath"]), 24, [],
[], (* XXX Augeas code needs tests. *)
- "return Augeas nodes which match path",
+ "return Augeas nodes which match augpath",
"\
Returns a list of paths which match the path expression C<path>.
The returned paths are sufficiently qualified so that they match
See C<aug_load> in the Augeas documentation for the full gory
details.");
- ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
+ ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [],
[], (* XXX Augeas code needs tests. *)
- "list Augeas nodes under a path",
+ "list Augeas nodes under augpath",
"\
This is just a shortcut for listing C<guestfs_aug_match>
C<path/*> and sorting the resulting nodes into alphabetical order.");
- ("rm", (RErr, [String "path"]), 29, [],
+ ("rm", (RErr, [Pathname "path"]), 29, [],
[InitBasicFS, Always, TestRun
[["touch"; "/new"];
["rm"; "/new"]];
"\
Remove the single file C<path>.");
- ("rmdir", (RErr, [String "path"]), 30, [],
+ ("rmdir", (RErr, [Pathname "path"]), 30, [],
[InitBasicFS, Always, TestRun
[["mkdir"; "/new"];
["rmdir"; "/new"]];
"\
Remove the single directory C<path>.");
- ("rm_rf", (RErr, [String "path"]), 31, [],
+ ("rm_rf", (RErr, [Pathname "path"]), 31, [],
[InitBasicFS, Always, TestOutputFalse
[["mkdir"; "/new"];
["mkdir"; "/new/foo"];
contents if its a directory. This is like the C<rm -rf> shell
command.");
- ("mkdir", (RErr, [String "path"]), 32, [],
+ ("mkdir", (RErr, [Pathname "path"]), 32, [],
[InitBasicFS, Always, TestOutputTrue
[["mkdir"; "/new"];
["is_dir"; "/new"]];
"\
Create a directory named C<path>.");
- ("mkdir_p", (RErr, [String "path"]), 33, [],
+ ("mkdir_p", (RErr, [Pathname "path"]), 33, [],
[InitBasicFS, Always, TestOutputTrue
[["mkdir_p"; "/new/foo/bar"];
["is_dir"; "/new/foo/bar"]];
Create a directory named C<path>, creating any parent directories
as necessary. This is like the C<mkdir -p> shell command.");
- ("chmod", (RErr, [Int "mode"; String "path"]), 34, [],
+ ("chmod", (RErr, [Int "mode"; Pathname "path"]), 34, [],
[], (* XXX Need stat command to test *)
"change file mode",
"\
Change the mode (permissions) of C<path> to C<mode>. Only
numeric modes are supported.");
- ("chown", (RErr, [Int "owner"; Int "group"; String "path"]), 35, [],
+ ("chown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 35, [],
[], (* XXX Need stat command to test *)
"change file owner and group",
"\
names, you will need to locate and parse the password file
yourself (Augeas support makes this relatively easy).");
- ("exists", (RBool "existsflag", [String "path"]), 36, [],
- [InitBasicFS, Always, TestOutputTrue (
- [["touch"; "/new"];
- ["exists"; "/new"]]);
- InitBasicFS, Always, TestOutputTrue (
- [["mkdir"; "/new"];
- ["exists"; "/new"]])],
+ ("exists", (RBool "existsflag", [Pathname "path"]), 36, [],
+ [InitSquashFS, Always, TestOutputTrue (
+ [["exists"; "/empty"]]);
+ InitSquashFS, Always, TestOutputTrue (
+ [["exists"; "/directory"]])],
"test if file or directory exists",
"\
This returns C<true> if and only if there is a file, directory
See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
- ("is_file", (RBool "fileflag", [String "path"]), 37, [],
- [InitBasicFS, Always, TestOutputTrue (
- [["touch"; "/new"];
- ["is_file"; "/new"]]);
- InitBasicFS, Always, TestOutputFalse (
- [["mkdir"; "/new"];
- ["is_file"; "/new"]])],
+ ("is_file", (RBool "fileflag", [Pathname "path"]), 37, [],
+ [InitSquashFS, Always, TestOutputTrue (
+ [["is_file"; "/known-1"]]);
+ InitSquashFS, Always, TestOutputFalse (
+ [["is_file"; "/directory"]])],
"test if file exists",
"\
This returns C<true> if and only if there is a file
See also C<guestfs_stat>.");
- ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
- [InitBasicFS, Always, TestOutputFalse (
- [["touch"; "/new"];
- ["is_dir"; "/new"]]);
- InitBasicFS, Always, TestOutputTrue (
- [["mkdir"; "/new"];
- ["is_dir"; "/new"]])],
+ ("is_dir", (RBool "dirflag", [Pathname "path"]), 38, [],
+ [InitSquashFS, Always, TestOutputFalse (
+ [["is_dir"; "/known-3"]]);
+ InitSquashFS, Always, TestOutputTrue (
+ [["is_dir"; "/directory"]])],
"test if file exists",
"\
This returns C<true> if and only if there is a directory
See also C<guestfs_stat>.");
- ("pvcreate", (RErr, [String "device"]), 39, [],
+ ("pvcreate", (RErr, [Device "device"]), 39, [],
[InitEmpty, Always, TestOutputListOfDevices (
[["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
["pvcreate"; "/dev/sda1"];
where C<device> should usually be a partition name such
as C</dev/sda1>.");
- ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
+ ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [],
[InitEmpty, Always, TestOutputList (
[["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
["pvcreate"; "/dev/sda1"];
This creates an LVM volume group called C<logvol>
on the volume group C<volgroup>, with C<size> megabytes.");
- ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
+ ("mkfs", (RErr, [String "fstype"; Device "device"]), 42, [],
[InitEmpty, Always, TestOutput (
[["sfdiskM"; "/dev/sda"; ","];
["mkfs"; "ext2"; "/dev/sda1"];
or LVM logical volume). The filesystem type is C<fstype>, for
example C<ext3>.");
- ("sfdisk", (RErr, [String "device";
- Int "cyls"; Int "heads"; Int "sectors";
- StringList "lines"]), 43, [DangerWillRobinson],
+ ("sfdisk", (RErr, [Device "device";
+ Int "cyls"; Int "heads"; Int "sectors";
+ StringList "lines"]), 43, [DangerWillRobinson],
[],
"create partitions on a block device",
"\
See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>");
- ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
+ ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
[InitBasicFS, Always, TestOutput (
[["write_file"; "/new"; "new file contents"; "0"];
["cat"; "/new"]], "new file contents");
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 (
This command removes all LVM logical volumes, volume groups
and physical volumes.");
- ("file", (RString "description", [String "path"]), 49, [],
- [InitBasicFS, Always, TestOutput (
- [["touch"; "/new"];
- ["file"; "/new"]], "empty");
- InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; "some content\n"; "0"];
- ["file"; "/new"]], "ASCII text");
- InitBasicFS, Always, TestLastFail (
- [["file"; "/nofile"]])],
+ ("file", (RString "description", [Dev_or_Path "path"]), 49, [],
+ [InitSquashFS, Always, TestOutput (
+ [["file"; "/empty"]], "empty");
+ InitSquashFS, Always, TestOutput (
+ [["file"; "/known-1"]], "ASCII text");
+ InitSquashFS, Always, TestLastFail (
+ [["file"; "/notexists"]])],
"determine file type",
"\
This call uses the standard L<file(1)> command to determine
the type or contents of the file. This also works on devices,
for example to find out whether a partition contains a filesystem.
-The exact command which runs is C<file -bsL path>. Note in
+This call will also transparently look inside various types
+of compressed file.
+
+The exact command which runs is C<file -zbsL path>. Note in
particular that the filename is not prepended to the output
(the C<-b> option).");
See also: C<guestfs_sh_lines>");
- ("stat", (RStruct ("statbuf", "stat"), [String "path"]), 52, [],
- [InitBasicFS, Always, TestOutputStruct (
- [["touch"; "/new"];
- ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
+ ("stat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 52, [],
+ [InitSquashFS, Always, TestOutputStruct (
+ [["stat"; "/empty"]], [CompareWithInt ("size", 0)])],
"get file information",
"\
Returns file information for the given C<path>.
This is the same as the C<stat(2)> system call.");
- ("lstat", (RStruct ("statbuf", "stat"), [String "path"]), 53, [],
- [InitBasicFS, Always, TestOutputStruct (
- [["touch"; "/new"];
- ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
+ ("lstat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 53, [],
+ [InitSquashFS, Always, TestOutputStruct (
+ [["lstat"; "/empty"]], [CompareWithInt ("size", 0)])],
"get file information for a symbolic link",
"\
Returns file information for the given C<path>.
This is the same as the C<lstat(2)> system call.");
- ("statvfs", (RStruct ("statbuf", "statvfs"), [String "path"]), 54, [],
- [InitBasicFS, Always, TestOutputStruct (
- [["statvfs"; "/"]], [CompareWithInt ("namemax", 255);
- CompareWithInt ("bsize", 1024)])],
+ ("statvfs", (RStruct ("statbuf", "statvfs"), [Pathname "path"]), 54, [],
+ [InitSquashFS, Always, TestOutputStruct (
+ [["statvfs"; "/"]], [CompareWithInt ("namemax", 256)])],
"get file system statistics",
"\
Returns file system statistics for any mounted file system.
This is the same as the C<statvfs(2)> system call.");
- ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
+ ("tune2fs_l", (RHashtable "superblock", [Device "device"]), 55, [],
[], (* XXX test *)
"get ext2/ext3/ext4 superblock details",
"\
clearly defined, and depends on both the version of C<tune2fs>
that libguestfs was built against, and the filesystem itself.");
- ("blockdev_setro", (RErr, [String "device"]), 56, [],
+ ("blockdev_setro", (RErr, [Device "device"]), 56, [],
[InitEmpty, Always, TestOutputTrue (
[["blockdev_setro"; "/dev/sda"];
["blockdev_getro"; "/dev/sda"]])],
This uses the L<blockdev(8)> command.");
- ("blockdev_setrw", (RErr, [String "device"]), 57, [],
+ ("blockdev_setrw", (RErr, [Device "device"]), 57, [],
[InitEmpty, Always, TestOutputFalse (
[["blockdev_setrw"; "/dev/sda"];
["blockdev_getro"; "/dev/sda"]])],
This uses the L<blockdev(8)> command.");
- ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
+ ("blockdev_getro", (RBool "ro", [Device "device"]), 58, [],
[InitEmpty, Always, TestOutputTrue (
[["blockdev_setro"; "/dev/sda"];
["blockdev_getro"; "/dev/sda"]])],
This uses the L<blockdev(8)> command.");
- ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
+ ("blockdev_getss", (RInt "sectorsize", [Device "device"]), 59, [],
[InitEmpty, Always, TestOutputInt (
[["blockdev_getss"; "/dev/sda"]], 512)],
"get sectorsize of block device",
This uses the L<blockdev(8)> command.");
- ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
+ ("blockdev_getbsz", (RInt "blocksize", [Device "device"]), 60, [],
[InitEmpty, Always, TestOutputInt (
[["blockdev_getbsz"; "/dev/sda"]], 4096)],
"get blocksize of block device",
This uses the L<blockdev(8)> command.");
- ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
+ ("blockdev_setbsz", (RErr, [Device "device"; Int "blocksize"]), 61, [],
[], (* XXX test *)
"set blocksize of block device",
"\
This uses the L<blockdev(8)> command.");
- ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
+ ("blockdev_getsz", (RInt64 "sizeinsectors", [Device "device"]), 62, [],
[InitEmpty, Always, TestOutputInt (
[["blockdev_getsz"; "/dev/sda"]], 1024000)],
"get total size of device in 512-byte sectors",
This uses the L<blockdev(8)> command.");
- ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
+ ("blockdev_getsize64", (RInt64 "sizeinbytes", [Device "device"]), 63, [],
[InitEmpty, Always, TestOutputInt (
[["blockdev_getsize64"; "/dev/sda"]], 524288000)],
"get total size of device in bytes",
This uses the L<blockdev(8)> command.");
- ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
+ ("blockdev_flushbufs", (RErr, [Device "device"]), 64, [],
[InitEmpty, Always, TestRun
[["blockdev_flushbufs"; "/dev/sda"]]],
"flush device buffers",
This uses the L<blockdev(8)> command.");
- ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
+ ("blockdev_rereadpt", (RErr, [Device "device"]), 65, [],
[InitEmpty, Always, TestRun
[["blockdev_rereadpt"; "/dev/sda"]]],
"reread partition table",
("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"]],
+ Digest.to_hex (Digest.file "COPYING.LIB"))],
"upload a file from the local machine",
"\
Upload local file C<filename> to C<remotefilename> on the
See also C<guestfs_download>.");
- ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
+ ("download", (RErr, [Dev_or_Path "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"]],
+ Digest.to_hex (Digest.file "COPYING.LIB"))],
"download a file to the local machine",
"\
Download file C<remotefilename> and save it as C<filename>
See also C<guestfs_upload>, C<guestfs_cat>.");
- ("checksum", (RString "checksum", [String "csumtype"; String "path"]), 68, [],
- [InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; "test\n"; "0"];
- ["checksum"; "crc"; "/new"]], "935282863");
- InitBasicFS, Always, TestLastFail (
- [["checksum"; "crc"; "/new"]]);
- InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; "test\n"; "0"];
- ["checksum"; "md5"; "/new"]], "d8e8fca2dc0f896fd7cb4cb0031ba249");
- InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; "test\n"; "0"];
- ["checksum"; "sha1"; "/new"]], "4e1243bd22c66e76c2ba9eddc1f91394e57f9f83");
- InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; "test\n"; "0"];
- ["checksum"; "sha224"; "/new"]], "52f1bf093f4b7588726035c176c0cdb4376cfea53819f1395ac9e6ec");
- InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; "test\n"; "0"];
- ["checksum"; "sha256"; "/new"]], "f2ca1bb6c7e907d06dafe4687e579fce76b37e4e93b7605022da52e6ccc26fd2");
- InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; "test\n"; "0"];
- ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d");
- InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; "test\n"; "0"];
- ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123");
- InitBasicFS, Always, TestOutput (
- (* RHEL 5 thinks this is an HFS+ filesystem unless we give
- * the type explicitly.
- *)
- [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
- ["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c")],
+ ("checksum", (RString "checksum", [String "csumtype"; Pathname "path"]), 68, [],
+ [InitSquashFS, Always, TestOutput (
+ [["checksum"; "crc"; "/known-3"]], "2891671662");
+ InitSquashFS, Always, TestLastFail (
+ [["checksum"; "crc"; "/notexists"]]);
+ InitSquashFS, Always, TestOutput (
+ [["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c");
+ InitSquashFS, Always, TestOutput (
+ [["checksum"; "sha1"; "/known-3"]], "b7ebccc3ee418311091c3eda0a45b83c0a770f15");
+ InitSquashFS, Always, TestOutput (
+ [["checksum"; "sha224"; "/known-3"]], "d2cd1774b28f3659c14116be0a6dc2bb5c4b350ce9cd5defac707741");
+ InitSquashFS, Always, TestOutput (
+ [["checksum"; "sha256"; "/known-3"]], "75bb71b90cd20cb13f86d2bea8dad63ac7194e7517c3b52b8d06ff52d3487d30");
+ InitSquashFS, Always, TestOutput (
+ [["checksum"; "sha384"; "/known-3"]], "5fa7883430f357b5d7b7271d3a1d2872b51d73cba72731de6863d3dea55f30646af2799bef44d5ea776a5ec7941ac640");
+ InitSquashFS, Always, TestOutput (
+ [["checksum"; "sha512"; "/known-3"]], "2794062c328c6b216dca90443b7f7134c5f40e56bd0ed7853123275a09982a6f992e6ca682f9d2fba34a4c5e870d8fe077694ff831e3032a004ee077e00603f6")],
"compute MD5, SHAx or CRC checksum of file",
"\
This call computes the MD5, SHAx or CRC checksum of the
To upload an uncompressed tarball, use C<guestfs_tar_in>.");
- ("tgz_out", (RErr, [String "directory"; FileOut "tarball"]), 72, [],
+ ("tgz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 72, [],
[],
"pack directory into compressed tarball",
"\
To download an uncompressed tarball, use C<guestfs_tar_out>.");
- ("mount_ro", (RErr, [String "device"; String "mountpoint"]), 73, [],
+ ("mount_ro", (RErr, [Device "device"; String "mountpoint"]), 73, [],
[InitBasicFS, Always, TestLastFail (
[["umount"; "/"];
["mount_ro"; "/dev/sda1"; "/"];
This is the same as the C<guestfs_mount> command, but it
mounts the filesystem with the read-only (I<-o ro>) flag.");
- ("mount_options", (RErr, [String "options"; String "device"; String "mountpoint"]), 74, [],
+ ("mount_options", (RErr, [String "options"; Device "device"; String "mountpoint"]), 74, [],
[],
"mount a guest disk with mount options",
"\
allows you to set the mount options as for the
L<mount(8)> I<-o> flag.");
- ("mount_vfs", (RErr, [String "options"; String "vfstype"; String "device"; String "mountpoint"]), 75, [],
+ ("mount_vfs", (RErr, [String "options"; String "vfstype"; Device "device"; String "mountpoint"]), 75, [],
[],
"mount a guest disk with mount options and vfstype",
"\
to look at the file C<daemon/debug.c> in the libguestfs source
to find out what you can do.");
- ("lvremove", (RErr, [String "device"]), 77, [],
+ ("lvremove", (RErr, [Device "device"]), 77, [],
[InitEmpty, Always, TestOutputList (
[["sfdiskM"; "/dev/sda"; ","];
["pvcreate"; "/dev/sda1"];
This also forcibly removes all logical volumes in the volume
group (if any).");
- ("pvremove", (RErr, [String "device"]), 79, [],
+ ("pvremove", (RErr, [Device "device"]), 79, [],
[InitEmpty, Always, TestOutputListOfDevices (
[["sfdiskM"; "/dev/sda"; ","];
["pvcreate"; "/dev/sda1"];
wipe physical volumes that contain any volume groups, so you have
to remove those first.");
- ("set_e2label", (RErr, [String "device"; String "label"]), 80, [],
+ ("set_e2label", (RErr, [Device "device"; String "label"]), 80, [],
[InitBasicFS, Always, TestOutput (
[["set_e2label"; "/dev/sda1"; "testlabel"];
["get_e2label"; "/dev/sda1"]], "testlabel")],
You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
to return the existing label on a filesystem.");
- ("get_e2label", (RString "label", [String "device"]), 81, [],
+ ("get_e2label", (RString "label", [Device "device"]), 81, [],
[],
"get the ext2/3/4 filesystem label",
"\
This returns the ext2/3/4 filesystem label of the filesystem on
C<device>.");
- ("set_e2uuid", (RErr, [String "device"; String "uuid"]), 82, [],
- [InitBasicFS, Always, TestOutput (
- [["set_e2uuid"; "/dev/sda1"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"];
- ["get_e2uuid"; "/dev/sda1"]], "a3a61220-882b-4f61-89f4-cf24dcc7297d");
- InitBasicFS, Always, TestOutput (
- [["set_e2uuid"; "/dev/sda1"; "clear"];
- ["get_e2uuid"; "/dev/sda1"]], "");
- (* We can't predict what UUIDs will be, so just check the commands run. *)
- InitBasicFS, Always, TestRun (
- [["set_e2uuid"; "/dev/sda1"; "random"]]);
- InitBasicFS, Always, TestRun (
- [["set_e2uuid"; "/dev/sda1"; "time"]])],
+ ("set_e2uuid", (RErr, [Device "device"; String "uuid"]), 82, [],
+ (let uuid = uuidgen () in
+ [InitBasicFS, Always, TestOutput (
+ [["set_e2uuid"; "/dev/sda1"; uuid];
+ ["get_e2uuid"; "/dev/sda1"]], uuid);
+ InitBasicFS, Always, TestOutput (
+ [["set_e2uuid"; "/dev/sda1"; "clear"];
+ ["get_e2uuid"; "/dev/sda1"]], "");
+ (* We can't predict what UUIDs will be, so just check the commands run. *)
+ InitBasicFS, Always, TestRun (
+ [["set_e2uuid"; "/dev/sda1"; "random"]]);
+ InitBasicFS, Always, TestRun (
+ [["set_e2uuid"; "/dev/sda1"; "time"]])]),
"set the ext2/3/4 filesystem UUID",
"\
This sets the ext2/3/4 filesystem UUID of the filesystem on
You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
to return the existing UUID of a filesystem.");
- ("get_e2uuid", (RString "uuid", [String "device"]), 83, [],
+ ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [],
[],
"get the ext2/3/4 filesystem UUID",
"\
This returns the ext2/3/4 filesystem UUID of the filesystem on
C<device>.");
- ("fsck", (RInt "status", [String "fstype"; String "device"]), 84, [],
+ ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [],
[InitBasicFS, Always, TestOutputInt (
[["umount"; "/dev/sda1"];
["fsck"; "ext2"; "/dev/sda1"]], 0);
This command is entirely equivalent to running C<fsck -a -t fstype device>.");
- ("zero", (RErr, [String "device"]), 85, [],
+ ("zero", (RErr, [Device "device"]), 85, [],
[InitBasicFS, Always, TestOutput (
[["umount"; "/dev/sda1"];
["zero"; "/dev/sda1"];
See also: C<guestfs_scrub_device>.");
- ("grub_install", (RErr, [String "root"; String "device"]), 86, [],
+ ("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
(* Test disabled because grub-install incompatible with virtio-blk driver.
* See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760
*)
This command installs GRUB (the Grand Unified Bootloader) on
C<device>, with the root directory being C<root>.");
- ("cp", (RErr, [String "src"; String "dest"]), 87, [],
+ ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
[InitBasicFS, Always, TestOutput (
[["write_file"; "/old"; "file content"; "0"];
["cp"; "/old"; "/new"];
This copies a file from C<src> to C<dest> where C<dest> is
either a destination filename or destination directory.");
- ("cp_a", (RErr, [String "src"; String "dest"]), 88, [],
+ ("cp_a", (RErr, [Pathname "src"; Pathname "dest"]), 88, [],
[InitBasicFS, Always, TestOutput (
[["mkdir"; "/olddir"];
["mkdir"; "/newdir"];
This copies a file or directory from C<src> to C<dest>
recursively using the C<cp -a> command.");
- ("mv", (RErr, [String "src"; String "dest"]), 89, [],
+ ("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
[InitBasicFS, Always, TestOutput (
[["write_file"; "/old"; "file content"; "0"];
["mv"; "/old"; "/new"];
daemon responds to the ping message, without affecting the daemon
or attached block device(s) in any other way.");
- ("equal", (RBool "equality", [String "file1"; String "file2"]), 93, [],
+ ("equal", (RBool "equality", [Pathname "file1"; Pathname "file2"]), 93, [],
[InitBasicFS, Always, TestOutputTrue (
[["write_file"; "/file1"; "contents of a file"; "0"];
["cp"; "/file1"; "/file2"];
The external L<cmp(1)> program is used for the comparison.");
- ("strings", (RStringList "stringsout", [String "path"]), 94, [ProtocolLimitWarning],
- [InitBasicFS, Always, TestOutputList (
- [["write_file"; "/new"; "hello\nworld\n"; "0"];
- ["strings"; "/new"]], ["hello"; "world"]);
- InitBasicFS, Always, TestOutputList (
- [["touch"; "/new"];
- ["strings"; "/new"]], [])],
+ ("strings", (RStringList "stringsout", [Pathname "path"]), 94, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["strings"; "/known-5"]], ["abcdefghi"; "jklmnopqr"]);
+ InitSquashFS, Always, TestOutputList (
+ [["strings"; "/empty"]], [])],
"print the printable strings in a file",
"\
This runs the L<strings(1)> command on a file and returns
the list of printable strings found.");
- ("strings_e", (RStringList "stringsout", [String "encoding"; String "path"]), 95, [ProtocolLimitWarning],
- [InitBasicFS, Always, TestOutputList (
- [["write_file"; "/new"; "hello\nworld\n"; "0"];
- ["strings_e"; "b"; "/new"]], []);
+ ("strings_e", (RStringList "stringsout", [String "encoding"; Pathname "path"]), 95, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["strings_e"; "b"; "/known-5"]], []);
InitBasicFS, Disabled, TestOutputList (
[["write_file"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"; "24"];
["strings_e"; "b"; "/new"]], ["hello"; "world"])],
The returned strings are transcoded to UTF-8.");
- ("hexdump", (RString "dump", [String "path"]), 96, [ProtocolLimitWarning],
- [InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; "hello\nworld\n"; "12"];
- ["hexdump"; "/new"]], "00000000 68 65 6c 6c 6f 0a 77 6f 72 6c 64 0a |hello.world.|\n0000000c\n");
+ ("hexdump", (RString "dump", [Pathname "path"]), 96, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutput (
+ [["hexdump"; "/known-4"]], "00000000 61 62 63 0a 64 65 66 0a 67 68 69 |abc.def.ghi|\n0000000b\n");
(* Test for RHBZ#501888c2 regression which caused large hexdump
* commands to segfault.
*)
- InitBasicFS, Always, TestRun (
- [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
- ["hexdump"; "/100krandom"]])],
+ InitSquashFS, Always, TestRun (
+ [["hexdump"; "/100krandom"]])],
"dump a file in hexadecimal",
"\
This runs C<hexdump -C> on the given C<path>. The result is
the human-readable, canonical hex dump of the file.");
- ("zerofree", (RErr, [String "device"]), 97, [],
+ ("zerofree", (RErr, [Device "device"]), 97, [],
[InitNone, Always, TestOutput (
[["sfdiskM"; "/dev/sda"; ","];
["mkfs"; "ext3"; "/dev/sda1"];
It is possible that using this program can damage the filesystem
or data on the filesystem.");
- ("pvresize", (RErr, [String "device"]), 98, [],
+ ("pvresize", (RErr, [Device "device"]), 98, [],
[],
"resize an LVM physical volume",
"\
This resizes (expands or shrinks) an existing LVM physical
volume to match the new size of the underlying device.");
- ("sfdisk_N", (RErr, [String "device"; Int "partnum";
- Int "cyls"; Int "heads"; Int "sectors";
- String "line"]), 99, [DangerWillRobinson],
+ ("sfdisk_N", (RErr, [Device "device"; Int "partnum";
+ Int "cyls"; Int "heads"; Int "sectors";
+ String "line"]), 99, [DangerWillRobinson],
[],
"modify a single partition on a block device",
"\
For other parameters, see C<guestfs_sfdisk>. You should usually
pass C<0> for the cyls/heads/sectors parameters.");
- ("sfdisk_l", (RString "partitions", [String "device"]), 100, [],
+ ("sfdisk_l", (RString "partitions", [Device "device"]), 100, [],
[],
"display the partition table",
"\
human-readable output of the L<sfdisk(8)> command. It is
not intended to be parsed.");
- ("sfdisk_kernel_geometry", (RString "partitions", [String "device"]), 101, [],
+ ("sfdisk_kernel_geometry", (RString "partitions", [Device "device"]), 101, [],
[],
"display the kernel geometry",
"\
The result is in human-readable format, and not designed to
be parsed.");
- ("sfdisk_disk_geometry", (RString "partitions", [String "device"]), 102, [],
+ ("sfdisk_disk_geometry", (RString "partitions", [Device "device"]), 102, [],
[],
"display the disk geometry from the partition table",
"\
Note that if C<volgroups> is an empty list then B<all> volume groups
are activated or deactivated.");
- ("lvresize", (RErr, [String "device"; Int "mbytes"]), 105, [],
+ ("lvresize", (RErr, [Device "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
volume to C<mbytes>. When reducing, data in the reduced part
is lost.");
- ("resize2fs", (RErr, [String "device"]), 106, [],
+ ("resize2fs", (RErr, [Device "device"]), 106, [],
[], (* lvresize tests this *)
"resize an ext2/ext3 filesystem",
"\
In any case, it is always safe to call C<guestfs_e2fsck_f> before
calling this function.");
- ("find", (RStringList "names", [String "directory"]), 107, [],
+ ("find", (RStringList "names", [Pathname "directory"]), 107, [],
[InitBasicFS, Always, TestOutputList (
[["find"; "/"]], ["lost+found"]);
InitBasicFS, Always, TestOutputList (
The returned list is sorted.");
- ("e2fsck_f", (RErr, [String "device"]), 108, [],
+ ("e2fsck_f", (RErr, [Device "device"]), 108, [],
[], (* lvresize tests this *)
"check an ext2/ext3 filesystem",
"\
("sleep", (RErr, [Int "secs"]), 109, [],
[InitNone, Always, TestRun (
- [["sleep"; "1"]])],
+ [["sleep"; "1"]])],
"sleep for some seconds",
"\
Sleep for C<secs> seconds.");
- ("ntfs_3g_probe", (RInt "status", [Bool "rw"; String "device"]), 110, [],
+ ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [],
[InitNone, Always, TestOutputInt (
[["sfdiskM"; "/dev/sda"; ","];
["mkfs"; "ntfs"; "/dev/sda1"];
See also: C<guestfs_command_lines>");
- ("glob_expand", (RStringList "paths", [String "pattern"]), 113, [],
+ ("glob_expand", (RStringList "paths", [Pathname "pattern"]), 113, [],
+ (* Use Pathname here, and hence ABS_PATH (pattern,... in generated
+ * code in stubs.c, since all valid glob patterns must start with "/".
+ * There is no concept of "cwd" in libguestfs, hence no "."-relative names.
+ *)
[InitBasicFS, Always, TestOutputList (
[["mkdir_p"; "/a/b/c"];
["touch"; "/a/b/c/d"];
with flags C<GLOB_MARK|GLOB_BRACE>.
See that manual page for more details.");
- ("scrub_device", (RErr, [String "device"]), 114, [DangerWillRobinson],
+ ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson],
[InitNone, Always, TestRun ( (* use /dev/sdc because it's smaller *)
[["scrub_device"; "/dev/sdc"]])],
"scrub (securely wipe) a device",
It is an interface to the L<scrub(1)> program. See that
manual page for more details.");
- ("scrub_file", (RErr, [String "file"]), 115, [],
+ ("scrub_file", (RErr, [Pathname "file"]), 115, [],
[InitBasicFS, Always, TestRun (
[["write_file"; "/file"; "content"; "0"];
["scrub_file"; "/file"]])],
It is an interface to the L<scrub(1)> program. See that
manual page for more details.");
- ("scrub_freespace", (RErr, [String "dir"]), 116, [],
+ ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [],
[], (* XXX needs testing *)
"scrub (securely wipe) free space",
"\
It is an interface to the L<scrub(1)> program. See that
manual page for more details.");
- ("mkdtemp", (RString "dir", [String "template"]), 117, [],
+ ("mkdtemp", (RString "dir", [Pathname "template"]), 117, [],
[InitBasicFS, Always, TestRun (
[["mkdir"; "/tmp"];
["mkdtemp"; "/tmp/tmpXXXXXX"]])],
See also: L<mkdtemp(3)>");
- ("wc_l", (RInt "lines", [String "path"]), 118, [],
- [InitBasicFS, Always, TestOutputInt (
- [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
- ["wc_l"; "/10klines"]], 10000)],
+ ("wc_l", (RInt "lines", [Pathname "path"]), 118, [],
+ [InitSquashFS, Always, TestOutputInt (
+ [["wc_l"; "/10klines"]], 10000)],
"count lines in a file",
"\
This command counts the lines in a file, using the
C<wc -l> external command.");
- ("wc_w", (RInt "words", [String "path"]), 119, [],
- [InitBasicFS, Always, TestOutputInt (
- [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
- ["wc_w"; "/10klines"]], 10000)],
+ ("wc_w", (RInt "words", [Pathname "path"]), 119, [],
+ [InitSquashFS, Always, TestOutputInt (
+ [["wc_w"; "/10klines"]], 10000)],
"count words in a file",
"\
This command counts the words in a file, using the
C<wc -w> external command.");
- ("wc_c", (RInt "chars", [String "path"]), 120, [],
- [InitBasicFS, Always, TestOutputInt (
- [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
- ["wc_c"; "/100kallspaces"]], 102400)],
+ ("wc_c", (RInt "chars", [Pathname "path"]), 120, [],
+ [InitSquashFS, Always, TestOutputInt (
+ [["wc_c"; "/100kallspaces"]], 102400)],
"count characters in a file",
"\
This command counts the characters in a file, using the
C<wc -c> external command.");
- ("head", (RStringList "lines", [String "path"]), 121, [ProtocolLimitWarning],
- [InitBasicFS, Always, TestOutputList (
- [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
- ["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
+ ("head", (RStringList "lines", [Pathname "path"]), 121, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
"return first 10 lines of a file",
"\
This command returns up to the first 10 lines of a file as
a list of strings.");
- ("head_n", (RStringList "lines", [Int "nrlines"; String "path"]), 122, [ProtocolLimitWarning],
- [InitBasicFS, Always, TestOutputList (
- [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
- ["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
- InitBasicFS, Always, TestOutputList (
- [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
- ["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
- InitBasicFS, Always, TestOutputList (
- [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
- ["head_n"; "0"; "/10klines"]], [])],
+ ("head_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 122, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
+ InitSquashFS, Always, TestOutputList (
+ [["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
+ InitSquashFS, Always, TestOutputList (
+ [["head_n"; "0"; "/10klines"]], [])],
"return first N lines of a file",
"\
If the parameter C<nrlines> is a positive number, this returns the first
If the parameter C<nrlines> is zero, this returns an empty list.");
- ("tail", (RStringList "lines", [String "path"]), 123, [ProtocolLimitWarning],
- [InitBasicFS, Always, TestOutputList (
- [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
- ["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
+ ("tail", (RStringList "lines", [Pathname "path"]), 123, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
"return last 10 lines of a file",
"\
This command returns up to the last 10 lines of a file as
a list of strings.");
- ("tail_n", (RStringList "lines", [Int "nrlines"; String "path"]), 124, [ProtocolLimitWarning],
- [InitBasicFS, Always, TestOutputList (
- [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
- ["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
- InitBasicFS, Always, TestOutputList (
- [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
- ["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
- InitBasicFS, Always, TestOutputList (
- [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
- ["tail_n"; "0"; "/10klines"]], [])],
+ ("tail_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 124, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
+ InitSquashFS, Always, TestOutputList (
+ [["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
+ InitSquashFS, Always, TestOutputList (
+ [["tail_n"; "0"; "/10klines"]], [])],
"return last N lines of a file",
"\
If the parameter C<nrlines> is a positive number, this returns the last
("df", (RString "output", []), 125, [],
[], (* XXX Tricky to test because it depends on the exact format
- * of the 'df' command and other imponderables.
- *)
+ * of the 'df' command and other imponderables.
+ *)
"report file system disk space usage",
"\
This command runs the C<df> command to report disk space used.
("df_h", (RString "output", []), 126, [],
[], (* XXX Tricky to test because it depends on the exact format
- * of the 'df' command and other imponderables.
- *)
+ * of the 'df' command and other imponderables.
+ *)
"report file system disk space usage (human readable)",
"\
This command runs the C<df -h> command to report disk space used
is I<not> intended that you try to parse the output string.
Use C<statvfs> from programs.");
- ("du", (RInt64 "sizekb", [String "path"]), 127, [],
- [InitBasicFS, Always, TestOutputInt (
- [["mkdir"; "/p"];
- ["du"; "/p"]], 1 (* ie. 1 block, so depends on ext3 blocksize *))],
+ ("du", (RInt64 "sizekb", [Pathname "path"]), 127, [],
+ [InitSquashFS, Always, TestOutputInt (
+ [["du"; "/directory"]], 0 (* squashfs doesn't have blocks *))],
"estimate file space usage",
"\
This command runs the C<du -s> command to estimate file space
The result is the estimated size in I<kilobytes>
(ie. units of 1024 bytes).");
- ("initrd_list", (RStringList "filenames", [String "path"]), 128, [],
- [InitBasicFS, Always, TestOutputList (
- [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
- ["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3"])],
+ ("initrd_list", (RStringList "filenames", [Pathname "path"]), 128, [],
+ [InitSquashFS, Always, TestOutputList (
+ [["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3";"known-4"; "known-5"])],
"list files in an initrd",
"\
This command lists out files contained in an initrd.
filesystem as initrd. We I<only> support the newer initramfs
format (compressed cpio files).");
- ("mount_loop", (RErr, [String "file"; String "mountpoint"]), 129, [],
+ ("mount_loop", (RErr, [Pathname "file"; Pathname "mountpoint"]), 129, [],
[],
"mount a file using the loop device",
"\
in a file) on a mount point. It is entirely equivalent to
the command C<mount -o loop file mountpoint>.");
- ("mkswap", (RErr, [String "device"]), 130, [],
+ ("mkswap", (RErr, [Device "device"]), 130, [],
[InitEmpty, Always, TestRun (
[["sfdiskM"; "/dev/sda"; ","];
["mkswap"; "/dev/sda1"]])],
"\
Create a swap partition on C<device>.");
- ("mkswap_L", (RErr, [String "label"; String "device"]), 131, [],
+ ("mkswap_L", (RErr, [String "label"; Device "device"]), 131, [],
[InitEmpty, Always, TestRun (
[["sfdiskM"; "/dev/sda"; ","];
["mkswap_L"; "hello"; "/dev/sda1"]])],
"create a swap partition with a label",
"\
-Create a swap partition on C<device> with label C<label>.");
+Create a swap partition on C<device> with label C<label>.
- ("mkswap_U", (RErr, [String "uuid"; String "device"]), 132, [],
- [InitEmpty, Always, TestRun (
- [["sfdiskM"; "/dev/sda"; ","];
- ["mkswap_U"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"; "/dev/sda1"]])],
+Note that you cannot attach a swap label to a block device
+(eg. C</dev/sda>), just to a partition. This appears to be
+a limitation of the kernel or swap tools.");
+
+ ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [],
+ (let uuid = uuidgen () in
+ [InitEmpty, Always, TestRun (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["mkswap_U"; uuid; "/dev/sda1"]])]),
"create a swap partition with an explicit UUID",
"\
Create a swap partition on C<device> with UUID C<uuid>.");
- ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; String "path"]), 133, [],
+ ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [],
[InitBasicFS, Always, TestOutputStruct (
[["mknod"; "0o10777"; "0"; "0"; "/node"];
(* NB: default umask 022 means 0777 -> 0755 in these tests *)
device major and minor numbers, only used when creating block
and character special devices.");
- ("mkfifo", (RErr, [Int "mode"; String "path"]), 134, [],
+ ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [],
[InitBasicFS, Always, TestOutputStruct (
[["mkfifo"; "0o777"; "/node"];
["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
mode C<mode>. It is just a convenient wrapper around
C<guestfs_mknod>.");
- ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; String "path"]), 135, [],
+ ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [],
[InitBasicFS, Always, TestOutputStruct (
[["mknod_b"; "0o777"; "99"; "66"; "/node"];
["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
mode C<mode> and device major/minor C<devmajor> and C<devminor>.
It is just a convenient wrapper around C<guestfs_mknod>.");
- ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; String "path"]), 136, [],
+ ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [],
[InitBasicFS, Always, TestOutputStruct (
[["mknod_c"; "0o777"; "99"; "66"; "/node"];
["stat"; "/node"]], [CompareWithInt ("mode", 0o20755)])],
("umask", (RInt "oldmask", [Int "mask"]), 137, [],
[], (* XXX umask is one of those stateful things that we should
- * reset between each test.
- *)
+ * reset between each test.
+ *)
"set file mode creation mask (umask)",
"\
This function sets the mask used for creating new files and
This call returns the previous umask.");
- ("readdir", (RStructList ("entries", "dirent"), [String "dir"]), 138, [],
+ ("readdir", (RStructList ("entries", "dirent"), [Pathname "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>.");
- ("sfdiskM", (RErr, [String "device"; StringList "lines"]), 139, [DangerWillRobinson],
+ ("sfdiskM", (RErr, [Device "device"; StringList "lines"]), 139, [DangerWillRobinson],
[],
"create partitions on a block device",
"\
See also C<guestfs_sfdisk> and the L<sfdisk(8)> manpage.");
+ ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
+ [],
+ "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>.
+
+Since 1.0.63, use C<guestfs_file> instead which can now
+process compressed files.");
+
+ ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "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"), [Pathname "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 *)
+ Pathname "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 *)
+ Pathname "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"; Pathname "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"; Pathname "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 "exemptpath"]), 148, [],
+ (* This is a special case: while you would expect a parameter
+ * of type "Pathname", that doesn't work, because it implies
+ * NEED_ROOT in the generated calling code in stubs.c, and
+ * this function cannot use NEED_ROOT.
+ *)
+ [],
+ "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 "exemptpath"]), 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", [Pathname "path"]), 150, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputBuffer (
+ [["read_file"; "/known-4"]], "abc\ndef\nghi")],
+ "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.");
+
+ ("grep", (RStringList "lines", [String "regex"; Pathname "path"]), 151, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
+ InitSquashFS, Always, TestOutputList (
+ [["grep"; "nomatch"; "/test-grep.txt"]], [])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<grep> program and returns the
+matching lines.");
+
+ ("egrep", (RStringList "lines", [String "regex"; Pathname "path"]), 152, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["egrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<egrep> program and returns the
+matching lines.");
+
+ ("fgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 153, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["fgrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<fgrep> program and returns the
+matching lines.");
+
+ ("grepi", (RStringList "lines", [String "regex"; Pathname "path"]), 154, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["grepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<grep -i> program and returns the
+matching lines.");
+
+ ("egrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 155, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["egrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<egrep -i> program and returns the
+matching lines.");
+
+ ("fgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 156, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["fgrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<fgrep -i> program and returns the
+matching lines.");
+
+ ("zgrep", (RStringList "lines", [String "regex"; Pathname "path"]), 157, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["zgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<zgrep> program and returns the
+matching lines.");
+
+ ("zegrep", (RStringList "lines", [String "regex"; Pathname "path"]), 158, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["zegrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<zegrep> program and returns the
+matching lines.");
+
+ ("zfgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 159, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["zfgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<zfgrep> program and returns the
+matching lines.");
+
+ ("zgrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 160, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["zgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<zgrep -i> program and returns the
+matching lines.");
+
+ ("zegrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 161, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["zegrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<zegrep -i> program and returns the
+matching lines.");
+
+ ("zfgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 162, [ProtocolLimitWarning],
+ [InitSquashFS, Always, TestOutputList (
+ [["zfgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
+ "return lines matching a pattern",
+ "\
+This calls the external C<zfgrep -i> program and returns the
+matching lines.");
+
+ ("realpath", (RString "rpath", [Pathname "path"]), 163, [],
+ [InitSquashFS, Always, TestOutput (
+ [["realpath"; "/../directory"]], "/directory")],
+ "canonicalized absolute pathname",
+ "\
+Return the canonicalized absolute pathname of C<path>. The
+returned path has no C<.>, C<..> or symbolic link path elements.");
+
+ ("ln", (RErr, [String "target"; Pathname "linkname"]), 164, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["touch"; "/a"];
+ ["ln"; "/a"; "/b"];
+ ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
+ "create a hard link",
+ "\
+This command creates a hard link using the C<ln> command.");
+
+ ("ln_f", (RErr, [String "target"; Pathname "linkname"]), 165, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["touch"; "/a"];
+ ["touch"; "/b"];
+ ["ln_f"; "/a"; "/b"];
+ ["stat"; "/b"]], [CompareWithInt ("nlink", 2)])],
+ "create a hard link",
+ "\
+This command creates a hard link using the C<ln -f> command.
+The C<-f> option removes the link (C<linkname>) if it exists already.");
+
+ ("ln_s", (RErr, [String "target"; Pathname "linkname"]), 166, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["touch"; "/a"];
+ ["ln_s"; "a"; "/b"];
+ ["lstat"; "/b"]], [CompareWithInt ("mode", 0o120777)])],
+ "create a symbolic link",
+ "\
+This command creates a symbolic link using the C<ln -s> command.");
+
+ ("ln_sf", (RErr, [String "target"; Pathname "linkname"]), 167, [],
+ [InitBasicFS, Always, TestOutput (
+ [["mkdir_p"; "/a/b"];
+ ["touch"; "/a/b/c"];
+ ["ln_sf"; "../d"; "/a/b/c"];
+ ["readlink"; "/a/b/c"]], "../d")],
+ "create a symbolic link",
+ "\
+This command creates a symbolic link using the C<ln -sf> command,
+The C<-f> option removes the link (C<linkname>) if it exists already.");
+
+ ("readlink", (RString "link", [Pathname "path"]), 168, [],
+ [] (* XXX tested above *),
+ "read the target of a symbolic link",
+ "\
+This command reads the target of a symbolic link.");
+
+ ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["fallocate"; "/a"; "1000000"];
+ ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
+ "preallocate a file in the guest filesystem",
+ "\
+This command preallocates a file (containing zero bytes) named
+C<path> of size C<len> bytes. If the file exists already, it
+is overwritten.
+
+Do not confuse this with the guestfish-specific
+C<alloc> command which allocates a file in the host and
+attaches it as a device.");
+
+ ("swapon_device", (RErr, [Device "device"]), 170, [],
+ [InitPartition, Always, TestRun (
+ [["mkswap"; "/dev/sda1"];
+ ["swapon_device"; "/dev/sda1"];
+ ["swapoff_device"; "/dev/sda1"]])],
+ "enable swap on device",
+ "\
+This command enables the libguestfs appliance to use the
+swap device or partition named C<device>. The increased
+memory is made available for all commands, for example
+those run using C<guestfs_command> or C<guestfs_sh>.
+
+Note that you should not swap to existing guest swap
+partitions unless you know what you are doing. They may
+contain hibernation information, or other information that
+the guest doesn't want you to trash. You also risk leaking
+information about the host to the guest this way. Instead,
+attach a new host device to the guest and swap on that.");
+
+ ("swapoff_device", (RErr, [Device "device"]), 171, [],
+ [], (* XXX tested by swapon_device *)
+ "disable swap on device",
+ "\
+This command disables the libguestfs appliance swap
+device or partition named C<device>.
+See C<guestfs_swapon_device>.");
+
+ ("swapon_file", (RErr, [Pathname "file"]), 172, [],
+ [InitBasicFS, Always, TestRun (
+ [["fallocate"; "/swap"; "8388608"];
+ ["mkswap_file"; "/swap"];
+ ["swapon_file"; "/swap"];
+ ["swapoff_file"; "/swap"]])],
+ "enable swap on file",
+ "\
+This command enables swap to a file.
+See C<guestfs_swapon_device> for other notes.");
+
+ ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
+ [], (* XXX tested by swapon_file *)
+ "disable swap on file",
+ "\
+This command disables the libguestfs appliance swap on file.");
+
+ ("swapon_label", (RErr, [String "label"]), 174, [],
+ [InitEmpty, Always, TestRun (
+ [["sfdiskM"; "/dev/sdb"; ","];
+ ["mkswap_L"; "swapit"; "/dev/sdb1"];
+ ["swapon_label"; "swapit"];
+ ["swapoff_label"; "swapit"];
+ ["zero"; "/dev/sdb"];
+ ["blockdev_rereadpt"; "/dev/sdb"]])],
+ "enable swap on labeled swap partition",
+ "\
+This command enables swap to a labeled swap partition.
+See C<guestfs_swapon_device> for other notes.");
+
+ ("swapoff_label", (RErr, [String "label"]), 175, [],
+ [], (* XXX tested by swapon_label *)
+ "disable swap on labeled swap partition",
+ "\
+This command disables the libguestfs appliance swap on
+labeled swap partition.");
+
+ ("swapon_uuid", (RErr, [String "uuid"]), 176, [],
+ (let uuid = uuidgen () in
+ [InitEmpty, Always, TestRun (
+ [["mkswap_U"; uuid; "/dev/sdb"];
+ ["swapon_uuid"; uuid];
+ ["swapoff_uuid"; uuid]])]),
+ "enable swap on swap partition by UUID",
+ "\
+This command enables swap to a swap partition with the given UUID.
+See C<guestfs_swapon_device> for other notes.");
+
+ ("swapoff_uuid", (RErr, [String "uuid"]), 177, [],
+ [], (* XXX tested by swapon_uuid *)
+ "disable swap on swap partition by UUID",
+ "\
+This command disables the libguestfs appliance swap partition
+with the given UUID.");
+
+ ("mkswap_file", (RErr, [Pathname "path"]), 178, [],
+ [InitBasicFS, Always, TestRun (
+ [["fallocate"; "/swap"; "8388608"];
+ ["mkswap_file"; "/swap"]])],
+ "create a swap file",
+ "\
+Create a swap file.
+
+This command just writes a swap file signature to an existing
+file. To create the file itself, use something like C<guestfs_fallocate>.");
+
+ ("inotify_init", (RErr, [Int "maxevents"]), 179, [],
+ [InitSquashFS, Always, TestRun (
+ [["inotify_init"; "0"]])],
+ "create an inotify handle",
+ "\
+This command creates a new inotify handle.
+The inotify subsystem can be used to notify events which happen to
+objects in the guest filesystem.
+
+C<maxevents> is the maximum number of events which will be
+queued up between calls to C<guestfs_inotify_read> or
+C<guestfs_inotify_files>.
+If this is passed as C<0>, then the kernel (or previously set)
+default is used. For Linux 2.6.29 the default was 16384 events.
+Beyond this limit, the kernel throws away events, but records
+the fact that it threw them away by setting a flag
+C<IN_Q_OVERFLOW> in the returned structure list (see
+C<guestfs_inotify_read>).
+
+Before any events are generated, you have to add some
+watches to the internal watch list. See:
+C<guestfs_inotify_add_watch>,
+C<guestfs_inotify_rm_watch> and
+C<guestfs_inotify_watch_all>.
+
+Queued up events should be read periodically by calling
+C<guestfs_inotify_read>
+(or C<guestfs_inotify_files> which is just a helpful
+wrapper around C<guestfs_inotify_read>). If you don't
+read the events out often enough then you risk the internal
+queue overflowing.
+
+The handle should be closed after use by calling
+C<guestfs_inotify_close>. This also removes any
+watches automatically.
+
+See also L<inotify(7)> for an overview of the inotify interface
+as exposed by the Linux kernel, which is roughly what we expose
+via libguestfs. Note that there is one global inotify handle
+per libguestfs instance.");
+
+ ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [],
+ [InitBasicFS, Always, TestOutputList (
+ [["inotify_init"; "0"];
+ ["inotify_add_watch"; "/"; "1073741823"];
+ ["touch"; "/a"];
+ ["touch"; "/b"];
+ ["inotify_files"]], ["a"; "b"])],
+ "add an inotify watch",
+ "\
+Watch C<path> for the events listed in C<mask>.
+
+Note that if C<path> is a directory then events within that
+directory are watched, but this does I<not> happen recursively
+(in subdirectories).
+
+Note for non-C or non-Linux callers: the inotify events are
+defined by the Linux kernel ABI and are listed in
+C</usr/include/sys/inotify.h>.");
+
+ ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [],
+ [],
+ "remove an inotify watch",
+ "\
+Remove a previously defined inotify watch.
+See C<guestfs_inotify_add_watch>.");
+
+ ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [],
+ [],
+ "return list of inotify events",
+ "\
+Return the complete queue of events that have happened
+since the previous read call.
+
+If no events have happened, this returns an empty list.
+
+I<Note>: In order to make sure that all events have been
+read, you must call this function repeatedly until it
+returns an empty list. The reason is that the call will
+read events up to the maximum appliance-to-host message
+size and leave remaining events in the queue.");
+
+ ("inotify_files", (RStringList "paths", []), 183, [],
+ [],
+ "return list of watched files that had events",
+ "\
+This function is a helpful wrapper around C<guestfs_inotify_read>
+which just returns a list of pathnames of objects that were
+touched. The returned pathnames are sorted and deduplicated.");
+
+ ("inotify_close", (RErr, []), 184, [],
+ [],
+ "close the inotify handle",
+ "\
+This closes the inotify handle which was previously
+opened by inotify_init. It removes all watches, throws
+away any pending events, and deallocates all resources.");
+
+ ("setcon", (RErr, [String "context"]), 185, [],
+ [],
+ "set SELinux security context",
+ "\
+This sets the SELinux security context of the daemon
+to the string C<context>.
+
+See the documentation about SELINUX in L<guestfs(3)>.");
+
+ ("getcon", (RString "context", []), 186, [],
+ [],
+ "get SELinux security context",
+ "\
+This gets the SELinux security context of the daemon.
+
+See the documentation about SELINUX in L<guestfs(3)>,
+and C<guestfs_setcon>");
+
+ ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
+ ["mount"; "/dev/sda1"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "make a filesystem with block size",
+ "\
+This call is similar to C<guestfs_mkfs>, but it allows you to
+control the block size of the resulting filesystem. Supported
+block sizes depend on the filesystem type, but typically they
+are C<1024>, C<2048> or C<4096> only.");
+
+ ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ",100 ,"];
+ ["mke2journal"; "4096"; "/dev/sda1"];
+ ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
+ ["mount"; "/dev/sda2"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "make ext2/3/4 external journal",
+ "\
+This creates an ext2 external journal on C<device>. It is equivalent
+to the command:
+
+ mke2fs -O journal_dev -b blocksize device");
+
+ ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ",100 ,"];
+ ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
+ ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
+ ["mount"; "/dev/sda2"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "make ext2/3/4 external journal with label",
+ "\
+This creates an ext2 external journal on C<device> with label C<label>.");
+
+ ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [],
+ (let uuid = uuidgen () in
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ",100 ,"];
+ ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
+ ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
+ ["mount"; "/dev/sda2"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")]),
+ "make ext2/3/4 external journal with UUID",
+ "\
+This creates an ext2 external journal on C<device> with UUID C<uuid>.");
+
+ ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
+ [],
+ "make ext2/3/4 filesystem with external journal",
+ "\
+This creates an ext2/3/4 filesystem on C<device> with
+an external journal on C<journal>. It is equivalent
+to the command:
+
+ mke2fs -t fstype -b blocksize -J device=<journal> <device>
+
+See also C<guestfs_mke2journal>.");
+
+ ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
+ [],
+ "make ext2/3/4 filesystem with external journal",
+ "\
+This creates an ext2/3/4 filesystem on C<device> with
+an external journal on the journal labeled C<label>.
+
+See also C<guestfs_mke2journal_L>.");
+
+ ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [],
+ [],
+ "make ext2/3/4 filesystem with external journal",
+ "\
+This creates an ext2/3/4 filesystem on C<device> with
+an external journal on the journal with UUID C<uuid>.
+
+See also C<guestfs_mke2journal_U>.");
+
+ ("modprobe", (RErr, [String "modulename"]), 194, [],
+ [InitNone, Always, TestRun [["modprobe"; "fat"]]],
+ "load a kernel module",
+ "\
+This loads a kernel module in the appliance.
+
+The kernel module must have been whitelisted when libguestfs
+was built (see C<appliance/kmod.whitelist.in> in the source).");
+
]
let all_functions = non_daemon_functions @ daemon_functions
*)
let all_functions_sorted =
List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
- compare n1 n2) all_functions
+ compare n1 n2) all_functions
(* Field types for structures. *)
type field =
| FChar (* C 'char' (really, a 7 bit byte). *)
- | FString (* nul-terminated ASCII string. *)
+ | FString (* nul-terminated ASCII string, NOT NULL. *)
+ | FBuffer (* opaque buffer of bytes, (char *, int) pair *)
| FUInt32
| FInt32
| FUInt64
"release", FInt64;
"extra", FString;
];
+
+ (* Extended attribute. *)
+ "xattr", [
+ "attrname", FString;
+ "attrval", FBuffer;
+ ];
+
+ (* Inotify events. *)
+ "inotify_event", [
+ "in_wd", FInt64;
+ "in_mask", FUInt32;
+ "in_cookie", FUInt32;
+ "in_name", FString;
+ ];
] (* end of structs *)
(* Ugh, Java has to be different ..
"statvfs", "StatVFS";
"dirent", "Dirent";
"version", "Version";
+ "xattr", "XAttr";
+ "inotify_event", "INotifyEvent";
]
+(* What structs are actually returned. *)
+type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
+
+(* Returns a list of RStruct/RStructList structs that are returned
+ * by any function. Each element of returned list is a pair:
+ *
+ * (structname, RStructOnly)
+ * == there exists function which returns RStruct (_, structname)
+ * (structname, RStructListOnly)
+ * == there exists function which returns RStructList (_, structname)
+ * (structname, RStructAndList)
+ * == there are functions returning both RStruct (_, structname)
+ * and RStructList (_, structname)
+ *)
+let rstructs_used =
+ (* ||| is a "logical OR" for rstructs_used_t *)
+ let (|||) a b =
+ match a, b with
+ | RStructAndList, _
+ | _, RStructAndList -> RStructAndList
+ | RStructOnly, RStructListOnly
+ | RStructListOnly, RStructOnly -> RStructAndList
+ | RStructOnly, RStructOnly -> RStructOnly
+ | RStructListOnly, RStructListOnly -> RStructListOnly
+ in
+
+ let h = Hashtbl.create 13 in
+
+ (* if elem->oldv exists, update entry using ||| operator,
+ * else just add elem->newv to the hash
+ *)
+ let update elem newv =
+ try let oldv = Hashtbl.find h elem in
+ Hashtbl.replace h elem (newv ||| oldv)
+ with Not_found -> Hashtbl.add h elem newv
+ in
+
+ List.iter (
+ fun (_, style, _, _, _, _, _) ->
+ match fst style with
+ | RStruct (_, structname) -> update structname RStructOnly
+ | RStructList (_, structname) -> update structname RStructListOnly
+ | _ -> ()
+ ) all_functions;
+
+ (* return key->values as a list of (key,value) *)
+ Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
+
+(* debug:
+let () =
+ List.iter (
+ function
+ | sn, RStructOnly -> printf "%s RStructOnly\n" sn
+ | sn, RStructListOnly -> printf "%s RStructListOnly\n" sn
+ | sn, RStructAndList -> printf "%s RStructAndList\n" sn
+ ) rstructs_used
+*)
+
(* Used for testing language bindings. *)
type callt =
| CallString of string
v
with
_ -> Hashtbl.create 13
+let pod2text_memo_updated () =
+ let chan = open_out pod2text_memo_filename in
+ output_value chan pod2text_memo;
+ close_out chan
(* Useful functions.
* Note we don't want to use any external OCaml libraries which
let rec loop i =
if i <= len-sublen then (
let rec loop2 j =
- if j < sublen then (
- if s.[i+j] = sub.[j] then loop2 (j+1)
- else -1
- ) else
- i (* found *)
+ if j < sublen then (
+ if s.[i+j] = sub.[j] then loop2 (j+1)
+ else -1
+ ) else
+ i (* found *)
in
let r = loop2 0 in
if r = -1 then loop (i+1) else r
| 1 -> false
| i -> failwithf "%s: failed with error code %d" cmd i
+let rec filter_map f = function
+ | [] -> []
+ | x :: xs ->
+ match f x with
+ | Some y -> y :: filter_map f xs
+ | None -> filter_map f xs
+
let rec find_map f = function
| [] -> raise Not_found
| x :: xs ->
loop 0 xs
let name_of_argt = function
- | String n | OptString n | StringList n | Bool n | Int n
+ | Pathname n | Device n | Dev_or_Path n | String n | OptString n
+ | StringList n | DeviceList n | Bool n | Int n
| FileIn n | FileOut n -> n
let java_name_of_struct typ =
let seq_of_test = function
| TestRun s | TestOutput (s, _) | TestOutputList (s, _)
| TestOutputListOfDevices (s, _)
- | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
- | TestOutputLength (s, _) | TestOutputStruct (s, _)
+ | TestOutputInt (s, _) | TestOutputIntOp (s, _, _)
+ | TestOutputTrue s | TestOutputFalse s
+ | TestOutputLength (s, _) | TestOutputBuffer (s, _)
+ | TestOutputStruct (s, _)
| TestLastFail s -> s
+(* Handling for function flags. *)
+let protocol_limit_warning =
+ "Because of the message protocol, there is a transfer limit
+of somewhere between 2MB and 4MB. To transfer large files you should use
+FTP."
+
+let danger_will_robinson =
+ "B<This command is dangerous. Without careful use you
+can easily destroy all your data>."
+
+let deprecation_notice flags =
+ try
+ let alt =
+ find_map (function DeprecatedBy str -> Some str | _ -> None) flags in
+ let txt =
+ sprintf "This function is deprecated.
+In new code, use the C<%s> call instead.
+
+Deprecated functions will not be removed from the API, but the
+fact that they are deprecated indicates that there are problems
+with correct use of these functions." alt in
+ Some txt
+ with
+ Not_found -> None
+
(* Check function names etc. for consistency. *)
let check_functions () =
let contains_uppercase str =
let rec loop i =
if i >= len then false
else (
- let c = str.[i] in
- if c >= 'A' && c <= 'Z' then true
- else loop (i+1)
+ let c = str.[i] in
+ if c >= 'A' && c <= 'Z' then true
+ else loop (i+1)
)
in
loop 0
List.iter (
fun (name, _, _, _, _, _, _) ->
if String.length name >= 7 && String.sub name 0 7 = "guestfs" then
- failwithf "function name %s does not need 'guestfs' prefix" name;
+ failwithf "function name %s does not need 'guestfs' prefix" name;
if name = "" then
- failwithf "function name is empty";
+ failwithf "function name is empty";
if name.[0] < 'a' || name.[0] > 'z' then
- failwithf "function name %s must start with lowercase a-z" name;
+ failwithf "function name %s must start with lowercase a-z" name;
if String.contains name '-' then
- failwithf "function name %s should not contain '-', use '_' instead."
- name
+ failwithf "function name %s should not contain '-', use '_' instead."
+ name
) all_functions;
(* Check function parameter/return names. *)
List.iter (
fun (name, style, _, _, _, _, _) ->
let check_arg_ret_name n =
- if contains_uppercase n then
- failwithf "%s param/ret %s should not contain uppercase chars"
- name n;
- if String.contains n '-' || String.contains n '_' then
- failwithf "%s param/ret %s should not contain '-' or '_'"
- name n;
- if n = "value" then
- failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" name;
- if n = "int" || n = "char" || n = "short" || n = "long" then
- failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
- if n = "i" || n = "n" then
- failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
- if n = "argv" || n = "args" then
- failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name
+ if contains_uppercase n then
+ failwithf "%s param/ret %s should not contain uppercase chars"
+ name n;
+ if String.contains n '-' || String.contains n '_' then
+ failwithf "%s param/ret %s should not contain '-' or '_'"
+ name n;
+ if n = "value" then
+ failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" name;
+ if n = "int" || n = "char" || n = "short" || n = "long" then
+ failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
+ if n = "i" || n = "n" then
+ failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
+ if n = "argv" || n = "args" then
+ failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
+
+ (* List Haskell, OCaml and C keywords here.
+ * http://www.haskell.org/haskellwiki/Keywords
+ * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
+ * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
+ * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
+ * |perl -pe 's/(.+)/"$1";/'|fmt -70
+ * Omitting _-containing words, since they're handled above.
+ * Omitting the OCaml reserved word, "val", is ok,
+ * and saves us from renaming several parameters.
+ *)
+ let reserved = [
+ "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
+ "char"; "class"; "const"; "constraint"; "continue"; "data";
+ "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
+ "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
+ "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
+ "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
+ "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
+ "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
+ "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
+ "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
+ "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
+ "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
+ "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
+ "volatile"; "when"; "where"; "while";
+ ] in
+ if List.mem n reserved then
+ failwithf "%s has param/ret using reserved word %s" name n;
in
(match fst style with
| RErr -> ()
- | RInt n | RInt64 n | RBool n | RConstString n | RString n
+ | RInt n | RInt64 n | RBool n
+ | RConstString n | RConstOptString n | RString n
| RStringList n | RStruct (n, _) | RStructList (n, _)
- | RHashtable n ->
- check_arg_ret_name n
+ | RHashtable n | RBufferOut n ->
+ check_arg_ret_name n
);
List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
) all_functions;
List.iter (
fun (name, _, _, _, _, shortdesc, _) ->
if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
- failwithf "short description of %s should begin with lowercase." name;
+ failwithf "short description of %s should begin with lowercase." name;
let c = shortdesc.[String.length shortdesc-1] in
if c = '\n' || c = '.' then
- failwithf "short description of %s should not end with . or \\n." name
+ failwithf "short description of %s should not end with . or \\n." name
) all_functions;
(* Check long dscriptions. *)
List.iter (
fun (name, _, _, _, _, _, longdesc) ->
if longdesc.[String.length longdesc-1] = '\n' then
- failwithf "long description of %s should not end with \\n." name
+ failwithf "long description of %s should not end with \\n." name
) all_functions;
(* Check proc_nrs. *)
List.iter (
fun (name, _, proc_nr, _, _, _, _) ->
if proc_nr <= 0 then
- failwithf "daemon function %s should have proc_nr > 0" name
+ failwithf "daemon function %s should have proc_nr > 0" name
) daemon_functions;
List.iter (
fun (name, _, proc_nr, _, _, _, _) ->
if proc_nr <> -1 then
- failwithf "non-daemon function %s should have proc_nr -1" name
+ failwithf "non-daemon function %s should have proc_nr -1" name
) non_daemon_functions;
let proc_nrs =
| [] -> ()
| [_] -> ()
| (name1,nr1) :: ((name2,nr2) :: _ as rest) when nr1 < nr2 ->
- loop rest
+ loop rest
| (name1,nr1) :: (name2,nr2) :: _ ->
- failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
- name1 name2 nr1 nr2
+ failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
+ name1 name2 nr1 nr2
in
loop proc_nrs;
*)
| name, _, _, _, [], _, _ -> ()
| name, _, _, _, tests, _, _ ->
- let funcs =
- List.map (
- fun (_, _, test) ->
- match seq_of_test test with
- | [] ->
- failwithf "%s has a test containing an empty sequence" name
- | cmds -> List.map List.hd cmds
- ) tests in
- let funcs = List.flatten funcs in
-
- let tested = List.mem name funcs in
-
- if not tested then
- failwithf "function %s has tests but does not test itself" name
+ let funcs =
+ List.map (
+ fun (_, _, test) ->
+ match seq_of_test test with
+ | [] ->
+ failwithf "%s has a test containing an empty sequence" name
+ | cmds -> List.map List.hd cmds
+ ) tests in
+ let funcs = List.flatten funcs in
+
+ let tested = List.mem name funcs in
+
+ if not tested then
+ failwithf "function %s has tests but does not test itself" name
) all_functions
(* 'pr' prints to the current output file. *)
List.iter (
fun (shortname, style, _, flags, _, _, longdesc) ->
if not (List.mem NotInDocs flags) then (
- let name = "guestfs_" ^ shortname in
- pr "=head2 %s\n\n" name;
- pr " ";
- generate_prototype ~extern:false ~handle:"handle" name style;
- pr "\n\n";
- pr "%s\n\n" longdesc;
- (match fst style with
- | RErr ->
- pr "This function returns 0 on success or -1 on error.\n\n"
- | RInt _ ->
- pr "On error this function returns -1.\n\n"
- | RInt64 _ ->
- pr "On error this function returns -1.\n\n"
- | RBool _ ->
- pr "This function returns a C truth value on success or -1 on error.\n\n"
- | RConstString _ ->
- pr "This function returns a string, or NULL on error.
+ let name = "guestfs_" ^ shortname in
+ pr "=head2 %s\n\n" name;
+ pr " ";
+ generate_prototype ~extern:false ~handle:"handle" name style;
+ pr "\n\n";
+ pr "%s\n\n" longdesc;
+ (match fst style with
+ | RErr ->
+ pr "This function returns 0 on success or -1 on error.\n\n"
+ | RInt _ ->
+ pr "On error this function returns -1.\n\n"
+ | RInt64 _ ->
+ pr "On error this function returns -1.\n\n"
+ | RBool _ ->
+ pr "This function returns a C truth value on success or -1 on error.\n\n"
+ | RConstString _ ->
+ pr "This function returns a string, or NULL on error.
The string is owned by the guest handle and must I<not> be freed.\n\n"
- | RString _ ->
- pr "This function returns a string, or NULL on error.
+ | RConstOptString _ ->
+ pr "This function returns a string which may be NULL.
+There is way to return an error from this function.
+The string is owned by the guest handle and must I<not> be freed.\n\n"
+ | RString _ ->
+ pr "This function returns a string, or NULL on error.
I<The caller must free the returned string after use>.\n\n"
- | RStringList _ ->
- pr "This function returns a NULL-terminated array of strings
+ | RStringList _ ->
+ 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"
- | RStruct (_, typ) ->
- pr "This function returns a C<struct guestfs_%s *>,
+ | 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_%s> after use>.\n\n" typ typ
- | RStructList (_, typ) ->
- pr "This function returns a C<struct guestfs_%s_list *>
+ | 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_%s_list> after use>.\n\n" typ typ
- | RHashtable _ ->
- pr "This function returns a NULL-terminated array of
+ | 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"
- );
- if List.mem ProtocolLimitWarning flags then
- pr "%s\n\n" protocol_limit_warning;
- if List.mem DangerWillRobinson flags then
- pr "%s\n\n" danger_will_robinson
+ | 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;
+ if List.mem DangerWillRobinson flags then
+ pr "%s\n\n" danger_will_robinson;
+ match deprecation_notice flags with
+ | None -> ()
+ | Some txt -> pr "%s\n\n" txt
)
) all_functions_sorted
pr "\n";
pr " struct guestfs_%s {\n" typ;
List.iter (
- function
- | 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, 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
+ function
+ | 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 " \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;
+ typ typ;
pr "\n"
) structs
List.iter (
function
| typ, cols ->
- pr "struct guestfs_int_%s {\n" typ;
- List.iter (function
- | name, FChar -> pr " char %s;\n" name
- | name, FString -> pr " string %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";
- pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
- pr "\n";
+ pr "struct guestfs_int_%s {\n" typ;
+ List.iter (function
+ | 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";
+ pr "typedef struct guestfs_int_%s guestfs_int_%s_list<>;\n" typ typ;
+ pr "\n";
) structs;
List.iter (
(match snd style with
| [] -> ()
| args ->
- pr "struct %s_args {\n" name;
- List.iter (
- function
- | String n -> pr " string %s<>;\n" n
- | OptString n -> pr " str *%s;\n" n
- | StringList n -> pr " str %s<>;\n" n
- | Bool n -> pr " bool %s;\n" n
- | Int n -> pr " int %s;\n" n
- | FileIn _ | FileOut _ -> ()
- ) args;
- pr "};\n\n"
+ pr "struct %s_args {\n" name;
+ List.iter (
+ function
+ | Pathname n | Device n | Dev_or_Path n | String n -> pr " string %s<>;\n" n
+ | OptString n -> pr " str *%s;\n" n
+ | StringList n | DeviceList n -> pr " str %s<>;\n" n
+ | Bool n -> pr " bool %s;\n" n
+ | Int n -> pr " int %s;\n" n
+ | FileIn _ | FileOut _ -> ()
+ ) args;
+ pr "};\n\n"
);
(match fst style with
| RErr -> ()
| RInt n ->
- pr "struct %s_ret {\n" name;
- pr " int %s;\n" n;
- pr "};\n\n"
+ pr "struct %s_ret {\n" name;
+ pr " int %s;\n" n;
+ pr "};\n\n"
| RInt64 n ->
- pr "struct %s_ret {\n" name;
- pr " hyper %s;\n" n;
- pr "};\n\n"
+ pr "struct %s_ret {\n" name;
+ pr " hyper %s;\n" n;
+ pr "};\n\n"
| RBool n ->
- pr "struct %s_ret {\n" name;
- pr " bool %s;\n" n;
- pr "};\n\n"
- | RConstString _ ->
- failwithf "RConstString cannot be returned from a daemon function"
+ pr "struct %s_ret {\n" name;
+ pr " bool %s;\n" n;
+ pr "};\n\n"
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
| RString n ->
- pr "struct %s_ret {\n" name;
- pr " string %s<>;\n" n;
- pr "};\n\n"
+ pr "struct %s_ret {\n" name;
+ pr " string %s<>;\n" n;
+ pr "};\n\n"
| RStringList n ->
- pr "struct %s_ret {\n" name;
- pr " str %s<>;\n" n;
- pr "};\n\n"
+ pr "struct %s_ret {\n" name;
+ pr " str %s<>;\n" n;
+ pr "};\n\n"
| RStruct (n, typ) ->
- pr "struct %s_ret {\n" name;
- pr " guestfs_int_%s %s;\n" typ n;
- pr "};\n\n"
+ pr "struct %s_ret {\n" name;
+ pr " guestfs_int_%s %s;\n" typ n;
+ pr "};\n\n"
| RStructList (n, typ) ->
- pr "struct %s_ret {\n" name;
- pr " guestfs_int_%s_list %s;\n" typ n;
- pr "};\n\n"
+ pr "struct %s_ret {\n" name;
+ 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"
+ pr "struct %s_ret {\n" name;
+ pr " str %s<>;\n" n;
+ pr "};\n\n"
+ | RBufferOut n ->
+ pr "struct %s_ret {\n" name;
+ pr " opaque %s<>;\n" n;
+ pr "};\n\n"
);
) daemon_functions;
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, 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
+ 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";
fun (shortname, style, _, _, _, _, _) ->
let name = "guestfs_" ^ shortname in
generate_prototype ~single_line:true ~newline:true ~handle:"handle"
- name style
+ name style
) all_functions
(* Generate the client-side dispatch stubs. *)
#include \"guestfs_protocol.h\"
#define error guestfs_error
-#define perrorf guestfs_perrorf
-#define safe_malloc guestfs_safe_malloc
+//#define perrorf guestfs_perrorf
+//#define safe_malloc guestfs_safe_malloc
#define safe_realloc guestfs_safe_realloc
-#define safe_strdup guestfs_safe_strdup
+//#define safe_strdup guestfs_safe_strdup
#define safe_memdup guestfs_safe_memdup
/* Check the return message from a call for validity. */
static int
check_reply_header (guestfs_h *g,
const struct guestfs_message_header *hdr,
- int proc_nr, int serial)
+ unsigned int proc_nr, unsigned int serial)
{
if (hdr->prog != GUESTFS_PROGRAM) {
error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
}
if (hdr->vers != GUESTFS_PROTOCOL_VERSION) {
error (g, \"wrong protocol version (%%d/%%d)\",
- hdr->vers, GUESTFS_PROTOCOL_VERSION);
+ hdr->vers, GUESTFS_PROTOCOL_VERSION);
return -1;
}
if (hdr->direction != GUESTFS_DIRECTION_REPLY) {
error (g, \"unexpected message direction (%%d/%%d)\",
- hdr->direction, GUESTFS_DIRECTION_REPLY);
+ hdr->direction, GUESTFS_DIRECTION_REPLY);
return -1;
}
if (hdr->proc != proc_nr) {
{
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\",
pr " struct guestfs_message_error err;\n";
(match fst style with
| RErr -> ()
- | RConstString _ ->
- failwithf "RConstString cannot be returned from a daemon function"
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
| RInt _ | RInt64 _
| RBool _ | RString _ | RStringList _
| RStruct _ | RStructList _
- | RHashtable _ ->
- pr " struct %s_ret ret;\n" name
+ | RHashtable _ | RBufferOut _ ->
+ pr " struct %s_ret ret;\n" name
);
pr "};\n";
pr "\n";
pr " if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
pr " if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
pr " error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
- name;
+ name;
pr " return;\n";
pr " }\n";
pr " goto done;\n";
(match fst style with
| RErr -> ()
- | RConstString _ ->
- failwithf "RConstString cannot be returned from a daemon function"
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
| RInt _ | RInt64 _
| RBool _ | RString _ | RStringList _
| RStruct _ | RStructList _
- | RHashtable _ ->
- 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";
+ | 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";
(* Generate the action stub. *)
generate_prototype ~extern:false ~semicolon:false ~newline:true
- ~handle:"g" name style;
+ ~handle:"g" name style;
let error_code =
- match fst style with
- | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
- | RConstString _ ->
- failwithf "RConstString cannot be returned from a daemon function"
- | RString _ | RStringList _
- | RStruct _ | RStructList _
- | RHashtable _ ->
- "NULL" in
+ match fst style with
+ | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
+ | RString _ | RStringList _
+ | RStruct _ | RStructList _
+ | RHashtable _ | RBufferOut _ ->
+ "NULL" in
pr "{\n";
(* Send the main header and arguments. *)
(match snd style with
| [] ->
- pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
- (String.uppercase shortname)
+ pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
+ (String.uppercase shortname)
| args ->
- List.iter (
- function
- | String n ->
- pr " args.%s = (char *) %s;\n" n n
- | OptString n ->
- pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
- | StringList n ->
- pr " args.%s.%s_val = (char **) %s;\n" n n n;
- pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
- | Bool n ->
- pr " args.%s = %s;\n" n n
- | Int n ->
- pr " args.%s = %s;\n" n n
- | FileIn _ | FileOut _ -> ()
- ) args;
- pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
- (String.uppercase shortname);
- pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
- name;
+ List.iter (
+ function
+ | Pathname n | Device n | Dev_or_Path n | String n ->
+ pr " args.%s = (char *) %s;\n" n n
+ | OptString n ->
+ pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
+ | StringList n | DeviceList n ->
+ pr " args.%s.%s_val = (char **) %s;\n" n n n;
+ pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
+ | Bool n ->
+ pr " args.%s = %s;\n" n n
+ | Int n ->
+ pr " args.%s = %s;\n" n n
+ | FileIn _ | FileOut _ -> ()
+ ) args;
+ pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
+ (String.uppercase shortname);
+ pr " (xdrproc_t) xdr_%s_args, (char *) &args);\n"
+ name;
);
pr " if (serial == -1) {\n";
pr " guestfs_end_busy (g);\n";
(* Send any additional files (FileIn) requested. *)
let need_read_reply_label = ref false in
List.iter (
- function
- | FileIn n ->
- pr " {\n";
- pr " int r;\n";
- pr "\n";
- pr " r = guestfs__send_file_sync (g, %s);\n" n;
- pr " if (r == -1) {\n";
- pr " guestfs_end_busy (g);\n";
- pr " return %s;\n" error_code;
- pr " }\n";
- pr " if (r == -2) /* daemon cancelled */\n";
- pr " goto read_reply;\n";
- need_read_reply_label := true;
- pr " }\n";
- pr "\n";
- | _ -> ()
+ function
+ | FileIn n ->
+ pr " {\n";
+ pr " int r;\n";
+ pr "\n";
+ pr " r = guestfs__send_file_sync (g, %s);\n" n;
+ pr " if (r == -1) {\n";
+ pr " guestfs_end_busy (g);\n";
+ pr " return %s;\n" error_code;
+ pr " }\n";
+ pr " if (r == -2) /* daemon cancelled */\n";
+ pr " goto read_reply;\n";
+ need_read_reply_label := true;
+ pr " }\n";
+ pr "\n";
+ | _ -> ()
) (snd style);
(* Wait for the reply from the remote end. *)
pr "\n";
pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
- (String.uppercase shortname);
+ (String.uppercase shortname);
pr " guestfs_end_busy (g);\n";
pr " return %s;\n" error_code;
pr " }\n";
(* Expecting to receive further files (FileOut)? *)
List.iter (
- function
- | FileOut n ->
- pr " if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
- pr " guestfs_end_busy (g);\n";
- pr " return %s;\n" error_code;
- pr " }\n";
- pr "\n";
- | _ -> ()
+ function
+ | FileOut n ->
+ pr " if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
+ pr " guestfs_end_busy (g);\n";
+ pr " return %s;\n" error_code;
+ pr " }\n";
+ pr "\n";
+ | _ -> ()
) (snd style);
pr " guestfs_end_busy (g);\n";
(match fst style with
| RErr -> pr " return 0;\n"
| RInt n | RInt64 n | RBool n ->
- pr " return ctx.ret.%s;\n" n
- | RConstString _ ->
- failwithf "RConstString cannot be returned from a daemon function"
+ pr " return ctx.ret.%s;\n" n
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
| RString n ->
- pr " return ctx.ret.%s; /* caller will free */\n" n
+ pr " return ctx.ret.%s; /* caller will free */\n" n
| RStringList n | RHashtable n ->
- pr " /* caller will free this, but we need to add a NULL entry */\n";
- pr " ctx.ret.%s.%s_val =\n" n n;
- pr " safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
- pr " sizeof (char *) * (ctx.ret.%s.%s_len + 1));\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
+ pr " /* caller will free this, but we need to add a NULL entry */\n";
+ pr " ctx.ret.%s.%s_val =\n" n n;
+ pr " safe_realloc (g, ctx.ret.%s.%s_val,\n" n n;
+ pr " sizeof (char *) * (ctx.ret.%s.%s_len + 1));\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
| RStruct (n, _) ->
- pr " /* caller will free this */\n";
- pr " return safe_memdup (g, &ctx.ret.%s, sizeof (ctx.ret.%s));\n" n 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
+ 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"
List.iter (
fun (name, style, _, _, _, _, _) ->
generate_prototype
- ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
- name style;
+ ~single_line:true ~newline:true ~in_daemon:true ~prefix:"do_"
+ name style;
) daemon_functions
(* Generate the server-side stubs. *)
pr "static void %s_stub (XDR *xdr_in)\n" name;
pr "{\n";
let error_code =
- match fst style with
- | RErr | RInt _ -> pr " int r;\n"; "-1"
- | RInt64 _ -> pr " int64_t r;\n"; "-1"
- | RBool _ -> pr " int r;\n"; "-1"
- | RConstString _ ->
- failwithf "RConstString cannot be returned from a daemon function"
- | RString _ -> pr " char *r;\n"; "NULL"
- | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
- | RStruct (_, typ) -> pr " guestfs_int_%s *r;\n" typ; "NULL"
- | RStructList (_, typ) -> pr " guestfs_int_%s_list *r;\n" typ; "NULL" in
+ match fst style with
+ | RErr | RInt _ -> pr " int r;\n"; "-1"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1"
+ | RBool _ -> pr " int r;\n"; "-1"
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
+ | RString _ -> pr " char *r;\n"; "NULL"
+ | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
+ | 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
| [] -> ()
| args ->
- pr " struct guestfs_%s_args args;\n" name;
- List.iter (
- function
- (* Note we allow the string to be writable, in order to
- * allow device name translation. This is safe because
- * we can modify the string (passed from RPC).
- *)
- | String n
- | OptString n -> pr " char *%s;\n" n
- | StringList n -> pr " char **%s;\n" n
- | Bool n -> pr " int %s;\n" n
- | Int n -> pr " int %s;\n" n
- | FileIn _ | FileOut _ -> ()
- ) args
+ pr " struct guestfs_%s_args args;\n" name;
+ List.iter (
+ function
+ | Device n | Dev_or_Path n
+ | Pathname n
+ | String n -> ()
+ | OptString n -> pr " char *%s;\n" n
+ | StringList n | DeviceList n -> pr " char **%s;\n" n
+ | Bool n -> pr " int %s;\n" n
+ | Int n -> pr " int %s;\n" n
+ | FileIn _ | FileOut _ -> ()
+ ) args
);
pr "\n";
(match snd style with
| [] -> ()
| args ->
- pr " memset (&args, 0, sizeof args);\n";
- pr "\n";
- pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
- pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
- pr " return;\n";
- pr " }\n";
- List.iter (
- function
- | String n -> pr " %s = args.%s;\n" n n
- | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
- | StringList n ->
- pr " %s = realloc (args.%s.%s_val,\n" n n n;
- pr " sizeof (char *) * (args.%s.%s_len+1));\n" n n;
- pr " if (%s == NULL) {\n" n;
- pr " reply_with_perror (\"realloc\");\n";
- pr " goto done;\n";
- pr " }\n";
- pr " %s[args.%s.%s_len] = NULL;\n" n n n;
- pr " args.%s.%s_val = %s;\n" n n n;
- | Bool n -> pr " %s = args.%s;\n" n n
- | Int n -> pr " %s = args.%s;\n" n n
- | FileIn _ | FileOut _ -> ()
- ) args;
- pr "\n"
+ pr " memset (&args, 0, sizeof args);\n";
+ pr "\n";
+ pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
+ pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
+ pr " return;\n";
+ pr " }\n";
+ let pr_args n =
+ pr " char *%s = args.%s;\n" n n
+ in
+ let pr_list_handling_code n =
+ pr " %s = realloc (args.%s.%s_val,\n" n n n;
+ pr " sizeof (char *) * (args.%s.%s_len+1));\n" n n;
+ pr " if (%s == NULL) {\n" n;
+ pr " reply_with_perror (\"realloc\");\n";
+ pr " goto done;\n";
+ pr " }\n";
+ pr " %s[args.%s.%s_len] = NULL;\n" n n n;
+ pr " args.%s.%s_val = %s;\n" n n n;
+ in
+ List.iter (
+ function
+ | Pathname n ->
+ pr_args n;
+ pr " ABS_PATH (%s, goto done);\n" n;
+ | Device n ->
+ pr_args n;
+ pr " RESOLVE_DEVICE (%s, goto done);\n" n;
+ | Dev_or_Path n ->
+ pr_args n;
+ pr " REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);\n" n;
+ | String n -> pr_args n
+ | OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
+ | StringList n ->
+ pr_list_handling_code n;
+ | DeviceList n ->
+ pr_list_handling_code n;
+ pr " /* Ensure that each is a device,\n";
+ pr " * and perform device name translation. */\n";
+ pr " { int pvi; for (pvi = 0; physvols[pvi] != NULL; ++pvi)\n";
+ pr " RESOLVE_DEVICE (physvols[pvi], goto done);\n";
+ pr " }\n";
+ | Bool n -> pr " %s = args.%s;\n" n n
+ | Int n -> pr " %s = args.%s;\n" n n
+ | FileIn _ | FileOut _ -> ()
+ ) args;
+ pr "\n"
+ );
+
+
+ (* this is used at least for do_equal *)
+ if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
+ (* Emit NEED_ROOT just once, even when there are two or
+ more Pathname args *)
+ pr " NEED_ROOT (goto done);\n";
);
(* Don't want to call the impl with any FileIn or FileOut
* parameters, since these go "outside" the RPC protocol.
*)
- let argsnofile =
- List.filter (function FileIn _ | FileOut _ -> false | _ -> true)
- (snd style) in
+ 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;
* send its own reply.
*)
let no_reply =
- List.exists (function FileOut _ -> true | _ -> false) (snd style) in
+ List.exists (function FileOut _ -> true | _ -> false) (snd style) in
if no_reply then
- pr " /* do_%s has already sent a reply */\n" name
+ pr " /* do_%s has already sent a reply */\n" name
else (
- match fst style with
- | RErr -> pr " reply (NULL, NULL);\n"
- | RInt n | RInt64 n | RBool 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
- | RConstString _ ->
- failwithf "RConstString cannot be returned from a daemon function"
- | RString 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 " free (r);\n"
- | RStringList n | RHashtable n ->
- pr " struct guestfs_%s_ret ret;\n" name;
- pr " ret.%s.%s_len = count_strings (r);\n" n n;
- pr " ret.%s.%s_val = r;\n" n n;
- pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
- name;
- pr " free_strings (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 *) &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
+ match fst style with
+ | RErr -> pr " reply (NULL, NULL);\n"
+ | RInt n | RInt64 n | RBool 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
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
+ | RString 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 " free (r);\n"
+ | RStringList n | RHashtable n ->
+ pr " struct guestfs_%s_ret ret;\n" name;
+ pr " ret.%s.%s_len = count_strings (r);\n" n n;
+ pr " ret.%s.%s_val = r;\n" n n;
+ pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n"
+ name;
+ pr " free_strings (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 *) &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. *)
(match snd style with
| [] ->
- pr "done: ;\n";
+ pr "done: ;\n";
| _ ->
- pr "done:\n";
- pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
- name
+ pr "done:\n";
+ pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
+ name
);
pr "}\n\n";
List.iter (
function
| typ, cols ->
- pr "static const char *lvm_%s_cols = \"%s\";\n"
- typ (String.concat "," (List.map fst cols));
- pr "\n";
-
- pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
- pr "{\n";
- pr " char *tok, *p, *next;\n";
- pr " int i, j;\n";
- pr "\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 " return -1;\n";
- pr " }\n";
- pr " if (!*str || isspace (*str)) {\n";
- pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
- pr " return -1;\n";
- pr " }\n";
- pr " tok = str;\n";
- List.iter (
- fun (name, coltype) ->
- pr " if (!tok) {\n";
- pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
- pr " return -1;\n";
- pr " }\n";
- pr " p = strchrnul (tok, ',');\n";
- pr " if (*p) next = p+1; else next = NULL;\n";
- pr " *p = '\\0';\n";
- (match coltype with
- | 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"
- | 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 " return -1;\n";
- pr " } else if (tok[j] != '-')\n";
- pr " r->%s[i++] = tok[j];\n" name;
- pr " }\n";
- | 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";
- | 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";
- | 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";
- | FInt32 | FUInt32 | FUInt64 | FChar ->
- assert false (* can never be an LVM column *)
- );
- pr " tok = next;\n";
- ) cols;
-
- pr " if (tok != NULL) {\n";
- pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
- pr " return -1;\n";
- pr " }\n";
- pr " return 0;\n";
- pr "}\n";
- pr "\n";
-
- 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_int_lvm_%s_list *ret;\n" typ;
- pr " void *newp;\n";
- pr "\n";
- pr " ret = malloc (sizeof *ret);\n";
- pr " if (!ret) {\n";
- pr " reply_with_perror (\"malloc\");\n";
- pr " return NULL;\n";
- pr " }\n";
- pr "\n";
- 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 " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
- pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
- pr " if (r == -1) {\n";
- pr " reply_with_error (\"%%s\", err);\n";
- pr " free (out);\n";
- pr " free (err);\n";
- pr " free (ret);\n";
- pr " return NULL;\n";
- pr " }\n";
- pr "\n";
- pr " free (err);\n";
- pr "\n";
- pr " /* Tokenize each line of the output. */\n";
- pr " p = out;\n";
- pr " i = 0;\n";
- pr " while (p) {\n";
- pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
- pr " if (pend) {\n";
- pr " *pend = '\\0';\n";
- pr " pend++;\n";
- pr " }\n";
- pr "\n";
- pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
- pr " p++;\n";
- pr "\n";
- pr " if (!*p) { /* Empty line? Skip it. */\n";
- pr " p = pend;\n";
- pr " continue;\n";
- pr " }\n";
- pr "\n";
- pr " /* Allocate some space to store this next entry. */\n";
- 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_int_lvm_%s_list_val);\n" typ;
- pr " free (ret);\n";
- pr " free (out);\n";
- pr " return NULL;\n";
- pr " }\n";
- 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_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 "static const char *lvm_%s_cols = \"%s\";\n"
+ typ (String.concat "," (List.map fst cols));
+ pr "\n";
+
+ pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
+ pr "{\n";
+ pr " char *tok, *p, *next;\n";
+ pr " int i, j;\n";
+ pr "\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 " return -1;\n";
+ pr " }\n";
+ pr " if (!*str || isspace (*str)) {\n";
+ pr " fprintf (stderr, \"%%s: failed: passed a empty string or one beginning with whitespace\\n\", __func__);\n";
+ pr " return -1;\n";
+ pr " }\n";
+ pr " tok = str;\n";
+ List.iter (
+ fun (name, coltype) ->
+ pr " if (!tok) {\n";
+ pr " fprintf (stderr, \"%%s: failed: string finished early, around token %%s\\n\", __func__, \"%s\");\n" name;
+ pr " return -1;\n";
+ pr " }\n";
+ pr " p = strchrnul (tok, ',');\n";
+ pr " if (*p) next = p+1; else next = NULL;\n";
+ pr " *p = '\\0';\n";
+ (match coltype with
+ | 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"
+ | 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 " return -1;\n";
+ pr " } else if (tok[j] != '-')\n";
+ pr " r->%s[i++] = tok[j];\n" name;
+ pr " }\n";
+ | 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";
+ | 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";
+ | 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 " if (tok != NULL) {\n";
+ pr " fprintf (stderr, \"%%s: failed: extra tokens at end of string\\n\", __func__);\n";
+ pr " return -1;\n";
+ pr " }\n";
+ pr " return 0;\n";
+ pr "}\n";
+ pr "\n";
+
+ 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_int_lvm_%s_list *ret;\n" typ;
+ pr " void *newp;\n";
+ pr "\n";
+ pr " ret = malloc (sizeof *ret);\n";
+ pr " if (!ret) {\n";
+ pr " reply_with_perror (\"malloc\");\n";
+ pr " return NULL;\n";
+ pr " }\n";
+ pr "\n";
+ 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 " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
+ pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
+ pr " if (r == -1) {\n";
+ pr " reply_with_error (\"%%s\", err);\n";
+ pr " free (out);\n";
+ pr " free (err);\n";
+ pr " free (ret);\n";
+ pr " return NULL;\n";
+ pr " }\n";
+ pr "\n";
+ pr " free (err);\n";
+ pr "\n";
+ pr " /* Tokenize each line of the output. */\n";
+ pr " p = out;\n";
+ pr " i = 0;\n";
+ pr " while (p) {\n";
+ pr " pend = strchr (p, '\\n'); /* Get the next line of output. */\n";
+ pr " if (pend) {\n";
+ pr " *pend = '\\0';\n";
+ pr " pend++;\n";
+ pr " }\n";
+ pr "\n";
+ pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
+ pr " p++;\n";
+ pr "\n";
+ pr " if (!*p) { /* Empty line? Skip it. */\n";
+ pr " p = pend;\n";
+ pr " continue;\n";
+ pr " }\n";
+ pr "\n";
+ pr " /* Allocate some space to store this next entry. */\n";
+ 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_int_lvm_%s_list_val);\n" typ;
+ pr " free (ret);\n";
+ pr " free (out);\n";
+ pr " return NULL;\n";
+ pr " }\n";
+ 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_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_int_lvm_%s_list_val);\n" typ;
pr " free (ret);\n";
- pr " free (out);\n";
- pr " return NULL;\n";
- pr " }\n";
- pr "\n";
- pr " ++i;\n";
- pr " p = pend;\n";
- pr " }\n";
- pr "\n";
- pr " ret->guestfs_int_lvm_%s_list_len = i;\n" typ;
- pr "\n";
- pr " free (out);\n";
- pr " return ret;\n";
- pr "}\n"
+ pr " free (out);\n";
+ pr " return NULL;\n";
+ pr " }\n";
+ pr "\n";
+ pr " ++i;\n";
+ pr " p = pend;\n";
+ pr " }\n";
+ pr "\n";
+ pr " ret->guestfs_int_lvm_%s_list_len = i;\n" typ;
+ pr "\n";
+ pr " free (out);\n";
+ pr " return ret;\n";
+ pr "}\n"
) ["pv", lvm_pv_cols; "vg", lvm_vg_cols; "lv", lvm_lv_cols]
fprintf (stderr, \"%%s\\n\", msg);
}
-static void print_strings (char * const * const argv)
+/* FIXME: nearly identical code appears in fish.c */
+static void print_strings (char *const *argv)
{
int argc;
}
/*
-static void print_table (char * const * const argv)
+static void print_table (char const *const *argv)
{
int i;
}
*/
-static void no_test_warnings (void)
-{
";
+ (* Generate a list of commands which are not tested anywhere. *)
+ pr "static void no_test_warnings (void)\n";
+ pr "{\n";
+
+ let hash : (string, bool) Hashtbl.t = Hashtbl.create 13 in
List.iter (
- function
- | name, _, _, _, [], _, _ ->
- pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
- | name, _, _, _, tests, _, _ -> ()
+ fun (_, _, _, _, tests, _, _) ->
+ let tests = filter_map (
+ function
+ | (_, (Always|If _|Unless _), test) -> Some test
+ | (_, Disabled, _) -> None
+ ) tests in
+ let seq = List.concat (List.map seq_of_test tests) in
+ let cmds_tested = List.map List.hd seq in
+ List.iter (fun cmd -> Hashtbl.replace hash cmd true) cmds_tested
+ ) all_functions;
+
+ List.iter (
+ fun (name, _, _, _, _, _, _) ->
+ if not (Hashtbl.mem hash name) then
+ pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
) all_functions;
pr "}\n";
let test_names =
List.map (
fun (name, _, _, _, tests, _, _) ->
- mapi (generate_one_test name) tests
+ mapi (generate_one_test name) tests
) (List.rev all_functions) in
let test_names = List.concat test_names in
let nr_tests = List.length test_names in
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)
- [["blockdev_setrw"; "/dev/sda"];
- ["umount_all"];
- ["lvm_remove_all"]]
+ [["blockdev_setrw"; "/dev/sda"];
+ ["umount_all"];
+ ["lvm_remove_all"]]
+ | InitPartition ->
+ pr " /* InitPartition for %s: create /dev/sda1 */\n" test_name;
+ List.iter (generate_test_command_call test_name)
+ [["blockdev_setrw"; "/dev/sda"];
+ ["umount_all"];
+ ["lvm_remove_all"];
+ ["sfdiskM"; "/dev/sda"; ","]]
| InitBasicFS ->
pr " /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
List.iter (generate_test_command_call test_name)
- [["blockdev_setrw"; "/dev/sda"];
- ["umount_all"];
- ["lvm_remove_all"];
- ["sfdiskM"; "/dev/sda"; ","];
- ["mkfs"; "ext2"; "/dev/sda1"];
- ["mount"; "/dev/sda1"; "/"]]
+ [["blockdev_setrw"; "/dev/sda"];
+ ["umount_all"];
+ ["lvm_remove_all"];
+ ["sfdiskM"; "/dev/sda"; ","];
+ ["mkfs"; "ext2"; "/dev/sda1"];
+ ["mount"; "/dev/sda1"; "/"]]
| InitBasicFSonLVM ->
pr " /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
- test_name;
+ test_name;
List.iter (generate_test_command_call test_name)
- [["blockdev_setrw"; "/dev/sda"];
- ["umount_all"];
- ["lvm_remove_all"];
- ["sfdiskM"; "/dev/sda"; ","];
- ["pvcreate"; "/dev/sda1"];
- ["vgcreate"; "VG"; "/dev/sda1"];
- ["lvcreate"; "LV"; "VG"; "8"];
- ["mkfs"; "ext2"; "/dev/VG/LV"];
- ["mount"; "/dev/VG/LV"; "/"]]
+ [["blockdev_setrw"; "/dev/sda"];
+ ["umount_all"];
+ ["lvm_remove_all"];
+ ["sfdiskM"; "/dev/sda"; ","];
+ ["pvcreate"; "/dev/sda1"];
+ ["vgcreate"; "VG"; "/dev/sda1"];
+ ["lvcreate"; "LV"; "VG"; "8"];
+ ["mkfs"; "ext2"; "/dev/VG/LV"];
+ ["mount"; "/dev/VG/LV"; "/"]]
+ | InitSquashFS ->
+ pr " /* InitSquashFS for %s */\n" test_name;
+ List.iter (generate_test_command_call test_name)
+ [["blockdev_setrw"; "/dev/sda"];
+ ["umount_all"];
+ ["lvm_remove_all"];
+ ["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"]]
);
let get_seq_last = function
| [] ->
- failwithf "%s: you cannot use [] (empty list) when expecting a command"
- test_name
+ failwithf "%s: you cannot use [] (empty list) when expecting a command"
+ test_name
| seq ->
- let seq = List.rev seq in
- List.rev (List.tl seq), List.hd seq
+ let seq = List.rev seq in
+ List.rev (List.tl seq), List.hd seq
in
match test with
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 " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
- pr " return -1;\n";
- pr " }\n"
+ pr " if (strcmp (r, expected) != 0) {\n";
+ pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
+ pr " return -1;\n";
+ pr " }\n"
in
List.iter (generate_test_command_call test_name) seq;
generate_test_command_call ~test test_name last
pr " /* TestOutputList for %s (%d) */\n" name i;
let seq, last = get_seq_last seq in
let test () =
- iteri (
- fun i str ->
- pr " if (!r[%d]) {\n" i;
- pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
- pr " print_strings (r);\n";
- pr " return -1;\n";
- pr " }\n";
+ iteri (
+ fun i str ->
+ pr " if (!r[%d]) {\n" i;
+ pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
+ pr " print_strings (r);\n";
+ pr " return -1;\n";
+ pr " }\n";
pr " {\n";
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 " }\n";
- pr " }\n"
- ) expected;
- pr " if (r[%d] != NULL) {\n" (List.length expected);
- pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
- test_name;
- pr " print_strings (r);\n";
- pr " return -1;\n";
- pr " }\n"
+ 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 " }\n";
+ pr " }\n"
+ ) expected;
+ pr " if (r[%d] != NULL) {\n" (List.length expected);
+ pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
+ test_name;
+ pr " print_strings (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
pr " /* TestOutputListOfDevices for %s (%d) */\n" name i;
let seq, last = get_seq_last seq in
let test () =
- iteri (
- fun i str ->
- pr " if (!r[%d]) {\n" i;
- pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
- pr " print_strings (r);\n";
- pr " return -1;\n";
- pr " }\n";
+ iteri (
+ fun i str ->
+ pr " if (!r[%d]) {\n" i;
+ pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
+ pr " print_strings (r);\n";
+ pr " return -1;\n";
+ pr " }\n";
pr " {\n";
pr " const char *expected = \"%s\";\n" (c_quote str);
- pr " r[%d][5] = 's';\n" i;
- pr " if (strcmp (r[%d], expected) != 0) {\n" i;
- pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
- pr " return -1;\n";
- pr " }\n";
- pr " }\n"
- ) expected;
- pr " if (r[%d] != NULL) {\n" (List.length expected);
- pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
- test_name;
- pr " print_strings (r);\n";
- pr " return -1;\n";
- pr " }\n"
+ 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;
+ pr " return -1;\n";
+ pr " }\n";
+ pr " }\n"
+ ) expected;
+ pr " if (r[%d] != NULL) {\n" (List.length expected);
+ pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
+ test_name;
+ pr " print_strings (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
pr " /* TestOutputInt for %s (%d) */\n" name i;
let seq, last = get_seq_last seq in
let test () =
- pr " if (r != %d) {\n" expected;
- pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
- test_name expected;
- pr " (int) r);\n";
- pr " return -1;\n";
- pr " }\n"
+ pr " if (r != %d) {\n" expected;
+ pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
+ test_name 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
+ | 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
pr " /* TestOutputTrue for %s (%d) */\n" name i;
let seq, last = get_seq_last seq in
let test () =
- pr " if (!r) {\n";
- pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
- test_name;
- pr " return -1;\n";
- pr " }\n"
+ pr " if (!r) {\n";
+ pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
+ test_name;
+ pr " return -1;\n";
+ pr " }\n"
in
List.iter (generate_test_command_call test_name) seq;
generate_test_command_call ~test test_name last
pr " /* TestOutputFalse for %s (%d) */\n" name i;
let seq, last = get_seq_last seq in
let test () =
- pr " if (r) {\n";
- pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
- test_name;
- pr " return -1;\n";
- pr " }\n"
+ pr " if (r) {\n";
+ pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
+ test_name;
+ pr " return -1;\n";
+ pr " }\n"
in
List.iter (generate_test_command_call test_name) seq;
generate_test_command_call ~test test_name last
pr " /* TestOutputLength for %s (%d) */\n" name i;
let seq, last = get_seq_last seq in
let test () =
- pr " int j;\n";
- pr " for (j = 0; j < %d; ++j)\n" expected;
- pr " if (r[j] == NULL) {\n";
- pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
- test_name;
- pr " print_strings (r);\n";
- pr " return -1;\n";
- pr " }\n";
- pr " if (r[j] != NULL) {\n";
- pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
- test_name;
- pr " print_strings (r);\n";
- pr " return -1;\n";
- pr " }\n"
+ pr " int j;\n";
+ pr " for (j = 0; j < %d; ++j)\n" expected;
+ pr " if (r[j] == NULL) {\n";
+ pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
+ test_name;
+ pr " print_strings (r);\n";
+ pr " return -1;\n";
+ pr " }\n";
+ pr " if (r[j] != NULL) {\n";
+ pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
+ test_name;
+ pr " print_strings (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
+ | TestOutputBuffer (seq, expected) ->
+ pr " /* TestOutputBuffer for %s (%d) */\n" name i;
+ pr " const char *expected = \"%s\";\n" (c_quote expected);
+ let seq, last = get_seq_last seq in
+ let len = String.length expected in
+ let test () =
+ pr " if (size != %d) {\n" len;
+ pr " fprintf (stderr, \"%s: returned size of buffer wrong, expected %d but got %%zu\\n\", size);\n" test_name len;
+ pr " return -1;\n";
+ pr " }\n";
+ pr " if (strncmp (r, expected, size) != 0) {\n";
+ pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
+ pr " return -1;\n";
+ pr " }\n"
in
List.iter (generate_test_command_call test_name) seq;
generate_test_command_call ~test test_name last
pr " /* TestOutputStruct for %s (%d) */\n" name i;
let seq, last = get_seq_last seq in
let test () =
- List.iter (
- function
- | CompareWithInt (field, expected) ->
- pr " if (r->%s != %d) {\n" field expected;
- pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
- test_name field 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"
- test_name field expected;
- pr " r->%s);\n" field;
- pr " return -1;\n";
- pr " }\n"
- | CompareFieldsIntEq (field1, field2) ->
- pr " if (r->%s != r->%s) {\n" field1 field2;
- pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
- test_name field1 field2;
- pr " (int) r->%s, (int) r->%s);\n" field1 field2;
- pr " return -1;\n";
- pr " }\n"
- | CompareFieldsStrEq (field1, field2) ->
- pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
- pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
- test_name field1 field2;
- pr " r->%s, r->%s);\n" field1 field2;
- pr " return -1;\n";
- pr " }\n"
- ) checks
+ List.iter (
+ function
+ | CompareWithInt (field, expected) ->
+ pr " if (r->%s != %d) {\n" field expected;
+ pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
+ test_name field expected;
+ 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"
+ test_name field expected;
+ pr " r->%s);\n" field;
+ pr " return -1;\n";
+ pr " }\n"
+ | CompareFieldsIntEq (field1, field2) ->
+ pr " if (r->%s != r->%s) {\n" field1 field2;
+ pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
+ test_name field1 field2;
+ pr " (int) r->%s, (int) r->%s);\n" field1 field2;
+ pr " return -1;\n";
+ pr " }\n"
+ | CompareFieldsStrEq (field1, field2) ->
+ pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
+ pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
+ test_name field1 field2;
+ pr " r->%s, r->%s);\n" field1 field2;
+ pr " return -1;\n";
+ pr " }\n"
+ ) checks
in
List.iter (generate_test_command_call test_name) seq;
generate_test_command_call ~test test_name last
| name :: args ->
(* Look up the command to find out what args/ret it has. *)
let style =
- try
- let _, style, _, _, _, _, _ =
- List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
- style
- with Not_found ->
- failwithf "%s: in test, command %s was not found" test_name name in
+ try
+ let _, style, _, _, _, _, _ =
+ List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
+ style
+ with Not_found ->
+ failwithf "%s: in test, command %s was not found" test_name name in
if List.length (snd style) <> List.length args then
- failwithf "%s: in test, wrong number of args given to %s"
- test_name name;
+ failwithf "%s: in test, wrong number of args given to %s"
+ test_name name;
pr " {\n";
List.iter (
- function
- | OptString n, "NULL" -> ()
- | String n, arg
- | OptString n, arg ->
- pr " const char *%s = \"%s\";\n" n (c_quote arg);
- | Int _, _
- | Bool _, _
- | FileIn _, _ | FileOut _, _ -> ()
- | StringList n, arg ->
- let strs = string_split " " arg in
- iteri (
- fun i str ->
+ function
+ | OptString n, "NULL" -> ()
+ | Pathname n, arg
+ | Device n, arg
+ | Dev_or_Path n, arg
+ | String n, arg
+ | OptString n, arg ->
+ pr " const char *%s = \"%s\";\n" n (c_quote arg);
+ | Int _, _
+ | Bool _, _
+ | FileIn _, _ | FileOut _, _ -> ()
+ | StringList n, arg | DeviceList n, arg ->
+ let strs = string_split " " arg in
+ iteri (
+ fun i str ->
pr " const char *%s_%d = \"%s\";\n" n i (c_quote str);
- ) strs;
- pr " const char *%s[] = {\n" n;
- iteri (
- fun i _ -> pr " %s_%d,\n" n i
- ) strs;
- pr " NULL\n";
- pr " };\n";
+ ) strs;
+ pr " const char *const %s[] = {\n" n;
+ iteri (
+ fun i _ -> pr " %s_%d,\n" n i
+ ) strs;
+ pr " NULL\n";
+ pr " };\n";
) (List.combine (snd style) args);
let error_code =
- match fst style with
- | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
- | RInt64 _ -> pr " int64_t r;\n"; "-1"
- | RConstString _ -> pr " const char *r;\n"; "NULL"
- | RString _ -> pr " char *r;\n"; "NULL"
- | RStringList _ | RHashtable _ ->
- pr " char **r;\n";
- pr " int i;\n";
- "NULL"
- | RStruct (_, typ) ->
- pr " struct guestfs_%s *r;\n" typ; "NULL"
- | RStructList (_, typ) ->
- pr " struct guestfs_%s_list *r;\n" typ; "NULL" in
+ match fst style with
+ | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1"
+ | RConstString _ | RConstOptString _ ->
+ pr " const char *r;\n"; "NULL"
+ | RString _ -> pr " char *r;\n"; "NULL"
+ | RStringList _ | RHashtable _ ->
+ pr " char **r;\n";
+ pr " int i;\n";
+ "NULL"
+ | 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;
(* Generate the parameters. *)
List.iter (
- function
- | OptString _, "NULL" -> pr ", NULL"
- | String n, _
- | OptString n, _ ->
+ function
+ | OptString _, "NULL" -> pr ", NULL"
+ | Pathname n, _
+ | Device n, _ | Dev_or_Path n, _
+ | String n, _
+ | OptString n, _ ->
pr ", %s" n
- | FileIn _, arg | FileOut _, arg ->
- pr ", \"%s\"" (c_quote arg)
- | StringList n, _ ->
- pr ", %s" n
- | Int _, arg ->
- let i =
- try int_of_string arg
- with Failure "int_of_string" ->
- failwithf "%s: expecting an int, but got '%s'" test_name arg in
- pr ", %d" i
- | Bool _, arg ->
- let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
+ | FileIn _, arg | FileOut _, arg ->
+ pr ", \"%s\"" (c_quote arg)
+ | StringList n, _ | DeviceList n, _ ->
+ pr ", (char **) %s" n
+ | Int _, arg ->
+ let i =
+ try int_of_string arg
+ with Failure "int_of_string" ->
+ failwithf "%s: expecting an int, but got '%s'" test_name arg in
+ pr ", %d" i
+ | Bool _, arg ->
+ 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
+ pr " if (r == %s)\n" error_code
else
- pr " if (r != %s)\n" error_code;
+ pr " if (r != %s)\n" error_code;
pr " return -1;\n";
(* Insert the test code. *)
);
(match fst style with
- | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
- | RString _ -> pr " free (r);\n"
+ | RErr | RInt _ | RInt64 _ | RBool _
+ | RConstString _ | RConstOptString _ -> ()
+ | 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"
+ pr " for (i = 0; r[i] != NULL; ++i)\n";
+ pr " free (r[i]);\n";
+ pr " free (r);\n"
| RStruct (_, typ) ->
- pr " guestfs_free_%s (r);\n" typ
+ pr " guestfs_free_%s (r);\n" typ
| RStructList (_, typ) ->
- pr " guestfs_free_%s_list (r);\n" 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";
(* list_commands function, which implements guestfish -h *)
pr "void list_commands (void)\n";
pr "{\n";
- pr " printf (\" %%-16s %%s\\n\", \"Command\", \"Description\");\n";
+ pr " printf (\" %%-16s %%s\\n\", _(\"Command\"), _(\"Description\"));\n";
pr " list_builtin_commands ();\n";
List.iter (
fun (name, _, _, flags, _, shortdesc, _) ->
let name = replace_char name '_' '-' in
- pr " printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
- name shortdesc
+ pr " printf (\"%%-20s %%s\\n\", \"%s\", _(\"%s\"));\n"
+ name shortdesc
) all_functions_sorted;
- pr " printf (\" Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
+ pr " printf (\" %%s\\n\",";
+ pr " _(\"Use -h <cmd> / help <cmd> to show detailed help for a command.\"));\n";
pr "}\n";
pr "\n";
fun (name, style, _, flags, _, shortdesc, longdesc) ->
let name2 = replace_char name '_' '-' in
let alias =
- try find_map (function FishAlias n -> Some n | _ -> None) flags
- with Not_found -> name in
+ try find_map (function FishAlias n -> Some n | _ -> None) flags
+ with Not_found -> name in
let longdesc = replace_str longdesc "C<guestfs_" "C<" in
let synopsis =
- match snd style with
- | [] -> name2
- | args ->
- sprintf "%s <%s>"
- name2 (String.concat "> <" (List.map name_of_argt args)) in
+ match snd style with
+ | [] -> name2
+ | args ->
+ sprintf "%s <%s>"
+ name2 (String.concat "> <" (List.map name_of_argt args)) in
let warnings =
- if List.mem ProtocolLimitWarning flags then
- ("\n\n" ^ protocol_limit_warning)
- else "" in
+ if List.mem ProtocolLimitWarning flags then
+ ("\n\n" ^ protocol_limit_warning)
+ else "" in
(* For DangerWillRobinson commands, we should probably have
* guestfish prompt before allowing you to use them (especially
* in interactive mode). XXX
*)
let warnings =
- warnings ^
- if List.mem DangerWillRobinson flags then
- ("\n\n" ^ danger_will_robinson)
- else "" in
+ warnings ^
+ if List.mem DangerWillRobinson flags then
+ ("\n\n" ^ danger_will_robinson)
+ else "" in
+
+ let warnings =
+ warnings ^
+ match deprecation_notice flags with
+ | None -> ""
+ | Some txt -> "\n\n" ^ txt in
let describe_alias =
- if name <> alias then
- sprintf "\n\nYou can use '%s' as an alias for this command." alias
- else "" in
+ if name <> alias then
+ sprintf "\n\nYou can use '%s' as an alias for this command." alias
+ else "" in
pr " if (";
pr "strcasecmp (cmd, \"%s\") == 0" name;
if name <> name2 then
- pr " || strcasecmp (cmd, \"%s\") == 0" name2;
+ pr " || strcasecmp (cmd, \"%s\") == 0" name2;
if name <> alias then
- pr " || strcasecmp (cmd, \"%s\") == 0" alias;
+ pr " || strcasecmp (cmd, \"%s\") == 0" alias;
pr ")\n";
- pr " pod2text (\"%s - %s\", %S);\n"
- name2 shortdesc
- (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
+ pr " pod2text (\"%s\", _(\"%s\"), %S);\n"
+ name2 shortdesc
+ (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
pr " else\n"
) all_functions;
pr " display_builtin_command (cmd);\n";
pr "}\n";
pr "\n";
+ let emit_print_list_function typ =
+ 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 " printf (\"[%%d] = {\\n\", i);\n";
+ pr " print_%s_indent (&%ss->val[i], \" \");\n" typ typ;
+ pr " printf (\"}\\n\");\n";
+ pr " }\n";
+ pr "}\n";
+ pr "\n";
+ in
+
(* print_* functions *)
List.iter (
fun (typ, cols) ->
let needs_i =
- List.exists (function (_, FUUID) -> true | _ -> false) cols in
+ List.exists (function (_, (FUUID|FBuffer)) -> true | _ -> false) cols in
- pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
+ pr "static void print_%s_indent (struct guestfs_%s *%s, const char *indent)\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, (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
+ function
+ | name, FString ->
+ pr " printf (\"%%s%s: %%s\\n\", indent, %s->%s);\n" name typ name
+ | name, FUUID ->
+ pr " printf (\"%s: \");\n" name;
+ pr " for (i = 0; i < 32; ++i)\n";
+ pr " printf (\"%%s%%c\", indent, %s->%s[i]);\n" typ name;
+ pr " printf (\"\\n\");\n"
+ | name, FBuffer ->
+ pr " printf (\"%%s%s: \", indent);\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 (\"%%s%%c\", indent, %s->%s[i]);\n" typ name;
+ pr " else\n";
+ pr " printf (\"%%s\\\\x%%02x\", indent, %s->%s[i]);\n" typ name;
+ pr " printf (\"\\n\");\n"
+ | name, (FUInt64|FBytes) ->
+ pr " printf (\"%%s%s: %%\" PRIu64 \"\\n\", indent, %s->%s);\n"
+ name typ name
+ | name, FInt64 ->
+ pr " printf (\"%%s%s: %%\" PRIi64 \"\\n\", indent, %s->%s);\n"
+ name typ name
+ | name, FUInt32 ->
+ pr " printf (\"%%s%s: %%\" PRIu32 \"\\n\", indent, %s->%s);\n"
+ name typ name
+ | name, FInt32 ->
+ pr " printf (\"%%s%s: %%\" PRIi32 \"\\n\", indent, %s->%s);\n"
+ name typ name
+ | name, FChar ->
+ pr " printf (\"%%s%s: %%c\\n\", indent, %s->%s);\n"
+ name typ name
+ | name, FOptPercent ->
+ pr " if (%s->%s >= 0) printf (\"%%s%s: %%g %%%%\\n\", indent, %s->%s);\n"
+ typ name name typ name;
+ pr " else printf (\"%%s%s: \\n\", indent);\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;
+ (* Emit a print_TYPE_list function definition only if that function is used. *)
+ List.iter (
+ function
+ | typ, (RStructListOnly | RStructAndList) ->
+ (* generate the function for typ *)
+ emit_print_list_function typ
+ | typ, _ -> () (* empty *)
+ ) rstructs_used;
+
+ (* Emit a print_TYPE function definition only if that function is used. *)
+ List.iter (
+ function
+ | typ, RStructOnly ->
+ pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
+ pr "{\n";
+ pr " print_%s_indent (%s, \"\");\n" typ typ;
+ pr "}\n";
+ pr "\n";
+ | typ, _ -> () (* empty *)
+ ) rstructs_used;
+
(* run_<action> actions *)
List.iter (
fun (name, style, _, flags, _, _, _) ->
| RInt _
| RBool _ -> pr " int r;\n"
| RInt64 _ -> pr " int64_t r;\n"
- | RConstString _ -> pr " const char *r;\n"
+ | RConstString _ | RConstOptString _ -> pr " const char *r;\n"
| RString _ -> pr " char *r;\n"
| RStringList _ | RHashtable _ -> pr " char **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
- | String n
- | OptString n
- | FileIn n
- | FileOut n -> pr " const char *%s;\n" n
- | StringList n -> pr " char **%s;\n" n
- | Bool n -> pr " int %s;\n" n
- | Int n -> pr " int %s;\n" n
+ function
+ | Pathname n
+ | Device n | Dev_or_Path n
+ | String n
+ | OptString n
+ | FileIn n
+ | FileOut n -> pr " const char *%s;\n" n
+ | StringList n | DeviceList n -> pr " char *const *%s;\n" n
+ | Bool n -> pr " int %s;\n" n
+ | Int n -> pr " int %s;\n" n
) (snd style);
(* Check and convert parameters. *)
let argc_expected = List.length (snd style) in
pr " if (argc != %d) {\n" argc_expected;
- pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
- argc_expected;
- pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
+ pr " fprintf (stderr, _(\"%%s should have %%d parameter(s)\\n\"), cmd, %d);\n"
+ argc_expected;
+ pr " fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n";
pr " return -1;\n";
pr " }\n";
iteri (
- fun i ->
- function
- | String name -> pr " %s = argv[%d];\n" name i
- | OptString name ->
- pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
- name i i
- | FileIn name ->
- pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
- name i i
- | FileOut name ->
- pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
- name i i
- | StringList name ->
- pr " %s = parse_string_list (argv[%d]);\n" name i
- | Bool name ->
- pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
- | Int name ->
- pr " %s = atoi (argv[%d]);\n" name i
+ fun i ->
+ function
+ | Pathname name
+ | Device name | Dev_or_Path name | String name -> pr " %s = argv[%d];\n" name i
+ | OptString name ->
+ pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
+ name i i
+ | FileIn name ->
+ pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
+ name i i
+ | FileOut name ->
+ pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
+ name i i
+ | StringList name | DeviceList name ->
+ pr " %s = parse_string_list (argv[%d]);\n" name i
+ | Bool name ->
+ pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
+ | Int name ->
+ pr " %s = atoi (argv[%d]);\n" name i
) (snd style);
(* Call C API function. *)
let fn =
- try find_map (function FishAction n -> Some n | _ -> None) flags
- with Not_found -> sprintf "guestfs_%s" name in
+ 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. *)
(match fst style with
| RErr -> pr " return r;\n"
| RInt _ ->
- pr " if (r == -1) return -1;\n";
- pr " printf (\"%%d\\n\", r);\n";
- pr " return 0;\n"
+ pr " if (r == -1) return -1;\n";
+ pr " printf (\"%%d\\n\", r);\n";
+ pr " return 0;\n"
| RInt64 _ ->
- pr " if (r == -1) return -1;\n";
- pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
- pr " return 0;\n"
+ pr " if (r == -1) return -1;\n";
+ pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
+ pr " return 0;\n"
| RBool _ ->
- pr " if (r == -1) return -1;\n";
- pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
- pr " return 0;\n"
+ pr " if (r == -1) return -1;\n";
+ pr " if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
+ pr " return 0;\n"
| RConstString _ ->
- pr " if (r == NULL) return -1;\n";
- pr " printf (\"%%s\\n\", r);\n";
- pr " return 0;\n"
+ pr " if (r == NULL) return -1;\n";
+ pr " printf (\"%%s\\n\", r);\n";
+ pr " return 0;\n"
+ | RConstOptString _ ->
+ pr " printf (\"%%s\\n\", r ? : \"(null)\");\n";
+ pr " return 0;\n"
| RString _ ->
- pr " if (r == NULL) return -1;\n";
- pr " printf (\"%%s\\n\", r);\n";
- pr " free (r);\n";
- pr " return 0;\n"
+ pr " if (r == NULL) return -1;\n";
+ pr " printf (\"%%s\\n\", r);\n";
+ pr " free (r);\n";
+ pr " return 0;\n"
| RStringList _ ->
- pr " if (r == NULL) return -1;\n";
- pr " print_strings (r);\n";
- pr " free_strings (r);\n";
- pr " return 0;\n"
+ pr " if (r == NULL) return -1;\n";
+ pr " print_strings (r);\n";
+ pr " free_strings (r);\n";
+ pr " return 0;\n"
| RStruct (_, typ) ->
- pr " if (r == NULL) return -1;\n";
- pr " print_%s (r);\n" typ;
- pr " guestfs_free_%s (r);\n" typ;
- pr " return 0;\n"
+ pr " if (r == NULL) return -1;\n";
+ pr " print_%s (r);\n" typ;
+ pr " guestfs_free_%s (r);\n" typ;
+ pr " return 0;\n"
| RStructList (_, typ) ->
- pr " if (r == NULL) return -1;\n";
- pr " print_%s_list (r);\n" typ;
- pr " guestfs_free_%s_list (r);\n" typ;
- pr " return 0;\n"
+ pr " if (r == NULL) return -1;\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"
+ pr " if (r == NULL) return -1;\n";
+ pr " print_table (r);\n";
+ pr " free_strings (r);\n";
+ pr " return 0;\n"
+ | RBufferOut _ ->
+ pr " if (r == NULL) return -1;\n";
+ pr " fwrite (r, size, 1, stdout);\n";
+ pr " free (r);\n";
+ pr " return 0;\n"
);
pr "}\n";
pr "\n"
fun (name, _, _, flags, _, _, _) ->
let name2 = replace_char name '_' '-' in
let alias =
- try find_map (function FishAlias n -> Some n | _ -> None) flags
- with Not_found -> name in
+ try find_map (function FishAlias n -> Some n | _ -> None) flags
+ with Not_found -> name in
pr " if (";
pr "strcasecmp (cmd, \"%s\") == 0" name;
if name <> name2 then
- pr " || strcasecmp (cmd, \"%s\") == 0" name2;
+ pr " || strcasecmp (cmd, \"%s\") == 0" name2;
if name <> alias then
- pr " || strcasecmp (cmd, \"%s\") == 0" alias;
+ pr " || strcasecmp (cmd, \"%s\") == 0" alias;
pr ")\n";
pr " return run_%s (cmd, argc, argv);\n" name;
pr " else\n";
) all_functions;
pr " {\n";
- pr " fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
+ pr " fprintf (stderr, _(\"%%s: unknown command\\n\"), cmd);\n";
pr " return -1;\n";
pr " }\n";
pr " return 0;\n";
let commands =
List.map (
fun (name, _, _, flags, _, _, _) ->
- let name2 = replace_char name '_' '-' in
- let alias =
- try find_map (function FishAlias n -> Some n | _ -> None) flags
- with Not_found -> name in
+ let name2 = replace_char name '_' '-' in
+ let alias =
+ try find_map (function FishAlias n -> Some n | _ -> None) flags
+ with Not_found -> name in
- if name <> alias then [name2; alias] else [name2]
+ if name <> alias then [name2; alias] else [name2]
) all_functions in
let commands = List.flatten commands in
let all_functions_sorted =
List.filter (
fun (_, _, _, flags, _, _, _) ->
- not (List.mem NotInFish flags || List.mem NotInDocs flags)
+ not (List.mem NotInFish flags || List.mem NotInDocs flags)
) all_functions_sorted in
let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
List.iter (
fun (name, style, _, flags, _, _, longdesc) ->
let longdesc =
- Str.global_substitute rex (
- fun s ->
- let sub =
- try Str.matched_group 1 s
- with Not_found ->
- failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
- "C<" ^ replace_char sub '_' '-' ^ ">"
- ) longdesc in
+ Str.global_substitute rex (
+ fun s ->
+ let sub =
+ try Str.matched_group 1 s
+ with Not_found ->
+ failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
+ "C<" ^ replace_char sub '_' '-' ^ ">"
+ ) longdesc in
let name = replace_char name '_' '-' in
let alias =
- try find_map (function FishAlias n -> Some n | _ -> None) flags
- with Not_found -> name in
+ try find_map (function FishAlias n -> Some n | _ -> None) flags
+ with Not_found -> name in
pr "=head2 %s" name;
if name <> alias then
- pr " | %s" alias;
+ pr " | %s" alias;
pr "\n";
pr "\n";
pr " %s" name;
List.iter (
- function
- | String n -> pr " %s" n
- | OptString n -> pr " %s" n
- | StringList n -> pr " '%s ...'" n
- | Bool _ -> pr " true|false"
- | Int n -> pr " %s" n
- | FileIn n | FileOut n -> pr " (%s|-)" n
+ function
+ | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
+ | OptString n -> pr " %s" n
+ | StringList n | DeviceList n -> pr " '%s ...'" n
+ | Bool _ -> pr " true|false"
+ | Int n -> pr " %s" n
+ | FileIn n | FileOut n -> pr " (%s|-)" n
) (snd style);
pr "\n";
pr "\n";
pr "%s\n\n" longdesc;
if List.exists (function FileIn _ | FileOut _ -> true
- | _ -> false) (snd style) then
- pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
+ | _ -> false) (snd style) then
+ pr "Use C<-> instead of a filename to read/write from stdin/stdout.\n\n";
if List.mem ProtocolLimitWarning flags then
- pr "%s\n\n" protocol_limit_warning;
+ pr "%s\n\n" protocol_limit_warning;
if List.mem DangerWillRobinson flags then
- pr "%s\n\n" danger_will_robinson
+ pr "%s\n\n" danger_will_robinson;
+
+ match deprecation_notice flags with
+ | None -> ()
+ | Some txt -> pr "%s\n\n" txt
) all_functions_sorted
(* Generate a C function prototype. *)
| RInt _ -> pr "int "
| RInt64 _ -> pr "int64_t "
| RBool _ -> pr "int "
- | RConstString _ -> pr "const char *"
- | RString _ -> pr "char *"
+ | RConstString _ | RConstOptString _ -> pr "const char *"
+ | RString _ | RBufferOut _ -> pr "char *"
| RStringList _ | RHashtable _ -> pr "char **"
| RStruct (_, typ) ->
if not in_daemon then pr "struct guestfs_%s *" typ
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
);
let next () =
if !comma then (
- if single_line then pr ", " else pr ",\n\t\t"
+ if single_line then pr ", " else pr ",\n\t\t"
);
comma := true
in
List.iter (
function
+ | Pathname n
+ | Device n | Dev_or_Path n
| String n
| OptString n ->
- next ();
- if not in_daemon then pr "const char *%s" n
- else pr "char *%s" n
- | StringList n ->
- next ();
- if not in_daemon then pr "char * const* const %s" n
- else pr "char **%s" n
+ next ();
+ pr "const char *%s" n
+ | StringList n | DeviceList n ->
+ next ();
+ pr "char *const *%s" n
| Bool n -> next (); pr "int %s" n
| Int n -> next (); pr "int %s" n
| FileIn n
| FileOut n ->
- if not in_daemon then (next (); pr "const char *%s" 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. *)
List.iter (
fun (typ, cols) ->
let has_optpercent_col =
- List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
+ List.exists (function (_, FOptPercent) -> true | _ -> false) cols in
pr "static CAMLprim value\n";
pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
pr "{\n";
pr " CAMLparam0 ();\n";
if has_optpercent_col then
- pr " CAMLlocal3 (rv, v, v2);\n"
+ pr " CAMLlocal3 (rv, v, v2);\n"
else
- pr " CAMLlocal2 (rv, v);\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, FString ->
- pr " v = caml_copy_string (%s->%s);\n" typ name
- | name, FUUID ->
- pr " v = caml_alloc_string (32);\n";
- pr " memcpy (String_val (v), %s->%s, 32);\n" typ name
- | name, (FBytes|FInt64|FUInt64) ->
- pr " v = caml_copy_int64 (%s->%s);\n" typ name
- | 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
+ fun i col ->
+ (match col with
+ | name, FString ->
+ pr " v = caml_copy_string (%s->%s);\n" typ name
+ | 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, (FBytes|FInt64|FUInt64) ->
+ pr " v = caml_copy_int64 (%s->%s);\n" typ name
+ | 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 " CAMLreturn (rv);\n";
pr "}\n";
pr "static CAMLprim value\n";
pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n"
- typ typ typ;
+ typ typ typ;
pr "{\n";
pr " CAMLparam0 ();\n";
pr " CAMLlocal2 (rv, v);\n";
List.iter (
fun (name, style, _, _, _, _, _) ->
let params =
- "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
+ "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
+
+ let needs_extra_vs =
+ match fst style with RConstOptString _ -> true | _ -> false in
pr "CAMLprim value\n";
pr "ocaml_guestfs_%s (value %s" name (List.hd params);
(match params with
| [p1; p2; p3; p4; p5] ->
- pr " CAMLparam5 (%s);\n" (String.concat ", " params)
+ pr " CAMLparam5 (%s);\n" (String.concat ", " params)
| p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
- pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
- pr " CAMLxparam%d (%s);\n"
- (List.length rest) (String.concat ", " rest)
+ pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
+ pr " CAMLxparam%d (%s);\n"
+ (List.length rest) (String.concat ", " rest)
| ps ->
- pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
+ pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
);
- pr " CAMLlocal1 (rv);\n";
+ if not needs_extra_vs then
+ pr " CAMLlocal1 (rv);\n"
+ else
+ pr " CAMLlocal3 (rv, v, v2);\n";
pr "\n";
pr " guestfs_h *g = Guestfs_val (gv);\n";
pr "\n";
List.iter (
- function
- | String n
- | FileIn n
- | FileOut n ->
- pr " const char *%s = String_val (%sv);\n" n n
- | OptString n ->
- pr " const char *%s =\n" n;
- pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
- n n
- | StringList n ->
- pr " char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
- | Bool n ->
- pr " int %s = Bool_val (%sv);\n" n n
- | Int n ->
- pr " int %s = Int_val (%sv);\n" n n
+ function
+ | Pathname n
+ | Device n | Dev_or_Path n
+ | String n
+ | FileIn n
+ | FileOut n ->
+ pr " const char *%s = String_val (%sv);\n" n n
+ | OptString n ->
+ pr " const char *%s =\n" n;
+ pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
+ n n
+ | StringList n | DeviceList n ->
+ pr " char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
+ | Bool n ->
+ pr " int %s = Bool_val (%sv);\n" n n
+ | Int n ->
+ pr " int %s = Int_val (%sv);\n" n n
) (snd style);
let error_code =
- match fst style with
- | RErr -> pr " int r;\n"; "-1"
- | RInt _ -> pr " int r;\n"; "-1"
- | RInt64 _ -> pr " int64_t r;\n"; "-1"
- | RBool _ -> pr " int r;\n"; "-1"
- | RConstString _ -> pr " const char *r;\n"; "NULL"
- | RString _ -> pr " char *r;\n"; "NULL"
- | RStringList _ ->
- pr " int i;\n";
- pr " char **r;\n";
- "NULL"
- | RStruct (_, typ) ->
- pr " struct guestfs_%s *r;\n" typ; "NULL"
- | RStructList (_, typ) ->
- pr " struct guestfs_%s_list *r;\n" typ; "NULL"
- | RHashtable _ ->
- pr " int i;\n";
- pr " char **r;\n";
- "NULL" in
+ match fst style with
+ | RErr -> pr " int r;\n"; "-1"
+ | RInt _ -> pr " int r;\n"; "-1"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1"
+ | RBool _ -> pr " int r;\n"; "-1"
+ | RConstString _ | RConstOptString _ ->
+ pr " const char *r;\n"; "NULL"
+ | RString _ -> pr " char *r;\n"; "NULL"
+ | RStringList _ ->
+ pr " int i;\n";
+ pr " char **r;\n";
+ "NULL"
+ | RStruct (_, typ) ->
+ pr " struct guestfs_%s *r;\n" typ; "NULL"
+ | RStructList (_, typ) ->
+ pr " struct guestfs_%s_list *r;\n" typ; "NULL"
+ | RHashtable _ ->
+ pr " int i;\n";
+ pr " char **r;\n";
+ "NULL"
+ | 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";
List.iter (
- function
- | StringList n ->
- pr " ocaml_guestfs_free_strings (%s);\n" n;
- | String _ | OptString _ | Bool _ | Int _ | FileIn _ | FileOut _ -> ()
+ function
+ | StringList n | DeviceList n ->
+ pr " ocaml_guestfs_free_strings (%s);\n" n;
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ | Bool _ | Int _
+ | FileIn _ | FileOut _ -> ()
) (snd style);
pr " if (r == %s)\n" error_code;
| RErr -> pr " rv = Val_unit;\n"
| RInt _ -> pr " rv = Val_int (r);\n"
| RInt64 _ ->
- pr " rv = caml_copy_int64 (r);\n"
+ pr " rv = caml_copy_int64 (r);\n"
| RBool _ -> pr " rv = Val_bool (r);\n"
- | RConstString _ -> pr " rv = caml_copy_string (r);\n"
+ | RConstString _ ->
+ pr " rv = caml_copy_string (r);\n"
+ | RConstOptString _ ->
+ pr " if (r) { /* Some string */\n";
+ pr " v = caml_alloc (1, 0);\n";
+ pr " v2 = caml_copy_string (r);\n";
+ pr " Store_field (v, 0, v2);\n";
+ pr " } else /* None */\n";
+ pr " v = Val_int (0);\n";
| RString _ ->
- pr " rv = caml_copy_string (r);\n";
- pr " free (r);\n"
+ pr " rv = caml_copy_string (r);\n";
+ pr " free (r);\n"
| RStringList _ ->
- 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"
+ 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"
| RStruct (_, typ) ->
- pr " rv = copy_%s (r);\n" typ;
- pr " guestfs_free_%s (r);\n" 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;
+ 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";
+ pr " rv = copy_table (r);\n";
+ pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
+ pr " free (r);\n";
+ | RBufferOut _ ->
+ pr " rv = caml_alloc_string (size);\n";
+ pr " memcpy (String_val (rv), r, size);\n";
);
pr " CAMLreturn (rv);\n";
pr "\n";
if List.length params > 5 then (
- pr "CAMLprim value\n";
- pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
- pr "{\n";
- pr " return ocaml_guestfs_%s (argv[0]" name;
- iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
- pr ");\n";
- pr "}\n";
- pr "\n"
+ pr "CAMLprim value\n";
+ pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
+ pr "{\n";
+ pr " return ocaml_guestfs_%s (argv[0]" name;
+ iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
+ pr ");\n";
+ pr "}\n";
+ pr "\n"
)
) all_functions
fun (typ, cols) ->
pr "type %s = {\n" typ;
List.iter (
- function
- | name, FString -> 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
+ function
+ | 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"
pr "%s : t -> " name;
List.iter (
function
- | String _ | FileIn _ | FileOut _ -> pr "string -> "
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
| OptString _ -> pr "string option -> "
- | StringList _ -> pr "string array -> "
+ | StringList _ | DeviceList _ -> pr "string array -> "
| Bool _ -> pr "bool -> "
| Int _ -> pr "int -> "
) (snd style);
| RInt64 _ -> pr "int64"
| RBool _ -> pr "bool"
| RConstString _ -> pr "string"
- | RString _ -> pr "string"
+ | RConstOptString _ -> pr "string option"
+ | RString _ | RBufferOut _ -> pr "string"
| RStringList _ -> pr "string array"
| RStruct (_, typ) -> pr "%s" typ
| RStructList (_, typ) -> pr "%s array" typ
| RInt64 _ -> pr "SV *\n"
| RBool _ -> pr "SV *\n"
| RConstString _ -> pr "SV *\n"
+ | RConstOptString _ -> pr "SV *\n"
| RString _ -> pr "SV *\n"
+ | RBufferOut _ -> pr "SV *\n"
| RStringList _
| RStruct _ | RStructList _
| RHashtable _ ->
- pr "void\n" (* all lists returned implictly on the stack *)
+ 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 (
- fun i ->
- function
- | String n | FileIn n | FileOut n -> pr " char *%s;\n" n
- | OptString n ->
- (* http://www.perlmonks.org/?node_id=554277
- * Note that the implicit handle argument means we have
- * to add 1 to the ST(x) operator.
- *)
- pr " char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
- | StringList n -> pr " char **%s;\n" n
- | Bool n -> pr " int %s;\n" n
- | Int n -> pr " int %s;\n" n
+ fun i ->
+ function
+ | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
+ pr " char *%s;\n" n
+ | OptString n ->
+ (* http://www.perlmonks.org/?node_id=554277
+ * Note that the implicit handle argument means we have
+ * to add 1 to the ST(x) operator.
+ *)
+ pr " char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
+ | StringList n | DeviceList n -> pr " char **%s;\n" n
+ | Bool n -> pr " int %s;\n" n
+ | Int n -> pr " int %s;\n" n
) (snd style);
let do_cleanups () =
- List.iter (
- function
- | String _ | OptString _ | Bool _ | Int _
- | FileIn _ | FileOut _ -> ()
- | StringList n -> pr " free (%s);\n" n
- ) (snd style)
+ List.iter (
+ function
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ | Bool _ | Int _
+ | FileIn _ | FileOut _ -> ()
+ | StringList n | DeviceList n -> pr " free (%s);\n" n
+ ) (snd style)
in
(* Code. *)
(match fst style with
| RErr ->
- pr "PREINIT:\n";
- pr " int r;\n";
- pr " PPCODE:\n";
- pr " r = guestfs_%s " name;
- generate_call_args ~handle:"g" (snd style);
- pr ";\n";
- do_cleanups ();
- pr " if (r == -1)\n";
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr "PREINIT:\n";
+ pr " int r;\n";
+ pr " PPCODE:\n";
+ pr " r = guestfs_%s " name;
+ generate_c_call_args ~handle:"g" style;
+ pr ";\n";
+ do_cleanups ();
+ pr " if (r == -1)\n";
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
| RInt n
| RBool n ->
- pr "PREINIT:\n";
- pr " int %s;\n" n;
- pr " CODE:\n";
- pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
- pr ";\n";
- do_cleanups ();
- pr " if (%s == -1)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
- pr " RETVAL = newSViv (%s);\n" n;
- pr " OUTPUT:\n";
- pr " RETVAL\n"
+ pr "PREINIT:\n";
+ pr " int %s;\n" n;
+ pr " CODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_c_call_args ~handle:"g" style;
+ pr ";\n";
+ do_cleanups ();
+ pr " if (%s == -1)\n" n;
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " RETVAL = newSViv (%s);\n" n;
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
| RInt64 n ->
- pr "PREINIT:\n";
- pr " int64_t %s;\n" n;
- pr " CODE:\n";
- pr " %s = guestfs_%s " n name;
- generate_call_args ~handle:"g" (snd style);
- pr ";\n";
- do_cleanups ();
- pr " if (%s == -1)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
- pr " RETVAL = my_newSVll (%s);\n" n;
- pr " OUTPUT:\n";
- pr " RETVAL\n"
+ pr "PREINIT:\n";
+ pr " int64_t %s;\n" n;
+ pr " CODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_c_call_args ~handle:"g" style;
+ pr ";\n";
+ do_cleanups ();
+ pr " if (%s == -1)\n" n;
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " RETVAL = my_newSVll (%s);\n" n;
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
| RConstString n ->
- pr "PREINIT:\n";
- pr " const char *%s;\n" n;
- pr " CODE:\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 " RETVAL = newSVpv (%s, 0);\n" n;
- pr " OUTPUT:\n";
- pr " RETVAL\n"
+ pr "PREINIT:\n";
+ pr " const char *%s;\n" n;
+ pr " CODE:\n";
+ pr " %s = guestfs_%s " n name;
+ 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 " RETVAL = newSVpv (%s, 0);\n" n;
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
+ | RConstOptString n ->
+ pr "PREINIT:\n";
+ pr " const char *%s;\n" n;
+ pr " CODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_c_call_args ~handle:"g" style;
+ pr ";\n";
+ do_cleanups ();
+ pr " if (%s == NULL)\n" n;
+ pr " RETVAL = &PL_sv_undef;\n";
+ pr " else\n";
+ pr " RETVAL = newSVpv (%s, 0);\n" n;
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
| RString n ->
- pr "PREINIT:\n";
- pr " char *%s;\n" n;
- pr " CODE:\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 " RETVAL = newSVpv (%s, 0);\n" n;
- pr " free (%s);\n" n;
- pr " OUTPUT:\n";
- pr " RETVAL\n"
+ pr "PREINIT:\n";
+ pr " char *%s;\n" n;
+ pr " CODE:\n";
+ pr " %s = guestfs_%s " n name;
+ 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 " RETVAL = newSVpv (%s, 0);\n" n;
+ pr " free (%s);\n" n;
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
| RStringList n | RHashtable n ->
- pr "PREINIT:\n";
- pr " char **%s;\n" n;
- pr " int i, n;\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 " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
- pr " EXTEND (SP, n);\n";
- pr " for (i = 0; i < n; ++i) {\n";
- pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
- pr " free (%s[i]);\n" n;
- pr " }\n";
- pr " free (%s);\n" n;
+ pr "PREINIT:\n";
+ pr " char **%s;\n" n;
+ pr " int i, n;\n";
+ pr " PPCODE:\n";
+ pr " %s = guestfs_%s " n name;
+ 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 " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
+ pr " EXTEND (SP, n);\n";
+ pr " for (i = 0; i < n; ++i) {\n";
+ pr " PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
+ pr " free (%s[i]);\n" n;
+ pr " }\n";
+ pr " free (%s);\n" n;
| RStruct (n, typ) ->
- let cols = cols_of_struct typ in
- generate_perl_struct_code typ cols name style n do_cleanups
+ 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
+ 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 " 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 (%s == NULL)\n" n;
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " RETVAL = newSVpv (%s, size);\n" n;
+ pr " free (%s);\n" n;
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
);
pr "\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;
List.iter (
function
| name, FString ->
- pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
- name (String.length name) n name
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
+ name (String.length name) n name
| name, FUUID ->
- pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
- name (String.length name) n name
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
+ name (String.length name) n name
+ | name, FBuffer ->
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
+ 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
+ pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
+ name (String.length name) n name
| name, FInt64 ->
- pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
- name (String.length name) n name
+ pr " (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
+ name (String.length name) n name
| name, (FInt32|FUInt32) ->
- pr " (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
- name (String.length name) n name
+ 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
+ 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
+ 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 " 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;
match col with
| name, FString ->
- pr " PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
- n name
+ 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
+ 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
+ pr " PUSHs (sv_2mortal (my_newSVull (%s->%s)));\n"
+ n name
| name, FInt64 ->
- pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
- n name
+ pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n"
+ n name
| name, (FInt32|FUInt32) ->
- pr " PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
- n name
+ pr " PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
+ n name
| name, FChar ->
- pr " PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
- n name
+ pr " PUSHs (sv_2mortal (newSVpv (&%s->%s, 1)));\n"
+ n name
| name, FOptPercent ->
- pr " PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
- n name
+ pr " PUSHs (sv_2mortal (newSVnv (%s->%s)));\n"
+ n name
) cols;
pr " free (%s);\n" n
List.iter (
fun (name, style, _, flags, _, _, longdesc) ->
if not (List.mem NotInDocs flags) then (
- let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
- pr "=item ";
- generate_perl_prototype name style;
- pr "\n\n";
- pr "%s\n\n" longdesc;
- if List.mem ProtocolLimitWarning flags then
- pr "%s\n\n" protocol_limit_warning;
- if List.mem DangerWillRobinson flags then
- pr "%s\n\n" danger_will_robinson
+ let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
+ pr "=item ";
+ generate_perl_prototype name style;
+ pr "\n\n";
+ pr "%s\n\n" longdesc;
+ if List.mem ProtocolLimitWarning flags then
+ pr "%s\n\n" protocol_limit_warning;
+ if List.mem DangerWillRobinson flags then
+ pr "%s\n\n" danger_will_robinson;
+ match deprecation_notice flags with
+ | None -> ()
+ | Some txt -> pr "%s\n\n" txt
)
) all_functions_sorted;
| RInt n
| RInt64 n
| RConstString n
- | RString n -> pr "$%s = " n
+ | RConstOptString n
+ | RString n
+ | RBufferOut n -> pr "$%s = " n
| RStruct (n,_)
| RHashtable n -> pr "%%%s = " n
| RStringList n
if !comma then pr ", ";
comma := true;
match arg with
- | String n | OptString n | Bool n | Int n | FileIn n | FileOut n ->
- pr "$%s" n
- | StringList n ->
- pr "\\@%s" n
+ | Pathname n | Device n | Dev_or_Path n | String n
+ | OptString n | Bool n | Int n | FileIn n | FileOut n ->
+ pr "$%s" n
+ | StringList n | DeviceList n ->
+ pr "\\@%s" n
) (snd style);
pr ");"
generate_header CStyle LGPLv2;
pr "\
+#include <Python.h>
+
#include <stdio.h>
#include <stdlib.h>
#include <assert.h>
-#include <Python.h>
-
#include \"guestfs.h\"
typedef struct {
}
/* This list should be freed (but not the strings) after use. */
-static const char **
+static char **
get_string_list (PyObject *obj)
{
int i, len;
- const char **r;
+ char **r;
assert (obj);
";
+ let emit_put_list_function typ =
+ pr "static PyObject *\n";
+ 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_%s (&%ss->val[i]));\n" typ typ;
+ pr " return list;\n";
+ pr "};\n";
+ pr "\n"
+ in
+
(* Structures, turned into Python dictionaries. *)
List.iter (
fun (typ, cols) ->
pr "\n";
pr " dict = PyDict_New ();\n";
List.iter (
- function
- | name, FString ->
- pr " PyDict_SetItemString (dict, \"%s\",\n" name;
- pr " PyString_FromString (%s->%s));\n"
- typ name
- | name, FUUID ->
- pr " PyDict_SetItemString (dict, \"%s\",\n" name;
- pr " PyString_FromStringAndSize (%s->%s, 32));\n"
- typ name
- | name, (FBytes|FUInt64) ->
- pr " PyDict_SetItemString (dict, \"%s\",\n" name;
- pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
- typ name
- | name, FInt64 ->
- pr " PyDict_SetItemString (dict, \"%s\",\n" name;
- pr " PyLong_FromLongLong (%s->%s));\n"
- typ name
- | 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"
- typ name;
- pr " else {\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
+ function
+ | name, FString ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyString_FromString (%s->%s));\n"
+ typ name
+ | 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, (FBytes|FUInt64) ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
+ typ name
+ | name, FInt64 ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyLong_FromLongLong (%s->%s));\n"
+ typ name
+ | 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"
+ typ name;
+ pr " else {\n";
+ pr " Py_INCREF (Py_None);\n";
+ pr " PyDict_SetItemString (dict, \"%s\", Py_None);\n" 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_%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_%s (&%ss->val[i]));\n" typ typ;
- pr " return list;\n";
- pr "};\n";
- pr "\n"
) structs;
+ (* Emit a put_TYPE_list function definition only if that function is used. *)
+ List.iter (
+ function
+ | typ, (RStructListOnly | RStructAndList) ->
+ (* generate the function for typ *)
+ emit_put_list_function typ
+ | typ, _ -> () (* empty *)
+ ) rstructs_used;
+
(* Python wrapper functions. *)
List.iter (
fun (name, style, _, _, _, _, _) ->
pr " PyObject *py_r;\n";
let error_code =
- match fst style with
- | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
- | RInt64 _ -> pr " int64_t r;\n"; "-1"
- | RConstString _ -> pr " const char *r;\n"; "NULL"
- | RString _ -> pr " char *r;\n"; "NULL"
- | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
- | RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ; "NULL"
- | RStructList (_, typ) ->
- pr " struct guestfs_%s_list *r;\n" typ; "NULL" in
+ match fst style with
+ | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1"
+ | RConstString _ | RConstOptString _ ->
+ pr " const char *r;\n"; "NULL"
+ | RString _ -> pr " char *r;\n"; "NULL"
+ | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
+ | RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ; "NULL"
+ | RStructList (_, typ) ->
+ pr " struct guestfs_%s_list *r;\n" typ; "NULL"
+ | RBufferOut _ ->
+ pr " char *r;\n";
+ pr " size_t size;\n";
+ "NULL" in
List.iter (
- function
- | String n | FileIn n | FileOut n -> pr " const char *%s;\n" n
- | OptString n -> pr " const char *%s;\n" n
- | StringList n ->
- pr " PyObject *py_%s;\n" n;
- pr " const char **%s;\n" n
- | Bool n -> pr " int %s;\n" n
- | Int n -> pr " int %s;\n" n
+ function
+ | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
+ pr " const char *%s;\n" n
+ | OptString n -> pr " const char *%s;\n" n
+ | StringList n | DeviceList n ->
+ pr " PyObject *py_%s;\n" n;
+ pr " char **%s;\n" n
+ | Bool n -> pr " int %s;\n" n
+ | Int n -> pr " int %s;\n" n
) (snd style);
pr "\n";
(* Convert the parameters. *)
pr " if (!PyArg_ParseTuple (args, (char *) \"O";
List.iter (
- function
- | String _ | FileIn _ | FileOut _ -> pr "s"
- | OptString _ -> pr "z"
- | StringList _ -> pr "O"
- | Bool _ -> pr "i" (* XXX Python has booleans? *)
- | Int _ -> pr "i"
+ function
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
+ | OptString _ -> pr "z"
+ | StringList _ | DeviceList _ -> pr "O"
+ | Bool _ -> pr "i" (* XXX Python has booleans? *)
+ | Int _ -> pr "i"
) (snd style);
pr ":guestfs_%s\",\n" name;
pr " &py_g";
List.iter (
- function
- | String n | FileIn n | FileOut n -> pr ", &%s" n
- | OptString n -> pr ", &%s" n
- | StringList n -> pr ", &py_%s" n
- | Bool n -> pr ", &%s" n
- | Int n -> pr ", &%s" n
+ function
+ | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
+ | OptString n -> pr ", &%s" n
+ | StringList n | DeviceList n -> pr ", &py_%s" n
+ | Bool n -> pr ", &%s" n
+ | Int n -> pr ", &%s" n
) (snd style);
pr "))\n";
pr " g = get_handle (py_g);\n";
List.iter (
- function
- | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
- | StringList n ->
- pr " %s = get_string_list (py_%s);\n" n n;
- pr " if (!%s) return NULL;\n" n
+ function
+ | Pathname _ | Device _ | Dev_or_Path _ | String _
+ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
+ | StringList n | DeviceList n ->
+ pr " %s = get_string_list (py_%s);\n" n n;
+ pr " if (!%s) return NULL;\n" n
) (snd style);
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 (
- function
- | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
- | StringList n ->
- pr " free (%s);\n" n
+ function
+ | Pathname _ | Device _ | Dev_or_Path _ | String _
+ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
+ | StringList n | DeviceList n ->
+ pr " free (%s);\n" n
) (snd style);
pr " if (r == %s) {\n" error_code;
(match fst style with
| RErr ->
- pr " Py_INCREF (Py_None);\n";
- pr " py_r = Py_None;\n"
+ pr " Py_INCREF (Py_None);\n";
+ pr " py_r = Py_None;\n"
| RInt _
| RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
| RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
| RConstString _ -> pr " py_r = PyString_FromString (r);\n"
+ | RConstOptString _ ->
+ pr " if (r)\n";
+ pr " py_r = PyString_FromString (r);\n";
+ pr " else {\n";
+ pr " Py_INCREF (Py_None);\n";
+ pr " py_r = Py_None;\n";
+ pr " }\n"
| RString _ ->
- pr " py_r = PyString_FromString (r);\n";
- pr " free (r);\n"
+ pr " py_r = PyString_FromString (r);\n";
+ pr " free (r);\n"
| RStringList _ ->
- pr " py_r = put_string_list (r);\n";
- pr " free_strings (r);\n"
+ pr " py_r = put_string_list (r);\n";
+ pr " free_strings (r);\n"
| RStruct (_, typ) ->
- pr " py_r = put_%s (r);\n" typ;
- pr " guestfs_free_%s (r);\n" 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
+ 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"
+ pr " py_r = put_table (r);\n";
+ pr " free_strings (r);\n"
+ | RBufferOut _ ->
+ pr " py_r = PyString_FromStringAndSize (r, size);\n";
+ pr " free (r);\n"
);
pr " return py_r;\n";
List.iter (
fun (name, _, _, _, _, _, _) ->
pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
- name name
+ name name
) all_functions;
pr " { NULL, NULL, 0, NULL }\n";
pr "};\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 = replace_str longdesc "C<guestfs_" "C<g." in
- let doc =
+ let doc = replace_str longdesc "C<guestfs_" "C<g." in
+ let doc =
match fst style with
- | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
- | RString _ -> doc
- | RStringList _ ->
- doc ^ "\n\nThis function returns a list of strings."
- | 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." in
- let doc =
- if List.mem ProtocolLimitWarning flags then
- doc ^ "\n\n" ^ protocol_limit_warning
- else doc in
- let doc =
- if List.mem DangerWillRobinson flags then
- doc ^ "\n\n" ^ danger_will_robinson
- else doc in
- let doc = pod2text ~width:60 name doc in
- let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
- let doc = String.concat "\n " doc in
- pr " u\"\"\"%s\"\"\"\n" doc;
+ | RErr | RInt _ | RInt64 _ | RBool _
+ | RConstOptString _ | RConstString _
+ | RString _ | RBufferOut _ -> doc
+ | RStringList _ ->
+ doc ^ "\n\nThis function returns a list of strings."
+ | 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." in
+ let doc =
+ if List.mem ProtocolLimitWarning flags then
+ doc ^ "\n\n" ^ protocol_limit_warning
+ else doc in
+ let doc =
+ if List.mem DangerWillRobinson flags then
+ doc ^ "\n\n" ^ danger_will_robinson
+ else doc in
+ let doc =
+ match deprecation_notice flags with
+ | None -> doc
+ | Some txt -> doc ^ "\n\n" ^ txt in
+ let doc = pod2text ~width:60 name doc in
+ let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
+ let doc = String.concat "\n " doc in
+ 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.
*
let rec loop i =
let line = input_line chan in
if i = 1 then (* discard the first line of output *)
- loop (i+1)
+ loop (i+1)
else (
- let line = triml line in
- lines := line :: !lines;
- loop (i+1)
+ let line = triml line in
+ lines := line :: !lines;
+ loop (i+1)
) in
let lines = try loop 1 with End_of_file -> List.rev !lines in
Unix.unlink filename;
(match Unix.close_process_in chan with
| Unix.WEXITED 0 -> ()
| Unix.WEXITED i ->
- failwithf "pod2text: process exited with non-zero status (%d)" i
+ failwithf "pod2text: process exited with non-zero status (%d)" i
| Unix.WSIGNALED i | Unix.WSTOPPED i ->
- failwithf "pod2text: process signalled or stopped by signal %d" i
+ failwithf "pod2text: process signalled or stopped by signal %d" i
);
Hashtbl.add pod2text_memo key lines;
- let chan = open_out pod2text_memo_filename in
- output_value chan pod2text_memo;
- close_out chan;
+ pod2text_memo_updated ();
lines
(* Generate ruby bindings. *)
pr " Data_Get_Struct (gv, guestfs_h, g);\n";
pr " if (!g)\n";
pr " rb_raise (rb_eArgError, \"%%s: used handle after closing it\", \"%s\");\n"
- name;
+ name;
pr "\n";
List.iter (
- function
- | String n | FileIn n | FileOut n ->
- pr " Check_Type (%sv, T_STRING);\n" n;
- pr " const char *%s = StringValueCStr (%sv);\n" n n;
- pr " if (!%s)\n" n;
- pr " rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
- pr " \"%s\", \"%s\");\n" n name
- | OptString n ->
- pr " const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
- | StringList n ->
- pr " char **%s;\n" n;
- pr " Check_Type (%sv, T_ARRAY);\n" n;
- pr " {\n";
- pr " int i, len;\n";
- pr " len = RARRAY_LEN (%sv);\n" n;
- pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
- n;
- pr " for (i = 0; i < len; ++i) {\n";
- pr " VALUE v = rb_ary_entry (%sv, i);\n" n;
- pr " %s[i] = StringValueCStr (v);\n" n;
- pr " }\n";
- pr " %s[len] = NULL;\n" n;
- pr " }\n";
- | Bool n ->
- pr " int %s = RTEST (%sv);\n" n n
- | Int n ->
- pr " int %s = NUM2INT (%sv);\n" n n
+ function
+ | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
+ pr " Check_Type (%sv, T_STRING);\n" n;
+ pr " const char *%s = StringValueCStr (%sv);\n" n n;
+ pr " if (!%s)\n" n;
+ pr " rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
+ pr " \"%s\", \"%s\");\n" n name
+ | OptString n ->
+ pr " const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
+ | StringList n | DeviceList n ->
+ pr " char **%s;\n" n;
+ pr " Check_Type (%sv, T_ARRAY);\n" n;
+ pr " {\n";
+ pr " int i, len;\n";
+ pr " len = RARRAY_LEN (%sv);\n" n;
+ pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
+ n;
+ pr " for (i = 0; i < len; ++i) {\n";
+ pr " VALUE v = rb_ary_entry (%sv, i);\n" n;
+ pr " %s[i] = StringValueCStr (v);\n" n;
+ pr " }\n";
+ pr " %s[len] = NULL;\n" n;
+ pr " }\n";
+ | Bool n ->
+ pr " int %s = RTEST (%sv);\n" n n
+ | Int n ->
+ pr " int %s = NUM2INT (%sv);\n" n n
) (snd style);
pr "\n";
let error_code =
- match fst style with
- | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
- | RInt64 _ -> pr " int64_t r;\n"; "-1"
- | RConstString _ -> pr " const char *r;\n"; "NULL"
- | RString _ -> pr " char *r;\n"; "NULL"
- | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
- | RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ; "NULL"
- | RStructList (_, typ) ->
- pr " struct guestfs_%s_list *r;\n" typ; "NULL" in
+ match fst style with
+ | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1"
+ | RConstString _ | RConstOptString _ ->
+ pr " const char *r;\n"; "NULL"
+ | RString _ -> pr " char *r;\n"; "NULL"
+ | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
+ | RStruct (_, typ) -> pr " struct guestfs_%s *r;\n" typ; "NULL"
+ | RStructList (_, typ) ->
+ pr " struct guestfs_%s_list *r;\n" typ; "NULL"
+ | 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 (
- function
- | String _ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
- | StringList n ->
- pr " free (%s);\n" n
+ function
+ | Pathname _ | Device _ | Dev_or_Path _ | String _
+ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
+ | StringList n | DeviceList n ->
+ pr " free (%s);\n" n
) (snd style);
pr " if (r == %s)\n" error_code;
(match fst style with
| RErr ->
- pr " return Qnil;\n"
+ pr " return Qnil;\n"
| RInt _ | RBool _ ->
- pr " return INT2NUM (r);\n"
+ pr " return INT2NUM (r);\n"
| RInt64 _ ->
- pr " return ULL2NUM (r);\n"
+ pr " return ULL2NUM (r);\n"
| RConstString _ ->
- pr " return rb_str_new2 (r);\n";
+ pr " return rb_str_new2 (r);\n";
+ | RConstOptString _ ->
+ pr " if (r)\n";
+ pr " return rb_str_new2 (r);\n";
+ pr " else\n";
+ pr " return Qnil;\n";
| RString _ ->
- pr " VALUE rv = rb_str_new2 (r);\n";
- pr " free (r);\n";
- pr " return rv;\n";
+ pr " VALUE rv = rb_str_new2 (r);\n";
+ pr " free (r);\n";
+ pr " return rv;\n";
| RStringList _ ->
- pr " int i, len = 0;\n";
- pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
- pr " VALUE rv = rb_ary_new2 (len);\n";
- pr " for (i = 0; r[i] != NULL; ++i) {\n";
- pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
- pr " free (r[i]);\n";
- pr " }\n";
- pr " free (r);\n";
- pr " return rv;\n"
+ pr " int i, len = 0;\n";
+ pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
+ pr " VALUE rv = rb_ary_new2 (len);\n";
+ pr " for (i = 0; r[i] != NULL; ++i) {\n";
+ pr " rb_ary_push (rv, rb_str_new2 (r[i]));\n";
+ pr " free (r[i]);\n";
+ pr " }\n";
+ pr " free (r);\n";
+ pr " return rv;\n"
| RStruct (_, typ) ->
- let cols = cols_of_struct typ in
- generate_ruby_struct_code typ cols
+ 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
+ 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 " for (i = 0; r[i] != NULL; i+=2) {\n";
- pr " rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
- pr " free (r[i]);\n";
- pr " free (r[i+1]);\n";
- pr " }\n";
- pr " free (r);\n";
- pr " return rv;\n"
+ pr " VALUE rv = rb_hash_new ();\n";
+ pr " int i;\n";
+ pr " for (i = 0; r[i] != NULL; i+=2) {\n";
+ pr " rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
+ pr " free (r[i]);\n";
+ pr " free (r[i+1]);\n";
+ pr " }\n";
+ pr " free (r);\n";
+ pr " return rv;\n"
+ | RBufferOut _ ->
+ pr " VALUE rv = rb_str_new (r, size);\n";
+ pr " free (r);\n";
+ pr " return rv;\n";
);
pr "}\n";
List.iter (
function
| name, FString ->
- pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), rb_str_new2 (r->%s));\n" name name
+ 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
+ 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
+ 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
+ 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
+ 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
+ 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
+ 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
+ pr " rb_hash_aset (rv, rb_str_new2 (\"%s\"), ULL2NUM (r->%s));\n" name name
) cols;
pr " guestfs_free_%s (r);\n" typ;
pr " return rv;\n"
List.iter (
function
| name, FString ->
- pr " rb_hash_aset (hv, rb_str_new2 (\"%s\"), rb_str_new2 (r->val[i].%s));\n" name name
+ 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
+ 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
+ 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
+ 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
+ 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
+ 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
+ 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
+ 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";
List.iter (
fun (name, style, _, flags, _, shortdesc, longdesc) ->
if not (List.mem NotInDocs flags); then (
- let doc = replace_str longdesc "C<guestfs_" "C<g." in
- let doc =
- if List.mem ProtocolLimitWarning flags then
- doc ^ "\n\n" ^ protocol_limit_warning
- else doc in
- let doc =
- if List.mem DangerWillRobinson flags then
- doc ^ "\n\n" ^ danger_will_robinson
- else doc in
- let doc = pod2text ~width:60 name doc in
- let doc = List.map ( (* RHBZ#501883 *)
- function
- | "" -> "<p>"
- | nonempty -> nonempty
- ) doc in
- let doc = String.concat "\n * " doc in
-
- pr " /**\n";
- pr " * %s\n" shortdesc;
- pr " * <p>\n";
- pr " * %s\n" doc;
- pr " * @throws LibGuestFSException\n";
- pr " */\n";
- pr " ";
+ let doc = replace_str longdesc "C<guestfs_" "C<g." in
+ let doc =
+ if List.mem ProtocolLimitWarning flags then
+ doc ^ "\n\n" ^ protocol_limit_warning
+ else doc in
+ let doc =
+ if List.mem DangerWillRobinson flags then
+ doc ^ "\n\n" ^ danger_will_robinson
+ else doc in
+ let doc =
+ match deprecation_notice flags with
+ | None -> doc
+ | Some txt -> doc ^ "\n\n" ^ txt in
+ let doc = pod2text ~width:60 name doc in
+ let doc = List.map ( (* RHBZ#501883 *)
+ function
+ | "" -> "<p>"
+ | nonempty -> nonempty
+ ) doc in
+ let doc = String.concat "\n * " doc in
+
+ pr " /**\n";
+ pr " * %s\n" shortdesc;
+ pr " * <p>\n";
+ pr " * %s\n" doc;
+ pr " * @throws LibGuestFSException\n";
+ pr " */\n";
+ pr " ";
);
generate_java_prototype ~public:true ~semicolon:false name style;
pr "\n";
pr " {\n";
pr " if (g == 0)\n";
pr " throw new LibGuestFSException (\"%s: handle is closed\");\n"
- name;
+ name;
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 _ | RConstOptString _ | RString _
+ | RBufferOut _ -> pr "String ";
| RStringList _ -> pr "String[] ";
| RStruct (_, typ) ->
let name = java_name_of_struct typ in
needs_comma := true;
match arg with
+ | Pathname n
+ | Device n | Dev_or_Path n
| String n
| OptString n
| FileIn n
| FileOut n ->
- pr "String %s" n
- | StringList n ->
- pr "String[] %s" n
+ pr "String %s" n
+ | StringList n | DeviceList n ->
+ pr "String[] %s" n
| Bool n ->
- pr "boolean %s" n
+ pr "boolean %s" n
| Int n ->
- pr "int %s" n
+ pr "int %s" n
) (snd style);
pr ")\n";
List.iter (
function
| name, FString
- | name, FUUID -> pr " public String %s;\n" name
+ | 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
+ pr " /* The next field is [0..100] or -1 meaning 'not present': */\n";
+ pr " public float %s;\n" name
) cols;
pr "}\n"
| RInt _ -> pr "jint ";
| RInt64 _ -> pr "jlong ";
| RBool _ -> pr "jboolean ";
- | RConstString _ | RString _ -> pr "jstring ";
+ | RConstString _ | RConstOptString _ | RString _
+ | RBufferOut _ -> pr "jstring ";
| RStruct _ | RHashtable _ ->
- pr "jobject ";
+ pr "jobject ";
| RStringList _ | RStructList _ ->
- pr "jobjectArray ";
+ pr "jobjectArray ";
);
pr "JNICALL\n";
pr "Java_com_redhat_et_libguestfs_GuestFS_";
pr "\n";
pr " (JNIEnv *env, jobject obj, jlong jg";
List.iter (
- function
- | String n
- | OptString n
- | FileIn n
- | FileOut n ->
- pr ", jstring j%s" n
- | StringList n ->
- pr ", jobjectArray j%s" n
- | Bool n ->
- pr ", jboolean j%s" n
- | Int n ->
- pr ", jint j%s" n
+ function
+ | Pathname n
+ | Device n | Dev_or_Path n
+ | String n
+ | OptString n
+ | FileIn n
+ | FileOut n ->
+ pr ", jstring j%s" n
+ | StringList n | DeviceList n ->
+ pr ", jobjectArray j%s" n
+ | Bool n ->
+ pr ", jboolean j%s" n
+ | Int n ->
+ pr ", jint j%s" n
) (snd style);
pr ")\n";
pr "{\n";
pr " guestfs_h *g = (guestfs_h *) (long) jg;\n";
let error_code, no_ret =
- match fst style with
- | RErr -> pr " int r;\n"; "-1", ""
- | RBool _
- | RInt _ -> pr " int r;\n"; "-1", "0"
- | RInt64 _ -> pr " int64_t r;\n"; "-1", "0"
- | RConstString _ -> pr " const char *r;\n"; "NULL", "NULL"
- | RString _ ->
- pr " jstring jr;\n";
- pr " char *r;\n"; "NULL", "NULL"
- | RStringList _ ->
- pr " jobjectArray jr;\n";
- pr " int r_len;\n";
- pr " jclass cl;\n";
- pr " jstring jstr;\n";
- pr " char **r;\n"; "NULL", "NULL"
- | RStruct (_, typ) ->
- pr " jobject jr;\n";
- pr " jclass cl;\n";
- pr " jfieldID fl;\n";
- 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_%s_list *r;\n" typ; "NULL", "NULL"
- | RHashtable _ -> pr " char **r;\n"; "NULL", "NULL" in
+ match fst style with
+ | RErr -> pr " int r;\n"; "-1", ""
+ | RBool _
+ | RInt _ -> pr " int r;\n"; "-1", "0"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1", "0"
+ | RConstString _ -> pr " const char *r;\n"; "NULL", "NULL"
+ | RConstOptString _ -> pr " const char *r;\n"; "NULL", "NULL"
+ | RString _ ->
+ pr " jstring jr;\n";
+ pr " char *r;\n"; "NULL", "NULL"
+ | RStringList _ ->
+ pr " jobjectArray jr;\n";
+ pr " int r_len;\n";
+ pr " jclass cl;\n";
+ pr " jstring jstr;\n";
+ pr " char **r;\n"; "NULL", "NULL"
+ | RStruct (_, typ) ->
+ pr " jobject jr;\n";
+ pr " jclass cl;\n";
+ pr " jfieldID fl;\n";
+ 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_%s_list *r;\n" typ; "NULL", "NULL"
+ | RHashtable _ -> pr " char **r;\n"; "NULL", "NULL"
+ | RBufferOut _ ->
+ pr " jstring jr;\n";
+ pr " char *r;\n";
+ pr " size_t size;\n";
+ "NULL", "NULL" in
List.iter (
- function
- | String n
- | OptString n
- | FileIn n
- | FileOut n ->
- pr " const char *%s;\n" n
- | StringList n ->
- pr " int %s_len;\n" n;
- pr " const char **%s;\n" n
- | Bool n
- | Int n ->
- pr " int %s;\n" n
+ function
+ | Pathname n
+ | Device n | Dev_or_Path n
+ | String n
+ | OptString n
+ | FileIn n
+ | FileOut n ->
+ pr " const char *%s;\n" n
+ | StringList n | DeviceList n ->
+ pr " int %s_len;\n" n;
+ pr " const char **%s;\n" n
+ | Bool n
+ | Int n ->
+ pr " int %s;\n" n
) (snd style);
let needs_i =
- (match fst style with
- | RStringList _ | RStructList _ -> true
- | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
- | RString _ | RStruct _ | RHashtable _ -> false) ||
- List.exists (function StringList _ -> true | _ -> false) (snd style) in
+ (match fst style with
+ | RStringList _ | RStructList _ -> true
+ | RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
+ | RConstOptString _
+ | RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
+ List.exists (function
+ | StringList _ -> true
+ | DeviceList _ -> true
+ | _ -> false) (snd style) in
if needs_i then
- pr " int i;\n";
+ pr " int i;\n";
pr "\n";
(* Get the parameters. *)
List.iter (
- function
- | String n
- | FileIn n
- | FileOut n ->
- pr " %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
- | OptString n ->
- (* This is completely undocumented, but Java null becomes
- * a NULL parameter.
- *)
- pr " %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
- | StringList n ->
- pr " %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
- pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
- pr " for (i = 0; i < %s_len; ++i) {\n" n;
- pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
- n;
- pr " %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
- pr " }\n";
- pr " %s[%s_len] = NULL;\n" n n;
- | Bool n
- | Int n ->
- pr " %s = j%s;\n" n n
+ function
+ | Pathname n
+ | Device n | Dev_or_Path n
+ | String n
+ | FileIn n
+ | FileOut n ->
+ pr " %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
+ | OptString n ->
+ (* This is completely undocumented, but Java null becomes
+ * a NULL parameter.
+ *)
+ pr " %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
+ | StringList n | DeviceList n ->
+ pr " %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
+ pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
+ pr " for (i = 0; i < %s_len; ++i) {\n" n;
+ pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
+ n;
+ pr " %s[i] = (*env)->GetStringUTFChars (env, o, NULL);\n" n;
+ pr " }\n";
+ pr " %s[%s_len] = NULL;\n" n n;
+ | Bool n
+ | Int n ->
+ pr " %s = j%s;\n" n n
) (snd style);
(* 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. *)
List.iter (
- function
- | String n
- | FileIn n
- | FileOut n ->
- pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
- | OptString n ->
- pr " if (j%s)\n" n;
- pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
- | StringList n ->
- pr " for (i = 0; i < %s_len; ++i) {\n" n;
- pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
- n;
- pr " (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
- pr " }\n";
- pr " free (%s);\n" n
- | Bool n
- | Int n -> ()
+ function
+ | Pathname n
+ | Device n | Dev_or_Path n
+ | String n
+ | FileIn n
+ | FileOut n ->
+ pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
+ | OptString n ->
+ pr " if (j%s)\n" n;
+ pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
+ | StringList n | DeviceList n ->
+ pr " for (i = 0; i < %s_len; ++i) {\n" n;
+ pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
+ n;
+ pr " (*env)->ReleaseStringUTFChars (env, o, %s[i]);\n" n;
+ pr " }\n";
+ pr " free (%s);\n" n
+ | Bool n
+ | Int n -> ()
) (snd style);
(* Check for errors. *)
| RBool _ -> pr " return (jboolean) r;\n"
| RInt64 _ -> pr " return (jlong) r;\n"
| RConstString _ -> pr " return (*env)->NewStringUTF (env, r);\n"
+ | RConstOptString _ ->
+ pr " return (*env)->NewStringUTF (env, r); /* XXX r NULL? */\n"
| RString _ ->
- pr " jr = (*env)->NewStringUTF (env, r);\n";
- pr " free (r);\n";
- pr " return jr;\n"
+ pr " jr = (*env)->NewStringUTF (env, r);\n";
+ pr " free (r);\n";
+ pr " return jr;\n"
| RStringList _ ->
- pr " for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
- pr " cl = (*env)->FindClass (env, \"java/lang/String\");\n";
- pr " jstr = (*env)->NewStringUTF (env, \"\");\n";
- pr " jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
- pr " for (i = 0; i < r_len; ++i) {\n";
- pr " jstr = (*env)->NewStringUTF (env, r[i]);\n";
- pr " (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
- pr " free (r[i]);\n";
- pr " }\n";
- pr " free (r);\n";
- pr " return jr;\n"
+ pr " for (r_len = 0; r[r_len] != NULL; ++r_len) ;\n";
+ pr " cl = (*env)->FindClass (env, \"java/lang/String\");\n";
+ pr " jstr = (*env)->NewStringUTF (env, \"\");\n";
+ pr " jr = (*env)->NewObjectArray (env, r_len, cl, jstr);\n";
+ pr " for (i = 0; i < r_len; ++i) {\n";
+ pr " jstr = (*env)->NewStringUTF (env, r[i]);\n";
+ pr " (*env)->SetObjectArrayElement (env, jr, i, jstr);\n";
+ pr " free (r[i]);\n";
+ pr " }\n";
+ pr " free (r);\n";
+ pr " return jr;\n"
| RStruct (_, typ) ->
- let jtyp = java_name_of_struct typ in
- let cols = cols_of_struct typ in
- generate_java_struct_return typ jtyp cols
+ 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
+ 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"
+ (* 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"
+ | RBufferOut _ ->
+ pr " jr = (*env)->NewStringUTF (env, r); /* XXX size */\n";
+ pr " free (r);\n";
+ pr " return jr;\n"
);
pr "}\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;
+ 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";
+ 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;
+ 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;
+ 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;
+ 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;
+ 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"
List.iter (
function
| 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;
+ 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, FUUID ->
- pr " {\n";
- pr " char s[33];\n";
- pr " memcpy (s, r->val[i].%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, jfl, fl, (*env)->NewStringUTF (env, s));\n";
- pr " }\n";
+ pr " {\n";
+ pr " char s[33];\n";
+ pr " memcpy (s, r->val[i].%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, jfl, fl, (*env)->NewStringUTF (env, s));\n";
+ pr " }\n";
+ | 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;
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"J\");\n" name;
+ pr " (*env)->SetLongField (env, jfl, fl, r->val[i].%s);\n" name;
| 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;
+ 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;
+ pr " fl = (*env)->GetFieldID (env, cl, \"%s\", \"F\");\n" name;
+ pr " (*env)->SetFloatField (env, jfl, fl, r->val[i].%s);\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;
+ 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";
pr " }\n";
pr " guestfs_free_%s_list (r);\n" typ;
pr " return jr;\n"
+and generate_java_makefile_inc () =
+ generate_header HashStyle GPLv2;
+
+ pr "java_built_sources = \\\n";
+ List.iter (
+ fun (typ, jtyp) ->
+ pr "\tcom/redhat/et/libguestfs/%s.java \\\n" jtyp;
+ ) java_structs;
+ pr "\tcom/redhat/et/libguestfs/GuestFS.java\n"
+
and generate_haskell_hs () =
generate_header HaskellStyle LGPLv2;
| RInt64 _, _ -> true
| RBool _, _
| RConstString _, _
+ | RConstOptString _, _
| RString _, _
| RStringList _, _
| RStruct _, _
| RStructList _, _
- | RHashtable _, _ -> false in
+ | RHashtable _, _
+ | RBufferOut _, _ -> false in
pr "\
{-# INCLUDE <guestfs.h> #-}
List.iter (
fun (name, style, _, _, _, _, _) ->
if can_generate style then (
- pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
- pr " :: ";
- generate_haskell_prototype ~handle:"GuestfsP" style;
- pr "\n";
- pr "\n";
- pr "%s :: " name;
- generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
- pr "\n";
- pr "%s %s = do\n" name
- (String.concat " " ("h" :: List.map name_of_argt (snd style)));
- pr " r <- ";
- (* Convert pointer arguments using with* functions. *)
- List.iter (
- function
- | FileIn n
- | FileOut n
- | String n -> pr "withCString %s $ \\%s -> " n n
- | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
- | StringList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
- | Bool _ | Int _ -> ()
- ) (snd style);
- (* Convert integer arguments. *)
- let args =
- List.map (
- function
- | Bool n -> sprintf "(fromBool %s)" n
- | Int n -> sprintf "(fromIntegral %s)" n
- | FileIn n | FileOut n | String n | OptString n | StringList n -> n
- ) (snd style) in
- pr "withForeignPtr h (\\p -> c_%s %s)\n" name
- (String.concat " " ("p" :: args));
- (match fst style with
- | RErr | RInt _ | RInt64 _ | RBool _ ->
- pr " if (r == -1)\n";
- pr " then do\n";
- pr " err <- last_error h\n";
- pr " fail err\n";
- | RConstString _ | RString _ | RStringList _ | RStruct _
- | RStructList _ | RHashtable _ ->
- pr " if (r == nullPtr)\n";
- pr " then do\n";
- pr " err <- last_error h\n";
- pr " fail err\n";
- );
- (match fst style with
- | RErr ->
- pr " else return ()\n"
- | RInt _ ->
- pr " else return (fromIntegral r)\n"
- | RInt64 _ ->
- pr " else return (fromIntegral r)\n"
- | RBool _ ->
- pr " else return (toBool r)\n"
- | RConstString _
- | RString _
- | RStringList _
- | RStruct _
- | RStructList _
- | RHashtable _ ->
- pr " else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
- );
- pr "\n";
+ pr "foreign import ccall unsafe \"guestfs_%s\" c_%s\n" name name;
+ pr " :: ";
+ generate_haskell_prototype ~handle:"GuestfsP" style;
+ pr "\n";
+ pr "\n";
+ pr "%s :: " name;
+ generate_haskell_prototype ~handle:"GuestfsH" ~hs:true style;
+ pr "\n";
+ pr "%s %s = do\n" name
+ (String.concat " " ("h" :: List.map name_of_argt (snd style)));
+ pr " r <- ";
+ (* Convert pointer arguments using with* functions. *)
+ List.iter (
+ function
+ | FileIn n
+ | FileOut n
+ | Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n
+ | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
+ | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
+ | Bool _ | Int _ -> ()
+ ) (snd style);
+ (* Convert integer arguments. *)
+ let args =
+ List.map (
+ function
+ | Bool n -> sprintf "(fromBool %s)" n
+ | Int n -> sprintf "(fromIntegral %s)" n
+ | FileIn n | FileOut n
+ | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
+ ) (snd style) in
+ pr "withForeignPtr h (\\p -> c_%s %s)\n" name
+ (String.concat " " ("p" :: args));
+ (match fst style with
+ | RErr | RInt _ | RInt64 _ | RBool _ ->
+ pr " if (r == -1)\n";
+ pr " then do\n";
+ pr " err <- last_error h\n";
+ pr " fail err\n";
+ | RConstString _ | RConstOptString _ | RString _
+ | RStringList _ | RStruct _
+ | RStructList _ | RHashtable _ | RBufferOut _ ->
+ pr " if (r == nullPtr)\n";
+ pr " then do\n";
+ pr " err <- last_error h\n";
+ pr " fail err\n";
+ );
+ (match fst style with
+ | RErr ->
+ pr " else return ()\n"
+ | RInt _ ->
+ pr " else return (fromIntegral r)\n"
+ | RInt64 _ ->
+ pr " else return (fromIntegral r)\n"
+ | RBool _ ->
+ pr " else return (toBool r)\n"
+ | RConstString _
+ | RConstOptString _
+ | RString _
+ | RStringList _
+ | RStruct _
+ | RStructList _
+ | RHashtable _
+ | RBufferOut _ ->
+ pr " else return ()\n" (* XXXXXXXXXXXXXXXXXXXX *)
+ );
+ pr "\n";
)
) all_functions
List.iter (
fun arg ->
(match arg with
- | String _ -> pr "%s" string
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
| OptString _ -> if hs then pr "Maybe String" else pr "CString"
- | StringList _ -> if hs then pr "[String]" else pr "Ptr CString"
+ | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
| Bool _ -> pr "%s" bool
| Int _ -> pr "%s" int
| FileIn _ -> pr "%s" string
| RInt64 _ -> pr "%s" int64
| RBool _ -> pr "%s" bool
| RConstString _ -> pr "%s" string
+ | RConstOptString _ -> pr "Maybe %s" string
| RString _ -> pr "%s" string
| RStringList _ -> pr "[%s]" string
| RStruct (_, typ) ->
let name = java_name_of_struct typ in
pr "[%s]" name
| RHashtable _ -> pr "Hashtable"
+ | RBufferOut _ -> pr "%s" string
);
pr ")"
#define safe_malloc guestfs_safe_malloc
static void
-print_strings (char * const* const argv)
+print_strings (char *const *argv)
{
int argc;
pr "{\n";
List.iter (
function
+ | Pathname n
+ | Device n | Dev_or_Path n
| String n
| FileIn n
| FileOut n -> pr " printf (\"%%s\\n\", %s);\n" n
| OptString n -> pr " printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
- | StringList n -> pr " print_strings (%s);\n" n
+ | StringList n | DeviceList n -> pr " print_strings (%s);\n" n
| Bool n -> pr " printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
| Int n -> pr " printf (\"%%d\\n\", %s);\n" n
) (snd style);
List.iter (
fun (name, style, _, _, _, _, _) ->
if String.sub name (String.length name - 3) 3 <> "err" then (
- pr "/* Test normal return. */\n";
- generate_prototype ~extern:false ~semicolon:false ~newline:true
- ~handle:"g" ~prefix:"guestfs_" name style;
- pr "{\n";
- (match fst style with
- | RErr ->
- pr " return 0;\n"
- | RInt _ ->
- pr " int r;\n";
- pr " sscanf (val, \"%%d\", &r);\n";
- pr " return r;\n"
- | RInt64 _ ->
- pr " int64_t r;\n";
- pr " sscanf (val, \"%%\" SCNi64, &r);\n";
- pr " return r;\n"
- | RBool _ ->
- pr " return strcmp (val, \"true\") == 0;\n"
- | RConstString _ ->
- (* Can't return the input string here. Return a static
- * string so we ensure we get a segfault if the caller
- * tries to free it.
- *)
- pr " return \"static string\";\n"
- | RString _ ->
- pr " return strdup (val);\n"
- | RStringList _ ->
- pr " char **strs;\n";
- pr " int n, i;\n";
- pr " sscanf (val, \"%%d\", &n);\n";
- pr " strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
- pr " for (i = 0; i < n; ++i) {\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"
- | RStruct (_, typ) ->
- pr " struct guestfs_%s *r;\n" typ;
- pr " r = safe_calloc (g, sizeof *r, 1);\n";
- pr " return r;\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 = 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 = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
- pr " for (i = 0; i < n; ++i) {\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"
- );
- pr "}\n";
- pr "\n"
+ pr "/* Test normal return. */\n";
+ generate_prototype ~extern:false ~semicolon:false ~newline:true
+ ~handle:"g" ~prefix:"guestfs_" name style;
+ pr "{\n";
+ (match fst style with
+ | RErr ->
+ pr " return 0;\n"
+ | RInt _ ->
+ pr " int r;\n";
+ pr " sscanf (val, \"%%d\", &r);\n";
+ pr " return r;\n"
+ | RInt64 _ ->
+ pr " int64_t r;\n";
+ pr " sscanf (val, \"%%\" SCNi64, &r);\n";
+ pr " return r;\n"
+ | RBool _ ->
+ pr " return strcmp (val, \"true\") == 0;\n"
+ | RConstString _
+ | RConstOptString _ ->
+ (* Can't return the input string here. Return a static
+ * string so we ensure we get a segfault if the caller
+ * tries to free it.
+ *)
+ pr " return \"static string\";\n"
+ | RString _ ->
+ pr " return strdup (val);\n"
+ | RStringList _ ->
+ pr " char **strs;\n";
+ pr " int n, i;\n";
+ pr " sscanf (val, \"%%d\", &n);\n";
+ pr " strs = safe_malloc (g, (n+1) * sizeof (char *));\n";
+ pr " for (i = 0; i < n; ++i) {\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"
+ | RStruct (_, typ) ->
+ pr " struct guestfs_%s *r;\n" typ;
+ pr " r = safe_calloc (g, sizeof *r, 1);\n";
+ pr " return r;\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 = 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 = safe_malloc (g, (n*2+1) * sizeof (*strs));\n";
+ pr " for (i = 0; i < n; ++i) {\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"
+ | RBufferOut _ ->
+ pr " return strdup (val);\n"
+ );
+ pr "}\n";
+ pr "\n"
) else (
- pr "/* Test error return. */\n";
- generate_prototype ~extern:false ~semicolon:false ~newline:true
- ~handle:"g" ~prefix:"guestfs_" name style;
- pr "{\n";
- pr " error (g, \"error\");\n";
- (match fst style with
- | RErr | RInt _ | RInt64 _ | RBool _ ->
- pr " return -1;\n"
- | RConstString _
- | RString _ | RStringList _ | RStruct _
- | RStructList _
- | RHashtable _ ->
- pr " return NULL;\n"
- );
- pr "}\n";
- pr "\n"
+ pr "/* Test error return. */\n";
+ generate_prototype ~extern:false ~semicolon:false ~newline:true
+ ~handle:"g" ~prefix:"guestfs_" name style;
+ pr "{\n";
+ pr " error (g, \"error\");\n";
+ (match fst style with
+ | RErr | RInt _ | RInt64 _ | RBool _ ->
+ pr " return -1;\n"
+ | RConstString _ | RConstOptString _
+ | RString _ | RStringList _ | RStruct _
+ | RStructList _
+ | RHashtable _
+ | RBufferOut _ ->
+ pr " return NULL;\n"
+ );
+ pr "}\n";
+ pr "\n"
)
) tests
let mkargs args =
String.concat " " (
List.map (
- function
- | CallString s -> "\"" ^ s ^ "\""
- | CallOptString None -> "None"
- | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
- | CallStringList xs ->
- "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
- | CallInt i when i >= 0 -> string_of_int i
- | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
- | CallBool b -> string_of_bool b
+ function
+ | CallString s -> "\"" ^ s ^ "\""
+ | CallOptString None -> "None"
+ | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
+ | CallStringList xs ->
+ "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
+ | CallInt i when i >= 0 -> string_of_int i
+ | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
+ | CallBool b -> string_of_bool b
) args
)
in
let mkargs args =
String.concat ", " (
List.map (
- function
- | CallString s -> "\"" ^ s ^ "\""
- | CallOptString None -> "undef"
- | CallOptString (Some s) -> sprintf "\"%s\"" s
- | CallStringList xs ->
- "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
- | CallInt i -> string_of_int i
- | CallBool b -> if b then "1" else "0"
+ function
+ | CallString s -> "\"" ^ s ^ "\""
+ | CallOptString None -> "undef"
+ | CallOptString (Some s) -> sprintf "\"%s\"" s
+ | CallStringList xs ->
+ "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
+ | CallInt i -> string_of_int i
+ | CallBool b -> if b then "1" else "0"
) args
)
in
let mkargs args =
String.concat ", " (
List.map (
- function
- | CallString s -> "\"" ^ s ^ "\""
- | CallOptString None -> "None"
- | CallOptString (Some s) -> sprintf "\"%s\"" s
- | CallStringList xs ->
- "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
- | CallInt i -> string_of_int i
- | CallBool b -> if b then "1" else "0"
+ function
+ | CallString s -> "\"" ^ s ^ "\""
+ | CallOptString None -> "None"
+ | CallOptString (Some s) -> sprintf "\"%s\"" s
+ | CallStringList xs ->
+ "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
+ | CallInt i -> string_of_int i
+ | CallBool b -> if b then "1" else "0"
) args
)
in
let mkargs args =
String.concat ", " (
List.map (
- function
- | CallString s -> "\"" ^ s ^ "\""
- | CallOptString None -> "nil"
- | CallOptString (Some s) -> sprintf "\"%s\"" s
- | CallStringList xs ->
- "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
- | CallInt i -> string_of_int i
- | CallBool b -> string_of_bool b
+ function
+ | CallString s -> "\"" ^ s ^ "\""
+ | CallOptString None -> "nil"
+ | CallOptString (Some s) -> sprintf "\"%s\"" s
+ | CallStringList xs ->
+ "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
+ | CallInt i -> string_of_int i
+ | CallBool b -> string_of_bool b
) args
)
in
let mkargs args =
String.concat ", " (
List.map (
- function
- | CallString s -> "\"" ^ s ^ "\""
- | CallOptString None -> "null"
- | CallOptString (Some s) -> sprintf "\"%s\"" s
- | CallStringList xs ->
- "new String[]{" ^
- String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
- | CallInt i -> string_of_int i
- | CallBool b -> string_of_bool b
+ function
+ | CallString s -> "\"" ^ s ^ "\""
+ | CallOptString None -> "null"
+ | CallOptString (Some s) -> sprintf "\"%s\"" s
+ | CallStringList xs ->
+ "new String[]{" ^
+ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
+ | CallInt i -> string_of_int i
+ | CallBool b -> string_of_bool b
) args
)
in
let mkargs args =
String.concat " " (
List.map (
- function
- | CallString s -> "\"" ^ s ^ "\""
- | CallOptString None -> "Nothing"
- | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
- | CallStringList xs ->
- "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
- | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
- | CallInt i -> string_of_int i
- | CallBool true -> "True"
- | CallBool false -> "False"
+ function
+ | CallString s -> "\"" ^ s ^ "\""
+ | CallOptString None -> "Nothing"
+ | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
+ | CallStringList xs ->
+ "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
+ | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
+ | CallInt i -> string_of_int i
+ | CallBool true -> "True"
+ | CallBool false -> "False"
) args
)
in
*)
and generate_lang_bindtests call =
call "test0" [CallString "abc"; CallOptString (Some "def");
- CallStringList []; CallBool false;
- CallInt 0; CallString "123"; CallString "456"];
+ CallStringList []; CallBool false;
+ CallInt 0; CallString "123"; CallString "456"];
call "test0" [CallString "abc"; CallOptString None;
- CallStringList []; CallBool false;
- CallInt 0; CallString "123"; CallString "456"];
+ CallStringList []; CallBool false;
+ CallInt 0; CallString "123"; CallString "456"];
call "test0" [CallString ""; CallOptString (Some "def");
- CallStringList []; CallBool false;
- CallInt 0; CallString "123"; CallString "456"];
+ CallStringList []; CallBool false;
+ CallInt 0; CallString "123"; CallString "456"];
call "test0" [CallString ""; CallOptString (Some "");
- CallStringList []; CallBool false;
- CallInt 0; CallString "123"; CallString "456"];
+ CallStringList []; CallBool false;
+ CallInt 0; CallString "123"; CallString "456"];
call "test0" [CallString "abc"; CallOptString (Some "def");
- CallStringList ["1"]; CallBool false;
- CallInt 0; CallString "123"; CallString "456"];
+ CallStringList ["1"]; CallBool false;
+ CallInt 0; CallString "123"; CallString "456"];
call "test0" [CallString "abc"; CallOptString (Some "def");
- CallStringList ["1"; "2"]; CallBool false;
- CallInt 0; CallString "123"; CallString "456"];
+ CallStringList ["1"; "2"]; CallBool false;
+ CallInt 0; CallString "123"; CallString "456"];
call "test0" [CallString "abc"; CallOptString (Some "def");
- CallStringList ["1"]; CallBool true;
- CallInt 0; CallString "123"; CallString "456"];
+ CallStringList ["1"]; CallBool true;
+ CallInt 0; CallString "123"; CallString "456"];
call "test0" [CallString "abc"; CallOptString (Some "def");
- CallStringList ["1"]; CallBool false;
- CallInt (-1); CallString "123"; CallString "456"];
+ CallStringList ["1"]; CallBool false;
+ CallInt (-1); CallString "123"; CallString "456"];
call "test0" [CallString "abc"; CallOptString (Some "def");
- CallStringList ["1"]; CallBool false;
- CallInt (-2); CallString "123"; CallString "456"];
+ CallStringList ["1"]; CallBool false;
+ CallInt (-2); CallString "123"; CallString "456"];
call "test0" [CallString "abc"; CallOptString (Some "def");
- CallStringList ["1"]; CallBool false;
- CallInt 1; CallString "123"; CallString "456"];
+ CallStringList ["1"]; CallBool false;
+ CallInt 1; CallString "123"; CallString "456"];
call "test0" [CallString "abc"; CallOptString (Some "def");
- CallStringList ["1"]; CallBool false;
- CallInt 2; CallString "123"; CallString "456"];
+ CallStringList ["1"]; CallBool false;
+ CallInt 2; CallString "123"; CallString "456"];
call "test0" [CallString "abc"; CallOptString (Some "def");
- CallStringList ["1"]; CallBool false;
- CallInt 4095; CallString "123"; CallString "456"];
+ CallStringList ["1"]; CallBool false;
+ CallInt 4095; CallString "123"; CallString "456"];
call "test0" [CallString "abc"; CallOptString (Some "def");
- CallStringList ["1"]; CallBool false;
- CallInt 0; CallString ""; CallString ""]
+ CallStringList ["1"]; CallBool false;
+ CallInt 0; CallString ""; CallString ""]
(* XXX Add here tests of the return and error functions. *)
close ();
) java_structs;
+ let close = output_to "java/Makefile.inc" in
+ generate_java_makefile_inc ();
+ close ();
+
let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in
generate_java_c ();
close ();
git.annexia.org / libguestfs.git / blobdiff