#!/usr/bin/env ocaml
(* libguestfs
- * Copyright (C) 2009 Red Hat Inc.
+ * Copyright (C) 2009-2010 Red Hat Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* all the daemon actions.
*
* To add a new action there are only two files you need to change,
- * this one to describe the interface (see the big table below), and
- * daemon/<somefile>.c to write the implementation.
+ * this one to describe the interface (see the big table of
+ * 'daemon_functions' below), and daemon/<somefile>.c to write the
+ * implementation.
*
- * After editing this file, run it (./src/generator.ml) to regenerate all the
- * output files. Note that if you are using a separate build directory you
- * must run generator.ml from the _source_ directory.
+ * After editing this file, run it (./src/generator.ml) to regenerate
+ * all the output files. 'make' will rerun this automatically when
+ * necessary. Note that if you are using a separate build directory
+ * you must run generator.ml from the _source_ directory.
*
* IMPORTANT: This script should NOT print any warnings. If it prints
* warnings, you should treat them as errors.
+ *
+ * OCaml tips:
+ * (1) In emacs, install tuareg-mode to display and format OCaml code
+ * correctly. 'vim' comes with a good OCaml editing mode by default.
+ * (2) Read the resources at http://ocaml-tutorial.org/
*)
#load "unix.cma";;
#load "str.cma";;
+#directory "+xml-light";;
+#directory "+../pkg-lib/xml-light";; (* for GODI users *)
+#load "xml-light.cma";;
+open Unix
open Printf
type style = ret * args
| DeviceList of string(* list of Device names (each cannot be NULL) *)
| Bool of string (* boolean *)
| Int of string (* int (smallish ints, signed, <= 31 bits) *)
+ | Int64 of string (* any 64 bit int *)
(* These are treated as filenames (simple string parameters) in
* the C API and bindings. But in the RPC protocol, we transfer
* the actual file content up to or down from the daemon.
*)
| 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.
+ * In the C API, this is expressed as <const char *, size_t> pair.
* Most other languages have a string type which can contain
* ASCII NUL. We use whatever type is appropriate for each
* language.
* To return an arbitrary buffer, use RBufferOut.
*)
| BufferIn of string
-*)
type flags =
| ProtocolLimitWarning (* display warning about protocol size limits *)
| DangerWillRobinson (* flags particularly dangerous commands *)
| FishAlias of string (* provide an alias for this cmd in guestfish *)
- | FishAction of string (* call this function in guestfish *)
+ | FishOutput of fish_output_t (* how to display output in guestfish *)
| NotInFish (* do not export via guestfish *)
| NotInDocs (* do not add this function to documentation *)
| DeprecatedBy of string (* function is deprecated, use .. instead *)
+ | Optional of string (* function is part of an optional group *)
+
+and fish_output_t =
+ | FishOutputOctal (* for int return, print in octal *)
+ | FishOutputHexadecimal (* for int return, print in hex *)
(* You can supply zero or as many tests as you want per API call.
*
(* As for 'If' but the test runs _unless_ the code returns true. *)
| Unless of string
+ (* Run the test only if 'string' is available in the daemon. *)
+ | IfAvailable of string
+
(* Some initial scenarios for testing. *)
and test_init =
(* Do nothing, block devices could contain random stuff including
(* Generate a random UUID (used in tests). *)
let uuidgen () =
- let chan = Unix.open_process_in "uuidgen" in
+ let chan = open_process_in "uuidgen" in
let uuid = input_line chan in
- (match Unix.close_process_in chan with
- | Unix.WEXITED 0 -> ()
- | Unix.WEXITED _ ->
+ (match close_process_in chan with
+ | WEXITED 0 -> ()
+ | WEXITED _ ->
failwith "uuidgen: process exited with non-zero status"
- | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
+ | WSIGNALED _ | WSTOPPED _ ->
failwith "uuidgen: process signalled or stopped by signal"
);
uuid
StringList "strlist";
Bool "b";
Int "integer";
+ Int64 "integer64";
FileIn "filein";
FileOut "fileout";
+ BufferIn "bufferin";
]
let test_all_rets = [
*)
let non_daemon_functions = test_functions @ [
- ("launch", (RErr, []), -1, [FishAlias "run"; FishAction "launch"],
+ ("launch", (RErr, []), -1, [FishAlias "run"],
[],
"launch the qemu subprocess",
"\
("wait_ready", (RErr, []), -1, [NotInFish],
[],
- "wait until the qemu subprocess launches",
+ "wait until the qemu subprocess launches (no op)",
"\
-Internally libguestfs is implemented by running a virtual machine
-using L<qemu(1)>.
+This function is a no op.
-You should call this after C<guestfs_launch> to wait for the launch
-to complete.");
+In versions of the API E<lt> 1.0.71 you had to call this function
+just after calling C<guestfs_launch> to wait for the launch
+to complete. However this is no longer necessary because
+C<guestfs_launch> now does the waiting.
+
+If you see any calls to this function in code then you can just
+remove them, unless you want to retain compatibility with older
+versions of the API.");
("kill_subprocess", (RErr, []), -1, [],
[],
This is equivalent to the qemu parameter
C<-drive file=filename,cache=off,if=...>.
+
C<cache=off> is omitted in cases where it is not supported by
the underlying filesystem.
+C<if=...> is set at compile time by the configuration option
+C<./configure --with-drive-if=...>. In the rare case where you
+might need to change this at run time, use C<guestfs_add_drive_with_if>
+or C<guestfs_add_drive_ro_with_if>.
+
Note that this call checks for the existence of C<filename>. This
stops you from specifying other types of drive which are supported
by qemu such as C<nbd:> and C<http:> URLs. To specify those, use
This is equivalent to the qemu parameter C<-cdrom filename>.
-Note that this call checks for the existence of C<filename>. This
+Notes:
+
+=over 4
+
+=item *
+
+This call checks for the existence of C<filename>. This
stops you from specifying other types of drive which are supported
by qemu such as C<nbd:> and C<http:> URLs. To specify those, use
-the general C<guestfs_config> call instead.");
+the general C<guestfs_config> call instead.
+
+=item *
+
+If you just want to add an ISO file (often you use this as an
+efficient way to transfer large files into the guest), then you
+should probably use C<guestfs_add_drive_ro> instead.
+
+=back");
("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"],
[],
This is equivalent to the qemu parameter
C<-drive file=filename,snapshot=on,if=...>.
+C<if=...> is set at compile time by the configuration option
+C<./configure --with-drive-if=...>. In the rare case where you
+might need to change this at run time, use C<guestfs_add_drive_with_if>
+or C<guestfs_add_drive_ro_with_if>.
+
Note that this call checks for the existence of C<filename>. This
stops you from specifying other types of drive which are supported
by qemu such as C<nbd:> and C<http:> URLs. To specify those, use
C<value> can be NULL.");
- ("set_qemu", (RErr, [String "qemu"]), -1, [FishAlias "qemu"],
+ ("set_qemu", (RErr, [OptString "qemu"]), -1, [FishAlias "qemu"],
[],
"set the qemu binary",
"\
You can also override this by setting the C<LIBGUESTFS_QEMU>
environment variable.
-Setting C<qemu> to C<NULL> restores the default qemu binary.");
+Setting C<qemu> to C<NULL> restores the default qemu binary.
+
+Note that you should call this function as early as possible
+after creating the handle. This is because some pre-launch
+operations depend on testing qemu features (by running C<qemu -help>).
+If the qemu binary changes, we don't retest features, and
+so you might see inconsistent results. Using the environment
+variable C<LIBGUESTFS_QEMU> is safest of all since that picks
+the qemu binary at the same time as the handle is created.");
("get_qemu", (RConstString "qemu", []), -1, [],
[InitNone, Always, TestRun (
This is always non-NULL. If it wasn't set already, then this will
return the default qemu binary name.");
- ("set_path", (RErr, [String "searchpath"]), -1, [FishAlias "path"],
+ ("set_path", (RErr, [OptString "searchpath"]), -1, [FishAlias "path"],
[],
"set the search path",
"\
For more information on states, see L<guestfs(3)>.");
- ("set_busy", (RErr, []), -1, [NotInFish],
- [],
- "set state to busy",
- "\
-This sets the state to C<BUSY>. This is only used when implementing
-actions using the low-level API.
-
-For more information on states, see L<guestfs(3)>.");
-
- ("set_ready", (RErr, []), -1, [NotInFish],
- [],
- "set state to ready",
- "\
-This sets the state to C<READY>. This is only used when implementing
-actions using the low-level API.
-
-For more information on states, see L<guestfs(3)>.");
-
- ("end_busy", (RErr, []), -1, [NotInFish],
- [],
- "leave the busy state",
- "\
-This sets the state to C<READY>, or if in C<CONFIG> then it leaves the
-state as is. This is only used when implementing
-actions using the low-level API.
-
-For more information on states, see L<guestfs(3)>.");
-
("set_memsize", (RErr, [Int "memsize"]), -1, [FishAlias "memsize"],
[InitNone, Always, TestOutputInt (
[["set_memsize"; "500"];
This call was added in version C<1.0.58>. In previous
versions of libguestfs there was no way to get the version
-number. From C code you can use ELF weak linking tricks to find out if
-this symbol exists (if it doesn't, then it's an earlier version).
+number. From C code you can use dynamic linker functions
+to find out if this symbol exists (if it doesn't, then
+it's an earlier version).
The call returns a structure with four elements. The first
three (C<major>, C<minor> and C<release>) are numbers and
To construct the original version string:
C<$major.$minor.$release$extra>
+See also: L<guestfs(3)/LIBGUESTFS VERSION NUMBERS>.
+
I<Note:> Don't use this call to test for availability
-of features. Distro backports makes this unreliable.");
+of features. In enterprise distributions we backport
+features from later versions into earlier versions,
+making this an unreliable way to test for features.
+Use C<guestfs_available> instead.");
("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
[InitNone, Always, TestOutputTrue (
For more information on the architecture of libguestfs,
see L<guestfs(3)>.");
+ ("set_trace", (RErr, [Bool "trace"]), -1, [FishAlias "trace"],
+ [InitNone, Always, TestOutputFalse (
+ [["set_trace"; "false"];
+ ["get_trace"]])],
+ "enable or disable command traces",
+ "\
+If the command trace flag is set to 1, then commands are
+printed on stdout before they are executed in a format
+which is very similar to the one used by guestfish. In
+other words, you can run a program with this enabled, and
+you will get out a script which you can feed to guestfish
+to perform the same set of actions.
+
+If you want to trace C API calls into libguestfs (and
+other libraries) then possibly a better way is to use
+the external ltrace(1) command.
+
+Command traces are disabled unless the environment variable
+C<LIBGUESTFS_TRACE> is defined and set to C<1>.");
+
+ ("get_trace", (RBool "trace", []), -1, [],
+ [],
+ "get command trace enabled flag",
+ "\
+Return the command trace flag.");
+
+ ("set_direct", (RErr, [Bool "direct"]), -1, [FishAlias "direct"],
+ [InitNone, Always, TestOutputFalse (
+ [["set_direct"; "false"];
+ ["get_direct"]])],
+ "enable or disable direct appliance mode",
+ "\
+If the direct appliance mode flag is enabled, then stdin and
+stdout are passed directly through to the appliance once it
+is launched.
+
+One consequence of this is that log messages aren't caught
+by the library and handled by C<guestfs_set_log_message_callback>,
+but go straight to stdout.
+
+You probably don't want to use this unless you know what you
+are doing.
+
+The default is disabled.");
+
+ ("get_direct", (RBool "direct", []), -1, [],
+ [],
+ "get direct appliance mode flag",
+ "\
+Return the direct appliance mode flag.");
+
+ ("set_recovery_proc", (RErr, [Bool "recoveryproc"]), -1, [FishAlias "recovery-proc"],
+ [InitNone, Always, TestOutputTrue (
+ [["set_recovery_proc"; "true"];
+ ["get_recovery_proc"]])],
+ "enable or disable the recovery process",
+ "\
+If this is called with the parameter C<false> then
+C<guestfs_launch> does not create a recovery process. The
+purpose of the recovery process is to stop runaway qemu
+processes in the case where the main program aborts abruptly.
+
+This only has any effect if called before C<guestfs_launch>,
+and the default is true.
+
+About the only time when you would want to disable this is
+if the main process will fork itself into the background
+(\"daemonize\" itself). In this case the recovery process
+thinks that the main program has disappeared and so kills
+qemu, which is not very helpful.");
+
+ ("get_recovery_proc", (RBool "recoveryproc", []), -1, [],
+ [],
+ "get recovery process enabled flag",
+ "\
+Return the recovery process enabled flag.");
+
+ ("add_drive_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
+ [],
+ "add a drive specifying the QEMU block emulation to use",
+ "\
+This is the same as C<guestfs_add_drive> but it allows you
+to specify the QEMU interface emulation to use at run time.");
+
+ ("add_drive_ro_with_if", (RErr, [String "filename"; String "iface"]), -1, [],
+ [],
+ "add a drive read-only specifying the QEMU block emulation to use",
+ "\
+This is the same as C<guestfs_add_drive_ro> but it allows you
+to specify the QEMU interface emulation to use at run time.");
+
]
(* daemon_functions are any functions which cause some action
let daemon_functions = [
("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [],
[InitEmpty, Always, TestOutput (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext2"; "/dev/sda1"];
["mount"; "/dev/sda1"; "/"];
- ["write_file"; "/new"; "new file contents"; "0"];
+ ["write"; "/new"; "new file contents"];
["cat"; "/new"]], "new file contents")],
"mount a guest disk at a position in the filesystem",
"\
The mounted filesystem is writable, if we have sufficient permissions
on the underlying device.
-The filesystem options C<sync> and C<noatime> are set with this
-call, in order to improve reliability.");
+B<Important note:>
+When you use this call, the filesystem options C<sync> and C<noatime>
+are set implicitly. This was originally done because we thought it
+would improve reliability, but it turns out that I<-o sync> has a
+very large negative performance impact and negligible effect on
+reliability. Therefore we recommend that you avoid using
+C<guestfs_mount> in any code that needs performance, and instead
+use C<guestfs_mount_options> (use an empty string for the first
+parameter if you don't want any options).");
("sync", (RErr, []), 2, [],
[ InitEmpty, Always, TestRun [["sync"]]],
"\
Touch acts like the L<touch(1)> command. It can be used to
update the timestamps on a file, or, if the file does not exist,
-to create a new zero-length file.");
+to create a new zero-length file.
+
+This command only works on regular files, and will fail on other
+file types such as directories, symbolic links, block special etc.");
("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
[InitISOFS, Always, TestOutput (
This does not return logical volumes. For that you will need to
call C<guestfs_lvs>.");
- ("pvs", (RStringList "physvols", []), 9, [],
+ ("pvs", (RStringList "physvols", []), 9, [Optional "lvm2"],
[InitBasicFSonLVM, Always, TestOutputListOfDevices (
[["pvs"]], ["/dev/sda1"]);
InitEmpty, Always, TestOutputListOfDevices (
See also C<guestfs_pvs_full>.");
- ("vgs", (RStringList "volgroups", []), 10, [],
+ ("vgs", (RStringList "volgroups", []), 10, [Optional "lvm2"],
[InitBasicFSonLVM, Always, TestOutputList (
[["vgs"]], ["VG"]);
InitEmpty, Always, TestOutputList (
See also C<guestfs_vgs_full>.");
- ("lvs", (RStringList "logvols", []), 11, [],
+ ("lvs", (RStringList "logvols", []), 11, [Optional "lvm2"],
[InitBasicFSonLVM, Always, TestOutputList (
[["lvs"]], ["/dev/VG/LV"]);
InitEmpty, Always, TestOutputList (
See also C<guestfs_lvs_full>.");
- ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [],
+ ("pvs_full", (RStructList ("physvols", "lvm_pv"), []), 12, [Optional "lvm2"],
[], (* XXX how to test? *)
"list the LVM physical volumes (PVs)",
"\
List all the physical volumes detected. This is the equivalent
of the L<pvs(8)> command. The \"full\" version includes all fields.");
- ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [],
+ ("vgs_full", (RStructList ("volgroups", "lvm_vg"), []), 13, [Optional "lvm2"],
[], (* XXX how to test? *)
"list the LVM volume groups (VGs)",
"\
List all the volumes groups detected. This is the equivalent
of the L<vgs(8)> command. The \"full\" version includes all fields.");
- ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [],
+ ("lvs_full", (RStructList ("logvols", "lvm_lv"), []), 14, [Optional "lvm2"],
[], (* XXX how to test? *)
"list the LVM logical volumes (LVs)",
"\
as end of line). For those you need to use the C<guestfs_read_file>
function which has a more complex interface.");
- ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [],
+ ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"create a new Augeas handle",
"\
To find out more about Augeas, see L<http://augeas.net/>.");
- ("aug_close", (RErr, []), 26, [],
+ ("aug_close", (RErr, []), 26, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"close the current Augeas handle",
"\
C<guestfs_aug_init> again before you can use any other
Augeas functions.");
- ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
+ ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"define an Augeas variable",
"\
On success this returns the number of nodes in C<expr>, or
C<0> if C<expr> evaluates to something which is not a nodeset.");
- ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [],
+ ("aug_defnode", (RStruct ("nrnodescreated", "int_bool"), [String "name"; String "expr"; String "val"]), 18, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"define an Augeas node",
"\
number of nodes in the nodeset, and a boolean flag
if a node was created.");
- ("aug_get", (RString "val", [String "augpath"]), 19, [],
+ ("aug_get", (RString "val", [String "augpath"]), 19, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"look up the value of an Augeas path",
"\
Look up the value associated with C<path>. If C<path>
matches exactly one node, the C<value> is returned.");
- ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [],
+ ("aug_set", (RErr, [String "augpath"; String "val"]), 20, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"set Augeas path to value",
"\
-Set the value associated with C<path> to C<value>.");
+Set the value associated with C<path> to C<val>.
+
+In the Augeas API, it is possible to clear a node by setting
+the value to NULL. Due to an oversight in the libguestfs API
+you cannot do that with this call. Instead you must use the
+C<guestfs_aug_clear> call.");
- ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [],
+ ("aug_insert", (RErr, [String "augpath"; String "label"; Bool "before"]), 21, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"insert a sibling Augeas node",
"\
C<label> must be a label, ie. not contain C</>, C<*> or end
with a bracketed index C<[N]>.");
- ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [],
+ ("aug_rm", (RInt "nrnodes", [String "augpath"]), 22, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"remove an Augeas path",
"\
On success this returns the number of entries which were removed.");
- ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [],
+ ("aug_mv", (RErr, [String "src"; String "dest"]), 23, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"move Augeas node",
"\
Move the node C<src> to C<dest>. C<src> must match exactly
one node. C<dest> is overwritten if it exists.");
- ("aug_match", (RStringList "matches", [String "augpath"]), 24, [],
+ ("aug_match", (RStringList "matches", [String "augpath"]), 24, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"return Augeas nodes which match augpath",
"\
The returned paths are sufficiently qualified so that they match
exactly one node in the current tree.");
- ("aug_save", (RErr, []), 25, [],
+ ("aug_save", (RErr, []), 25, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"write all pending Augeas changes to disk",
"\
The flags which were passed to C<guestfs_aug_init> affect exactly
how files are saved.");
- ("aug_load", (RErr, []), 27, [],
+ ("aug_load", (RErr, []), 27, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"load files into the tree",
"\
See C<aug_load> in the Augeas documentation for the full gory
details.");
- ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [],
+ ("aug_ls", (RStringList "matches", [String "augpath"]), 28, [Optional "augeas"],
[], (* XXX Augeas code needs tests. *)
"list Augeas nodes under augpath",
"\
"change file mode",
"\
Change the mode (permissions) of C<path> to C<mode>. Only
-numeric modes are supported.");
+numeric modes are supported.
+
+I<Note>: When using this command from guestfish, C<mode>
+by default would be decimal, unless you prefix it with
+C<0> to get octal, ie. use C<0700> not C<700>.
+
+The mode actually set is affected by the umask.");
("chown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 35, [],
[], (* XXX Need stat command to test *)
See also C<guestfs_stat>.");
- ("pvcreate", (RErr, [Device "device"]), 39, [],
+ ("pvcreate", (RErr, [Device "device"]), 39, [Optional "lvm2"],
[InitEmpty, Always, TestOutputListOfDevices (
[["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
["pvcreate"; "/dev/sda1"];
where C<device> should usually be a partition name such
as C</dev/sda1>.");
- ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [],
+ ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [Optional "lvm2"],
[InitEmpty, Always, TestOutputList (
[["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
["pvcreate"; "/dev/sda1"];
This creates an LVM volume group called C<volgroup>
from the non-empty list of physical volumes C<physvols>.");
- ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [],
+ ("lvcreate", (RErr, [String "logvol"; String "volgroup"; Int "mbytes"]), 41, [Optional "lvm2"],
[InitEmpty, Always, TestOutputList (
[["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
["pvcreate"; "/dev/sda1"];
["lvs"]],
["/dev/VG1/LV1"; "/dev/VG1/LV2";
"/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
- "create an LVM volume group",
+ "create an LVM logical volume",
"\
-This creates an LVM volume group called C<logvol>
+This creates an LVM logical volume called C<logvol>
on the volume group C<volgroup>, with C<size> megabytes.");
("mkfs", (RErr, [String "fstype"; Device "device"]), 42, [],
[InitEmpty, Always, TestOutput (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext2"; "/dev/sda1"];
- ["mount"; "/dev/sda1"; "/"];
- ["write_file"; "/new"; "new file contents"; "0"];
+ ["mount_options"; ""; "/dev/sda1"; "/"];
+ ["write"; "/new"; "new file contents"];
["cat"; "/new"]], "new file contents")],
"make a filesystem",
"\
pass C<lines> as a single element list, when the single element being
the string C<,> (comma).
-See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>");
+See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>,
+C<guestfs_part_init>");
- ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
- [InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; "new file contents"; "0"];
- ["cat"; "/new"]], "new file contents");
- InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; "\nnew file contents\n"; "0"];
- ["cat"; "/new"]], "\nnew file contents\n");
- InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; "\n\n"; "0"];
- ["cat"; "/new"]], "\n\n");
- InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; ""; "0"];
- ["cat"; "/new"]], "");
- InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; "\n\n\n"; "0"];
- ["cat"; "/new"]], "\n\n\n");
- InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; "\n"; "0"];
- ["cat"; "/new"]], "\n")],
+ ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning; DeprecatedBy "write"],
+ (* Regression test for RHBZ#597135. *)
+ [InitBasicFS, Always, TestLastFail
+ [["write_file"; "/new"; "abc"; "10000"]]],
"create a file",
"\
This call creates a file called C<path>. The contents of the
the content cannot contain embedded ASCII NULs).
I<NB.> Owing to a bug, writing content containing ASCII NUL
-characters does I<not> work, even if the length is specified.
-We hope to resolve this bug in a future version. In the meantime
-use C<guestfs_upload>.");
+characters does I<not> work, even if the length is specified.");
("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
[InitEmpty, Always, TestOutputListOfDevices (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext2"; "/dev/sda1"];
- ["mount"; "/dev/sda1"; "/"];
+ ["mount_options"; ""; "/dev/sda1"; "/"];
["mounts"]], ["/dev/sda1"]);
InitEmpty, Always, TestOutputList (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext2"; "/dev/sda1"];
- ["mount"; "/dev/sda1"; "/"];
+ ["mount_options"; ""; "/dev/sda1"; "/"];
["umount"; "/"];
["mounts"]], [])],
"unmount a filesystem",
["mkfs"; "ext2"; "/dev/sda1"];
["mkfs"; "ext2"; "/dev/sda2"];
["mkfs"; "ext2"; "/dev/sda3"];
- ["mount"; "/dev/sda1"; "/"];
+ ["mount_options"; ""; "/dev/sda1"; "/"];
["mkdir"; "/mp1"];
- ["mount"; "/dev/sda2"; "/mp1"];
+ ["mount_options"; ""; "/dev/sda2"; "/mp1"];
["mkdir"; "/mp1/mp2"];
- ["mount"; "/dev/sda3"; "/mp1/mp2"];
+ ["mount_options"; ""; "/dev/sda3"; "/mp1/mp2"];
["mkdir"; "/mp1/mp2/mp3"];
["umount_all"];
["mounts"]], [])],
Some internal mounts are not unmounted by this call.");
- ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
+ ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson; Optional "lvm2"],
[],
"remove all LVM LVs, VGs and PVs",
"\
InitISOFS, Always, TestOutput (
[["file"; "/known-1"]], "ASCII text");
InitISOFS, Always, TestLastFail (
- [["file"; "/notexists"]])],
+ [["file"; "/notexists"]]);
+ InitISOFS, Always, TestOutput (
+ [["file"; "/abssymlink"]], "symbolic link");
+ InitISOFS, Always, TestOutput (
+ [["file"; "/directory"]], "directory")],
"determine file type",
"\
This call uses the standard L<file(1)> command to determine
-the type or contents of the file. This also works on devices,
-for example to find out whether a partition contains a filesystem.
+the type or contents of the file.
This call will also transparently look inside various types
of compressed file.
-The exact command which runs is C<file -zbsL path>. Note in
+The exact command which runs is C<file -zb path>. Note in
particular that the filename is not prepended to the output
-(the C<-b> option).");
+(the C<-b> option).
+
+This command can also be used on C</dev/> devices
+(and partitions, LV names). You can for example use this
+to determine if a device contains a filesystem, although
+it's usually better to use C<guestfs_vfs_type>.
+
+If the C<path> does not begin with C</dev/> then
+this command only works for the content of regular files.
+For other file types (directory, symbolic link etc) it
+will just return the string C<directory> etc.");
("command", (RString "output", [StringList "arguments"]), 50, [ProtocolLimitWarning],
[InitBasicFS, Always, TestOutput (
This uses the L<blockdev(8)> command.");
- ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
+ ("upload", (RErr, [FileIn "filename"; Dev_or_Path "remotefilename"]), 66, [],
[InitBasicFS, Always, TestOutput (
(* Pick a file from cwd which isn't likely to change. *)
[["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
["checksum"; "md5"; "/COPYING.LIB"]],
- Digest.to_hex (Digest.file "COPYING.LIB"))],
+ Digest.to_hex (Digest.file "COPYING.LIB"))],
"upload a file from the local machine",
"\
Upload local file C<filename> to C<remotefilename> on the
["download"; "/COPYING.LIB"; "testdownload.tmp"];
["upload"; "testdownload.tmp"; "/upload"];
["checksum"; "md5"; "/upload"]],
- Digest.to_hex (Digest.file "COPYING.LIB"))],
+ Digest.to_hex (Digest.file "COPYING.LIB"))],
"download a file to the local machine",
"\
Download file C<remotefilename> and save it as C<filename>
InitISOFS, Always, TestOutput (
[["checksum"; "sha384"; "/known-3"]], "5fa7883430f357b5d7b7271d3a1d2872b51d73cba72731de6863d3dea55f30646af2799bef44d5ea776a5ec7941ac640");
InitISOFS, Always, TestOutput (
- [["checksum"; "sha512"; "/known-3"]], "2794062c328c6b216dca90443b7f7134c5f40e56bd0ed7853123275a09982a6f992e6ca682f9d2fba34a4c5e870d8fe077694ff831e3032a004ee077e00603f6")],
+ [["checksum"; "sha512"; "/known-3"]], "2794062c328c6b216dca90443b7f7134c5f40e56bd0ed7853123275a09982a6f992e6ca682f9d2fba34a4c5e870d8fe077694ff831e3032a004ee077e00603f6");
+ (* Test for RHBZ#579608, absolute symbolic links. *)
+ InitISOFS, Always, TestOutput (
+ [["checksum"; "sha512"; "/abssymlink"]], "5f57d0639bc95081c53afc63a449403883818edc64da48930ad6b1a4fb49be90404686877743fbcd7c99811f3def7df7bc22635c885c6a8cf79c806b43451c1a")],
"compute MD5, SHAx or CRC checksum of file",
"\
This call computes the MD5, SHAx or CRC checksum of the
=back
-The checksum is returned as a printable string.");
+The checksum is returned as a printable string.
- ("tar_in", (RErr, [FileIn "tarfile"; String "directory"]), 69, [],
+To get the checksum for a device, use C<guestfs_checksum_device>.
+
+To get the checksums for many files, use C<guestfs_checksums_out>.");
+
+ ("tar_in", (RErr, [FileIn "tarfile"; Pathname "directory"]), 69, [],
[InitBasicFS, Always, TestOutput (
[["tar_in"; "../images/helloworld.tar"; "/"];
["cat"; "/hello"]], "hello\n")],
This command uploads and unpacks local file C<tarfile> (an
I<uncompressed> tar file) into C<directory>.
-To upload a compressed tarball, use C<guestfs_tgz_in>.");
+To upload a compressed tarball, use C<guestfs_tgz_in>
+or C<guestfs_txz_in>.");
("tar_out", (RErr, [String "directory"; FileOut "tarfile"]), 70, [],
[],
This command packs the contents of C<directory> and downloads
it to local file C<tarfile>.
-To download a compressed tarball, use C<guestfs_tgz_out>.");
+To download a compressed tarball, use C<guestfs_tgz_out>
+or C<guestfs_txz_out>.");
- ("tgz_in", (RErr, [FileIn "tarball"; String "directory"]), 71, [],
+ ("tgz_in", (RErr, [FileIn "tarball"; Pathname "directory"]), 71, [],
[InitBasicFS, Always, TestOutput (
[["tgz_in"; "../images/helloworld.tar.gz"; "/"];
["cat"; "/hello"]], "hello\n")],
["mount_ro"; "/dev/sda1"; "/"];
["touch"; "/new"]]);
InitBasicFS, Always, TestOutput (
- [["write_file"; "/new"; "data"; "0"];
+ [["write"; "/new"; "data"];
["umount"; "/"];
["mount_ro"; "/dev/sda1"; "/"];
["cat"; "/new"]], "data")],
"\
This is the same as the C<guestfs_mount> command, but it
allows you to set the mount options as for the
-L<mount(8)> I<-o> flag.");
+L<mount(8)> I<-o> flag.
+
+If the C<options> parameter is an empty string, then
+no options are passed (all options default to whatever
+the filesystem uses).");
("mount_vfs", (RErr, [String "options"; String "vfstype"; Device "device"; String "mountpoint"]), 75, [],
[],
to look at the file C<daemon/debug.c> in the libguestfs source
to find out what you can do.");
- ("lvremove", (RErr, [Device "device"]), 77, [],
+ ("lvremove", (RErr, [Device "device"]), 77, [Optional "lvm2"],
[InitEmpty, Always, TestOutputList (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV1"; "VG"; "50"];
["lvremove"; "/dev/VG/LV1"];
["lvs"]], ["/dev/VG/LV2"]);
InitEmpty, Always, TestOutputList (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV1"; "VG"; "50"];
["lvremove"; "/dev/VG"];
["lvs"]], []);
InitEmpty, Always, TestOutputList (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV1"; "VG"; "50"];
You can also remove all LVs in a volume group by specifying
the VG name, C</dev/VG>.");
- ("vgremove", (RErr, [String "vgname"]), 78, [],
+ ("vgremove", (RErr, [String "vgname"]), 78, [Optional "lvm2"],
[InitEmpty, Always, TestOutputList (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV1"; "VG"; "50"];
["vgremove"; "VG"];
["lvs"]], []);
InitEmpty, Always, TestOutputList (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV1"; "VG"; "50"];
This also forcibly removes all logical volumes in the volume
group (if any).");
- ("pvremove", (RErr, [Device "device"]), 79, [],
+ ("pvremove", (RErr, [Device "device"]), 79, [Optional "lvm2"],
[InitEmpty, Always, TestOutputListOfDevices (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV1"; "VG"; "50"];
["pvremove"; "/dev/sda1"];
["lvs"]], []);
InitEmpty, Always, TestOutputListOfDevices (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV1"; "VG"; "50"];
["pvremove"; "/dev/sda1"];
["vgs"]], []);
InitEmpty, Always, TestOutputListOfDevices (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV1"; "VG"; "50"];
You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
to return the existing label on a filesystem.");
- ("get_e2label", (RString "label", [Device "device"]), 81, [],
+ ("get_e2label", (RString "label", [Device "device"]), 81, [DeprecatedBy "vfs_label"],
[],
"get the ext2/3/4 filesystem label",
"\
You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
to return the existing UUID of a filesystem.");
- ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [],
- [],
+ ("get_e2uuid", (RString "uuid", [Device "device"]), 83, [DeprecatedBy "vfs_uuid"],
+ (* Regression test for RHBZ#597112. *)
+ (let uuid = uuidgen () in
+ [InitBasicFS, Always, TestOutput (
+ [["mke2journal"; "1024"; "/dev/sdb"];
+ ["set_e2uuid"; "/dev/sdb"; uuid];
+ ["get_e2uuid"; "/dev/sdb"]], uuid)]),
"get the ext2/3/4 filesystem UUID",
"\
This returns the ext2/3/4 filesystem UUID of the filesystem on
C<device>.");
- ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [],
+ ("fsck", (RInt "status", [String "fstype"; Device "device"]), 84, [FishOutput FishOutputHexadecimal],
[InitBasicFS, Always, TestOutputInt (
[["umount"; "/dev/sda1"];
["fsck"; "ext2"; "/dev/sda1"]], 0);
to securely wipe the device). It should be sufficient to remove
any partition tables, filesystem superblocks and so on.
-See also: C<guestfs_scrub_device>.");
+See also: C<guestfs_zero_device>, C<guestfs_scrub_device>.");
("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
- (* Test disabled because grub-install incompatible with virtio-blk driver.
- * See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760
+ (* See:
+ * https://bugzilla.redhat.com/show_bug.cgi?id=484986
+ * https://bugzilla.redhat.com/show_bug.cgi?id=479760
*)
- [InitBasicFS, Disabled, TestOutputTrue (
- [["grub_install"; "/"; "/dev/sda1"];
+ [InitBasicFS, Always, TestOutputTrue (
+ [["mkdir_p"; "/boot/grub"];
+ ["write"; "/boot/grub/device.map"; "(hd0) /dev/vda"];
+ ["grub_install"; "/"; "/dev/vda"];
["is_dir"; "/boot"]])],
"install GRUB",
"\
This command installs GRUB (the Grand Unified Bootloader) on
-C<device>, with the root directory being C<root>.");
+C<device>, with the root directory being C<root>.
+
+Note: If grub-install reports the error
+\"No suitable drive was found in the generated device map.\"
+it may be that you need to create a C</boot/grub/device.map>
+file first that contains the mapping between grub device names
+and Linux device names. It is usually sufficient to create
+a file containing:
+
+ (hd0) /dev/vda
+
+replacing C</dev/vda> with the name of the installation device.");
("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
[InitBasicFS, Always, TestOutput (
- [["write_file"; "/old"; "file content"; "0"];
+ [["write"; "/old"; "file content"];
["cp"; "/old"; "/new"];
["cat"; "/new"]], "file content");
InitBasicFS, Always, TestOutputTrue (
- [["write_file"; "/old"; "file content"; "0"];
+ [["write"; "/old"; "file content"];
["cp"; "/old"; "/new"];
["is_file"; "/old"]]);
InitBasicFS, Always, TestOutput (
- [["write_file"; "/old"; "file content"; "0"];
+ [["write"; "/old"; "file content"];
["mkdir"; "/dir"];
["cp"; "/old"; "/dir/new"];
["cat"; "/dir/new"]], "file content")],
[InitBasicFS, Always, TestOutput (
[["mkdir"; "/olddir"];
["mkdir"; "/newdir"];
- ["write_file"; "/olddir/file"; "file content"; "0"];
+ ["write"; "/olddir/file"; "file content"];
["cp_a"; "/olddir"; "/newdir"];
["cat"; "/newdir/olddir/file"]], "file content")],
"copy a file or directory recursively",
("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
[InitBasicFS, Always, TestOutput (
- [["write_file"; "/old"; "file content"; "0"];
+ [["write"; "/old"; "file content"];
["mv"; "/old"; "/new"];
["cat"; "/new"]], "file content");
InitBasicFS, Always, TestOutputFalse (
- [["write_file"; "/old"; "file content"; "0"];
+ [["write"; "/old"; "file content"];
["mv"; "/old"; "/new"];
["is_file"; "/old"]])],
"move a file",
("equal", (RBool "equality", [Pathname "file1"; Pathname "file2"]), 93, [],
[InitBasicFS, Always, TestOutputTrue (
- [["write_file"; "/file1"; "contents of a file"; "0"];
+ [["write"; "/file1"; "contents of a file"];
["cp"; "/file1"; "/file2"];
["equal"; "/file1"; "/file2"]]);
InitBasicFS, Always, TestOutputFalse (
- [["write_file"; "/file1"; "contents of a file"; "0"];
- ["write_file"; "/file2"; "contents of another file"; "0"];
+ [["write"; "/file1"; "contents of a file"];
+ ["write"; "/file2"; "contents of another file"];
["equal"; "/file1"; "/file2"]]);
InitBasicFS, Always, TestLastFail (
[["equal"; "/file1"; "/file2"]])],
[InitISOFS, Always, TestOutputList (
[["strings"; "/known-5"]], ["abcdefghi"; "jklmnopqr"]);
InitISOFS, Always, TestOutputList (
- [["strings"; "/empty"]], [])],
+ [["strings"; "/empty"]], []);
+ (* Test for RHBZ#579608, absolute symbolic links. *)
+ InitISOFS, Always, TestRun (
+ [["strings"; "/abssymlink"]])],
"print the printable strings in a file",
"\
This runs the L<strings(1)> command on a file and returns
("strings_e", (RStringList "stringsout", [String "encoding"; Pathname "path"]), 95, [ProtocolLimitWarning],
[InitISOFS, 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"];
+ InitBasicFS, Always, TestOutputList (
+ [["write"; "/new"; "\000h\000e\000l\000l\000o\000\n\000w\000o\000r\000l\000d\000\n"];
["strings_e"; "b"; "/new"]], ["hello"; "world"])],
"print the printable strings in a file",
"\
This is like the C<guestfs_strings> command, but allows you to
-specify the encoding.
+specify the encoding of strings that are looked for in
+the source file C<path>.
+
+Allowed encodings are:
+
+=over 4
+
+=item s
-See the L<strings(1)> manpage for the full list of encodings.
+Single 7-bit-byte characters like ASCII and the ASCII-compatible
+parts of ISO-8859-X (this is what C<guestfs_strings> uses).
-Commonly useful encodings are C<l> (lower case L) which will
-show strings inside Windows/x86 files.
+=item S
+
+Single 8-bit-byte characters.
+
+=item b
+
+16-bit big endian strings such as those encoded in
+UTF-16BE or UCS-2BE.
+
+=item l (lower case letter L)
+
+16-bit little endian such as UTF-16LE and UCS-2LE.
+This is useful for examining binaries in Windows guests.
+
+=item B
+
+32-bit big endian such as UCS-4BE.
+
+=item L
+
+32-bit little endian such as UCS-4LE.
+
+=back
The returned strings are transcoded to UTF-8.");
* commands to segfault.
*)
InitISOFS, Always, TestRun (
- [["hexdump"; "/100krandom"]])],
+ [["hexdump"; "/100krandom"]]);
+ (* Test for RHBZ#579608, absolute symbolic links. *)
+ InitISOFS, Always, TestRun (
+ [["hexdump"; "/abssymlink"]])],
"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, [Device "device"]), 97, [],
+ ("zerofree", (RErr, [Device "device"]), 97, [Optional "zerofree"],
[InitNone, Always, TestOutput (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext3"; "/dev/sda1"];
- ["mount"; "/dev/sda1"; "/"];
- ["write_file"; "/new"; "test file"; "0"];
+ ["mount_options"; ""; "/dev/sda1"; "/"];
+ ["write"; "/new"; "test file"];
["umount"; "/dev/sda1"];
["zerofree"; "/dev/sda1"];
- ["mount"; "/dev/sda1"; "/"];
+ ["mount_options"; ""; "/dev/sda1"; "/"];
["cat"; "/new"]], "test file")],
"zero unused inodes and disk blocks on ext2/3 filesystem",
"\
It is possible that using this program can damage the filesystem
or data on the filesystem.");
- ("pvresize", (RErr, [Device "device"]), 98, [],
+ ("pvresize", (RErr, [Device "device"]), 98, [Optional "lvm2"],
[],
"resize an LVM physical volume",
"\
partition C<n> (note: C<n> counts from 1).
For other parameters, see C<guestfs_sfdisk>. You should usually
-pass C<0> for the cyls/heads/sectors parameters.");
+pass C<0> for the cyls/heads/sectors parameters.
+
+See also: C<guestfs_part_add>");
("sfdisk_l", (RString "partitions", [Device "device"]), 100, [],
[],
"\
This displays the partition table on C<device>, in the
human-readable output of the L<sfdisk(8)> command. It is
-not intended to be parsed.");
+not intended to be parsed.
+
+See also: C<guestfs_part_list>");
("sfdisk_kernel_geometry", (RString "partitions", [Device "device"]), 101, [],
[],
The result is in human-readable format, and not designed to
be parsed.");
- ("vg_activate_all", (RErr, [Bool "activate"]), 103, [],
+ ("vg_activate_all", (RErr, [Bool "activate"]), 103, [Optional "lvm2"],
[],
"activate or deactivate all volume groups",
"\
This command is the same as running C<vgchange -a y|n>");
- ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [],
+ ("vg_activate", (RErr, [Bool "activate"; StringList "volgroups"]), 104, [Optional "lvm2"],
[],
"activate or deactivate some volume groups",
"\
Note that if C<volgroups> is an empty list then B<all> volume groups
are activated or deactivated.");
- ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [],
+ ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [Optional "lvm2"],
[InitNone, Always, TestOutput (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV"; "VG"; "10"];
["mkfs"; "ext2"; "/dev/VG/LV"];
- ["mount"; "/dev/VG/LV"; "/"];
- ["write_file"; "/new"; "test content"; "0"];
+ ["mount_options"; ""; "/dev/VG/LV"; "/"];
+ ["write"; "/new"; "test content"];
["umount"; "/"];
["lvresize"; "/dev/VG/LV"; "20"];
["e2fsck_f"; "/dev/VG/LV"];
["resize2fs"; "/dev/VG/LV"];
- ["mount"; "/dev/VG/LV"; "/"];
- ["cat"; "/new"]], "test content")],
+ ["mount_options"; ""; "/dev/VG/LV"; "/"];
+ ["cat"; "/new"]], "test content");
+ InitNone, Always, TestRun (
+ (* Make an LV smaller to test RHBZ#587484. *)
+ [["part_disk"; "/dev/sda"; "mbr"];
+ ["pvcreate"; "/dev/sda1"];
+ ["vgcreate"; "VG"; "/dev/sda1"];
+ ["lvcreate"; "LV"; "VG"; "20"];
+ ["lvresize"; "/dev/VG/LV"; "10"]])],
"resize an LVM logical volume",
"\
This resizes (expands or shrinks) an existing LVM logical
("resize2fs", (RErr, [Device "device"]), 106, [],
[], (* lvresize tests this *)
- "resize an ext2/ext3 filesystem",
+ "resize an ext2, ext3 or ext4 filesystem",
"\
-This resizes an ext2 or ext3 filesystem to match the size of
+This resizes an ext2, ext3 or ext4 filesystem to match the size of
the underlying device.
I<Note:> It is sometimes required that you run C<guestfs_e2fsck_f>
In any case, it is always safe to call C<guestfs_e2fsck_f> before
calling this function.");
- ("find", (RStringList "names", [Pathname "directory"]), 107, [],
+ ("find", (RStringList "names", [Pathname "directory"]), 107, [ProtocolLimitWarning],
[InitBasicFS, Always, TestOutputList (
[["find"; "/"]], ["lost+found"]);
InitBasicFS, Always, TestOutputList (
If C<directory> is not a directory, then this command returns
an error.
-The returned list is sorted.");
+The returned list is sorted.
+
+See also C<guestfs_find0>.");
("e2fsck_f", (RErr, [Device "device"]), 108, [],
[], (* lvresize tests this *)
"\
Sleep for C<secs> seconds.");
- ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [],
+ ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [Optional "ntfs3g"],
[InitNone, Always, TestOutputInt (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ntfs"; "/dev/sda1"];
["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0);
InitNone, Always, TestOutputInt (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext2"; "/dev/sda1"];
["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)],
"probe NTFS volume",
with flags C<GLOB_MARK|GLOB_BRACE>.
See that manual page for more details.");
- ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson],
+ ("scrub_device", (RErr, [Device "device"]), 114, [DangerWillRobinson; Optional "scrub"],
[InitNone, Always, TestRun ( (* use /dev/sdc because it's smaller *)
[["scrub_device"; "/dev/sdc"]])],
"scrub (securely wipe) a device",
It is an interface to the L<scrub(1)> program. See that
manual page for more details.");
- ("scrub_file", (RErr, [Pathname "file"]), 115, [],
+ ("scrub_file", (RErr, [Pathname "file"]), 115, [Optional "scrub"],
[InitBasicFS, Always, TestRun (
- [["write_file"; "/file"; "content"; "0"];
+ [["write"; "/file"; "content"];
["scrub_file"; "/file"]])],
"scrub (securely wipe) a file",
"\
It is an interface to the L<scrub(1)> program. See that
manual page for more details.");
- ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [],
+ ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [Optional "scrub"],
[], (* XXX needs testing *)
"scrub (securely wipe) free space",
"\
("wc_l", (RInt "lines", [Pathname "path"]), 118, [],
[InitISOFS, Always, TestOutputInt (
- [["wc_l"; "/10klines"]], 10000)],
+ [["wc_l"; "/10klines"]], 10000);
+ (* Test for RHBZ#579608, absolute symbolic links. *)
+ InitISOFS, Always, TestOutputInt (
+ [["wc_l"; "/abssymlink"]], 10000)],
"count lines in a file",
"\
This command counts the lines in a file, using the
("head", (RStringList "lines", [Pathname "path"]), 121, [ProtocolLimitWarning],
[InitISOFS, Always, TestOutputList (
- [["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
+ [["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"]);
+ (* Test for RHBZ#579608, absolute symbolic links. *)
+ InitISOFS, Always, TestOutputList (
+ [["head"; "/abssymlink"]], ["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
("mkswap", (RErr, [Device "device"]), 130, [],
[InitEmpty, Always, TestRun (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkswap"; "/dev/sda1"]])],
"create a swap partition",
"\
("mkswap_L", (RErr, [String "label"; Device "device"]), 131, [],
[InitEmpty, Always, TestRun (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkswap_L"; "hello"; "/dev/sda1"]])],
"create a swap partition with a label",
"\
(eg. C</dev/sda>), just to a partition. This appears to be
a limitation of the kernel or swap tools.");
- ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [],
+ ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [Optional "linuxfsuuid"],
(let uuid = uuidgen () in
[InitEmpty, Always, TestRun (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkswap_U"; uuid; "/dev/sda1"]])]),
"create a swap partition with an explicit UUID",
"\
Create a swap partition on C<device> with UUID C<uuid>.");
- ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [],
+ ("mknod", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 133, [Optional "mknod"],
[InitBasicFS, Always, TestOutputStruct (
[["mknod"; "0o10777"; "0"; "0"; "/node"];
(* NB: default umask 022 means 0777 -> 0755 in these tests *)
The C<mode> parameter should be the mode, using the standard
constants. C<devmajor> and C<devminor> are the
device major and minor numbers, only used when creating block
-and character special devices.");
+and character special devices.
- ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [],
+Note that, just like L<mknod(2)>, the mode must be bitwise
+OR'd with S_IFBLK, S_IFCHR, S_IFIFO or S_IFSOCK (otherwise this call
+just creates a regular file). These constants are
+available in the standard Linux header files, or you can use
+C<guestfs_mknod_b>, C<guestfs_mknod_c> or C<guestfs_mkfifo>
+which are wrappers around this command which bitwise OR
+in the appropriate constant for you.
+
+The mode actually set is affected by the umask.");
+
+ ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [Optional "mknod"],
[InitBasicFS, Always, TestOutputStruct (
[["mkfifo"; "0o777"; "/node"];
["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
"\
This call creates a FIFO (named pipe) called C<path> with
mode C<mode>. It is just a convenient wrapper around
-C<guestfs_mknod>.");
+C<guestfs_mknod>.
- ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [],
+The mode actually set is affected by the umask.");
+
+ ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [Optional "mknod"],
[InitBasicFS, Always, TestOutputStruct (
[["mknod_b"; "0o777"; "99"; "66"; "/node"];
["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
"\
This call creates a block device node called C<path> with
mode C<mode> and device major/minor C<devmajor> and C<devminor>.
-It is just a convenient wrapper around C<guestfs_mknod>.");
+It is just a convenient wrapper around C<guestfs_mknod>.
+
+The mode actually set is affected by the umask.");
- ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [],
+ ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 136, [Optional "mknod"],
[InitBasicFS, Always, TestOutputStruct (
[["mknod_c"; "0o777"; "99"; "66"; "/node"];
["stat"; "/node"]], [CompareWithInt ("mode", 0o20755)])],
"\
This call creates a char device node called C<path> with
mode C<mode> and device major/minor C<devmajor> and C<devminor>.
-It is just a convenient wrapper around C<guestfs_mknod>.");
+It is just a convenient wrapper around C<guestfs_mknod>.
- ("umask", (RInt "oldmask", [Int "mask"]), 137, [],
- [], (* XXX umask is one of those stateful things that we should
- * reset between each test.
- *)
+The mode actually set is affected by the umask.");
+
+ ("umask", (RInt "oldmask", [Int "mask"]), 137, [FishOutput FishOutputOctal],
+ [InitEmpty, Always, TestOutputInt (
+ [["umask"; "0o22"]], 0o22)],
"set file mode creation mask (umask)",
"\
This function sets the mask used for creating new files and
means that directories and device nodes will be created with
C<0644> or C<0755> mode even if you specify C<0777>.
-See also L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
+See also C<guestfs_get_umask>,
+L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
This call returns the previous umask.");
=item '?'
-The L<readdir(3)> returned a C<d_type> field with an
+The L<readdir(3)> call returned a C<d_type> field with an
unexpected value
=back
to specify the cyls, heads and sectors parameters which
were rarely if ever used anyway.
-See also C<guestfs_sfdisk> and the L<sfdisk(8)> manpage.");
+See also: C<guestfs_sfdisk>, the L<sfdisk(8)> manpage
+and C<guestfs_part_disk>");
("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
[],
Since 1.0.63, use C<guestfs_file> instead which can now
process compressed files.");
- ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [],
+ ("getxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 141, [Optional "linuxxattrs"],
[],
"list extended attributes of a file or directory",
"\
See also: C<guestfs_lgetxattrs>, L<attr(5)>.");
- ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [],
+ ("lgetxattrs", (RStructList ("xattrs", "xattr"), [Pathname "path"]), 142, [Optional "linuxxattrs"],
[],
"list extended attributes of a file or directory",
"\
("setxattr", (RErr, [String "xattr";
String "val"; Int "vallen"; (* will be BufferIn *)
- Pathname "path"]), 143, [],
+ Pathname "path"]), 143, [Optional "linuxxattrs"],
[],
"set extended attribute of a file or directory",
"\
("lsetxattr", (RErr, [String "xattr";
String "val"; Int "vallen"; (* will be BufferIn *)
- Pathname "path"]), 144, [],
+ Pathname "path"]), 144, [Optional "linuxxattrs"],
[],
"set extended attribute of a file or directory",
"\
is a symbolic link, then it sets an extended attribute
of the link itself.");
- ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [],
+ ("removexattr", (RErr, [String "xattr"; Pathname "path"]), 145, [Optional "linuxxattrs"],
[],
"remove extended attribute of a file or directory",
"\
See also: C<guestfs_lremovexattr>, L<attr(5)>.");
- ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [],
+ ("lremovexattr", (RErr, [String "xattr"; Pathname "path"]), 146, [Optional "linuxxattrs"],
[],
"remove extended attribute of a file or directory",
"\
device name to directory where the device is mounted.");
("mkmountpoint", (RErr, [String "exemptpath"]), 148, [],
- (* This is a special case: while you would expect a parameter
- * of type "Pathname", that doesn't work, because it implies
- * NEED_ROOT in the generated calling code in stubs.c, and
- * this function cannot use NEED_ROOT.
- *)
+ (* This is a special case: while you would expect a parameter
+ * of type "Pathname", that doesn't work, because it implies
+ * NEED_ROOT in the generated calling code in stubs.c, and
+ * this function cannot use NEED_ROOT.
+ *)
[],
"create a mountpoint",
"\
("read_file", (RBufferOut "content", [Pathname "path"]), 150, [ProtocolLimitWarning],
[InitISOFS, Always, TestOutputBuffer (
- [["read_file"; "/known-4"]], "abc\ndef\nghi")],
+ [["read_file"; "/known-4"]], "abc\ndef\nghi");
+ (* Test various near large, large and too large files (RHBZ#589039). *)
+ InitBasicFS, Always, TestLastFail (
+ [["touch"; "/a"];
+ ["truncate_size"; "/a"; "4194303"]; (* GUESTFS_MESSAGE_MAX - 1 *)
+ ["read_file"; "/a"]]);
+ InitBasicFS, Always, TestLastFail (
+ [["touch"; "/a"];
+ ["truncate_size"; "/a"; "4194304"]; (* GUESTFS_MESSAGE_MAX *)
+ ["read_file"; "/a"]]);
+ InitBasicFS, Always, TestLastFail (
+ [["touch"; "/a"];
+ ["truncate_size"; "/a"; "41943040"]; (* GUESTFS_MESSAGE_MAX * 10 *)
+ ["read_file"; "/a"]])],
"read a file",
"\
This calls returns the contents of the file C<path> as a
[InitISOFS, Always, TestOutputList (
[["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
InitISOFS, Always, TestOutputList (
- [["grep"; "nomatch"; "/test-grep.txt"]], [])],
+ [["grep"; "nomatch"; "/test-grep.txt"]], []);
+ (* Test for RHBZ#579608, absolute symbolic links. *)
+ InitISOFS, Always, TestOutputList (
+ [["grep"; "nomatch"; "/abssymlink"]], [])],
"return lines matching a pattern",
"\
This calls the external C<grep> program and returns the
This calls the external C<zfgrep -i> program and returns the
matching lines.");
- ("realpath", (RString "rpath", [Pathname "path"]), 163, [],
+ ("realpath", (RString "rpath", [Pathname "path"]), 163, [Optional "realpath"],
[InitISOFS, Always, TestOutput (
[["realpath"; "/../directory"]], "/directory")],
"canonicalized absolute pathname",
"\
This command reads the target of a symbolic link.");
- ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [],
+ ("fallocate", (RErr, [Pathname "path"; Int "len"]), 169, [DeprecatedBy "fallocate64"],
[InitBasicFS, Always, TestOutputStruct (
[["fallocate"; "/a"; "1000000"];
["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
("swapon_label", (RErr, [String "label"]), 174, [],
[InitEmpty, Always, TestRun (
- [["sfdiskM"; "/dev/sdb"; ","];
+ [["part_disk"; "/dev/sdb"; "mbr"];
["mkswap_L"; "swapit"; "/dev/sdb1"];
["swapon_label"; "swapit"];
["swapoff_label"; "swapit"];
This command disables the libguestfs appliance swap on
labeled swap partition.");
- ("swapon_uuid", (RErr, [String "uuid"]), 176, [],
+ ("swapon_uuid", (RErr, [String "uuid"]), 176, [Optional "linuxfsuuid"],
(let uuid = uuidgen () in
[InitEmpty, Always, TestRun (
[["mkswap_U"; uuid; "/dev/sdb"];
This command enables swap to a swap partition with the given UUID.
See C<guestfs_swapon_device> for other notes.");
- ("swapoff_uuid", (RErr, [String "uuid"]), 177, [],
+ ("swapoff_uuid", (RErr, [String "uuid"]), 177, [Optional "linuxfsuuid"],
[], (* XXX tested by swapon_uuid *)
"disable swap on swap partition by UUID",
"\
This command just writes a swap file signature to an existing
file. To create the file itself, use something like C<guestfs_fallocate>.");
- ("inotify_init", (RErr, [Int "maxevents"]), 179, [],
+ ("inotify_init", (RErr, [Int "maxevents"]), 179, [Optional "inotify"],
[InitISOFS, Always, TestRun (
[["inotify_init"; "0"]])],
"create an inotify handle",
via libguestfs. Note that there is one global inotify handle
per libguestfs instance.");
- ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [],
+ ("inotify_add_watch", (RInt64 "wd", [Pathname "path"; Int "mask"]), 180, [Optional "inotify"],
[InitBasicFS, Always, TestOutputList (
[["inotify_init"; "0"];
["inotify_add_watch"; "/"; "1073741823"];
defined by the Linux kernel ABI and are listed in
C</usr/include/sys/inotify.h>.");
- ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [],
+ ("inotify_rm_watch", (RErr, [Int(*XXX64*) "wd"]), 181, [Optional "inotify"],
[],
"remove an inotify watch",
"\
Remove a previously defined inotify watch.
See C<guestfs_inotify_add_watch>.");
- ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [],
+ ("inotify_read", (RStructList ("events", "inotify_event"), []), 182, [Optional "inotify"],
[],
"return list of inotify events",
"\
read events up to the maximum appliance-to-host message
size and leave remaining events in the queue.");
- ("inotify_files", (RStringList "paths", []), 183, [],
+ ("inotify_files", (RStringList "paths", []), 183, [Optional "inotify"],
[],
"return list of watched files that had events",
"\
which just returns a list of pathnames of objects that were
touched. The returned pathnames are sorted and deduplicated.");
- ("inotify_close", (RErr, []), 184, [],
+ ("inotify_close", (RErr, []), 184, [Optional "inotify"],
[],
"close the inotify handle",
"\
opened by inotify_init. It removes all watches, throws
away any pending events, and deallocates all resources.");
- ("setcon", (RErr, [String "context"]), 185, [],
+ ("setcon", (RErr, [String "context"]), 185, [Optional "selinux"],
[],
"set SELinux security context",
"\
See the documentation about SELINUX in L<guestfs(3)>.");
- ("getcon", (RString "context", []), 186, [],
+ ("getcon", (RString "context", []), 186, [Optional "selinux"],
[],
"get SELinux security context",
"\
("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
[InitEmpty, Always, TestOutput (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
- ["mount"; "/dev/sda1"; "/"];
- ["write_file"; "/new"; "new file contents"; "0"];
- ["cat"; "/new"]], "new file contents")],
+ ["mount_options"; ""; "/dev/sda1"; "/"];
+ ["write"; "/new"; "new file contents"];
+ ["cat"; "/new"]], "new file contents");
+ InitEmpty, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "mbr"];
+ ["mkfs_b"; "vfat"; "32768"; "/dev/sda1"]]);
+ InitEmpty, Always, TestLastFail (
+ [["part_disk"; "/dev/sda"; "mbr"];
+ ["mkfs_b"; "vfat"; "32769"; "/dev/sda1"]]);
+ InitEmpty, Always, TestLastFail (
+ [["part_disk"; "/dev/sda"; "mbr"];
+ ["mkfs_b"; "vfat"; "33280"; "/dev/sda1"]]);
+ InitEmpty, IfAvailable "ntfsprogs", TestRun (
+ [["part_disk"; "/dev/sda"; "mbr"];
+ ["mkfs_b"; "ntfs"; "32768"; "/dev/sda1"]])],
"make a filesystem with block size",
"\
This call is similar to C<guestfs_mkfs>, but it allows you to
control the block size of the resulting filesystem. Supported
block sizes depend on the filesystem type, but typically they
-are C<1024>, C<2048> or C<4096> only.");
+are C<1024>, C<2048> or C<4096> only.
+
+For VFAT and NTFS the C<blocksize> parameter is treated as
+the requested cluster size.");
("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
[InitEmpty, Always, TestOutput (
[["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"];
+ ["mount_options"; ""; "/dev/sda2"; "/"];
+ ["write"; "/new"; "new file contents"];
["cat"; "/new"]], "new file contents")],
"make ext2/3/4 external journal",
"\
[["sfdiskM"; "/dev/sda"; ",100 ,"];
["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
- ["mount"; "/dev/sda2"; "/"];
- ["write_file"; "/new"; "new file contents"; "0"];
+ ["mount_options"; ""; "/dev/sda2"; "/"];
+ ["write"; "/new"; "new file contents"];
["cat"; "/new"]], "new file contents")],
"make ext2/3/4 external journal with label",
"\
This creates an ext2 external journal on C<device> with label C<label>.");
- ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [],
+ ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [Optional "linuxfsuuid"],
(let uuid = uuidgen () in
[InitEmpty, Always, TestOutput (
[["sfdiskM"; "/dev/sda"; ",100 ,"];
["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
- ["mount"; "/dev/sda2"; "/"];
- ["write_file"; "/new"; "new file contents"; "0"];
+ ["mount_options"; ""; "/dev/sda2"; "/"];
+ ["write"; "/new"; "new file contents"];
["cat"; "/new"]], "new file contents")]),
"make ext2/3/4 external journal with UUID",
"\
See also C<guestfs_mke2journal_L>.");
- ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [],
+ ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [Optional "linuxfsuuid"],
[],
"make ext2/3/4 filesystem with external journal",
"\
See also C<guestfs_mke2journal_U>.");
- ("modprobe", (RErr, [String "modulename"]), 194, [],
+ ("modprobe", (RErr, [String "modulename"]), 194, [Optional "linuxmodules"],
[InitNone, Always, TestRun [["modprobe"; "fat"]]],
"load a kernel module",
"\
The kernel module must have been whitelisted when libguestfs
was built (see C<appliance/kmod.whitelist.in> in the source).");
-]
+ ("echo_daemon", (RString "output", [StringList "words"]), 195, [],
+ [InitNone, Always, TestOutput (
+ [["echo_daemon"; "This is a test"]], "This is a test"
+ )],
+ "echo arguments back to the client",
+ "\
+This command concatenates the list of C<words> passed with single spaces
+between them and returns the resulting string.
-let all_functions = non_daemon_functions @ daemon_functions
+You can use this command to test the connection through to the daemon.
-(* In some places we want the functions to be displayed sorted
- * alphabetically, so this is useful:
- *)
-let all_functions_sorted =
- List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
- compare n1 n2) all_functions
+See also C<guestfs_ping_daemon>.");
-(* Field types for structures. *)
-type field =
- | FChar (* C 'char' (really, a 7 bit byte). *)
- | FString (* nul-terminated ASCII string, NOT NULL. *)
- | FBuffer (* opaque buffer of bytes, (char *, int) pair *)
- | FUInt32
- | FInt32
- | FUInt64
- | FInt64
- | FBytes (* Any int measure that counts bytes. *)
- | FUUID (* 32 bytes long, NOT nul-terminated. *)
- | FOptPercent (* [0..100], or -1 meaning "not present". *)
+ ("find0", (RErr, [Pathname "directory"; FileOut "files"]), 196, [],
+ [], (* There is a regression test for this. *)
+ "find all files and directories, returning NUL-separated list",
+ "\
+This command lists out all files and directories, recursively,
+starting at C<directory>, placing the resulting list in the
+external file called C<files>.
-(* Because we generate extra parsing code for LVM command line tools,
- * we have to pull out the LVM columns separately here.
- *)
-let lvm_pv_cols = [
- "pv_name", FString;
- "pv_uuid", FUUID;
- "pv_fmt", FString;
- "pv_size", FBytes;
- "dev_size", FBytes;
- "pv_free", FBytes;
- "pv_used", FBytes;
- "pv_attr", FString (* XXX *);
- "pv_pe_count", FInt64;
- "pv_pe_alloc_count", FInt64;
- "pv_tags", FString;
- "pe_start", FBytes;
- "pv_mda_count", FInt64;
- "pv_mda_free", FBytes;
- (* Not in Fedora 10:
- "pv_mda_size", FBytes;
- *)
-]
-let lvm_vg_cols = [
- "vg_name", FString;
- "vg_uuid", FUUID;
- "vg_fmt", FString;
- "vg_attr", FString (* XXX *);
- "vg_size", FBytes;
- "vg_free", FBytes;
- "vg_sysid", FString;
- "vg_extent_size", FBytes;
- "vg_extent_count", FInt64;
- "vg_free_count", FInt64;
- "max_lv", FInt64;
- "max_pv", FInt64;
- "pv_count", FInt64;
- "lv_count", FInt64;
- "snap_count", FInt64;
- "vg_seqno", FInt64;
- "vg_tags", FString;
- "vg_mda_count", FInt64;
- "vg_mda_free", FBytes;
- (* Not in Fedora 10:
- "vg_mda_size", FBytes;
- *)
-]
-let lvm_lv_cols = [
- "lv_name", FString;
- "lv_uuid", FUUID;
- "lv_attr", FString (* XXX *);
- "lv_major", FInt64;
- "lv_minor", FInt64;
- "lv_kernel_major", FInt64;
- "lv_kernel_minor", FInt64;
- "lv_size", FBytes;
- "seg_count", FInt64;
- "origin", FString;
- "snap_percent", FOptPercent;
- "copy_percent", FOptPercent;
- "move_pv", FString;
- "lv_tags", FString;
- "mirror_log", FString;
- "modules", FString;
-]
+This command works the same way as C<guestfs_find> with the
+following exceptions:
-(* Names and fields in all structures (in RStruct and RStructList)
- * that we support.
- *)
-let structs = [
- (* The old RIntBool return type, only ever used for aug_defnode. Do
- * not use this struct in any new code.
- *)
- "int_bool", [
- "i", FInt32; (* for historical compatibility *)
- "b", FInt32; (* for historical compatibility *)
- ];
+=over 4
- (* LVM PVs, VGs, LVs. *)
- "lvm_pv", lvm_pv_cols;
- "lvm_vg", lvm_vg_cols;
- "lvm_lv", lvm_lv_cols;
+=item *
+
+The resulting list is written to an external file.
+
+=item *
+
+Items (filenames) in the result are separated
+by C<\\0> characters. See L<find(1)> option I<-print0>.
+
+=item *
+
+This command is not limited in the number of names that it
+can return.
+
+=item *
+
+The result list is not sorted.
+
+=back");
+
+ ("case_sensitive_path", (RString "rpath", [Pathname "path"]), 197, [],
+ [InitISOFS, Always, TestOutput (
+ [["case_sensitive_path"; "/DIRECTORY"]], "/directory");
+ InitISOFS, Always, TestOutput (
+ [["case_sensitive_path"; "/DIRECTORY/"]], "/directory");
+ InitISOFS, Always, TestOutput (
+ [["case_sensitive_path"; "/Known-1"]], "/known-1");
+ InitISOFS, Always, TestLastFail (
+ [["case_sensitive_path"; "/Known-1/"]]);
+ InitBasicFS, Always, TestOutput (
+ [["mkdir"; "/a"];
+ ["mkdir"; "/a/bbb"];
+ ["touch"; "/a/bbb/c"];
+ ["case_sensitive_path"; "/A/bbB/C"]], "/a/bbb/c");
+ InitBasicFS, Always, TestOutput (
+ [["mkdir"; "/a"];
+ ["mkdir"; "/a/bbb"];
+ ["touch"; "/a/bbb/c"];
+ ["case_sensitive_path"; "/A////bbB/C"]], "/a/bbb/c");
+ InitBasicFS, Always, TestLastFail (
+ [["mkdir"; "/a"];
+ ["mkdir"; "/a/bbb"];
+ ["touch"; "/a/bbb/c"];
+ ["case_sensitive_path"; "/A/bbb/../bbb/C"]])],
+ "return true path on case-insensitive filesystem",
+ "\
+This can be used to resolve case insensitive paths on
+a filesystem which is case sensitive. The use case is
+to resolve paths which you have read from Windows configuration
+files or the Windows Registry, to the true path.
+
+The command handles a peculiarity of the Linux ntfs-3g
+filesystem driver (and probably others), which is that although
+the underlying filesystem is case-insensitive, the driver
+exports the filesystem to Linux as case-sensitive.
+
+One consequence of this is that special directories such
+as C<c:\\windows> may appear as C</WINDOWS> or C</windows>
+(or other things) depending on the precise details of how
+they were created. In Windows itself this would not be
+a problem.
+
+Bug or feature? You decide:
+L<http://www.tuxera.com/community/ntfs-3g-faq/#posixfilenames1>
+
+This function resolves the true case of each element in the
+path and returns the case-sensitive path.
+
+Thus C<guestfs_case_sensitive_path> (\"/Windows/System32\")
+might return C<\"/WINDOWS/system32\"> (the exact return value
+would depend on details of how the directories were originally
+created under Windows).
+
+I<Note>:
+This function does not handle drive names, backslashes etc.
+
+See also C<guestfs_realpath>.");
+
+ ("vfs_type", (RString "fstype", [Device "device"]), 198, [],
+ [InitBasicFS, Always, TestOutput (
+ [["vfs_type"; "/dev/sda1"]], "ext2")],
+ "get the Linux VFS type corresponding to a mounted device",
+ "\
+This command gets the filesystem type corresponding to
+the filesystem on C<device>.
+
+For most filesystems, the result is the name of the Linux
+VFS module which would be used to mount this filesystem
+if you mounted it without specifying the filesystem type.
+For example a string such as C<ext3> or C<ntfs>.");
+
+ ("truncate", (RErr, [Pathname "path"]), 199, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["write"; "/test"; "some stuff so size is not zero"];
+ ["truncate"; "/test"];
+ ["stat"; "/test"]], [CompareWithInt ("size", 0)])],
+ "truncate a file to zero size",
+ "\
+This command truncates C<path> to a zero-length file. The
+file must exist already.");
+
+ ("truncate_size", (RErr, [Pathname "path"; Int64 "size"]), 200, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["touch"; "/test"];
+ ["truncate_size"; "/test"; "1000"];
+ ["stat"; "/test"]], [CompareWithInt ("size", 1000)])],
+ "truncate a file to a particular size",
+ "\
+This command truncates C<path> to size C<size> bytes. The file
+must exist already.
+
+If the current file size is less than C<size> then
+the file is extended to the required size with zero bytes.
+This creates a sparse file (ie. disk blocks are not allocated
+for the file until you write to it). To create a non-sparse
+file of zeroes, use C<guestfs_fallocate64> instead.");
+
+ ("utimens", (RErr, [Pathname "path"; Int64 "atsecs"; Int64 "atnsecs"; Int64 "mtsecs"; Int64 "mtnsecs"]), 201, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["touch"; "/test"];
+ ["utimens"; "/test"; "12345"; "67890"; "9876"; "5432"];
+ ["stat"; "/test"]], [CompareWithInt ("mtime", 9876)])],
+ "set timestamp of a file with nanosecond precision",
+ "\
+This command sets the timestamps of a file with nanosecond
+precision.
+
+C<atsecs, atnsecs> are the last access time (atime) in secs and
+nanoseconds from the epoch.
+
+C<mtsecs, mtnsecs> are the last modification time (mtime) in
+secs and nanoseconds from the epoch.
+
+If the C<*nsecs> field contains the special value C<-1> then
+the corresponding timestamp is set to the current time. (The
+C<*secs> field is ignored in this case).
+
+If the C<*nsecs> field contains the special value C<-2> then
+the corresponding timestamp is left unchanged. (The
+C<*secs> field is ignored in this case).");
+
+ ("mkdir_mode", (RErr, [Pathname "path"; Int "mode"]), 202, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["mkdir_mode"; "/test"; "0o111"];
+ ["stat"; "/test"]], [CompareWithInt ("mode", 0o40111)])],
+ "create a directory with a particular mode",
+ "\
+This command creates a directory, setting the initial permissions
+of the directory to C<mode>.
+
+For common Linux filesystems, the actual mode which is set will
+be C<mode & ~umask & 01777>. Non-native-Linux filesystems may
+interpret the mode in other ways.
+
+See also C<guestfs_mkdir>, C<guestfs_umask>");
+
+ ("lchown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 203, [],
+ [], (* XXX *)
+ "change file owner and group",
+ "\
+Change the file owner to C<owner> and group to C<group>.
+This is like C<guestfs_chown> but if C<path> is a symlink then
+the link itself is changed, not the target.
+
+Only numeric uid and gid are supported. If you want to use
+names, you will need to locate and parse the password file
+yourself (Augeas support makes this relatively easy).");
+
+ ("lstatlist", (RStructList ("statbufs", "stat"), [Pathname "path"; StringList "names"]), 204, [],
+ [], (* XXX *)
+ "lstat on multiple files",
+ "\
+This call allows you to perform the C<guestfs_lstat> operation
+on multiple files, where all files are in the directory C<path>.
+C<names> is the list of files from this directory.
+
+On return you get a list of stat structs, with a one-to-one
+correspondence to the C<names> list. If any name did not exist
+or could not be lstat'd, then the C<ino> field of that structure
+is set to C<-1>.
+
+This call is intended for programs that want to efficiently
+list a directory contents without making many round-trips.
+See also C<guestfs_lxattrlist> for a similarly efficient call
+for getting extended attributes. Very long directory listings
+might cause the protocol message size to be exceeded, causing
+this call to fail. The caller must split up such requests
+into smaller groups of names.");
+
+ ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [Optional "linuxxattrs"],
+ [], (* XXX *)
+ "lgetxattr on multiple files",
+ "\
+This call allows you to get the extended attributes
+of multiple files, where all files are in the directory C<path>.
+C<names> is the list of files from this directory.
+
+On return you get a flat list of xattr structs which must be
+interpreted sequentially. The first xattr struct always has a zero-length
+C<attrname>. C<attrval> in this struct is zero-length
+to indicate there was an error doing C<lgetxattr> for this
+file, I<or> is a C string which is a decimal number
+(the number of following attributes for this file, which could
+be C<\"0\">). Then after the first xattr struct are the
+zero or more attributes for the first named file.
+This repeats for the second and subsequent files.
+
+This call is intended for programs that want to efficiently
+list a directory contents without making many round-trips.
+See also C<guestfs_lstatlist> for a similarly efficient call
+for getting standard stats. Very long directory listings
+might cause the protocol message size to be exceeded, causing
+this call to fail. The caller must split up such requests
+into smaller groups of names.");
+
+ ("readlinklist", (RStringList "links", [Pathname "path"; StringList "names"]), 206, [],
+ [], (* XXX *)
+ "readlink on multiple files",
+ "\
+This call allows you to do a C<readlink> operation
+on multiple files, where all files are in the directory C<path>.
+C<names> is the list of files from this directory.
+
+On return you get a list of strings, with a one-to-one
+correspondence to the C<names> list. Each string is the
+value of the symbolic link.
+
+If the C<readlink(2)> operation fails on any name, then
+the corresponding result string is the empty string C<\"\">.
+However the whole operation is completed even if there
+were C<readlink(2)> errors, and so you can call this
+function with names where you don't know if they are
+symbolic links already (albeit slightly less efficient).
+
+This call is intended for programs that want to efficiently
+list a directory contents without making many round-trips.
+Very long directory listings might cause the protocol
+message size to be exceeded, causing
+this call to fail. The caller must split up such requests
+into smaller groups of names.");
+
+ ("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputBuffer (
+ [["pread"; "/known-4"; "1"; "3"]], "\n");
+ InitISOFS, Always, TestOutputBuffer (
+ [["pread"; "/empty"; "0"; "100"]], "")],
+ "read part of a file",
+ "\
+This command lets you read part of a file. It reads C<count>
+bytes of the file, starting at C<offset>, from file C<path>.
+
+This may read fewer bytes than requested. For further details
+see the L<pread(2)> system call.
+
+See also C<guestfs_pwrite>.");
+
+ ("part_init", (RErr, [Device "device"; String "parttype"]), 208, [],
+ [InitEmpty, Always, TestRun (
+ [["part_init"; "/dev/sda"; "gpt"]])],
+ "create an empty partition table",
+ "\
+This creates an empty partition table on C<device> of one of the
+partition types listed below. Usually C<parttype> should be
+either C<msdos> or C<gpt> (for large disks).
+
+Initially there are no partitions. Following this, you should
+call C<guestfs_part_add> for each partition required.
+
+Possible values for C<parttype> are:
+
+=over 4
+
+=item B<efi> | B<gpt>
+
+Intel EFI / GPT partition table.
+
+This is recommended for >= 2 TB partitions that will be accessed
+from Linux and Intel-based Mac OS X. It also has limited backwards
+compatibility with the C<mbr> format.
+
+=item B<mbr> | B<msdos>
+
+The standard PC \"Master Boot Record\" (MBR) format used
+by MS-DOS and Windows. This partition type will B<only> work
+for device sizes up to 2 TB. For large disks we recommend
+using C<gpt>.
+
+=back
+
+Other partition table types that may work but are not
+supported include:
+
+=over 4
+
+=item B<aix>
+
+AIX disk labels.
+
+=item B<amiga> | B<rdb>
+
+Amiga \"Rigid Disk Block\" format.
+
+=item B<bsd>
+
+BSD disk labels.
+
+=item B<dasd>
+
+DASD, used on IBM mainframes.
+
+=item B<dvh>
+
+MIPS/SGI volumes.
+
+=item B<mac>
+
+Old Mac partition format. Modern Macs use C<gpt>.
+
+=item B<pc98>
+
+NEC PC-98 format, common in Japan apparently.
+
+=item B<sun>
+
+Sun disk labels.
+
+=back");
+
+ ("part_add", (RErr, [Device "device"; String "prlogex"; Int64 "startsect"; Int64 "endsect"]), 209, [],
+ [InitEmpty, Always, TestRun (
+ [["part_init"; "/dev/sda"; "mbr"];
+ ["part_add"; "/dev/sda"; "primary"; "1"; "-1"]]);
+ InitEmpty, Always, TestRun (
+ [["part_init"; "/dev/sda"; "gpt"];
+ ["part_add"; "/dev/sda"; "primary"; "34"; "127"];
+ ["part_add"; "/dev/sda"; "primary"; "128"; "-34"]]);
+ InitEmpty, Always, TestRun (
+ [["part_init"; "/dev/sda"; "mbr"];
+ ["part_add"; "/dev/sda"; "primary"; "32"; "127"];
+ ["part_add"; "/dev/sda"; "primary"; "128"; "255"];
+ ["part_add"; "/dev/sda"; "primary"; "256"; "511"];
+ ["part_add"; "/dev/sda"; "primary"; "512"; "-1"]])],
+ "add a partition to the device",
+ "\
+This command adds a partition to C<device>. If there is no partition
+table on the device, call C<guestfs_part_init> first.
+
+The C<prlogex> parameter is the type of partition. Normally you
+should pass C<p> or C<primary> here, but MBR partition tables also
+support C<l> (or C<logical>) and C<e> (or C<extended>) partition
+types.
+
+C<startsect> and C<endsect> are the start and end of the partition
+in I<sectors>. C<endsect> may be negative, which means it counts
+backwards from the end of the disk (C<-1> is the last sector).
+
+Creating a partition which covers the whole disk is not so easy.
+Use C<guestfs_part_disk> to do that.");
+
+ ("part_disk", (RErr, [Device "device"; String "parttype"]), 210, [DangerWillRobinson],
+ [InitEmpty, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "mbr"]]);
+ InitEmpty, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "gpt"]])],
+ "partition whole disk with a single primary partition",
+ "\
+This command is simply a combination of C<guestfs_part_init>
+followed by C<guestfs_part_add> to create a single primary partition
+covering the whole disk.
+
+C<parttype> is the partition table type, usually C<mbr> or C<gpt>,
+but other possible values are described in C<guestfs_part_init>.");
+
+ ("part_set_bootable", (RErr, [Device "device"; Int "partnum"; Bool "bootable"]), 211, [],
+ [InitEmpty, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "mbr"];
+ ["part_set_bootable"; "/dev/sda"; "1"; "true"]])],
+ "make a partition bootable",
+ "\
+This sets the bootable flag on partition numbered C<partnum> on
+device C<device>. Note that partitions are numbered from 1.
+
+The bootable flag is used by some operating systems (notably
+Windows) to determine which partition to boot from. It is by
+no means universally recognized.");
+
+ ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [],
+ [InitEmpty, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "gpt"];
+ ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])],
+ "set partition name",
+ "\
+This sets the partition name on partition numbered C<partnum> on
+device C<device>. Note that partitions are numbered from 1.
+
+The partition name can only be set on certain types of partition
+table. This works on C<gpt> but not on C<mbr> partitions.");
+
+ ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [],
+ [], (* XXX Add a regression test for this. *)
+ "list partitions on a device",
+ "\
+This command parses the partition table on C<device> and
+returns the list of partitions found.
+
+The fields in the returned structure are:
+
+=over 4
+
+=item B<part_num>
+
+Partition number, counting from 1.
+
+=item B<part_start>
+
+Start of the partition I<in bytes>. To get sectors you have to
+divide by the device's sector size, see C<guestfs_blockdev_getss>.
+
+=item B<part_end>
+
+End of the partition in bytes.
+
+=item B<part_size>
+
+Size of the partition in bytes.
+
+=back");
+
+ ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [],
+ [InitEmpty, Always, TestOutput (
+ [["part_disk"; "/dev/sda"; "gpt"];
+ ["part_get_parttype"; "/dev/sda"]], "gpt")],
+ "get the partition table type",
+ "\
+This command examines the partition table on C<device> and
+returns the partition table type (format) being used.
+
+Common return values include: C<msdos> (a DOS/Windows style MBR
+partition table), C<gpt> (a GPT/EFI-style partition table). Other
+values are possible, although unusual. See C<guestfs_part_init>
+for a full list.");
+
+ ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
+ [InitBasicFS, Always, TestOutputBuffer (
+ [["fill"; "0x63"; "10"; "/test"];
+ ["read_file"; "/test"]], "cccccccccc")],
+ "fill a file with octets",
+ "\
+This command creates a new file called C<path>. The initial
+content of the file is C<len> octets of C<c>, where C<c>
+must be a number in the range C<[0..255]>.
+
+To fill a file with zero bytes (sparsely), it is
+much more efficient to use C<guestfs_truncate_size>.
+To create a file with a pattern of repeating bytes
+use C<guestfs_fill_pattern>.");
+
+ ("available", (RErr, [StringList "groups"]), 216, [],
+ [InitNone, Always, TestRun [["available"; ""]]],
+ "test availability of some parts of the API",
+ "\
+This command is used to check the availability of some
+groups of functionality in the appliance, which not all builds of
+the libguestfs appliance will be able to provide.
+
+The libguestfs groups, and the functions that those
+groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
+You can also fetch this list at runtime by calling
+C<guestfs_available_all_groups>.
+
+The argument C<groups> is a list of group names, eg:
+C<[\"inotify\", \"augeas\"]> would check for the availability of
+the Linux inotify functions and Augeas (configuration file
+editing) functions.
+
+The command returns no error if I<all> requested groups are available.
+
+It fails with an error if one or more of the requested
+groups is unavailable in the appliance.
+
+If an unknown group name is included in the
+list of groups then an error is always returned.
+
+I<Notes:>
+
+=over 4
+
+=item *
+
+You must call C<guestfs_launch> before calling this function.
+
+The reason is because we don't know what groups are
+supported by the appliance/daemon until it is running and can
+be queried.
+
+=item *
+
+If a group of functions is available, this does not necessarily
+mean that they will work. You still have to check for errors
+when calling individual API functions even if they are
+available.
+
+=item *
+
+It is usually the job of distro packagers to build
+complete functionality into the libguestfs appliance.
+Upstream libguestfs, if built from source with all
+requirements satisfied, will support everything.
+
+=item *
+
+This call was added in version C<1.0.80>. In previous
+versions of libguestfs all you could do would be to speculatively
+execute a command to find out if the daemon implemented it.
+See also C<guestfs_version>.
+
+=back");
+
+ ("dd", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"]), 217, [],
+ [InitBasicFS, Always, TestOutputBuffer (
+ [["write"; "/src"; "hello, world"];
+ ["dd"; "/src"; "/dest"];
+ ["read_file"; "/dest"]], "hello, world")],
+ "copy from source to destination using dd",
+ "\
+This command copies from one source device or file C<src>
+to another destination device or file C<dest>. Normally you
+would use this to copy to or from a device or partition, for
+example to duplicate a filesystem.
+
+If the destination is a device, it must be as large or larger
+than the source file or device, otherwise the copy will fail.
+This command cannot do partial copies (see C<guestfs_copy_size>).");
+
+ ("filesize", (RInt64 "size", [Pathname "file"]), 218, [],
+ [InitBasicFS, Always, TestOutputInt (
+ [["write"; "/file"; "hello, world"];
+ ["filesize"; "/file"]], 12)],
+ "return the size of the file in bytes",
+ "\
+This command returns the size of C<file> in bytes.
+
+To get other stats about a file, use C<guestfs_stat>, C<guestfs_lstat>,
+C<guestfs_is_dir>, C<guestfs_is_file> etc.
+To get the size of block devices, use C<guestfs_blockdev_getsize64>.");
+
+ ("lvrename", (RErr, [String "logvol"; String "newlogvol"]), 219, [],
+ [InitBasicFSonLVM, Always, TestOutputList (
+ [["lvrename"; "/dev/VG/LV"; "/dev/VG/LV2"];
+ ["lvs"]], ["/dev/VG/LV2"])],
+ "rename an LVM logical volume",
+ "\
+Rename a logical volume C<logvol> with the new name C<newlogvol>.");
+
+ ("vgrename", (RErr, [String "volgroup"; String "newvolgroup"]), 220, [],
+ [InitBasicFSonLVM, Always, TestOutputList (
+ [["umount"; "/"];
+ ["vg_activate"; "false"; "VG"];
+ ["vgrename"; "VG"; "VG2"];
+ ["vg_activate"; "true"; "VG2"];
+ ["mount_options"; ""; "/dev/VG2/LV"; "/"];
+ ["vgs"]], ["VG2"])],
+ "rename an LVM volume group",
+ "\
+Rename a volume group C<volgroup> with the new name C<newvolgroup>.");
+
+ ("initrd_cat", (RBufferOut "content", [Pathname "initrdpath"; String "filename"]), 221, [ProtocolLimitWarning],
+ [InitISOFS, Always, TestOutputBuffer (
+ [["initrd_cat"; "/initrd"; "known-4"]], "abc\ndef\nghi")],
+ "list the contents of a single file in an initrd",
+ "\
+This command unpacks the file C<filename> from the initrd file
+called C<initrdpath>. The filename must be given I<without> the
+initial C</> character.
+
+For example, in guestfish you could use the following command
+to examine the boot script (usually called C</init>)
+contained in a Linux initrd or initramfs image:
+
+ initrd-cat /boot/initrd-<version>.img init
+
+See also C<guestfs_initrd_list>.");
+
+ ("pvuuid", (RString "uuid", [Device "device"]), 222, [],
+ [],
+ "get the UUID of a physical volume",
+ "\
+This command returns the UUID of the LVM PV C<device>.");
+
+ ("vguuid", (RString "uuid", [String "vgname"]), 223, [],
+ [],
+ "get the UUID of a volume group",
+ "\
+This command returns the UUID of the LVM VG named C<vgname>.");
+
+ ("lvuuid", (RString "uuid", [Device "device"]), 224, [],
+ [],
+ "get the UUID of a logical volume",
+ "\
+This command returns the UUID of the LVM LV C<device>.");
+
+ ("vgpvuuids", (RStringList "uuids", [String "vgname"]), 225, [],
+ [],
+ "get the PV UUIDs containing the volume group",
+ "\
+Given a VG called C<vgname>, this returns the UUIDs of all
+the physical volumes that this volume group resides on.
+
+You can use this along with C<guestfs_pvs> and C<guestfs_pvuuid>
+calls to associate physical volumes and volume groups.
+
+See also C<guestfs_vglvuuids>.");
+
+ ("vglvuuids", (RStringList "uuids", [String "vgname"]), 226, [],
+ [],
+ "get the LV UUIDs of all LVs in the volume group",
+ "\
+Given a VG called C<vgname>, this returns the UUIDs of all
+the logical volumes created in this volume group.
+
+You can use this along with C<guestfs_lvs> and C<guestfs_lvuuid>
+calls to associate logical volumes and volume groups.
+
+See also C<guestfs_vgpvuuids>.");
+
+ ("copy_size", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"; Int64 "size"]), 227, [],
+ [InitBasicFS, Always, TestOutputBuffer (
+ [["write"; "/src"; "hello, world"];
+ ["copy_size"; "/src"; "/dest"; "5"];
+ ["read_file"; "/dest"]], "hello")],
+ "copy size bytes from source to destination using dd",
+ "\
+This command copies exactly C<size> bytes from one source device
+or file C<src> to another destination device or file C<dest>.
+
+Note this will fail if the source is too short or if the destination
+is not large enough.");
+
+ ("zero_device", (RErr, [Device "device"]), 228, [DangerWillRobinson],
+ [InitBasicFSonLVM, Always, TestRun (
+ [["zero_device"; "/dev/VG/LV"]])],
+ "write zeroes to an entire device",
+ "\
+This command writes zeroes over the entire C<device>. Compare
+with C<guestfs_zero> which just zeroes the first few blocks of
+a device.");
+
+ ("txz_in", (RErr, [FileIn "tarball"; Pathname "directory"]), 229, [Optional "xz"],
+ [InitBasicFS, Always, TestOutput (
+ [["txz_in"; "../images/helloworld.tar.xz"; "/"];
+ ["cat"; "/hello"]], "hello\n")],
+ "unpack compressed tarball to directory",
+ "\
+This command uploads and unpacks local file C<tarball> (an
+I<xz compressed> tar file) into C<directory>.");
+
+ ("txz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 230, [Optional "xz"],
+ [],
+ "pack directory into compressed tarball",
+ "\
+This command packs the contents of C<directory> and downloads
+it to local file C<tarball> (as an xz compressed tar archive).");
+
+ ("ntfsresize", (RErr, [Device "device"]), 231, [Optional "ntfsprogs"],
+ [],
+ "resize an NTFS filesystem",
+ "\
+This command resizes an NTFS filesystem, expanding or
+shrinking it to the size of the underlying device.
+See also L<ntfsresize(8)>.");
+
+ ("vgscan", (RErr, []), 232, [],
+ [InitEmpty, Always, TestRun (
+ [["vgscan"]])],
+ "rescan for LVM physical volumes, volume groups and logical volumes",
+ "\
+This rescans all block devices and rebuilds the list of LVM
+physical volumes, volume groups and logical volumes.");
+
+ ("part_del", (RErr, [Device "device"; Int "partnum"]), 233, [],
+ [InitEmpty, Always, TestRun (
+ [["part_init"; "/dev/sda"; "mbr"];
+ ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
+ ["part_del"; "/dev/sda"; "1"]])],
+ "delete a partition",
+ "\
+This command deletes the partition numbered C<partnum> on C<device>.
+
+Note that in the case of MBR partitioning, deleting an
+extended partition also deletes any logical partitions
+it contains.");
+
+ ("part_get_bootable", (RBool "bootable", [Device "device"; Int "partnum"]), 234, [],
+ [InitEmpty, Always, TestOutputTrue (
+ [["part_init"; "/dev/sda"; "mbr"];
+ ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
+ ["part_set_bootable"; "/dev/sda"; "1"; "true"];
+ ["part_get_bootable"; "/dev/sda"; "1"]])],
+ "return true if a partition is bootable",
+ "\
+This command returns true if the partition C<partnum> on
+C<device> has the bootable flag set.
+
+See also C<guestfs_part_set_bootable>.");
+
+ ("part_get_mbr_id", (RInt "idbyte", [Device "device"; Int "partnum"]), 235, [FishOutput FishOutputHexadecimal],
+ [InitEmpty, Always, TestOutputInt (
+ [["part_init"; "/dev/sda"; "mbr"];
+ ["part_add"; "/dev/sda"; "primary"; "1"; "-1"];
+ ["part_set_mbr_id"; "/dev/sda"; "1"; "0x7f"];
+ ["part_get_mbr_id"; "/dev/sda"; "1"]], 0x7f)],
+ "get the MBR type byte (ID byte) from a partition",
+ "\
+Returns the MBR type byte (also known as the ID byte) from
+the numbered partition C<partnum>.
+
+Note that only MBR (old DOS-style) partitions have type bytes.
+You will get undefined results for other partition table
+types (see C<guestfs_part_get_parttype>).");
+
+ ("part_set_mbr_id", (RErr, [Device "device"; Int "partnum"; Int "idbyte"]), 236, [],
+ [], (* tested by part_get_mbr_id *)
+ "set the MBR type byte (ID byte) of a partition",
+ "\
+Sets the MBR type byte (also known as the ID byte) of
+the numbered partition C<partnum> to C<idbyte>. Note
+that the type bytes quoted in most documentation are
+in fact hexadecimal numbers, but usually documented
+without any leading \"0x\" which might be confusing.
+
+Note that only MBR (old DOS-style) partitions have type bytes.
+You will get undefined results for other partition table
+types (see C<guestfs_part_get_parttype>).");
+
+ ("checksum_device", (RString "checksum", [String "csumtype"; Device "device"]), 237, [],
+ [InitISOFS, Always, TestOutput (
+ [["checksum_device"; "md5"; "/dev/sdd"]],
+ (Digest.to_hex (Digest.file "images/test.iso")))],
+ "compute MD5, SHAx or CRC checksum of the contents of a device",
+ "\
+This call computes the MD5, SHAx or CRC checksum of the
+contents of the device named C<device>. For the types of
+checksums supported see the C<guestfs_checksum> command.");
+
+ ("lvresize_free", (RErr, [Device "lv"; Int "percent"]), 238, [Optional "lvm2"],
+ [InitNone, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "mbr"];
+ ["pvcreate"; "/dev/sda1"];
+ ["vgcreate"; "VG"; "/dev/sda1"];
+ ["lvcreate"; "LV"; "VG"; "10"];
+ ["lvresize_free"; "/dev/VG/LV"; "100"]])],
+ "expand an LV to fill free space",
+ "\
+This expands an existing logical volume C<lv> so that it fills
+C<pc>% of the remaining free space in the volume group. Commonly
+you would call this with pc = 100 which expands the logical volume
+as much as possible, using all remaining free space in the volume
+group.");
+
+ ("aug_clear", (RErr, [String "augpath"]), 239, [Optional "augeas"],
+ [], (* XXX Augeas code needs tests. *)
+ "clear Augeas path",
+ "\
+Set the value associated with C<path> to C<NULL>. This
+is the same as the L<augtool(1)> C<clear> command.");
+
+ ("get_umask", (RInt "mask", []), 240, [FishOutput FishOutputOctal],
+ [InitEmpty, Always, TestOutputInt (
+ [["get_umask"]], 0o22)],
+ "get the current umask",
+ "\
+Return the current umask. By default the umask is C<022>
+unless it has been set by calling C<guestfs_umask>.");
+
+ ("debug_upload", (RErr, [FileIn "filename"; String "tmpname"; Int "mode"]), 241, [],
+ [],
+ "upload a file to the appliance (internal use only)",
+ "\
+The C<guestfs_debug_upload> command uploads a file to
+the libguestfs appliance.
+
+There is no comprehensive help for this command. You have
+to look at the file C<daemon/debug.c> in the libguestfs source
+to find out what it is for.");
+
+ ("base64_in", (RErr, [FileIn "base64file"; Pathname "filename"]), 242, [],
+ [InitBasicFS, Always, TestOutput (
+ [["base64_in"; "../images/hello.b64"; "/hello"];
+ ["cat"; "/hello"]], "hello\n")],
+ "upload base64-encoded data to file",
+ "\
+This command uploads base64-encoded data from C<base64file>
+to C<filename>.");
+
+ ("base64_out", (RErr, [Pathname "filename"; FileOut "base64file"]), 243, [],
+ [],
+ "download file and encode as base64",
+ "\
+This command downloads the contents of C<filename>, writing
+it out to local file C<base64file> encoded as base64.");
+
+ ("checksums_out", (RErr, [String "csumtype"; Pathname "directory"; FileOut "sumsfile"]), 244, [],
+ [],
+ "compute MD5, SHAx or CRC checksum of files in a directory",
+ "\
+This command computes the checksums of all regular files in
+C<directory> and then emits a list of those checksums to
+the local output file C<sumsfile>.
+
+This can be used for verifying the integrity of a virtual
+machine. However to be properly secure you should pay
+attention to the output of the checksum command (it uses
+the ones from GNU coreutils). In particular when the
+filename is not printable, coreutils uses a special
+backslash syntax. For more information, see the GNU
+coreutils info file.");
+
+ ("fill_pattern", (RErr, [String "pattern"; Int "len"; Pathname "path"]), 245, [],
+ [InitBasicFS, Always, TestOutputBuffer (
+ [["fill_pattern"; "abcdefghijklmnopqrstuvwxyz"; "28"; "/test"];
+ ["read_file"; "/test"]], "abcdefghijklmnopqrstuvwxyzab")],
+ "fill a file with a repeating pattern of bytes",
+ "\
+This function is like C<guestfs_fill> except that it creates
+a new file of length C<len> containing the repeating pattern
+of bytes in C<pattern>. The pattern is truncated if necessary
+to ensure the length of the file is exactly C<len> bytes.");
+
+ ("write", (RErr, [Pathname "path"; BufferIn "content"]), 246, [ProtocolLimitWarning],
+ [InitBasicFS, Always, TestOutput (
+ [["write"; "/new"; "new file contents"];
+ ["cat"; "/new"]], "new file contents");
+ InitBasicFS, Always, TestOutput (
+ [["write"; "/new"; "\nnew file contents\n"];
+ ["cat"; "/new"]], "\nnew file contents\n");
+ InitBasicFS, Always, TestOutput (
+ [["write"; "/new"; "\n\n"];
+ ["cat"; "/new"]], "\n\n");
+ InitBasicFS, Always, TestOutput (
+ [["write"; "/new"; ""];
+ ["cat"; "/new"]], "");
+ InitBasicFS, Always, TestOutput (
+ [["write"; "/new"; "\n\n\n"];
+ ["cat"; "/new"]], "\n\n\n");
+ InitBasicFS, Always, TestOutput (
+ [["write"; "/new"; "\n"];
+ ["cat"; "/new"]], "\n")],
+ "create a new file",
+ "\
+This call creates a file called C<path>. The content of the
+file is the string C<content> (which can contain any 8 bit data).");
+
+ ("pwrite", (RInt "nbytes", [Pathname "path"; BufferIn "content"; Int64 "offset"]), 247, [ProtocolLimitWarning],
+ [InitBasicFS, Always, TestOutput (
+ [["write"; "/new"; "new file contents"];
+ ["pwrite"; "/new"; "data"; "4"];
+ ["cat"; "/new"]], "new data contents");
+ InitBasicFS, Always, TestOutput (
+ [["write"; "/new"; "new file contents"];
+ ["pwrite"; "/new"; "is extended"; "9"];
+ ["cat"; "/new"]], "new file is extended");
+ InitBasicFS, Always, TestOutput (
+ [["write"; "/new"; "new file contents"];
+ ["pwrite"; "/new"; ""; "4"];
+ ["cat"; "/new"]], "new file contents")],
+ "write to part of a file",
+ "\
+This command writes to part of a file. It writes the data
+buffer C<content> to the file C<path> starting at offset C<offset>.
+
+This command implements the L<pwrite(2)> system call, and like
+that system call it may not write the full data requested. The
+return value is the number of bytes that were actually written
+to the file. This could even be 0, although short writes are
+unlikely for regular files in ordinary circumstances.
+
+See also C<guestfs_pread>.");
+
+ ("resize2fs_size", (RErr, [Device "device"; Int64 "size"]), 248, [],
+ [],
+ "resize an ext2, ext3 or ext4 filesystem (with size)",
+ "\
+This command is the same as C<guestfs_resize2fs> except that it
+allows you to specify the new size (in bytes) explicitly.");
+
+ ("pvresize_size", (RErr, [Device "device"; Int64 "size"]), 249, [Optional "lvm2"],
+ [],
+ "resize an LVM physical volume (with size)",
+ "\
+This command is the same as C<guestfs_pvresize> except that it
+allows you to specify the new size (in bytes) explicitly.");
+
+ ("ntfsresize_size", (RErr, [Device "device"; Int64 "size"]), 250, [Optional "ntfsprogs"],
+ [],
+ "resize an NTFS filesystem (with size)",
+ "\
+This command is the same as C<guestfs_ntfsresize> except that it
+allows you to specify the new size (in bytes) explicitly.");
+
+ ("available_all_groups", (RStringList "groups", []), 251, [],
+ [InitNone, Always, TestRun [["available_all_groups"]]],
+ "return a list of all optional groups",
+ "\
+This command returns a list of all optional groups that this
+daemon knows about. Note this returns both supported and unsupported
+groups. To find out which ones the daemon can actually support
+you have to call C<guestfs_available> on each member of the
+returned list.
+
+See also C<guestfs_available> and L<guestfs(3)/AVAILABILITY>.");
+
+ ("fallocate64", (RErr, [Pathname "path"; Int64 "len"]), 252, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["fallocate64"; "/a"; "1000000"];
+ ["stat"; "/a"]], [CompareWithInt ("size", 1_000_000)])],
+ "preallocate a file in the guest filesystem",
+ "\
+This command preallocates a file (containing zero bytes) named
+C<path> of size C<len> bytes. If the file exists already, it
+is overwritten.
+
+Note that this call allocates disk blocks for the file.
+To create a sparse file use C<guestfs_truncate_size> instead.
+
+The deprecated call C<guestfs_fallocate> does the same,
+but owing to an oversight it only allowed 30 bit lengths
+to be specified, effectively limiting the maximum size
+of files created through that call to 1GB.
+
+Do not confuse this with the guestfish-specific
+C<alloc> and C<sparse> commands which create
+a file in the host and attach it as a device.");
+
+ ("vfs_label", (RString "label", [Device "device"]), 253, [],
+ [InitBasicFS, Always, TestOutput (
+ [["set_e2label"; "/dev/sda1"; "LTEST"];
+ ["vfs_label"; "/dev/sda1"]], "LTEST")],
+ "get the filesystem label",
+ "\
+This returns the filesystem label of the filesystem on
+C<device>.
+
+If the filesystem is unlabeled, this returns the empty string.");
+
+ ("vfs_uuid", (RString "uuid", [Device "device"]), 254, [],
+ (let uuid = uuidgen () in
+ [InitBasicFS, Always, TestOutput (
+ [["set_e2uuid"; "/dev/sda1"; uuid];
+ ["vfs_uuid"; "/dev/sda1"]], uuid)]),
+ "get the filesystem UUID",
+ "\
+This returns the filesystem UUID of the filesystem on
+C<device>.
+
+If the filesystem does not have a UUID, this returns the empty string.");
+
+]
+
+let all_functions = non_daemon_functions @ daemon_functions
+
+(* In some places we want the functions to be displayed sorted
+ * alphabetically, so this is useful:
+ *)
+let all_functions_sorted =
+ List.sort (fun (n1,_,_,_,_,_,_) (n2,_,_,_,_,_,_) ->
+ compare n1 n2) all_functions
+
+(* This is used to generate the src/MAX_PROC_NR file which
+ * contains the maximum procedure number, a surrogate for the
+ * ABI version number. See src/Makefile.am for the details.
+ *)
+let max_proc_nr =
+ let proc_nrs = List.map (
+ fun (_, _, proc_nr, _, _, _, _) -> proc_nr
+ ) daemon_functions in
+ List.fold_left max 0 proc_nrs
+
+(* Field types for structures. *)
+type field =
+ | FChar (* C 'char' (really, a 7 bit byte). *)
+ | FString (* nul-terminated ASCII string, NOT NULL. *)
+ | FBuffer (* opaque buffer of bytes, (char *, int) pair *)
+ | FUInt32
+ | FInt32
+ | FUInt64
+ | FInt64
+ | FBytes (* Any int measure that counts bytes. *)
+ | FUUID (* 32 bytes long, NOT nul-terminated. *)
+ | FOptPercent (* [0..100], or -1 meaning "not present". *)
+
+(* Because we generate extra parsing code for LVM command line tools,
+ * we have to pull out the LVM columns separately here.
+ *)
+let lvm_pv_cols = [
+ "pv_name", FString;
+ "pv_uuid", FUUID;
+ "pv_fmt", FString;
+ "pv_size", FBytes;
+ "dev_size", FBytes;
+ "pv_free", FBytes;
+ "pv_used", FBytes;
+ "pv_attr", FString (* XXX *);
+ "pv_pe_count", FInt64;
+ "pv_pe_alloc_count", FInt64;
+ "pv_tags", FString;
+ "pe_start", FBytes;
+ "pv_mda_count", FInt64;
+ "pv_mda_free", FBytes;
+ (* Not in Fedora 10:
+ "pv_mda_size", FBytes;
+ *)
+]
+let lvm_vg_cols = [
+ "vg_name", FString;
+ "vg_uuid", FUUID;
+ "vg_fmt", FString;
+ "vg_attr", FString (* XXX *);
+ "vg_size", FBytes;
+ "vg_free", FBytes;
+ "vg_sysid", FString;
+ "vg_extent_size", FBytes;
+ "vg_extent_count", FInt64;
+ "vg_free_count", FInt64;
+ "max_lv", FInt64;
+ "max_pv", FInt64;
+ "pv_count", FInt64;
+ "lv_count", FInt64;
+ "snap_count", FInt64;
+ "vg_seqno", FInt64;
+ "vg_tags", FString;
+ "vg_mda_count", FInt64;
+ "vg_mda_free", FBytes;
+ (* Not in Fedora 10:
+ "vg_mda_size", FBytes;
+ *)
+]
+let lvm_lv_cols = [
+ "lv_name", FString;
+ "lv_uuid", FUUID;
+ "lv_attr", FString (* XXX *);
+ "lv_major", FInt64;
+ "lv_minor", FInt64;
+ "lv_kernel_major", FInt64;
+ "lv_kernel_minor", FInt64;
+ "lv_size", FBytes;
+ "seg_count", FInt64;
+ "origin", FString;
+ "snap_percent", FOptPercent;
+ "copy_percent", FOptPercent;
+ "move_pv", FString;
+ "lv_tags", FString;
+ "mirror_log", FString;
+ "modules", FString;
+]
+
+(* Names and fields in all structures (in RStruct and RStructList)
+ * that we support.
+ *)
+let structs = [
+ (* The old RIntBool return type, only ever used for aug_defnode. Do
+ * not use this struct in any new code.
+ *)
+ "int_bool", [
+ "i", FInt32; (* for historical compatibility *)
+ "b", FInt32; (* for historical compatibility *)
+ ];
+
+ (* LVM PVs, VGs, LVs. *)
+ "lvm_pv", lvm_pv_cols;
+ "lvm_vg", lvm_vg_cols;
+ "lvm_lv", lvm_lv_cols;
(* Column names and types from stat structures.
* NB. Can't use things like 'st_atime' because glibc header files
"in_cookie", FUInt32;
"in_name", FString;
];
+
+ (* Partition table entry. *)
+ "partition", [
+ "part_num", FInt32;
+ "part_start", FBytes;
+ "part_end", FBytes;
+ "part_size", FBytes;
+ ];
] (* end of structs *)
(* Ugh, Java has to be different ..
"version", "Version";
"xattr", "XAttr";
"inotify_event", "INotifyEvent";
+ "partition", "Partition";
]
(* What structs are actually returned. *)
* == there are functions returning both RStruct (_, structname)
* and RStructList (_, structname)
*)
-let rstructs_used =
+let rstructs_used_by functions =
(* ||| is a "logical OR" for rstructs_used_t *)
let (|||) a b =
match a, b with
| RStruct (_, structname) -> update structname RStructOnly
| RStructList (_, structname) -> update structname RStructListOnly
| _ -> ()
- ) all_functions;
+ ) 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
| CallOptString of string option
| CallStringList of string list
| CallInt of int
+ | CallInt64 of int64
| CallBool of bool
+ | CallBuffer of string
(* Used to memoize the result of pod2text. *)
let pod2text_memo_filename = "src/.pod2text.data"
* Note we don't want to use any external OCaml libraries which
* makes this a bit harder than it should be.
*)
+module StringMap = Map.Make (String)
+
let failwithf fs = ksprintf failwith fs
+let unique = let i = ref 0 in fun () -> incr i; !i
+
let replace_char s c1 c2 =
let s2 = String.copy s in
let r = ref false in
in
loop 0 xs
+let count_chars c str =
+ let count = ref 0 in
+ for i = 0 to String.length str - 1 do
+ if c = String.unsafe_get str i then incr count
+ done;
+ !count
+
+let explode str =
+ let r = ref [] in
+ for i = 0 to String.length str - 1 do
+ let c = String.unsafe_get str i in
+ r := c :: !r;
+ done;
+ List.rev !r
+
+let map_chars f str =
+ List.map f (explode str)
+
let name_of_argt = function
| Pathname n | Device n | Dev_or_Path n | String n | OptString n
- | StringList n | DeviceList n | Bool n | Int n
- | FileIn n | FileOut n -> n
+ | StringList n | DeviceList n | Bool n | Int n | Int64 n
+ | FileIn n | FileOut n | BufferIn n -> n
let java_name_of_struct typ =
try List.assoc typ java_structs
(* Handling for function flags. *)
let protocol_limit_warning =
"Because of the message protocol, there is a transfer limit
-of somewhere between 2MB and 4MB. To transfer large files you should use
-FTP."
+of somewhere between 2MB and 4MB. See L<guestfs(3)/PROTOCOL LIMITS>."
let danger_will_robinson =
"B<This command is dangerous. Without careful use you
with
Not_found -> None
+(* Create list of optional groups. *)
+let optgroups =
+ let h = Hashtbl.create 13 in
+ List.iter (
+ fun (name, _, _, flags, _, _, _) ->
+ List.iter (
+ function
+ | Optional group ->
+ let names = try Hashtbl.find h group with Not_found -> [] in
+ Hashtbl.replace h group (name :: names)
+ | _ -> ()
+ ) flags
+ ) daemon_functions;
+ let groups = Hashtbl.fold (fun k _ ks -> k :: ks) h [] in
+ let groups =
+ List.map (
+ fun group -> group, List.sort compare (Hashtbl.find h group)
+ ) groups in
+ List.sort (fun x y -> compare (fst x) (fst y)) groups
+
(* Check function names etc. for consistency. *)
let check_functions () =
let contains_uppercase str =
"for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
"hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
"infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
+ "interface";
"land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
"match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
"newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
failwithf "short description of %s should not end with . or \\n." name
) all_functions;
- (* Check long dscriptions. *)
+ (* Check long descriptions. *)
List.iter (
fun (name, _, _, _, _, _, longdesc) ->
if longdesc.[String.length longdesc-1] = '\n' then
) all_functions
(* 'pr' prints to the current output file. *)
-let chan = ref stdout
-let pr fs = ksprintf (output_string !chan) fs
+let chan = ref Pervasives.stdout
+let lines = ref 0
+let pr fs =
+ ksprintf
+ (fun str ->
+ let i = count_chars '\n' str in
+ lines := !lines + i;
+ output_string !chan str
+ ) fs
+
+let copyright_years =
+ let this_year = 1900 + (localtime (time ())).tm_year in
+ if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
(* Generate a header block in a number of standard styles. *)
-type comment_style = CStyle | HashStyle | OCamlStyle | HaskellStyle
-type license = GPLv2 | LGPLv2
+type comment_style =
+ CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
+type license = GPLv2plus | LGPLv2plus
-let generate_header comment license =
+let generate_header ?(extra_inputs = []) comment license =
+ let inputs = "src/generator.ml" :: extra_inputs in
let c = match comment with
- | CStyle -> pr "/* "; " *"
- | HashStyle -> pr "# "; "#"
- | OCamlStyle -> pr "(* "; " *"
- | HaskellStyle -> pr "{- "; " " in
+ | CStyle -> pr "/* "; " *"
+ | CPlusPlusStyle -> pr "// "; "//"
+ | HashStyle -> pr "# "; "#"
+ | OCamlStyle -> pr "(* "; " *"
+ | HaskellStyle -> pr "{- "; " " in
pr "libguestfs generated file\n";
- pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
+ pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
+ List.iter (pr "%s %s\n" c) inputs;
pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
pr "%s\n" c;
- pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
+ pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
pr "%s\n" c;
(match license with
- | GPLv2 ->
+ | GPLv2plus ->
pr "%s This program is free software; you can redistribute it and/or modify\n" c;
pr "%s it under the terms of the GNU General Public License as published by\n" c;
pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
- | LGPLv2 ->
+ | LGPLv2plus ->
pr "%s This library is free software; you can redistribute it and/or\n" c;
pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
pr "%s License as published by the Free Software Foundation; either\n" c;
);
(match comment with
| CStyle -> pr " */\n"
+ | CPlusPlusStyle
| HashStyle -> ()
| OCamlStyle -> pr " *)\n"
| HaskellStyle -> pr "-}\n"
let name = "guestfs_" ^ shortname in
pr "=head2 %s\n\n" name;
pr " ";
- generate_prototype ~extern:false ~handle:"handle" name style;
+ generate_prototype ~extern:false ~handle:"g" name style;
pr "\n\n";
pr "%s\n\n" longdesc;
(match fst style with
The string is owned by the guest handle and must I<not> be freed.\n\n"
| RConstOptString _ ->
pr "This function returns a string which may be NULL.
-There is way to return an error from this function.
+There is no way to return an error from this function.
The string is owned by the guest handle and must I<not> be freed.\n\n"
| RString _ ->
pr "This function returns a string, or NULL on error.
pr "\n"
) structs
+and generate_availability_pod () =
+ (* Availability documentation. *)
+ pr "=over 4\n";
+ pr "\n";
+ List.iter (
+ fun (group, functions) ->
+ pr "=item B<%s>\n" group;
+ pr "\n";
+ pr "The following functions:\n";
+ List.iter (pr "L</guestfs_%s>\n") functions;
+ pr "\n"
+ ) optgroups;
+ pr "=back\n";
+ pr "\n"
+
(* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
* indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
*
* This header is NOT exported to clients, but see also generate_structs_h.
*)
and generate_xdr () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
(* This has to be defined to get around a limitation in Sun's rpcgen. *)
- pr "typedef string str<>;\n";
+ pr "typedef string guestfs_str<>;\n";
pr "\n";
(* Internal structures. *)
pr "struct %s_args {\n" name;
List.iter (
function
- | Pathname n | Device n | Dev_or_Path n | String n -> pr " string %s<>;\n" n
- | OptString n -> pr " str *%s;\n" n
- | StringList n | DeviceList n -> pr " str %s<>;\n" n
+ | Pathname n | Device n | Dev_or_Path n | String n ->
+ pr " string %s<>;\n" n
+ | OptString n -> pr " guestfs_str *%s;\n" n
+ | StringList n | DeviceList n -> pr " guestfs_str %s<>;\n" n
| Bool n -> pr " bool %s;\n" n
| Int n -> pr " int %s;\n" n
+ | Int64 n -> pr " hyper %s;\n" n
+ | BufferIn n ->
+ pr " opaque %s<>;\n" n
| FileIn _ | FileOut _ -> ()
) args;
pr "};\n\n"
pr "};\n\n"
| RStringList n ->
pr "struct %s_ret {\n" name;
- pr " str %s<>;\n" n;
+ pr " guestfs_str %s<>;\n" n;
pr "};\n\n"
| RStruct (n, typ) ->
pr "struct %s_ret {\n" name;
pr "};\n\n"
| RHashtable n ->
pr "struct %s_ret {\n" name;
- pr " str %s<>;\n" n;
+ pr " guestfs_str %s<>;\n" n;
pr "};\n\n"
| RBufferOut n ->
pr "struct %s_ret {\n" name;
(* Having to choose a maximum message size is annoying for several
* reasons (it limits what we can do in the API), but it (a) makes
* the protocol a lot simpler, and (b) provides a bound on the size
- * of the daemon which operates in limited memory space. For large
- * file transfers you should use FTP.
+ * of the daemon which operates in limited memory space.
*)
pr "const GUESTFS_MESSAGE_MAX = %d;\n" (4 * 1024 * 1024);
pr "\n";
(* Generate the guestfs-structs.h file. *)
and generate_structs_h () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
(* This is a public exported header file containing various
* structures. The structures are carefully written to have
(* Generate the guestfs-actions.h file. *)
and generate_actions_h () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
List.iter (
fun (shortname, style, _, _, _, _, _) ->
let name = "guestfs_" ^ shortname in
- generate_prototype ~single_line:true ~newline:true ~handle:"handle"
+ generate_prototype ~single_line:true ~newline:true ~handle:"g"
name style
) all_functions
+(* Generate the guestfs-internal-actions.h file. *)
+and generate_internal_actions_h () =
+ generate_header CStyle LGPLv2plus;
+ List.iter (
+ fun (shortname, style, _, _, _, _, _) ->
+ let name = "guestfs__" ^ shortname in
+ generate_prototype ~single_line:true ~newline:true ~handle:"g"
+ name style
+ ) non_daemon_functions
+
(* Generate the client-side dispatch stubs. *)
and generate_client_actions () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
#include <stdio.h>
#include <stdlib.h>
+#include <stdint.h>
+#include <string.h>
+#include <inttypes.h>
#include \"guestfs.h\"
+#include \"guestfs-internal.h\"
+#include \"guestfs-internal-actions.h\"
#include \"guestfs_protocol.h\"
-#define error guestfs_error
-//#define perrorf guestfs_perrorf
-//#define safe_malloc guestfs_safe_malloc
-#define safe_realloc guestfs_safe_realloc
-//#define safe_strdup guestfs_safe_strdup
-#define safe_memdup guestfs_safe_memdup
-
/* Check the return message from a call for validity. */
static int
check_reply_header (guestfs_h *g,
static int
check_state (guestfs_h *g, const char *caller)
{
- if (!guestfs_is_ready (g)) {
- if (guestfs_is_config (g))
+ if (!guestfs__is_ready (g)) {
+ if (guestfs__is_config (g) || guestfs__is_launching (g))
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\",
- caller);
else
error (g, \"%%s called from the wrong state, %%d != READY\",
- caller, guestfs_get_state (g));
+ caller, guestfs__get_state (g));
return -1;
}
return 0;
";
- (* Client-side stubs for each function. *)
+ let error_code_of = function
+ | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
+ | RConstString _ | RConstOptString _
+ | RString _ | RStringList _
+ | RStruct _ | RStructList _
+ | RHashtable _ | RBufferOut _ -> "NULL"
+ in
+
+ (* Generate code to check String-like parameters are not passed in
+ * as NULL (returning an error if they are).
+ *)
+ let check_null_strings shortname style =
+ let pr_newline = ref false in
+ List.iter (
+ function
+ (* parameters which should not be NULL *)
+ | String n
+ | Device n
+ | Pathname n
+ | Dev_or_Path n
+ | FileIn n
+ | FileOut n
+ | BufferIn n
+ | StringList n
+ | DeviceList n ->
+ pr " if (%s == NULL) {\n" n;
+ pr " error (g, \"%%s: %%s: parameter cannot be NULL\",\n";
+ pr " \"%s\", \"%s\");\n" shortname n;
+ pr " return %s;\n" (error_code_of (fst style));
+ pr " }\n";
+ pr_newline := true
+
+ (* can be NULL *)
+ | OptString _
+
+ (* not applicable *)
+ | Bool _
+ | Int _
+ | Int64 _ -> ()
+ ) (snd style);
+
+ if !pr_newline then pr "\n";
+ in
+
+ (* Generate code to generate guestfish call traces. *)
+ let trace_call shortname style =
+ pr " if (guestfs__get_trace (g)) {\n";
+
+ let needs_i =
+ List.exists (function
+ | StringList _ | DeviceList _ -> true
+ | _ -> false) (snd style) in
+ if needs_i then (
+ pr " size_t i;\n";
+ pr "\n"
+ );
+
+ pr " printf (\"%s\");\n" shortname;
+ List.iter (
+ function
+ | String n (* strings *)
+ | Device n
+ | Pathname n
+ | Dev_or_Path n
+ | FileIn n
+ | FileOut n
+ | BufferIn n ->
+ (* guestfish doesn't support string escaping, so neither do we *)
+ pr " printf (\" \\\"%%s\\\"\", %s);\n" n
+ | OptString n -> (* string option *)
+ pr " if (%s) printf (\" \\\"%%s\\\"\", %s);\n" n n;
+ pr " else printf (\" null\");\n"
+ | StringList n
+ | DeviceList n -> (* string list *)
+ pr " putchar (' ');\n";
+ pr " putchar ('\"');\n";
+ pr " for (i = 0; %s[i]; ++i) {\n" n;
+ pr " if (i > 0) putchar (' ');\n";
+ pr " fputs (%s[i], stdout);\n" n;
+ pr " }\n";
+ pr " putchar ('\"');\n";
+ | Bool n -> (* boolean *)
+ pr " fputs (%s ? \" true\" : \" false\", stdout);\n" n
+ | Int n -> (* int *)
+ pr " printf (\" %%d\", %s);\n" n
+ | Int64 n ->
+ pr " printf (\" %%\" PRIi64, %s);\n" n
+ ) (snd style);
+ pr " putchar ('\\n');\n";
+ pr " }\n";
+ pr "\n";
+ in
+
+ (* For non-daemon functions, generate a wrapper around each function. *)
List.iter (
fun (shortname, style, _, _, _, _, _) ->
let name = "guestfs_" ^ shortname in
- (* Generate the context struct which stores the high-level
- * state between callback functions.
- *)
- pr "struct %s_ctx {\n" shortname;
- pr " /* This flag is set by the callbacks, so we know we've done\n";
- pr " * the callbacks as expected, and in the right sequence.\n";
- pr " * 0 = not called, 1 = reply_cb called.\n";
- pr " */\n";
- pr " int cb_sequence;\n";
- pr " struct guestfs_message_header hdr;\n";
- pr " struct guestfs_message_error err;\n";
- (match fst style with
- | RErr -> ()
- | RConstString _ | RConstOptString _ ->
- failwithf "RConstString|RConstOptString cannot be used by daemon functions"
- | RInt _ | RInt64 _
- | RBool _ | RString _ | RStringList _
- | RStruct _ | RStructList _
- | RHashtable _ | RBufferOut _ ->
- pr " struct %s_ret ret;\n" name
- );
- pr "};\n";
- pr "\n";
-
- (* Generate the reply callback function. *)
- pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
+ generate_prototype ~extern:false ~semicolon:false ~newline:true
+ ~handle:"g" name style;
pr "{\n";
- pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
- pr " struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
- pr "\n";
- pr " /* This should definitely not happen. */\n";
- pr " if (ctx->cb_sequence != 0) {\n";
- pr " ctx->cb_sequence = 9999;\n";
- pr " error (g, \"%%s: internal error: reply callback called twice\", \"%s\");\n" name;
- pr " return;\n";
- pr " }\n";
- pr "\n";
- pr " ml->main_loop_quit (ml, g);\n";
- pr "\n";
- pr " if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
- pr " error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
- pr " return;\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;
- pr " return;\n";
- pr " }\n";
- pr " goto done;\n";
- pr " }\n";
-
- (match fst style with
- | RErr -> ()
- | RConstString _ | RConstOptString _ ->
- failwithf "RConstString|RConstOptString cannot be used by daemon functions"
- | RInt _ | RInt64 _
- | RBool _ | RString _ | RStringList _
- | RStruct _ | RStructList _
- | RHashtable _ | RBufferOut _ ->
- pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
- pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
- pr " return;\n";
- pr " }\n";
- );
+ check_null_strings shortname style;
+ trace_call shortname style;
+ pr " return guestfs__%s " shortname;
+ generate_c_call_args ~handle:"g" style;
+ pr ";\n";
+ pr "}\n";
+ pr "\n"
+ ) non_daemon_functions;
- pr " done:\n";
- pr " ctx->cb_sequence = 1;\n";
- pr "}\n\n";
+ (* Client-side stubs for each function. *)
+ List.iter (
+ fun (shortname, style, _, _, _, _, _) ->
+ let name = "guestfs_" ^ shortname in
+ let error_code = error_code_of (fst style) in
(* Generate the action stub. *)
generate_prototype ~extern:false ~semicolon:false ~newline:true
~handle:"g" name style;
- let error_code =
- 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";
(match snd style with
| _ -> pr " struct %s_args args;\n" name
);
- pr " struct %s_ctx ctx;\n" shortname;
- pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
+ pr " guestfs_message_header hdr;\n";
+ pr " guestfs_message_error err;\n";
+ let has_ret =
+ match fst style with
+ | RErr -> false
+ | RConstString _ | RConstOptString _ ->
+ failwithf "RConstString|RConstOptString cannot be used by daemon functions"
+ | RInt _ | RInt64 _
+ | RBool _ | RString _ | RStringList _
+ | RStruct _ | RStructList _
+ | RHashtable _ | RBufferOut _ ->
+ pr " struct %s_ret ret;\n" name;
+ true in
+
pr " int serial;\n";
+ pr " int r;\n";
pr "\n";
- pr " if (check_state (g, \"%s\") == -1) return %s;\n" name error_code;
- pr " guestfs_set_busy (g);\n";
- pr "\n";
- pr " memset (&ctx, 0, sizeof ctx);\n";
+ check_null_strings shortname style;
+ trace_call shortname style;
+ pr " if (check_state (g, \"%s\") == -1) return %s;\n"
+ shortname error_code;
+ pr " guestfs___set_busy (g);\n";
pr "\n";
(* Send the main header and arguments. *)
(match snd style with
| [] ->
- pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s, NULL, NULL);\n"
+ pr " serial = guestfs___send (g, GUESTFS_PROC_%s, NULL, NULL);\n"
(String.uppercase shortname)
| args ->
List.iter (
pr " args.%s = %s;\n" n n
| Int n ->
pr " args.%s = %s;\n" n n
+ | Int64 n ->
+ pr " args.%s = %s;\n" n n
| FileIn _ | FileOut _ -> ()
+ | BufferIn n ->
+ pr " /* Just catch grossly large sizes. XDR encoding will make this precise. */\n";
+ pr " if (%s_size >= GUESTFS_MESSAGE_MAX) {\n" n;
+ pr " error (g, \"%%s: size of input buffer too large\", \"%s\");\n"
+ shortname;
+ pr " guestfs___end_busy (g);\n";
+ pr " return %s;\n" error_code;
+ pr " }\n";
+ pr " args.%s.%s_val = (char *) %s;\n" n n n;
+ pr " args.%s.%s_len = %s_size;\n" n n n
) args;
- pr " serial = guestfs__send_sync (g, GUESTFS_PROC_%s,\n"
+ pr " serial = guestfs___send (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";
+ pr " guestfs___end_busy (g);\n";
pr " return %s;\n" error_code;
pr " }\n";
pr "\n";
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 " r = guestfs___send_file (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";
| _ -> ()
) (snd style);
(* Wait for the reply from the remote end. *)
if !need_read_reply_label then pr " read_reply:\n";
- pr " guestfs__switch_to_receiving (g);\n";
- pr " ctx.cb_sequence = 0;\n";
- pr " guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
- pr " (void) ml->main_loop_run (ml, g);\n";
- pr " guestfs_set_reply_callback (g, NULL, NULL);\n";
- pr " if (ctx.cb_sequence != 1) {\n";
- pr " error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
- pr " guestfs_end_busy (g);\n";
+ pr " memset (&hdr, 0, sizeof hdr);\n";
+ pr " memset (&err, 0, sizeof err);\n";
+ if has_ret then pr " memset (&ret, 0, sizeof ret);\n";
+ pr "\n";
+ pr " r = guestfs___recv (g, \"%s\", &hdr, &err,\n " shortname;
+ if not has_ret then
+ pr "NULL, NULL"
+ else
+ pr "(xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret" shortname;
+ pr ");\n";
+
+ pr " if (r == -1) {\n";
+ pr " guestfs___end_busy (g);\n";
pr " return %s;\n" error_code;
pr " }\n";
pr "\n";
- pr " if (check_reply_header (g, &ctx.hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
+ pr " if (check_reply_header (g, &hdr, GUESTFS_PROC_%s, serial) == -1) {\n"
(String.uppercase shortname);
- pr " guestfs_end_busy (g);\n";
+ pr " guestfs___end_busy (g);\n";
pr " return %s;\n" error_code;
pr " }\n";
pr "\n";
- pr " if (ctx.hdr.status == GUESTFS_STATUS_ERROR) {\n";
- pr " error (g, \"%%s\", ctx.err.error_message);\n";
- pr " free (ctx.err.error_message);\n";
- pr " guestfs_end_busy (g);\n";
+ pr " if (hdr.status == GUESTFS_STATUS_ERROR) {\n";
+ pr " error (g, \"%%s: %%s\", \"%s\", err.error_message);\n" shortname;
+ pr " free (err.error_message);\n";
+ pr " guestfs___end_busy (g);\n";
pr " return %s;\n" error_code;
pr " }\n";
pr "\n";
List.iter (
function
| FileOut n ->
- pr " if (guestfs__receive_file_sync (g, %s) == -1) {\n" n;
- pr " guestfs_end_busy (g);\n";
+ pr " if (guestfs___recv_file (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";
+ 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
+ pr " return 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 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"
+ pr " ret.%s.%s_val =\n" n n;
+ pr " safe_realloc (g, ret.%s.%s_val,\n" n n;
+ pr " sizeof (char *) * (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 " ret.%s.%s_val[ret.%s.%s_len] = NULL;\n" n n n n;
+ pr " return 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 " return safe_memdup (g, &ret.%s, sizeof (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 " return safe_memdup (g, &ret.%s, sizeof (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 " /* RBufferOut is tricky: If the buffer is zero-length, then\n";
+ pr " * _val might be NULL here. To make the API saner for\n";
+ pr " * callers, we turn this case into a unique pointer (using\n";
+ pr " * malloc(1)).\n";
+ pr " */\n";
+ pr " if (ret.%s.%s_len > 0) {\n" n n;
+ pr " *size_r = ret.%s.%s_len;\n" n n;
+ pr " return ret.%s.%s_val; /* caller will free */\n" n n;
+ pr " } else {\n";
+ pr " free (ret.%s.%s_val);\n" n n;
+ pr " char *p = safe_malloc (g, 1);\n";
+ pr " *size_r = ret.%s.%s_len;\n" n n;
+ pr " return p;\n";
+ pr " }\n";
);
pr "}\n\n"
(* Generate daemon/actions.h. *)
and generate_daemon_actions_h () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
pr "#include \"../src/guestfs_protocol.h\"\n";
pr "\n";
name style;
) daemon_functions
+(* Generate the linker script which controls the visibility of
+ * symbols in the public ABI and ensures no other symbols get
+ * exported accidentally.
+ *)
+and generate_linker_script () =
+ generate_header HashStyle GPLv2plus;
+
+ let globals = [
+ "guestfs_create";
+ "guestfs_close";
+ "guestfs_get_error_handler";
+ "guestfs_get_out_of_memory_handler";
+ "guestfs_last_error";
+ "guestfs_set_close_callback";
+ "guestfs_set_error_handler";
+ "guestfs_set_launch_done_callback";
+ "guestfs_set_log_message_callback";
+ "guestfs_set_out_of_memory_handler";
+ "guestfs_set_subprocess_quit_callback";
+
+ (* Unofficial parts of the API: the bindings code use these
+ * functions, so it is useful to export them.
+ *)
+ "guestfs_safe_calloc";
+ "guestfs_safe_malloc";
+ "guestfs_safe_strdup";
+ "guestfs_safe_memdup";
+ ] in
+ let functions =
+ List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name)
+ all_functions in
+ let structs =
+ List.concat (
+ List.map (fun (typ, _) ->
+ ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"])
+ structs
+ ) in
+ let globals = List.sort compare (globals @ functions @ structs) in
+
+ pr "{\n";
+ pr " global:\n";
+ List.iter (pr " %s;\n") globals;
+ pr "\n";
+
+ pr " local:\n";
+ pr " *;\n";
+ pr "};\n"
+
(* Generate the server-side stubs. *)
and generate_daemon_actions () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
pr "#include <config.h>\n";
pr "\n";
pr "#include <stdlib.h>\n";
pr "#include <string.h>\n";
pr "#include <inttypes.h>\n";
- pr "#include <ctype.h>\n";
pr "#include <rpc/types.h>\n";
pr "#include <rpc/xdr.h>\n";
pr "\n";
pr "#include \"daemon.h\"\n";
+ pr "#include \"c-ctype.h\"\n";
pr "#include \"../src/guestfs_protocol.h\"\n";
pr "#include \"actions.h\"\n";
pr "\n";
| RStruct (_, typ) -> pr " guestfs_int_%s *r;\n" typ; "NULL"
| RStructList (_, typ) -> pr " guestfs_int_%s_list *r;\n" typ; "NULL"
| RBufferOut _ ->
- pr " size_t size;\n";
+ pr " size_t size = 1;\n";
pr " char *r;\n";
"NULL" in
| StringList n | DeviceList n -> pr " char **%s;\n" n
| Bool n -> pr " int %s;\n" n
| Int n -> pr " int %s;\n" n
+ | Int64 n -> pr " int64_t %s;\n" n
| FileIn _ | FileOut _ -> ()
+ | BufferIn n ->
+ pr " const char *%s;\n" n;
+ pr " size_t %s_size;\n" n
) args
);
pr "\n";
+ let is_filein =
+ List.exists (function FileIn _ -> true | _ -> false) (snd style) in
+
(match snd style with
| [] -> ()
| args ->
pr " memset (&args, 0, sizeof args);\n";
pr "\n";
pr " if (!xdr_guestfs_%s_args (xdr_in, &args)) {\n" name;
- pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
- pr " return;\n";
+ if is_filein then
+ pr " if (cancel_receive () != -2)\n";
+ pr " reply_with_error (\"daemon failed to decode procedure arguments\");\n";
+ pr " goto done;\n";
pr " }\n";
let pr_args n =
pr " char *%s = args.%s;\n" n n
pr " %s = realloc (args.%s.%s_val,\n" n n n;
pr " sizeof (char *) * (args.%s.%s_len+1));\n" n n;
pr " if (%s == NULL) {\n" n;
- pr " reply_with_perror (\"realloc\");\n";
+ if is_filein then
+ pr " if (cancel_receive () != -2)\n";
+ pr " reply_with_perror (\"realloc\");\n";
pr " goto done;\n";
pr " }\n";
pr " %s[args.%s.%s_len] = NULL;\n" n n n;
function
| Pathname n ->
pr_args n;
- pr " ABS_PATH (%s, goto done);\n" n;
+ pr " ABS_PATH (%s, %s, goto done);\n"
+ n (if is_filein then "cancel_receive ()" else "0");
| Device n ->
pr_args n;
- pr " RESOLVE_DEVICE (%s, goto done);\n" n;
+ pr " RESOLVE_DEVICE (%s, %s, goto done);\n"
+ n (if is_filein then "cancel_receive ()" else "0");
| Dev_or_Path n ->
pr_args n;
- pr " REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);\n" n;
+ pr " REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, %s, goto done);\n"
+ n (if is_filein then "cancel_receive ()" else "0");
| String n -> pr_args n
| OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
| StringList 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 " * and perform device name translation.\n";
+ pr " */\n";
+ pr " {\n";
+ pr " size_t i;\n";
+ pr " for (i = 0; %s[i] != NULL; ++i)\n" n;
+ pr " RESOLVE_DEVICE (%s[i], %s, goto done);\n" n
+ (if is_filein then "cancel_receive ()" else "0");
pr " }\n";
| Bool n -> pr " %s = args.%s;\n" n n
| Int n -> pr " %s = args.%s;\n" n n
+ | Int64 n -> pr " %s = args.%s;\n" n n
| FileIn _ | FileOut _ -> ()
+ | BufferIn n ->
+ pr " %s = args.%s.%s_val;\n" n n n;
+ pr " %s_size = args.%s.%s_len;\n" n n n
) 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";
+ pr " NEED_ROOT (%s, goto done);\n"
+ (if is_filein then "cancel_receive ()" else "0");
);
(* Don't want to call the impl with any FileIn or FileOut
generate_c_call_args (fst style, args');
pr ";\n";
- pr " if (r == %s)\n" error_code;
- pr " /* do_%s has already called reply_with_error */\n" name;
- pr " goto done;\n";
- pr "\n";
+ (match fst style with
+ | RErr | RInt _ | RInt64 _ | RBool _
+ | RConstString _ | RConstOptString _
+ | RString _ | RStringList _ | RHashtable _
+ | RStruct (_, _) | RStructList (_, _) ->
+ pr " if (r == %s)\n" error_code;
+ pr " /* do_%s has already called reply_with_error */\n" name;
+ pr " goto done;\n";
+ pr "\n"
+ | RBufferOut _ ->
+ pr " /* size == 0 && r == NULL could be a non-error case (just\n";
+ pr " * an ordinary zero-length buffer), so be careful ...\n";
+ pr " */\n";
+ pr " if (size == 1 && r == %s)\n" error_code;
+ pr " /* do_%s has already called reply_with_error */\n" name;
+ pr " goto done;\n";
+ pr "\n"
+ );
(* If there are any FileOut parameters, then the impl must
* send its own reply.
);
(* Free the args. *)
+ pr "done:\n";
(match snd style with
- | [] ->
- pr "done: ;\n";
+ | [] -> ()
| _ ->
- pr "done:\n";
pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
name
);
-
+ pr " return;\n";
pr "}\n\n";
) daemon_functions;
pr "static int lvm_tokenize_%s (char *str, guestfs_int_lvm_%s *r)\n" typ typ;
pr "{\n";
pr " char *tok, *p, *next;\n";
- pr " int i, j;\n";
+ pr " size_t i, j;\n";
pr "\n";
(*
pr " fprintf (stderr, \"%%s: <<%%s>>\\n\", __func__, str);\n";
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 " if (!*str || c_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 " ret->guestfs_int_lvm_%s_list_val = NULL;\n" typ;
pr "\n";
pr " r = command (&out, &err,\n";
- pr " \"/sbin/lvm\", \"%ss\",\n" typ;
+ pr " \"lvm\", \"%ss\",\n" typ;
pr " \"-o\", lvm_%s_cols, \"--unbuffered\", \"--noheadings\",\n" typ;
pr " \"--nosuffix\", \"--separator\", \",\", \"--units\", \"b\", NULL);\n";
pr " if (r == -1) {\n";
pr " pend++;\n";
pr " }\n";
pr "\n";
- pr " while (*p && isspace (*p)) /* Skip any leading whitespace. */\n";
+ pr " while (*p && c_isspace (*p)) /* Skip any leading whitespace. */\n";
pr " p++;\n";
pr "\n";
pr " if (!*p) { /* Empty line? Skip it. */\n";
(* Generate a list of function names, for debugging in the daemon.. *)
and generate_daemon_names () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
pr "#include <config.h>\n";
pr "\n";
) daemon_functions;
pr "};\n";
+(* Generate the optional groups for the daemon to implement
+ * guestfs_available.
+ *)
+and generate_daemon_optgroups_c () =
+ generate_header CStyle GPLv2plus;
+
+ pr "#include <config.h>\n";
+ pr "\n";
+ pr "#include \"daemon.h\"\n";
+ pr "#include \"optgroups.h\"\n";
+ pr "\n";
+
+ pr "struct optgroup optgroups[] = {\n";
+ List.iter (
+ fun (group, _) ->
+ pr " { \"%s\", optgroup_%s_available },\n" group group
+ ) optgroups;
+ pr " { NULL, NULL }\n";
+ pr "};\n"
+
+and generate_daemon_optgroups_h () =
+ generate_header CStyle GPLv2plus;
+
+ List.iter (
+ fun (group, _) ->
+ pr "extern int optgroup_%s_available (void);\n" group
+ ) optgroups
+
(* Generate the tests. *)
and generate_tests () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
pr "\
#include <stdio.h>
#include <fcntl.h>
#include \"guestfs.h\"
+#include \"guestfs-internal.h\"
static guestfs_h *g;
static int suppress_error = 0;
/* FIXME: nearly identical code appears in fish.c */
static void print_strings (char *const *argv)
{
- int argc;
+ size_t argc;
for (argc = 0; argv[argc] != NULL; ++argc)
printf (\"\\t%%s\\n\", argv[argc]);
/*
static void print_table (char const *const *argv)
{
- int i;
+ size_t i;
for (i = 0; argv[i] != NULL; i += 2)
printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
}
*/
+static int
+is_available (const char *group)
+{
+ const char *groups[] = { group, NULL };
+ int r;
+
+ suppress_error = 1;
+ r = guestfs_available (g, (char **) groups);
+ suppress_error = 0;
+
+ return r == 0;
+}
+
+static void
+incr (guestfs_h *g, void *iv)
+{
+ int *i = (int *) iv;
+ (*i)++;
+}
+
";
(* Generate a list of commands which are not tested anywhere. *)
fun (_, _, _, _, tests, _, _) ->
let tests = filter_map (
function
- | (_, (Always|If _|Unless _), test) -> Some test
+ | (_, (Always|If _|Unless _|IfAvailable _), test) -> Some test
| (_, Disabled, _) -> None
) tests in
let seq = List.concat (List.map seq_of_test tests) in
*)
let test_names =
List.map (
- fun (name, _, _, _, tests, _, _) ->
- mapi (generate_one_test name) tests
+ fun (name, _, _, flags, tests, _, _) ->
+ mapi (generate_one_test name flags) tests
) (List.rev all_functions) in
let test_names = List.concat test_names in
let nr_tests = List.length test_names in
int main (int argc, char *argv[])
{
char c = 0;
- int failed = 0;
+ unsigned long int n_failed = 0;
const char *filename;
int fd;
int nr_tests, test_num = 0;
g = guestfs_create ();
if (g == NULL) {
printf (\"guestfs_create FAILED\\n\");
- exit (1);
+ exit (EXIT_FAILURE);
}
guestfs_set_error_handler (g, print_error, NULL);
fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
if (fd == -1) {
perror (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (lseek (fd, %d, SEEK_SET) == -1) {
perror (\"lseek\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (write (fd, &c, 1) == -1) {
perror (\"write\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (close (fd) == -1) {
perror (filename);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (guestfs_add_drive (g, filename) == -1) {
printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
filename = \"test2.img\";
fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
if (fd == -1) {
perror (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (lseek (fd, %d, SEEK_SET) == -1) {
perror (\"lseek\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (write (fd, &c, 1) == -1) {
perror (\"write\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (close (fd) == -1) {
perror (filename);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (guestfs_add_drive (g, filename) == -1) {
printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
filename = \"test3.img\";
fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
if (fd == -1) {
perror (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (lseek (fd, %d, SEEK_SET) == -1) {
perror (\"lseek\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (write (fd, &c, 1) == -1) {
perror (\"write\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (close (fd) == -1) {
perror (filename);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (guestfs_add_drive (g, filename) == -1) {
printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
- exit (1);
- }
-
- if (guestfs_launch (g) == -1) {
- printf (\"guestfs_launch FAILED\\n\");
- exit (1);
+ exit (EXIT_FAILURE);
}
/* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
alarm (600);
- if (guestfs_wait_ready (g) == -1) {
- printf (\"guestfs_wait_ready FAILED\\n\");
- exit (1);
+ if (guestfs_launch (g) == -1) {
+ printf (\"guestfs_launch FAILED\\n\");
+ exit (EXIT_FAILURE);
}
/* Cancel previous alarm. */
iteri (
fun i test_name ->
pr " test_num++;\n";
+ pr " if (guestfs_get_verbose (g))\n";
+ pr " printf (\"-------------------------------------------------------------------------------\\n\");\n";
pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
pr " if (%s () == -1) {\n" test_name;
pr " printf (\"%s FAILED\\n\");\n" test_name;
- pr " failed++;\n";
+ pr " n_failed++;\n";
pr " }\n";
) test_names;
pr "\n";
- pr " guestfs_close (g);\n";
- pr " unlink (\"test1.img\");\n";
- pr " unlink (\"test2.img\");\n";
- pr " unlink (\"test3.img\");\n";
- pr "\n";
+ pr " /* Check close callback is called. */
+ int close_sentinel = 1;
+ guestfs_set_close_callback (g, incr, &close_sentinel);
+
+ guestfs_close (g);
+
+ if (close_sentinel != 2) {
+ fprintf (stderr, \"close callback was not called\\n\");
+ exit (EXIT_FAILURE);
+ }
+
+ unlink (\"test1.img\");
+ unlink (\"test2.img\");
+ unlink (\"test3.img\");
+
+";
- pr " if (failed > 0) {\n";
- pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
- pr " exit (1);\n";
+ pr " if (n_failed > 0) {\n";
+ pr " printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
+ pr " exit (EXIT_FAILURE);\n";
pr " }\n";
pr "\n";
- pr " exit (0);\n";
+ pr " exit (EXIT_SUCCESS);\n";
pr "}\n"
-and generate_one_test name i (init, prereq, test) =
+and generate_one_test name flags i (init, prereq, test) =
let test_name = sprintf "test_%s_%d" name i in
pr "\
if (str)
return strstr (str, \"%s\") == NULL;
str = getenv (\"SKIP_%s\");
- if (str && strcmp (str, \"1\") == 0) return 1;
+ if (str && STREQ (str, \"1\")) return 1;
str = getenv (\"SKIP_TEST_%s\");
- if (str && strcmp (str, \"1\") == 0) return 1;
+ if (str && STREQ (str, \"1\")) return 1;
return 0;
}
" test_name name (String.uppercase test_name) (String.uppercase name);
(match prereq with
- | Disabled | Always -> ()
+ | Disabled | Always | IfAvailable _ -> ()
| If code | Unless code ->
pr "static int %s_prereq (void)\n" test_name;
pr "{\n";
" test_name test_name test_name;
+ (* Optional functions should only be tested if the relevant
+ * support is available in the daemon.
+ *)
+ List.iter (
+ function
+ | Optional group ->
+ pr " if (!is_available (\"%s\")) {\n" group;
+ pr " printf (\" %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", \"%s\");\n" test_name group;
+ pr " return 0;\n";
+ pr " }\n";
+ | _ -> ()
+ ) flags;
+
(match prereq with
| Disabled ->
pr " printf (\" %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
pr " }\n";
pr "\n";
generate_one_test_body name i test_name init test;
+ | IfAvailable group ->
+ pr " if (!is_available (\"%s\")) {\n" group;
+ pr " printf (\" %%s skipped (reason: %%s not available)\\n\", \"%s\", \"%s\");\n" test_name group;
+ pr " return 0;\n";
+ pr " }\n";
+ pr "\n";
+ generate_one_test_body name i test_name init test;
| Always ->
generate_one_test_body name i test_name init test
);
[["blockdev_setrw"; "/dev/sda"];
["umount_all"];
["lvm_remove_all"];
- ["sfdiskM"; "/dev/sda"; ","]]
+ ["part_disk"; "/dev/sda"; "mbr"]]
| InitBasicFS ->
pr " /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
List.iter (generate_test_command_call test_name)
[["blockdev_setrw"; "/dev/sda"];
["umount_all"];
["lvm_remove_all"];
- ["sfdiskM"; "/dev/sda"; ","];
+ ["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext2"; "/dev/sda1"];
- ["mount"; "/dev/sda1"; "/"]]
+ ["mount_options"; ""; "/dev/sda1"; "/"]]
| InitBasicFSonLVM ->
pr " /* InitBasicFSonLVM for %s: create ext2 on /dev/VG/LV */\n"
test_name;
[["blockdev_setrw"; "/dev/sda"];
["umount_all"];
["lvm_remove_all"];
- ["sfdiskM"; "/dev/sda"; ","];
+ ["part_disk"; "/dev/sda"; "mbr"];
["pvcreate"; "/dev/sda1"];
["vgcreate"; "VG"; "/dev/sda1"];
["lvcreate"; "LV"; "VG"; "8"];
["mkfs"; "ext2"; "/dev/VG/LV"];
- ["mount"; "/dev/VG/LV"; "/"]]
+ ["mount_options"; ""; "/dev/VG/LV"; "/"]]
| InitISOFS ->
pr " /* InitISOFS for %s */\n" test_name;
List.iter (generate_test_command_call test_name)
pr " const char *expected = \"%s\";\n" (c_quote expected);
let seq, last = get_seq_last seq in
let test () =
- pr " if (strcmp (r, expected) != 0) {\n";
+ pr " if (STRNEQ (r, expected)) {\n";
pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
pr " return -1;\n";
pr " }\n"
pr " }\n";
pr " {\n";
pr " const char *expected = \"%s\";\n" (c_quote str);
- pr " if (strcmp (r[%d], expected) != 0) {\n" i;
+ pr " if (STRNEQ (r[%d], expected)) {\n" i;
pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
pr " return -1;\n";
pr " }\n";
pr " {\n";
pr " const char *expected = \"%s\";\n" (c_quote str);
pr " r[%d][5] = 's';\n" i;
- pr " if (strcmp (r[%d], expected) != 0) {\n" i;
+ pr " if (STRNEQ (r[%d], expected)) {\n" i;
pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i;
pr " return -1;\n";
pr " }\n";
pr " 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 " if (STRNEQLEN (r, expected, size)) {\n";
pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name;
pr " return -1;\n";
pr " }\n"
pr " return -1;\n";
pr " }\n"
| CompareWithString (field, expected) ->
- pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
+ pr " if (STRNEQ (r->%s, \"%s\")) {\n" field expected;
pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
test_name field expected;
pr " r->%s);\n" field;
pr " return -1;\n";
pr " }\n"
| CompareFieldsStrEq (field1, field2) ->
- pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
+ pr " if (STRNEQ (r->%s, r->%s)) {\n" field1 field2;
pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
test_name field1 field2;
pr " r->%s, r->%s);\n" field1 field2;
| String n, arg
| OptString n, arg ->
pr " const char *%s = \"%s\";\n" n (c_quote arg);
+ | BufferIn n, arg ->
+ pr " const char *%s = \"%s\";\n" n (c_quote arg);
+ pr " size_t %s_size = %d;\n" n (String.length arg)
| Int _, _
+ | Int64 _, _
| Bool _, _
| FileIn _, _ | FileOut _, _ -> ()
+ | StringList n, "" | DeviceList n, "" ->
+ pr " const char *const %s[1] = { NULL };\n" n
| StringList n, arg | DeviceList n, arg ->
let strs = string_split " " arg in
iteri (
| RString _ -> pr " char *r;\n"; "NULL"
| RStringList _ | RHashtable _ ->
pr " char **r;\n";
- pr " int i;\n";
+ pr " size_t i;\n";
"NULL"
| RStruct (_, typ) ->
pr " struct guestfs_%s *r;\n" typ; "NULL"
| String n, _
| OptString n, _ ->
pr ", %s" n
+ | BufferIn n, _ ->
+ pr ", %s, %s_size" n n
| FileIn _, arg | FileOut _, arg ->
pr ", \"%s\"" (c_quote arg)
| StringList n, _ | DeviceList n, _ ->
with Failure "int_of_string" ->
failwithf "%s: expecting an int, but got '%s'" test_name arg in
pr ", %d" i
+ | Int64 _, arg ->
+ let i =
+ try Int64.of_string arg
+ with Failure "int_of_string" ->
+ failwithf "%s: expecting an int64, but got '%s'" test_name arg in
+ pr ", %Ld" i
| Bool _, arg ->
let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
) (List.combine (snd style) args);
(* Generate a lot of different functions for guestfish. *)
and generate_fish_cmds () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
let all_functions =
List.filter (
fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
) all_functions_sorted in
+ pr "#include <config.h>\n";
+ pr "\n";
pr "#include <stdio.h>\n";
pr "#include <stdlib.h>\n";
pr "#include <string.h>\n";
pr "#include <inttypes.h>\n";
- pr "#include <ctype.h>\n";
pr "\n";
pr "#include <guestfs.h>\n";
+ pr "#include \"c-ctype.h\"\n";
+ pr "#include \"full-write.h\"\n";
+ pr "#include \"xstrtol.h\"\n";
pr "#include \"fish.h\"\n";
pr "\n";
+ pr "/* Valid suffixes allowed for numbers. See Gnulib xstrtol function. */\n";
+ pr "static const char *xstrtol_suffixes = \"0kKMGTPEZY\";\n";
+ pr "\n";
(* list_commands function, which implements guestfish -h *)
pr "void list_commands (void)\n";
pr "\n";
(* display_command function, which implements guestfish -h cmd *)
- pr "void display_command (const char *cmd)\n";
+ pr "int display_command (const char *cmd)\n";
pr "{\n";
List.iter (
fun (name, style, _, flags, _, shortdesc, longdesc) ->
match snd style with
| [] -> name2
| args ->
- sprintf "%s <%s>"
- name2 (String.concat "> <" (List.map name_of_argt args)) in
+ sprintf "%s %s"
+ name2 (String.concat " " (List.map name_of_argt args)) in
let warnings =
if List.mem ProtocolLimitWarning flags then
else "" in
pr " if (";
- pr "strcasecmp (cmd, \"%s\") == 0" name;
+ pr "STRCASEEQ (cmd, \"%s\")" name;
if name <> name2 then
- pr " || strcasecmp (cmd, \"%s\") == 0" name2;
+ pr " || STRCASEEQ (cmd, \"%s\")" name2;
if name <> alias then
- pr " || strcasecmp (cmd, \"%s\") == 0" alias;
- pr ")\n";
+ pr " || STRCASEEQ (cmd, \"%s\")" alias;
+ pr ") {\n";
pr " pod2text (\"%s\", _(\"%s\"), %S);\n"
name2 shortdesc
- (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
+ ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
+ "=head1 DESCRIPTION\n\n" ^
+ longdesc ^ warnings ^ describe_alias);
+ pr " return 0;\n";
+ pr " }\n";
pr " else\n"
) all_functions;
- pr " display_builtin_command (cmd);\n";
+ pr " return display_builtin_command (cmd);\n";
pr "}\n";
pr "\n";
| name, FString ->
pr " printf (\"%%s%s: %%s\\n\", indent, %s->%s);\n" name typ name
| name, FUUID ->
- pr " printf (\"%s: \");\n" name;
+ pr " printf (\"%%s%s: \", indent);\n" name;
pr " for (i = 0; i < 32; ++i)\n";
- pr " printf (\"%%s%%c\", indent, %s->%s[i]);\n" typ name;
+ pr " printf (\"%%c\", %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 " if (c_isprint (%s->%s[i]))\n" typ name;
+ pr " printf (\"%%c\", %s->%s[i]);\n" typ name;
pr " else\n";
- pr " printf (\"%%s\\\\x%%02x\", indent, %s->%s[i]);\n" typ name;
+ pr " printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name;
pr " printf (\"\\n\");\n"
| name, (FUInt64|FBytes) ->
pr " printf (\"%%s%s: %%\" PRIu64 \"\\n\", indent, %s->%s);\n"
(* generate the function for typ *)
emit_print_list_function typ
| typ, _ -> () (* empty *)
- ) rstructs_used;
+ ) (rstructs_used_by all_functions);
(* Emit a print_TYPE function definition only if that function is used. *)
List.iter (
function
- | typ, RStructOnly ->
+ | typ, (RStructOnly | RStructAndList) ->
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;
+ ) (rstructs_used_by all_functions);
(* run_<action> actions *)
List.iter (
);
List.iter (
function
- | Pathname n
- | Device n | Dev_or_Path n
+ | Device n
| String n
- | OptString n
+ | OptString n -> pr " const char *%s;\n" n
+ | Pathname n
+ | Dev_or_Path n
| FileIn n
- | FileOut n -> pr " const char *%s;\n" n
- | StringList n | DeviceList n -> pr " char *const *%s;\n" n
+ | FileOut n -> pr " char *%s;\n" n
+ | BufferIn n ->
+ pr " const char *%s;\n" n;
+ pr " size_t %s_size;\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
+ | Int64 n -> pr " int64_t %s;\n" n
) (snd style);
(* Check and convert parameters. *)
pr " fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n";
pr " return -1;\n";
pr " }\n";
+
+ let parse_integer fn fntyp rtyp range name i =
+ pr " {\n";
+ pr " strtol_error xerr;\n";
+ pr " %s r;\n" fntyp;
+ pr "\n";
+ pr " xerr = %s (argv[%d], NULL, 0, &r, xstrtol_suffixes);\n" fn i;
+ pr " if (xerr != LONGINT_OK) {\n";
+ pr " fprintf (stderr,\n";
+ pr " _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n";
+ pr " cmd, \"%s\", \"%s\", xerr);\n" name fn;
+ pr " return -1;\n";
+ pr " }\n";
+ (match range with
+ | None -> ()
+ | Some (min, max, comment) ->
+ pr " /* %s */\n" comment;
+ pr " if (r < %s || r > %s) {\n" min max;
+ pr " fprintf (stderr, _(\"%%s: %%s: integer out of range\\n\"), cmd, \"%s\");\n"
+ name;
+ pr " return -1;\n";
+ pr " }\n";
+ pr " /* The check above should ensure this assignment does not overflow. */\n";
+ );
+ pr " %s = r;\n" name;
+ pr " }\n";
+ in
+
iteri (
fun i ->
function
+ | Device name
+ | String name ->
+ pr " %s = argv[%d];\n" name i
| Pathname name
- | Device name | Dev_or_Path name | String name -> pr " %s = argv[%d];\n" name i
+ | Dev_or_Path name ->
+ pr " %s = resolve_win_path (argv[%d]);\n" name i;
+ pr " if (%s == NULL) return -1;\n" name
| OptString name ->
- pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
+ pr " %s = STRNEQ (argv[%d], \"\") ? argv[%d] : NULL;\n"
name i i
+ | BufferIn name ->
+ pr " %s = argv[%d];\n" name i;
+ pr " %s_size = strlen (argv[%d]);\n" name i
| FileIn name ->
- pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
- name i i
+ pr " %s = file_in (argv[%d]);\n" name i;
+ pr " if (%s == NULL) return -1;\n" name
| FileOut name ->
- pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
- name i i
+ pr " %s = file_out (argv[%d]);\n" name i;
+ pr " if (%s == NULL) return -1;\n" name
| StringList name | DeviceList name ->
- pr " %s = parse_string_list (argv[%d]);\n" name i
+ pr " %s = parse_string_list (argv[%d]);\n" name i;
+ pr " if (%s == NULL) return -1;\n" name;
| Bool name ->
pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
| Int name ->
- pr " %s = atoi (argv[%d]);\n" name i
+ let range =
+ let min = "(-(2LL<<30))"
+ and max = "((2LL<<30)-1)"
+ and comment =
+ "The Int type in the generator is a signed 31 bit int." in
+ Some (min, max, comment) in
+ parse_integer "xstrtoll" "long long" "int" range name i
+ | Int64 name ->
+ parse_integer "xstrtoll" "long long" "int64_t" None 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
- pr " r = %s " fn;
+ pr " r = guestfs_%s " name;
generate_c_call_args ~handle:"g" style;
pr ";\n";
+ List.iter (
+ function
+ | Device _ | String _
+ | OptString _ | Bool _
+ | Int _ | Int64 _
+ | BufferIn _ -> ()
+ | Pathname name | Dev_or_Path name | FileOut name ->
+ pr " free (%s);\n" name
+ | FileIn name ->
+ pr " free_file_in (%s);\n" name
+ | StringList name | DeviceList name ->
+ pr " free_strings (%s);\n" name
+ ) (snd style);
+
+ (* Any output flags? *)
+ let fish_output =
+ let flags = filter_map (
+ function FishOutput flag -> Some flag | _ -> None
+ ) flags in
+ match flags with
+ | [] -> None
+ | [f] -> Some f
+ | _ ->
+ failwithf "%s: more than one FishOutput flag is not allowed" name in
+
(* Check return value for errors and display command results. *)
(match fst style with
| RErr -> pr " return r;\n"
| RInt _ ->
pr " if (r == -1) return -1;\n";
- pr " printf (\"%%d\\n\", r);\n";
+ (match fish_output with
+ | None ->
+ pr " printf (\"%%d\\n\", r);\n";
+ | Some FishOutputOctal ->
+ pr " printf (\"%%s%%o\\n\", r != 0 ? \"0\" : \"\", r);\n";
+ | Some FishOutputHexadecimal ->
+ pr " printf (\"%%s%%x\\n\", r != 0 ? \"0x\" : \"\", r);\n");
pr " return 0;\n"
| RInt64 _ ->
pr " if (r == -1) return -1;\n";
- pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
+ (match fish_output with
+ | None ->
+ pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
+ | Some FishOutputOctal ->
+ pr " printf (\"%%s%%\" PRIo64 \"\\n\", r != 0 ? \"0\" : \"\", r);\n";
+ | Some FishOutputHexadecimal ->
+ pr " printf (\"%%s%%\" PRIx64 \"\\n\", r != 0 ? \"0x\" : \"\", r);\n");
pr " return 0;\n"
| RBool _ ->
pr " if (r == -1) return -1;\n";
pr " return 0;\n"
| RBufferOut _ ->
pr " if (r == NULL) return -1;\n";
- pr " fwrite (r, size, 1, stdout);\n";
+ pr " if (full_write (1, r, size) != size) {\n";
+ pr " perror (\"write\");\n";
+ pr " free (r);\n";
+ pr " return -1;\n";
+ pr " }\n";
pr " free (r);\n";
pr " return 0;\n"
);
try find_map (function FishAlias n -> Some n | _ -> None) flags
with Not_found -> name in
pr " if (";
- pr "strcasecmp (cmd, \"%s\") == 0" name;
+ pr "STRCASEEQ (cmd, \"%s\")" name;
if name <> name2 then
- pr " || strcasecmp (cmd, \"%s\") == 0" name2;
+ pr " || STRCASEEQ (cmd, \"%s\")" name2;
if name <> alias then
- pr " || strcasecmp (cmd, \"%s\") == 0" alias;
+ pr " || STRCASEEQ (cmd, \"%s\")" 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 " if (command_num == 1)\n";
+ pr " extended_help_message ();\n";
pr " return -1;\n";
pr " }\n";
pr " return 0;\n";
(* Readline completion for guestfish. *)
and generate_fish_completion () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
let all_functions =
List.filter (
static char *
generator (const char *text, int state)
{
- static int index, len;
+ static size_t index, len;
const char *name;
if (!state) {
while ((name = commands[index]) != NULL) {
index++;
- if (strncasecmp (name, text, len) == 0)
+ if (STRCASEEQLEN (name, text, len))
return strdup (name);
}
#endif /* HAVE_LIBREADLINE */
-char **do_completion (const char *text, int start, int end)
+#ifdef HAVE_RL_COMPLETION_MATCHES
+#define RL_COMPLETION_MATCHES rl_completion_matches
+#else
+#ifdef HAVE_COMPLETION_MATCHES
+#define RL_COMPLETION_MATCHES completion_matches
+#endif
+#endif /* else just fail if we don't have either symbol */
+
+char **
+do_completion (const char *text, int start, int end)
{
char **matches = NULL;
rl_completion_append_character = ' ';
if (start == 0)
- matches = rl_completion_matches (text, generator);
+ matches = RL_COMPLETION_MATCHES (text, generator);
else if (complete_dest_paths)
- matches = rl_completion_matches (text, complete_dest_paths_generator);
+ matches = RL_COMPLETION_MATCHES (text, complete_dest_paths_generator);
#endif
return matches;
| StringList n | DeviceList n -> pr " '%s ...'" n
| Bool _ -> pr " true|false"
| Int n -> pr " %s" n
+ | Int64 n -> pr " %s" n
| FileIn n | FileOut n -> pr " (%s|-)" n
+ | BufferIn n -> pr " %s" n
) (snd style);
pr "\n";
pr "\n";
pr "char *const *%s" n
| Bool n -> next (); pr "int %s" n
| Int n -> next (); pr "int %s" n
+ | Int64 n -> next (); pr "int64_t %s" n
| FileIn n
| FileOut n ->
if not in_daemon then (next (); pr "const char *%s" n)
+ | BufferIn n ->
+ next ();
+ pr "const char *%s" n;
+ next ();
+ pr "size_t %s_size" n
) (snd style);
if is_RBufferOut then (next (); pr "size_t *size_r");
);
| Some handle -> pr "%s" handle; comma := true
);
List.iter (
- fun arg ->
- next ();
- pr "%s" (name_of_argt arg)
+ function
+ | BufferIn n ->
+ next ();
+ pr "%s, %s_size" n n
+ | arg ->
+ next ();
+ pr "%s" (name_of_argt arg)
) (snd style);
(* For RBufferOut calls, add implicit &size parameter. *)
if not decl then (
(* Generate the OCaml bindings interface. *)
and generate_ocaml_mli () =
- generate_header OCamlStyle LGPLv2;
+ generate_header OCamlStyle LGPLv2plus;
pr "\
(** For API documentation you should refer to the C API
exception Error of string
(** This exception is raised when there is an error. *)
+exception Handle_closed of string
+(** This exception is raised if you use a {!Guestfs.t} handle
+ after calling {!close} on it. The string is the name of
+ the function. *)
+
val create : unit -> t
+(** Create a {!Guestfs.t} handle. *)
val close : t -> unit
-(** Handles are closed by the garbage collector when they become
- unreferenced, but callers can also call this in order to
- provide predictable cleanup. *)
+(** Close the {!Guestfs.t} handle and free up all resources used
+ by it immediately.
+
+ Handles are closed by the garbage collector when they become
+ unreferenced, but callers can call this in order to provide
+ predictable cleanup. *)
";
generate_ocaml_structure_decls ();
generate_ocaml_prototype name style;
pr "(** %s *)\n" shortdesc;
pr "\n"
- ) all_functions
+ ) all_functions_sorted
(* Generate the OCaml bindings implementation. *)
and generate_ocaml_ml () =
- generate_header OCamlStyle LGPLv2;
+ generate_header OCamlStyle LGPLv2plus;
pr "\
type t
+
exception Error of string
+exception Handle_closed of string
+
external create : unit -> t = \"ocaml_guestfs_create\"
external close : t -> unit = \"ocaml_guestfs_close\"
+(* Give the exceptions names, so they can be raised from the C code. *)
let () =
- Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
+ Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
+ Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\")
";
List.iter (
fun (name, style, _, _, _, shortdesc, _) ->
generate_ocaml_prototype ~is_external:true name style;
- ) all_functions
+ ) all_functions_sorted
(* Generate the OCaml bindings C implementation. *)
and generate_ocaml_c () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
#include <stdio.h>
#include <caml/mlvalues.h>
#include <caml/signals.h>
-#include <guestfs.h>
+#include \"guestfs.h\"
#include \"guestfs_c.h\"
{
CAMLparam0 ();
CAMLlocal5 (rv, pairv, kv, vv, cons);
- int i;
+ size_t i;
rv = Val_int (0);
for (i = 0; argv[i] != NULL; i += 2) {
";
(* Struct copy functions. *)
+
+ let emit_ocaml_copy_list_function typ =
+ pr "static CAMLprim value\n";
+ pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
+ pr "{\n";
+ pr " CAMLparam0 ();\n";
+ pr " CAMLlocal2 (rv, v);\n";
+ pr " unsigned int i;\n";
+ pr "\n";
+ pr " if (%ss->len == 0)\n" typ;
+ pr " CAMLreturn (Atom (0));\n";
+ pr " else {\n";
+ pr " rv = caml_alloc (%ss->len, 0);\n" typ;
+ pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
+ pr " v = copy_%s (&%ss->val[i]);\n" typ typ;
+ pr " caml_modify (&Field (rv, i), v);\n";
+ pr " }\n";
+ pr " CAMLreturn (rv);\n";
+ pr " }\n";
+ pr "}\n";
+ pr "\n";
+ in
+
List.iter (
fun (typ, cols) ->
let has_optpercent_col =
pr " CAMLreturn (rv);\n";
pr "}\n";
pr "\n";
-
- pr "static CAMLprim value\n";
- pr "copy_%s_list (const struct guestfs_%s_list *%ss)\n"
- typ typ typ;
- pr "{\n";
- pr " CAMLparam0 ();\n";
- pr " CAMLlocal2 (rv, v);\n";
- pr " int i;\n";
- pr "\n";
- pr " if (%ss->len == 0)\n" typ;
- pr " CAMLreturn (Atom (0));\n";
- pr " else {\n";
- pr " rv = caml_alloc (%ss->len, 0);\n" typ;
- pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
- pr " v = copy_%s (&%ss->val[i]);\n" typ typ;
- pr " caml_modify (&Field (rv, i), v);\n";
- pr " }\n";
- pr " CAMLreturn (rv);\n";
- pr " }\n";
- pr "}\n";
- pr "\n";
) structs;
+ (* Emit a copy_TYPE_list function definition only if that function is used. *)
+ List.iter (
+ function
+ | typ, (RStructListOnly | RStructAndList) ->
+ (* generate the function for typ *)
+ emit_ocaml_copy_list_function typ
+ | typ, _ -> () (* empty *)
+ ) (rstructs_used_by all_functions);
+
(* The wrappers. *)
List.iter (
fun (name, style, _, _, _, _, _) ->
+ pr "/* Automatically generated wrapper for function\n";
+ pr " * ";
+ generate_ocaml_prototype name style;
+ pr " */\n";
+ pr "\n";
+
let params =
"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 "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
+ pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params);
+ List.iter (pr ", value %s") (List.tl params); pr ");\n";
+ pr "\n";
+
pr "CAMLprim value\n";
pr "ocaml_guestfs_%s (value %s" name (List.hd params);
List.iter (pr ", value %s") (List.tl params);
pr " guestfs_h *g = Guestfs_val (gv);\n";
pr " if (g == NULL)\n";
- pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
+ pr " ocaml_guestfs_raise_closed (\"%s\");\n" name;
pr "\n";
List.iter (
| String n
| FileIn n
| FileOut n ->
- pr " const char *%s = String_val (%sv);\n" n n
+ (* Copy strings in case the GC moves them: RHBZ#604691 *)
+ pr " char *%s = guestfs_safe_strdup (g, String_val (%sv));\n" n n
| OptString n ->
- pr " const char *%s =\n" n;
- pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
- n n
+ pr " char *%s =\n" n;
+ pr " %sv != Val_int (0) ?" n;
+ pr " guestfs_safe_strdup (g, String_val (Field (%sv, 0))) : NULL;\n" n
+ | BufferIn n ->
+ pr " size_t %s_size = caml_string_length (%sv);\n" n n;
+ pr " char *%s = guestfs_safe_memdup (g, String_val (%sv), %s_size);\n" n n n
| StringList n | DeviceList n ->
pr " char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
| Bool n ->
pr " int %s = Bool_val (%sv);\n" n n
| Int n ->
pr " int %s = Int_val (%sv);\n" n n
+ | Int64 n ->
+ pr " int64_t %s = Int64_val (%sv);\n" n n
) (snd style);
let error_code =
match fst style with
pr " const char *r;\n"; "NULL"
| RString _ -> pr " char *r;\n"; "NULL"
| RStringList _ ->
- pr " int i;\n";
+ pr " size_t i;\n";
pr " char **r;\n";
"NULL"
| RStruct (_, typ) ->
| RStructList (_, typ) ->
pr " struct guestfs_%s_list *r;\n" typ; "NULL"
| RHashtable _ ->
- pr " int i;\n";
+ pr " size_t i;\n";
pr " char **r;\n";
"NULL"
| RBufferOut _ ->
pr ";\n";
pr " caml_leave_blocking_section ();\n";
+ (* Free strings if we copied them above. *)
List.iter (
function
+ | Pathname n | Device n | Dev_or_Path n | String n | OptString n
+ | FileIn n | FileOut n | BufferIn n ->
+ pr " free (%s);\n" n
| StringList n | DeviceList n ->
pr " ocaml_guestfs_free_strings (%s);\n" n;
- | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ | Bool _ | Int _
- | FileIn _ | FileOut _ -> ()
+ | Bool _ | Int _ | Int64 _ -> ()
) (snd style);
pr " if (r == %s)\n" error_code;
pr "\n";
if List.length params > 5 then (
+ pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n";
+ pr "CAMLprim value ";
+ pr "ocaml_guestfs_%s_byte (value *argv, int argn);\n" name;
pr "CAMLprim value\n";
pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
pr "{\n";
pr "}\n";
pr "\n"
)
- ) all_functions
+ ) all_functions_sorted
and generate_ocaml_structure_decls () =
List.iter (
pr "%s : t -> " name;
List.iter (
function
- | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _
+ | BufferIn _ -> pr "string -> "
| OptString _ -> pr "string option -> "
| StringList _ | DeviceList _ -> pr "string array -> "
| Bool _ -> pr "bool -> "
| Int _ -> pr "int -> "
+ | Int64 _ -> pr "int64 -> "
) (snd style);
(match fst style with
| RErr -> pr "unit" (* all errors are turned into exceptions *)
(* Generate Perl xs code, a sort of crazy variation of C with macros. *)
and generate_perl_xs () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
#include \"EXTERN.h\"
RETVAL
void
-DESTROY (g)
+DESTROY (sv)
+ SV *sv;
+ PPCODE:
+ /* For the 'g' argument above we do the conversion explicitly and
+ * don't rely on the typemap, because if the handle has been
+ * explicitly closed we don't want the typemap conversion to
+ * display an error.
+ */
+ HV *hv = (HV *) SvRV (sv);
+ SV **svp = hv_fetch (hv, \"_g\", 2, 0);
+ if (svp != NULL) {
+ guestfs_h *g = (guestfs_h *) SvIV (*svp);
+ assert (g != NULL);
+ guestfs_close (g);
+ }
+
+void
+close (g)
guestfs_h *g;
PPCODE:
guestfs_close (g);
+ /* Avoid double-free in DESTROY method. */
+ HV *hv = (HV *) SvRV (ST(0));
+ (void) hv_delete (hv, \"_g\", 2, G_DISCARD);
";
pr "void\n" (* all lists returned implictly on the stack *)
);
(* Call and arguments. *)
- pr "%s " name;
- generate_c_call_args ~handle:"g" ~decl:true style;
- pr "\n";
+ pr "%s (g" name;
+ List.iter (
+ fun arg -> pr ", %s" (name_of_argt arg)
+ ) (snd style);
+ pr ")\n";
pr " guestfs_h *g;\n";
iteri (
fun i ->
function
- | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
+ | Pathname n | Device n | Dev_or_Path n | String n
+ | FileIn n | FileOut n ->
pr " char *%s;\n" n
+ | BufferIn n ->
+ pr " char *%s;\n" n;
+ pr " size_t %s_size = SvCUR (ST(%d));\n" n (i+1)
| OptString n ->
(* http://www.perlmonks.org/?node_id=554277
* Note that the implicit handle argument means we have
| StringList n | DeviceList n -> pr " char **%s;\n" n
| Bool n -> pr " int %s;\n" n
| Int n -> pr " int %s;\n" n
+ | Int64 n -> pr " int64_t %s;\n" n
) (snd style);
let do_cleanups () =
List.iter (
function
- | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ | Bool _ | Int _
- | FileIn _ | FileOut _ -> ()
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
+ | Bool _ | Int _ | Int64 _
+ | FileIn _ | FileOut _
+ | BufferIn _ -> ()
| StringList n | DeviceList n -> pr " free (%s);\n" n
) (snd style)
in
pr ";\n";
do_cleanups ();
pr " if (r == -1)\n";
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
| RInt n
| RBool n ->
pr "PREINIT:\n";
pr ";\n";
do_cleanups ();
pr " if (%s == -1)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
pr " RETVAL = newSViv (%s);\n" n;
pr " OUTPUT:\n";
pr " RETVAL\n"
pr ";\n";
do_cleanups ();
pr " if (%s == -1)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
pr " RETVAL = my_newSVll (%s);\n" n;
pr " OUTPUT:\n";
pr " RETVAL\n"
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
pr " RETVAL = newSVpv (%s, 0);\n" n;
pr " OUTPUT:\n";
pr " RETVAL\n"
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
pr " RETVAL = newSVpv (%s, 0);\n" n;
pr " free (%s);\n" n;
pr " OUTPUT:\n";
| RStringList n | RHashtable n ->
pr "PREINIT:\n";
pr " char **%s;\n" n;
- pr " int i, n;\n";
+ pr " size_t i, n;\n";
pr " PPCODE:\n";
pr " %s = guestfs_%s " n name;
generate_c_call_args ~handle:"g" style;
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
pr " EXTEND (SP, n);\n";
pr " for (i = 0; i < n; ++i) {\n";
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
- pr " RETVAL = newSVpv (%s, size);\n" n;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
+ pr " RETVAL = newSVpvn (%s, size);\n" n;
pr " free (%s);\n" n;
pr " OUTPUT:\n";
pr " RETVAL\n"
and generate_perl_struct_list_code typ cols name style n do_cleanups =
pr "PREINIT:\n";
pr " struct guestfs_%s_list *%s;\n" typ n;
- pr " int i;\n";
+ pr " size_t i;\n";
pr " HV *hv;\n";
pr " PPCODE:\n";
pr " %s = guestfs_%s " n name;
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
pr " EXTEND (SP, %s->len);\n" n;
pr " for (i = 0; i < %s->len; ++i) {\n" n;
pr " hv = newHV ();\n";
pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
name (String.length name) n name
| name, FBuffer ->
- pr " (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
+ pr " (void) hv_store (hv, \"%s\", %d, newSVpvn (%s->val[i].%s, %s->val[i].%s_len), 0);\n"
name (String.length name) n name n name
| name, (FBytes|FUInt64) ->
pr " (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
pr ";\n";
do_cleanups ();
pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " croak (\"%%s\", guestfs_last_error (g));\n";
pr " EXTEND (SP, 2 * %d);\n" (List.length cols);
List.iter (
fun ((name, _) as col) ->
pr " PUSHs (sv_2mortal (newSVpv (%s->%s, 0)));\n"
n name
| name, FBuffer ->
- pr " PUSHs (sv_2mortal (newSVpv (%s->%s, %s->%s_len)));\n"
+ pr " PUSHs (sv_2mortal (newSVpvn (%s->%s, %s->%s_len)));\n"
n name n name
| name, FUUID ->
pr " PUSHs (sv_2mortal (newSVpv (%s->%s, 32)));\n"
(* Generate Sys/Guestfs.pm. *)
and generate_perl_pm () =
- generate_header HashStyle LGPLv2;
+ generate_header HashStyle LGPLv2plus;
pr "\
=pod
my $h = Sys::Guestfs->new ();
$h->add_drive ('guest.img');
$h->launch ();
- $h->wait_ready ();
$h->mount ('/dev/sda1', '/');
$h->touch ('/hello');
$h->sync ();
Libguestfs provides ways to enumerate guest storage (eg. partitions,
LVs, what filesystem is in each LV, etc.). It can also run commands
-in the context of the guest. Also you can access filesystems over FTP.
+in the context of the guest. Also you can access filesystems over
+FUSE.
See also L<Sys::Guestfs::Lib(3)> for a set of useful library
functions for using libguestfs from Perl, including integration
use strict;
use warnings;
+# This version number changes whenever a new function
+# is added to the libguestfs API. It is not directly
+# related to the libguestfs version number.
+use vars qw($VERSION);
+$VERSION = '0.%d';
+
require XSLoader;
XSLoader::load ('Sys::Guestfs');
my $proto = shift;
my $class = ref ($proto) || $proto;
- my $self = Sys::Guestfs::_create ();
+ my $g = Sys::Guestfs::_create ();
+ my $self = { _g => $g };
bless $self, $class;
return $self;
}
-";
+=item $h->close ();
+
+Explicitly close the guestfs handle.
+
+B<Note:> You should not usually call this function. The handle will
+be closed implicitly when its reference count goes to zero (eg.
+when it goes out of scope or the program ends). This call is
+only required in some exceptional cases, such as where the program
+may contain cached references to the handle 'somewhere' and you
+really have to have the close happen right away. After calling
+C<close> the program must not call any method (including C<close>)
+on the handle (but the implicit call to C<DESTROY> that happens
+when the final reference is cleaned up is OK).
+
+=cut
+
+" max_proc_nr;
(* Actions. We only need to print documentation for these as
* they are pulled in from the XS code automatically.
=head1 COPYRIGHT
-Copyright (C) 2009 Red Hat Inc.
+Copyright (C) %s Red Hat Inc.
=head1 LICENSE
L<Sys::Guestfs::Lib(3)>.
=cut
-"
+" copyright_years
and generate_perl_prototype name style =
(match fst style with
comma := true;
match arg with
| Pathname n | Device n | Dev_or_Path n | String n
- | OptString n | Bool n | Int n | FileIn n | FileOut n ->
+ | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n
+ | BufferIn n ->
pr "$%s" n
| StringList n | DeviceList n ->
pr "\\@%s" n
(* Generate Python C module. *)
and generate_python_c () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
+#define PY_SSIZE_T_CLEAN 1
#include <Python.h>
+#if PY_VERSION_HEX < 0x02050000
+typedef int Py_ssize_t;
+#define PY_SSIZE_T_MAX INT_MAX
+#define PY_SSIZE_T_MIN INT_MIN
+#endif
+
#include <stdio.h>
#include <stdlib.h>
#include <assert.h>
static char **
get_string_list (PyObject *obj)
{
- int i, len;
+ size_t i, len;
char **r;
assert (obj);
return NULL;
}
- len = PyList_Size (obj);
+ Py_ssize_t slen = PyList_Size (obj);
+ if (slen == -1) {
+ PyErr_SetString (PyExc_RuntimeError, \"get_string_list: PyList_Size failure\");
+ return NULL;
+ }
+ len = (size_t) slen;
r = malloc (sizeof (char *) * (len+1));
if (r == NULL) {
PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
pr "{\n";
pr " PyObject *list;\n";
- pr " int i;\n";
+ pr " size_t i;\n";
pr "\n";
pr " list = PyList_New (%ss->len);\n" typ;
pr " for (i = 0; i < %ss->len; ++i)\n" typ;
(* generate the function for typ *)
emit_put_list_function typ
| typ, _ -> () (* empty *)
- ) rstructs_used;
+ ) (rstructs_used_by all_functions);
(* Python wrapper functions. *)
List.iter (
List.iter (
function
- | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
+ | Pathname n | Device n | Dev_or_Path n | String n
+ | FileIn n | FileOut n ->
pr " const char *%s;\n" n
| OptString n -> pr " const char *%s;\n" n
+ | BufferIn n ->
+ pr " const char *%s;\n" n;
+ pr " Py_ssize_t %s_size;\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
+ | Int64 n -> pr " long long %s;\n" n
) (snd style);
pr "\n";
| StringList _ | DeviceList _ -> pr "O"
| Bool _ -> pr "i" (* XXX Python has booleans? *)
| Int _ -> pr "i"
+ | Int64 _ -> pr "L" (* XXX Whoever thought it was a good idea to
+ * emulate C's int/long/long long in Python?
+ *)
+ | BufferIn _ -> pr "s#"
) (snd style);
pr ":guestfs_%s\",\n" name;
pr " &py_g";
| StringList n | DeviceList n -> pr ", &py_%s" n
| Bool n -> pr ", &%s" n
| Int n -> pr ", &%s" n
+ | Int64 n -> pr ", &%s" n
+ | BufferIn n -> pr ", &%s, &%s_size" n n
) (snd style);
pr "))\n";
List.iter (
function
| Pathname _ | Device _ | Dev_or_Path _ | String _
- | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
+ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _
+ | BufferIn _ -> ()
| StringList n | DeviceList n ->
pr " %s = get_string_list (py_%s);\n" n n;
pr " if (!%s) return NULL;\n" n
List.iter (
function
| Pathname _ | Device _ | Dev_or_Path _ | String _
- | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
+ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _
+ | BufferIn _ -> ()
| StringList n | DeviceList n ->
pr " free (%s);\n" n
) (snd style);
(* Generate Python module. *)
and generate_python_py () =
- generate_header HashStyle LGPLv2;
+ generate_header HashStyle LGPLv2plus;
pr "\
u\"\"\"Python bindings for libguestfs
g = guestfs.GuestFS ()
g.add_drive (\"guest.img\")
g.launch ()
-g.wait_ready ()
parts = g.list_partitions ()
The guestfs module provides a Python binding to the libguestfs API
Libguestfs provides ways to enumerate guest storage (eg. partitions,
LVs, what filesystem is in each LV, etc.). It can also run commands
-in the context of the guest. Also you can access filesystems over FTP.
+in the context of the guest. Also you can access filesystems over
+FUSE.
Errors which happen while using the API are turned into Python
RuntimeError exceptions.
# Launch the qemu subprocess and wait for it to become ready:
g.launch ()
-g.wait_ready ()
# Now you can issue commands, for example:
logvols = g.lvs ()
fprintf chan "=head1 %s\n\n%s\n" name longdesc;
close_out chan;
let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
- let chan = Unix.open_process_in cmd in
+ let chan = open_process_in cmd in
let lines = ref [] in
let rec loop i =
let line = input_line chan in
loop (i+1)
) in
let lines = try loop 1 with End_of_file -> List.rev !lines in
- Unix.unlink filename;
- (match Unix.close_process_in chan with
- | Unix.WEXITED 0 -> ()
- | Unix.WEXITED i ->
+ unlink filename;
+ (match close_process_in chan with
+ | WEXITED 0 -> ()
+ | WEXITED i ->
failwithf "pod2text: process exited with non-zero status (%d)" i
- | Unix.WSIGNALED i | Unix.WSTOPPED i ->
+ | WSIGNALED i | WSTOPPED i ->
failwithf "pod2text: process signalled or stopped by signal %d" i
);
Hashtbl.add pod2text_memo key lines;
(* Generate ruby bindings. *)
and generate_ruby_c () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
#include <stdio.h>
pr " if (!%s)\n" n;
pr " rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
pr " \"%s\", \"%s\");\n" n name
+ | BufferIn n ->
+ pr " Check_Type (%sv, T_STRING);\n" n;
+ pr " const char *%s = RSTRING (%sv)->ptr;\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;
+ pr " size_t %s_size = RSTRING (%sv)->len;\n" n n
| 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 " size_t i, len;\n";
pr " len = RARRAY_LEN (%sv);\n" n;
pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
n;
pr " int %s = RTEST (%sv);\n" n n
| Int n ->
pr " int %s = NUM2INT (%sv);\n" n n
+ | Int64 n ->
+ pr " long long %s = NUM2LL (%sv);\n" n n
) (snd style);
pr "\n";
List.iter (
function
| Pathname _ | Device _ | Dev_or_Path _ | String _
- | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
+ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _
+ | BufferIn _ -> ()
| StringList n | DeviceList n ->
pr " free (%s);\n" n
) (snd style);
pr " free (r);\n";
pr " return rv;\n";
| RStringList _ ->
- pr " int i, len = 0;\n";
+ pr " size_t i, len = 0;\n";
pr " for (i = 0; r[i] != NULL; ++i) len++;\n";
pr " VALUE rv = rb_ary_new2 (len);\n";
pr " for (i = 0; r[i] != NULL; ++i) {\n";
generate_ruby_struct_list_code typ cols
| RHashtable _ ->
pr " VALUE rv = rb_hash_new ();\n";
- pr " int i;\n";
+ pr " size_t i;\n";
pr " for (i = 0; r[i] != NULL; i+=2) {\n";
pr " rb_hash_aset (rv, rb_str_new2 (r[i]), rb_str_new2 (r[i+1]));\n";
pr " free (r[i]);\n";
(* Ruby code to return a struct list. *)
and generate_ruby_struct_list_code typ cols =
pr " VALUE rv = rb_ary_new2 (r->len);\n";
- pr " int i;\n";
+ pr " size_t i;\n";
pr " for (i = 0; i < r->len; ++i) {\n";
pr " VALUE hv = rb_hash_new ();\n";
List.iter (
(* Generate Java bindings GuestFS.java file. *)
and generate_java_java () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
package com.redhat.et.libguestfs;
| FileIn n
| FileOut n ->
pr "String %s" n
+ | BufferIn n ->
+ pr "byte[] %s" n
| StringList n | DeviceList n ->
pr "String[] %s" n
| Bool n ->
pr "boolean %s" n
| Int n ->
pr "int %s" n
+ | Int64 n ->
+ pr "long %s" n
) (snd style);
pr ")\n";
pr " throws LibGuestFSException";
if semicolon then pr ";"
-and generate_java_struct jtyp cols =
- generate_header CStyle LGPLv2;
+and generate_java_struct jtyp cols () =
+ generate_header CStyle LGPLv2plus;
pr "\
package com.redhat.et.libguestfs;
pr "}\n"
and generate_java_c () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
#include <stdio.h>
| FileIn n
| FileOut n ->
pr ", jstring j%s" n
+ | BufferIn n ->
+ pr ", jbyteArray 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
+ | Int64 n ->
+ pr ", jlong j%s" n
) (snd style);
pr ")\n";
pr "{\n";
| FileIn n
| FileOut n ->
pr " const char *%s;\n" n
+ | BufferIn n ->
+ pr " jbyte *%s;\n" n;
+ pr " size_t %s_size;\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
+ | Int64 n ->
+ pr " int64_t %s;\n" n
) (snd style);
let needs_i =
| DeviceList _ -> true
| _ -> false) (snd style) in
if needs_i then
- pr " int i;\n";
+ pr " size_t i;\n";
pr "\n";
* a NULL parameter.
*)
pr " %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
+ | BufferIn n ->
+ pr " %s = (*env)->GetByteArrayElements (env, j%s, NULL);\n" n n;
+ pr " %s_size = (*env)->GetArrayLength (env, j%s);\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 " }\n";
pr " %s[%s_len] = NULL;\n" n n;
| Bool n
- | Int n ->
+ | Int n
+ | Int64 n ->
pr " %s = j%s;\n" n n
) (snd style);
| OptString n ->
pr " if (j%s)\n" n;
pr " (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
+ | BufferIn n ->
+ pr " (*env)->ReleaseByteArrayElements (env, j%s, %s, 0);\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"
pr " }\n";
pr " free (%s);\n" n
| Bool n
- | Int n -> ()
+ | Int n
+ | Int64 n -> ()
) (snd style);
(* Check for errors. *)
pr " return jr;\n"
and generate_java_makefile_inc () =
- generate_header HashStyle GPLv2;
+ generate_header HashStyle GPLv2plus;
pr "java_built_sources = \\\n";
List.iter (
pr "\tcom/redhat/et/libguestfs/GuestFS.java\n"
and generate_haskell_hs () =
- generate_header HaskellStyle LGPLv2;
+ generate_header HaskellStyle LGPLv2plus;
(* XXX We only know how to generate partial FFI for Haskell
* at the moment. Please help out!
pr "
) where
+
+-- Unfortunately some symbols duplicate ones already present
+-- in Prelude. We don't know which, so we hard-code a list
+-- here.
+import Prelude hiding (truncate)
+
import Foreign
import Foreign.C
import Foreign.C.Types
function
| FileIn n
| FileOut n
- | Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n
+ | Pathname n | Device n | Dev_or_Path n | String n ->
+ pr "withCString %s $ \\%s -> " n n
+ | BufferIn n ->
+ pr "withCStringLen %s $ \\(%s, %s_size) -> " n 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 _ -> ()
+ | Bool _ | Int _ | Int64 _ -> ()
) (snd style);
(* Convert integer arguments. *)
let args =
function
| Bool n -> sprintf "(fromBool %s)" n
| Int n -> sprintf "(fromIntegral %s)" n
+ | Int64 n -> sprintf "(fromIntegral %s)" n
| FileIn n | FileOut n
| Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
+ | BufferIn n -> sprintf "%s (fromIntegral %s_size)" n n
) (snd style) in
pr "withForeignPtr h (\\p -> c_%s %s)\n" name
(String.concat " " ("p" :: args));
fun arg ->
(match arg with
| Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
+ | BufferIn _ ->
+ if hs then pr "String"
+ else pr "CString -> CInt"
| OptString _ -> if hs then pr "Maybe String" else pr "CString"
| StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
| Bool _ -> pr "%s" bool
| Int _ -> pr "%s" int
+ | Int64 _ -> pr "%s" int
| FileIn _ -> pr "%s" string
| FileOut _ -> pr "%s" string
);
);
pr ")"
+and generate_csharp () =
+ generate_header CPlusPlusStyle LGPLv2plus;
+
+ (* XXX Make this configurable by the C# assembly users. *)
+ let library = "libguestfs.so.0" in
+
+ pr "\
+// These C# bindings are highly experimental at present.
+//
+// Firstly they only work on Linux (ie. Mono). In order to get them
+// to work on Windows (ie. .Net) you would need to port the library
+// itself to Windows first.
+//
+// The second issue is that some calls are known to be incorrect and
+// can cause Mono to segfault. Particularly: calls which pass or
+// return string[], or return any structure value. This is because
+// we haven't worked out the correct way to do this from C#.
+//
+// The third issue is that when compiling you get a lot of warnings.
+// We are not sure whether the warnings are important or not.
+//
+// Fourthly we do not routinely build or test these bindings as part
+// of the make && make check cycle, which means that regressions might
+// go unnoticed.
+//
+// Suggestions and patches are welcome.
+
+// To compile:
+//
+// gmcs Libguestfs.cs
+// mono Libguestfs.exe
+//
+// (You'll probably want to add a Test class / static main function
+// otherwise this won't do anything useful).
+
+using System;
+using System.IO;
+using System.Runtime.InteropServices;
+using System.Runtime.Serialization;
+using System.Collections;
+
+namespace Guestfs
+{
+ class Error : System.ApplicationException
+ {
+ public Error (string message) : base (message) {}
+ protected Error (SerializationInfo info, StreamingContext context) {}
+ }
+
+ class Guestfs
+ {
+ IntPtr _handle;
+
+ [DllImport (\"%s\")]
+ static extern IntPtr guestfs_create ();
+
+ public Guestfs ()
+ {
+ _handle = guestfs_create ();
+ if (_handle == IntPtr.Zero)
+ throw new Error (\"could not create guestfs handle\");
+ }
+
+ [DllImport (\"%s\")]
+ static extern void guestfs_close (IntPtr h);
+
+ ~Guestfs ()
+ {
+ guestfs_close (_handle);
+ }
+
+ [DllImport (\"%s\")]
+ static extern string guestfs_last_error (IntPtr h);
+
+" library library library;
+
+ (* Generate C# structure bindings. We prefix struct names with
+ * underscore because C# cannot have conflicting struct names and
+ * method names (eg. "class stat" and "stat").
+ *)
+ List.iter (
+ fun (typ, cols) ->
+ pr " [StructLayout (LayoutKind.Sequential)]\n";
+ pr " public class _%s {\n" typ;
+ List.iter (
+ function
+ | name, FChar -> pr " char %s;\n" name
+ | name, FString -> pr " string %s;\n" name
+ | name, FBuffer ->
+ pr " uint %s_len;\n" name;
+ pr " string %s;\n" name
+ | name, FUUID ->
+ pr " [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
+ pr " string %s;\n" name
+ | name, FUInt32 -> pr " uint %s;\n" name
+ | name, FInt32 -> pr " int %s;\n" name
+ | name, (FUInt64|FBytes) -> pr " ulong %s;\n" name
+ | name, FInt64 -> pr " long %s;\n" name
+ | name, FOptPercent -> pr " float %s; /* [0..100] or -1 */\n" name
+ ) cols;
+ pr " }\n";
+ pr "\n"
+ ) structs;
+
+ (* Generate C# function bindings. *)
+ List.iter (
+ fun (name, style, _, _, _, shortdesc, _) ->
+ let rec csharp_return_type () =
+ match fst style with
+ | RErr -> "void"
+ | RBool n -> "bool"
+ | RInt n -> "int"
+ | RInt64 n -> "long"
+ | RConstString n
+ | RConstOptString n
+ | RString n
+ | RBufferOut n -> "string"
+ | RStruct (_,n) -> "_" ^ n
+ | RHashtable n -> "Hashtable"
+ | RStringList n -> "string[]"
+ | RStructList (_,n) -> sprintf "_%s[]" n
+
+ and c_return_type () =
+ match fst style with
+ | RErr
+ | RBool _
+ | RInt _ -> "int"
+ | RInt64 _ -> "long"
+ | RConstString _
+ | RConstOptString _
+ | RString _
+ | RBufferOut _ -> "string"
+ | RStruct (_,n) -> "_" ^ n
+ | RHashtable _
+ | RStringList _ -> "string[]"
+ | RStructList (_,n) -> sprintf "_%s[]" n
+
+ and c_error_comparison () =
+ match fst style with
+ | RErr
+ | RBool _
+ | RInt _
+ | RInt64 _ -> "== -1"
+ | RConstString _
+ | RConstOptString _
+ | RString _
+ | RBufferOut _
+ | RStruct (_,_)
+ | RHashtable _
+ | RStringList _
+ | RStructList (_,_) -> "== null"
+
+ and generate_extern_prototype () =
+ pr " static extern %s guestfs_%s (IntPtr h"
+ (c_return_type ()) name;
+ List.iter (
+ function
+ | Pathname n | Device n | Dev_or_Path n | String n | OptString n
+ | FileIn n | FileOut n
+ | BufferIn n ->
+ pr ", [In] string %s" n
+ | StringList n | DeviceList n ->
+ pr ", [In] string[] %s" n
+ | Bool n ->
+ pr ", bool %s" n
+ | Int n ->
+ pr ", int %s" n
+ | Int64 n ->
+ pr ", long %s" n
+ ) (snd style);
+ pr ");\n"
+
+ and generate_public_prototype () =
+ pr " public %s %s (" (csharp_return_type ()) name;
+ let comma = ref false in
+ let next () =
+ if !comma then pr ", ";
+ comma := true
+ in
+ List.iter (
+ function
+ | Pathname n | Device n | Dev_or_Path n | String n | OptString n
+ | FileIn n | FileOut n
+ | BufferIn n ->
+ next (); pr "string %s" n
+ | StringList n | DeviceList n ->
+ next (); pr "string[] %s" n
+ | Bool n ->
+ next (); pr "bool %s" n
+ | Int n ->
+ next (); pr "int %s" n
+ | Int64 n ->
+ next (); pr "long %s" n
+ ) (snd style);
+ pr ")\n"
+
+ and generate_call () =
+ pr "guestfs_%s (_handle" name;
+ List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
+ pr ");\n";
+ in
+
+ pr " [DllImport (\"%s\")]\n" library;
+ generate_extern_prototype ();
+ pr "\n";
+ pr " /// <summary>\n";
+ pr " /// %s\n" shortdesc;
+ pr " /// </summary>\n";
+ generate_public_prototype ();
+ pr " {\n";
+ pr " %s r;\n" (c_return_type ());
+ pr " r = ";
+ generate_call ();
+ pr " if (r %s)\n" (c_error_comparison ());
+ pr " throw new Error (guestfs_last_error (_handle));\n";
+ (match fst style with
+ | RErr -> ()
+ | RBool _ ->
+ pr " return r != 0 ? true : false;\n"
+ | RHashtable _ ->
+ pr " Hashtable rr = new Hashtable ();\n";
+ pr " for (size_t i = 0; i < r.Length; i += 2)\n";
+ pr " rr.Add (r[i], r[i+1]);\n";
+ pr " return rr;\n"
+ | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
+ | RString _ | RBufferOut _ | RStruct _ | RStringList _
+ | RStructList _ ->
+ pr " return r;\n"
+ );
+ pr " }\n";
+ pr "\n";
+ ) all_functions_sorted;
+
+ pr " }
+}
+"
+
and generate_bindtests () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
#include <stdio.h>
#include <string.h>
#include \"guestfs.h\"
+#include \"guestfs-internal.h\"
+#include \"guestfs-internal-actions.h\"
#include \"guestfs_protocol.h\"
#define error guestfs_error
static void
print_strings (char *const *argv)
{
- int argc;
+ size_t argc;
printf (\"[\");
for (argc = 0; argv[argc] != NULL; ++argc) {
let () =
let (name, style, _, _, _, _, _) = test0 in
generate_prototype ~extern:false ~semicolon:false ~newline:true
- ~handle:"g" ~prefix:"guestfs_" name style;
+ ~handle:"g" ~prefix:"guestfs__" name style;
pr "{\n";
List.iter (
function
| String n
| FileIn n
| FileOut n -> pr " printf (\"%%s\\n\", %s);\n" n
+ | BufferIn n ->
+ pr " {\n";
+ pr " size_t i;\n";
+ pr " for (i = 0; i < %s_size; ++i)\n" n;
+ pr " printf (\"<%%02x>\", %s[i]);\n" n;
+ pr " printf (\"\\n\");\n";
+ pr " }\n";
| OptString n -> pr " printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
| StringList n | DeviceList n -> pr " print_strings (%s);\n" n
| Bool n -> pr " printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
| Int n -> pr " printf (\"%%d\\n\", %s);\n" n
+ | Int64 n -> pr " printf (\"%%\" PRIi64 \"\\n\", %s);\n" n
) (snd style);
pr " /* Java changes stdout line buffering so we need this: */\n";
pr " fflush (stdout);\n";
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;
+ ~handle:"g" ~prefix:"guestfs__" name style;
pr "{\n";
(match fst style with
| RErr ->
pr " sscanf (val, \"%%\" SCNi64, &r);\n";
pr " return r;\n"
| RBool _ ->
- pr " return strcmp (val, \"true\") == 0;\n"
+ pr " return STREQ (val, \"true\");\n"
| RConstString _
| RConstOptString _ ->
(* Can't return the input string here. Return a static
) else (
pr "/* Test error return. */\n";
generate_prototype ~extern:false ~semicolon:false ~newline:true
- ~handle:"g" ~prefix:"guestfs_" name style;
+ ~handle:"g" ~prefix:"guestfs__" name style;
pr "{\n";
pr " error (g, \"error\");\n";
(match fst style with
) tests
and generate_ocaml_bindtests () =
- generate_header OCamlStyle GPLv2;
+ generate_header OCamlStyle GPLv2plus;
pr "\
let () =
"[|" ^ 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 ^ ")"
+ | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L"
+ | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)"
| CallBool b -> string_of_bool b
+ | CallBuffer s -> sprintf "%S" s
) args
)
in
and generate_perl_bindtests () =
pr "#!/usr/bin/perl -w\n";
- generate_header HashStyle GPLv2;
+ generate_header HashStyle GPLv2plus;
pr "\
use strict;
| CallStringList xs ->
"[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
| CallInt i -> string_of_int i
+ | CallInt64 i -> Int64.to_string i
| CallBool b -> if b then "1" else "0"
+ | CallBuffer s -> "\"" ^ c_quote s ^ "\""
) args
)
in
pr "print \"EOF\\n\"\n"
and generate_python_bindtests () =
- generate_header HashStyle GPLv2;
+ generate_header HashStyle GPLv2plus;
pr "\
import guestfs
| CallStringList xs ->
"[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
| CallInt i -> string_of_int i
+ | CallInt64 i -> Int64.to_string i
| CallBool b -> if b then "1" else "0"
+ | CallBuffer s -> "\"" ^ c_quote s ^ "\""
) args
)
in
pr "print \"EOF\"\n"
and generate_ruby_bindtests () =
- generate_header HashStyle GPLv2;
+ generate_header HashStyle GPLv2plus;
pr "\
require 'guestfs'
| CallStringList xs ->
"[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
| CallInt i -> string_of_int i
+ | CallInt64 i -> Int64.to_string i
| CallBool b -> string_of_bool b
+ | CallBuffer s -> "\"" ^ c_quote s ^ "\""
) args
)
in
pr "print \"EOF\\n\"\n"
and generate_java_bindtests () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
pr "\
import com.redhat.et.libguestfs.*;
"new String[]{" ^
String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
| CallInt i -> string_of_int i
+ | CallInt64 i -> Int64.to_string i
| CallBool b -> string_of_bool b
+ | CallBuffer s ->
+ "new byte[] { " ^ String.concat "," (
+ map_chars (fun c -> string_of_int (Char.code c)) s
+ ) ^ " }"
) args
)
in
"
and generate_haskell_bindtests () =
- generate_header HaskellStyle GPLv2;
+ generate_header HaskellStyle GPLv2plus;
pr "\
module Bindtests where
"[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
| CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
| CallInt i -> string_of_int i
+ | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")"
+ | CallInt64 i -> Int64.to_string i
| CallBool true -> "True"
| CallBool false -> "False"
+ | CallBuffer s -> "\"" ^ c_quote s ^ "\""
) args
)
in
and generate_lang_bindtests call =
call "test0" [CallString "abc"; CallOptString (Some "def");
CallStringList []; CallBool false;
- CallInt 0; CallString "123"; CallString "456"];
+ CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
+ CallBuffer "abc\000abc"];
call "test0" [CallString "abc"; CallOptString None;
CallStringList []; CallBool false;
- CallInt 0; CallString "123"; CallString "456"];
+ CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
+ CallBuffer "abc\000abc"];
call "test0" [CallString ""; CallOptString (Some "def");
CallStringList []; CallBool false;
- CallInt 0; CallString "123"; CallString "456"];
+ CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
+ CallBuffer "abc\000abc"];
call "test0" [CallString ""; CallOptString (Some "");
CallStringList []; CallBool false;
- CallInt 0; CallString "123"; CallString "456"];
+ CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
+ CallBuffer "abc\000abc"];
call "test0" [CallString "abc"; CallOptString (Some "def");
CallStringList ["1"]; CallBool false;
- CallInt 0; CallString "123"; CallString "456"];
+ CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
+ CallBuffer "abc\000abc"];
call "test0" [CallString "abc"; CallOptString (Some "def");
CallStringList ["1"; "2"]; CallBool false;
- CallInt 0; CallString "123"; CallString "456"];
+ CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
+ CallBuffer "abc\000abc"];
call "test0" [CallString "abc"; CallOptString (Some "def");
CallStringList ["1"]; CallBool true;
- CallInt 0; CallString "123"; CallString "456"];
+ CallInt 0; CallInt64 0L; CallString "123"; CallString "456";
+ CallBuffer "abc\000abc"];
call "test0" [CallString "abc"; CallOptString (Some "def");
CallStringList ["1"]; CallBool false;
- CallInt (-1); CallString "123"; CallString "456"];
+ CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456";
+ CallBuffer "abc\000abc"];
call "test0" [CallString "abc"; CallOptString (Some "def");
CallStringList ["1"]; CallBool false;
- CallInt (-2); CallString "123"; CallString "456"];
+ CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456";
+ CallBuffer "abc\000abc"];
call "test0" [CallString "abc"; CallOptString (Some "def");
CallStringList ["1"]; CallBool false;
- CallInt 1; CallString "123"; CallString "456"];
+ CallInt 1; CallInt64 1L; CallString "123"; CallString "456";
+ CallBuffer "abc\000abc"];
call "test0" [CallString "abc"; CallOptString (Some "def");
CallStringList ["1"]; CallBool false;
- CallInt 2; CallString "123"; CallString "456"];
+ CallInt 2; CallInt64 2L; CallString "123"; CallString "456";
+ CallBuffer "abc\000abc"];
call "test0" [CallString "abc"; CallOptString (Some "def");
CallStringList ["1"]; CallBool false;
- CallInt 4095; CallString "123"; CallString "456"];
+ CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456";
+ CallBuffer "abc\000abc"];
call "test0" [CallString "abc"; CallOptString (Some "def");
CallStringList ["1"]; CallBool false;
- CallInt 0; CallString ""; CallString ""]
+ CallInt 0; CallInt64 0L; CallString ""; CallString "";
+ CallBuffer "abc\000abc"]
(* XXX Add here tests of the return and error functions. *)
-(* This is used to generate the src/MAX_PROC_NR file which
- * contains the maximum procedure number, a surrogate for the
- * ABI version number. See src/Makefile.am for the details.
+(* Code to generator bindings for virt-inspector. Currently only
+ * implemented for OCaml code (for virt-p2v 2.0).
*)
-and generate_max_proc_nr () =
- let proc_nrs = List.map (
- fun (_, _, proc_nr, _, _, _, _) -> proc_nr
- ) daemon_functions in
-
- let max_proc_nr = List.fold_left max 0 proc_nrs in
+let rng_input = "inspector/virt-inspector.rng"
- pr "%d\n" max_proc_nr
+(* Read the input file and parse it into internal structures. This is
+ * by no means a complete RELAX NG parser, but is just enough to be
+ * able to parse the specific input file.
+ *)
+type rng =
+ | Element of string * rng list (* <element name=name/> *)
+ | Attribute of string * rng list (* <attribute name=name/> *)
+ | Interleave of rng list (* <interleave/> *)
+ | ZeroOrMore of rng (* <zeroOrMore/> *)
+ | OneOrMore of rng (* <oneOrMore/> *)
+ | Optional of rng (* <optional/> *)
+ | Choice of string list (* <choice><value/>*</choice> *)
+ | Value of string (* <value>str</value> *)
+ | Text (* <text/> *)
+
+let rec string_of_rng = function
+ | Element (name, xs) ->
+ "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
+ | Attribute (name, xs) ->
+ "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
+ | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")"
+ | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")"
+ | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")"
+ | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")"
+ | Choice values -> "Choice [" ^ String.concat ", " values ^ "]"
+ | Value value -> "Value \"" ^ value ^ "\""
+ | Text -> "Text"
+
+and string_of_rng_list xs =
+ String.concat ", " (List.map string_of_rng xs)
+
+let rec parse_rng ?defines context = function
+ | [] -> []
+ | Xml.Element ("element", ["name", name], children) :: rest ->
+ Element (name, parse_rng ?defines context children)
+ :: parse_rng ?defines context rest
+ | Xml.Element ("attribute", ["name", name], children) :: rest ->
+ Attribute (name, parse_rng ?defines context children)
+ :: parse_rng ?defines context rest
+ | Xml.Element ("interleave", [], children) :: rest ->
+ Interleave (parse_rng ?defines context children)
+ :: parse_rng ?defines context rest
+ | Xml.Element ("zeroOrMore", [], [child]) :: rest ->
+ let rng = parse_rng ?defines context [child] in
+ (match rng with
+ | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
+ | _ ->
+ failwithf "%s: <zeroOrMore> contains more than one child element"
+ context
+ )
+ | Xml.Element ("oneOrMore", [], [child]) :: rest ->
+ let rng = parse_rng ?defines context [child] in
+ (match rng with
+ | [child] -> OneOrMore child :: parse_rng ?defines context rest
+ | _ ->
+ failwithf "%s: <oneOrMore> contains more than one child element"
+ context
+ )
+ | Xml.Element ("optional", [], [child]) :: rest ->
+ let rng = parse_rng ?defines context [child] in
+ (match rng with
+ | [child] -> Optional child :: parse_rng ?defines context rest
+ | _ ->
+ failwithf "%s: <optional> contains more than one child element"
+ context
+ )
+ | Xml.Element ("choice", [], children) :: rest ->
+ let values = List.map (
+ function Xml.Element ("value", [], [Xml.PCData value]) -> value
+ | _ ->
+ failwithf "%s: can't handle anything except <value> in <choice>"
+ context
+ ) children in
+ Choice values
+ :: parse_rng ?defines context rest
+ | Xml.Element ("value", [], [Xml.PCData value]) :: rest ->
+ Value value :: parse_rng ?defines context rest
+ | Xml.Element ("text", [], []) :: rest ->
+ Text :: parse_rng ?defines context rest
+ | Xml.Element ("ref", ["name", name], []) :: rest ->
+ (* Look up the reference. Because of limitations in this parser,
+ * we can't handle arbitrarily nested <ref> yet. You can only
+ * use <ref> from inside <start>.
+ *)
+ (match defines with
+ | None ->
+ failwithf "%s: contains <ref>, but no refs are defined yet" context
+ | Some map ->
+ let rng = StringMap.find name map in
+ rng @ parse_rng ?defines context rest
+ )
+ | x :: _ ->
+ failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
+
+let grammar =
+ let xml = Xml.parse_file rng_input in
+ match xml with
+ | Xml.Element ("grammar", _,
+ Xml.Element ("start", _, gram) :: defines) ->
+ (* The <define/> elements are referenced in the <start> section,
+ * so build a map of those first.
+ *)
+ let defines = List.fold_left (
+ fun map ->
+ function Xml.Element ("define", ["name", name], defn) ->
+ StringMap.add name defn map
+ | _ ->
+ failwithf "%s: expected <define name=name/>" rng_input
+ ) StringMap.empty defines in
+ let defines = StringMap.mapi parse_rng defines in
+
+ (* Parse the <start> clause, passing the defines. *)
+ parse_rng ~defines "<start>" gram
+ | _ ->
+ failwithf "%s: input is not <grammar><start/><define>*</grammar>"
+ rng_input
+
+let name_of_field = function
+ | Element (name, _) | Attribute (name, _)
+ | ZeroOrMore (Element (name, _))
+ | OneOrMore (Element (name, _))
+ | Optional (Element (name, _)) -> name
+ | Optional (Attribute (name, _)) -> name
+ | Text -> (* an unnamed field in an element *)
+ "data"
+ | rng ->
+ failwithf "name_of_field failed at: %s" (string_of_rng rng)
+
+(* At the moment this function only generates OCaml types. However we
+ * should parameterize it later so it can generate types/structs in a
+ * variety of languages.
+ *)
+let generate_types xs =
+ (* A simple type is one that can be printed out directly, eg.
+ * "string option". A complex type is one which has a name and has
+ * to be defined via another toplevel definition, eg. a struct.
+ *
+ * generate_type generates code for either simple or complex types.
+ * In the simple case, it returns the string ("string option"). In
+ * the complex case, it returns the name ("mountpoint"). In the
+ * complex case it has to print out the definition before returning,
+ * so it should only be called when we are at the beginning of a
+ * new line (BOL context).
+ *)
+ let rec generate_type = function
+ | Text -> (* string *)
+ "string", true
+ | Choice values -> (* [`val1|`val2|...] *)
+ "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
+ | ZeroOrMore rng -> (* <rng> list *)
+ let t, is_simple = generate_type rng in
+ t ^ " list (* 0 or more *)", is_simple
+ | OneOrMore rng -> (* <rng> list *)
+ let t, is_simple = generate_type rng in
+ t ^ " list (* 1 or more *)", is_simple
+ (* virt-inspector hack: bool *)
+ | Optional (Attribute (name, [Value "1"])) ->
+ "bool", true
+ | Optional rng -> (* <rng> list *)
+ let t, is_simple = generate_type rng in
+ t ^ " option", is_simple
+ (* type name = { fields ... } *)
+ | Element (name, fields) when is_attrs_interleave fields ->
+ generate_type_struct name (get_attrs_interleave fields)
+ | Element (name, [field]) (* type name = field *)
+ | Attribute (name, [field]) ->
+ let t, is_simple = generate_type field in
+ if is_simple then (t, true)
+ else (
+ pr "type %s = %s\n" name t;
+ name, false
+ )
+ | Element (name, fields) -> (* type name = { fields ... } *)
+ generate_type_struct name fields
+ | rng ->
+ failwithf "generate_type failed at: %s" (string_of_rng rng)
+
+ and is_attrs_interleave = function
+ | [Interleave _] -> true
+ | Attribute _ :: fields -> is_attrs_interleave fields
+ | Optional (Attribute _) :: fields -> is_attrs_interleave fields
+ | _ -> false
+
+ and get_attrs_interleave = function
+ | [Interleave fields] -> fields
+ | ((Attribute _) as field) :: fields
+ | ((Optional (Attribute _)) as field) :: fields ->
+ field :: get_attrs_interleave fields
+ | _ -> assert false
+
+ and generate_types xs =
+ List.iter (fun x -> ignore (generate_type x)) xs
+
+ and generate_type_struct name fields =
+ (* Calculate the types of the fields first. We have to do this
+ * before printing anything so we are still in BOL context.
+ *)
+ let types = List.map fst (List.map generate_type fields) in
-let output_to filename =
- let filename_new = filename ^ ".new" in
- chan := open_out filename_new;
- let close () =
- close_out !chan;
- chan := stdout;
-
- (* Is the new file different from the current file? *)
- if Sys.file_exists filename && files_equal filename filename_new then
- Unix.unlink filename_new (* same, so skip it *)
- else (
- (* different, overwrite old one *)
- (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ());
- Unix.rename filename_new filename;
- Unix.chmod filename 0o444;
- printf "written %s\n%!" filename;
- )
+ (* Special case of a struct containing just a string and another
+ * field. Turn it into an assoc list.
+ *)
+ match types with
+ | ["string"; other] ->
+ let fname1, fname2 =
+ match fields with
+ | [f1; f2] -> name_of_field f1, name_of_field f2
+ | _ -> assert false in
+ pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
+ name, false
+
+ | types ->
+ pr "type %s = {\n" name;
+ List.iter (
+ fun (field, ftype) ->
+ let fname = name_of_field field in
+ pr " %s_%s : %s;\n" name fname ftype
+ ) (List.combine fields types);
+ pr "}\n";
+ (* Return the name of this type, and
+ * false because it's not a simple type.
+ *)
+ name, false
in
- close
-
-(* Main program. *)
-let () =
- check_functions ();
-
- if not (Sys.file_exists "HACKING") then (
- eprintf "\
-You are probably running this from the wrong directory.
-Run it from the top source directory using the command
- src/generator.ml
-";
- exit 1
- );
-
- let close = output_to "src/guestfs_protocol.x" in
- generate_xdr ();
- close ();
- let close = output_to "src/guestfs-structs.h" in
- generate_structs_h ();
- close ();
+ generate_types xs
- let close = output_to "src/guestfs-actions.h" in
- generate_actions_h ();
- close ();
+let generate_parsers xs =
+ (* As for generate_type above, generate_parser makes a parser for
+ * some type, and returns the name of the parser it has generated.
+ * Because it (may) need to print something, it should always be
+ * called in BOL context.
+ *)
+ let rec generate_parser = function
+ | Text -> (* string *)
+ "string_child_or_empty"
+ | Choice values -> (* [`val1|`val2|...] *)
+ sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))"
+ (String.concat "|"
+ (List.map (fun v -> sprintf "%S -> `%s" v v) values))
+ | ZeroOrMore rng -> (* <rng> list *)
+ let pa = generate_parser rng in
+ sprintf "(fun x -> List.map %s (Xml.children x))" pa
+ | OneOrMore rng -> (* <rng> list *)
+ let pa = generate_parser rng in
+ sprintf "(fun x -> List.map %s (Xml.children x))" pa
+ (* virt-inspector hack: bool *)
+ | Optional (Attribute (name, [Value "1"])) ->
+ sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name
+ | Optional rng -> (* <rng> list *)
+ let pa = generate_parser rng in
+ sprintf "(function None -> None | Some x -> Some (%s x))" pa
+ (* type name = { fields ... } *)
+ | Element (name, fields) when is_attrs_interleave fields ->
+ generate_parser_struct name (get_attrs_interleave fields)
+ | Element (name, [field]) -> (* type name = field *)
+ let pa = generate_parser field in
+ let parser_name = sprintf "parse_%s_%d" name (unique ()) in
+ pr "let %s =\n" parser_name;
+ pr " %s\n" pa;
+ pr "let parse_%s = %s\n" name parser_name;
+ parser_name
+ | Attribute (name, [field]) ->
+ let pa = generate_parser field in
+ let parser_name = sprintf "parse_%s_%d" name (unique ()) in
+ pr "let %s =\n" parser_name;
+ pr " %s\n" pa;
+ pr "let parse_%s = %s\n" name parser_name;
+ parser_name
+ | Element (name, fields) -> (* type name = { fields ... } *)
+ generate_parser_struct name ([], fields)
+ | rng ->
+ failwithf "generate_parser failed at: %s" (string_of_rng rng)
+
+ and is_attrs_interleave = function
+ | [Interleave _] -> true
+ | Attribute _ :: fields -> is_attrs_interleave fields
+ | Optional (Attribute _) :: fields -> is_attrs_interleave fields
+ | _ -> false
+
+ and get_attrs_interleave = function
+ | [Interleave fields] -> [], fields
+ | ((Attribute _) as field) :: fields
+ | ((Optional (Attribute _)) as field) :: fields ->
+ let attrs, interleaves = get_attrs_interleave fields in
+ (field :: attrs), interleaves
+ | _ -> assert false
+
+ and generate_parsers xs =
+ List.iter (fun x -> ignore (generate_parser x)) xs
+
+ and generate_parser_struct name (attrs, interleaves) =
+ (* Generate parsers for the fields first. We have to do this
+ * before printing anything so we are still in BOL context.
+ *)
+ let fields = attrs @ interleaves in
+ let pas = List.map generate_parser fields in
- let close = output_to "src/guestfs-actions.c" in
- generate_client_actions ();
- close ();
+ (* Generate an intermediate tuple from all the fields first.
+ * If the type is just a string + another field, then we will
+ * return this directly, otherwise it is turned into a record.
+ *
+ * RELAX NG note: This code treats <interleave> and plain lists of
+ * fields the same. In other words, it doesn't bother enforcing
+ * any ordering of fields in the XML.
+ *)
+ pr "let parse_%s x =\n" name;
+ pr " let t = (\n ";
+ let comma = ref false in
+ List.iter (
+ fun x ->
+ if !comma then pr ",\n ";
+ comma := true;
+ match x with
+ | Optional (Attribute (fname, [field])), pa ->
+ pr "%s x" pa
+ | Optional (Element (fname, [field])), pa ->
+ pr "%s (optional_child %S x)" pa fname
+ | Attribute (fname, [Text]), _ ->
+ pr "attribute %S x" fname
+ | (ZeroOrMore _ | OneOrMore _), pa ->
+ pr "%s x" pa
+ | Text, pa ->
+ pr "%s x" pa
+ | (field, pa) ->
+ let fname = name_of_field field in
+ pr "%s (child %S x)" pa fname
+ ) (List.combine fields pas);
+ pr "\n ) in\n";
+
+ (match fields with
+ | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
+ pr " t\n"
+
+ | _ ->
+ pr " (Obj.magic t : %s)\n" name
+(*
+ List.iter (
+ function
+ | (Optional (Attribute (fname, [field])), pa) ->
+ pr " %s_%s =\n" name fname;
+ pr " %s x;\n" pa
+ | (Optional (Element (fname, [field])), pa) ->
+ pr " %s_%s =\n" name fname;
+ pr " (let x = optional_child %S x in\n" fname;
+ pr " %s x);\n" pa
+ | (field, pa) ->
+ let fname = name_of_field field in
+ pr " %s_%s =\n" name fname;
+ pr " (let x = child %S x in\n" fname;
+ pr " %s x);\n" pa
+ ) (List.combine fields pas);
+ pr "}\n"
+*)
+ );
+ sprintf "parse_%s" name
+ in
- let close = output_to "daemon/actions.h" in
- generate_daemon_actions_h ();
- close ();
+ generate_parsers xs
- let close = output_to "daemon/stubs.c" in
- generate_daemon_actions ();
- close ();
+(* Generate ocaml/guestfs_inspector.mli. *)
+let generate_ocaml_inspector_mli () =
+ generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
- let close = output_to "daemon/names.c" in
- generate_daemon_names ();
- close ();
+ pr "\
+(** This is an OCaml language binding to the external [virt-inspector]
+ program.
- let close = output_to "capitests/tests.c" in
- generate_tests ();
- close ();
+ For more information, please read the man page [virt-inspector(1)].
+*)
- let close = output_to "src/guestfs-bindtests.c" in
- generate_bindtests ();
- close ();
+";
- let close = output_to "fish/cmds.c" in
- generate_fish_cmds ();
- close ();
+ generate_types grammar;
+ pr "(** The nested information returned from the {!inspect} function. *)\n";
+ pr "\n";
- let close = output_to "fish/completion.c" in
- generate_fish_completion ();
- close ();
+ pr "\
+val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems
+(** To inspect a libvirt domain called [name], pass a singleton
+ list: [inspect [name]]. When using libvirt only, you may
+ optionally pass a libvirt URI using [inspect ~connect:uri ...].
+
+ To inspect a disk image or images, pass a list of the filenames
+ of the disk images: [inspect filenames]
+
+ This function inspects the given guest or disk images and
+ returns a list of operating system(s) found and a large amount
+ of information about them. In the vast majority of cases,
+ a virtual machine only contains a single operating system.
+
+ If the optional [~xml] parameter is given, then this function
+ skips running the external virt-inspector program and just
+ parses the given XML directly (which is expected to be XML
+ produced from a previous run of virt-inspector). The list of
+ names and connect URI are ignored in this case.
+
+ This function can throw a wide variety of exceptions, for example
+ if the external virt-inspector program cannot be found, or if
+ it doesn't generate valid XML.
+*)
+"
- let close = output_to "guestfs-structs.pod" in
- generate_structs_pod ();
- close ();
+(* Generate ocaml/guestfs_inspector.ml. *)
+let generate_ocaml_inspector_ml () =
+ generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
- let close = output_to "guestfs-actions.pod" in
- generate_actions_pod ();
- close ();
+ pr "open Unix\n";
+ pr "\n";
- let close = output_to "guestfish-actions.pod" in
- generate_fish_actions_pod ();
- close ();
+ generate_types grammar;
+ pr "\n";
- let close = output_to "ocaml/guestfs.mli" in
- generate_ocaml_mli ();
- close ();
+ pr "\
+(* Misc functions which are used by the parser code below. *)
+let first_child = function
+ | Xml.Element (_, _, c::_) -> c
+ | Xml.Element (name, _, []) ->
+ failwith (\"expected <\" ^ name ^ \"/> to have a child node\")
+ | Xml.PCData str ->
+ failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
+
+let string_child_or_empty = function
+ | Xml.Element (_, _, [Xml.PCData s]) -> s
+ | Xml.Element (_, _, []) -> \"\"
+ | Xml.Element (x, _, _) ->
+ failwith (\"expected XML tag with a single PCDATA child, but got \" ^
+ x ^ \" instead\")
+ | Xml.PCData str ->
+ failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
+
+let optional_child name xml =
+ let children = Xml.children xml in
+ try
+ Some (List.find (function
+ | Xml.Element (n, _, _) when n = name -> true
+ | _ -> false) children)
+ with
+ Not_found -> None
- let close = output_to "ocaml/guestfs.ml" in
- generate_ocaml_ml ();
- close ();
+let child name xml =
+ match optional_child name xml with
+ | Some c -> c
+ | None ->
+ failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
- let close = output_to "ocaml/guestfs_c_actions.c" in
- generate_ocaml_c ();
- close ();
+let attribute name xml =
+ try Xml.attrib xml name
+ with Xml.No_attribute _ ->
+ failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
- let close = output_to "ocaml/bindtests.ml" in
- generate_ocaml_bindtests ();
- close ();
+";
- let close = output_to "perl/Guestfs.xs" in
- generate_perl_xs ();
- close ();
+ generate_parsers grammar;
+ pr "\n";
- let close = output_to "perl/lib/Sys/Guestfs.pm" in
- generate_perl_pm ();
- close ();
+ pr "\
+(* Run external virt-inspector, then use parser to parse the XML. *)
+let inspect ?connect ?xml names =
+ let xml =
+ match xml with
+ | None ->
+ if names = [] then invalid_arg \"inspect: no names given\";
+ let cmd = [ \"virt-inspector\"; \"--xml\" ] @
+ (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @
+ names in
+ let cmd = List.map Filename.quote cmd in
+ let cmd = String.concat \" \" cmd in
+ let chan = open_process_in cmd in
+ let xml = Xml.parse_in chan in
+ (match close_process_in chan with
+ | WEXITED 0 -> ()
+ | WEXITED _ -> failwith \"external virt-inspector command failed\"
+ | WSIGNALED i | WSTOPPED i ->
+ failwith (\"external virt-inspector command died or stopped on sig \" ^
+ string_of_int i)
+ );
+ xml
+ | Some doc ->
+ Xml.parse_string doc in
+ parse_operatingsystems xml
+"
- let close = output_to "perl/bindtests.pl" in
- generate_perl_bindtests ();
- close ();
+and generate_max_proc_nr () =
+ pr "%d\n" max_proc_nr
- let close = output_to "python/guestfs-py.c" in
- generate_python_c ();
- close ();
+let output_to filename k =
+ let filename_new = filename ^ ".new" in
+ chan := open_out filename_new;
+ k ();
+ close_out !chan;
+ chan := Pervasives.stdout;
- let close = output_to "python/guestfs.py" in
- generate_python_py ();
- close ();
+ (* Is the new file different from the current file? *)
+ if Sys.file_exists filename && files_equal filename filename_new then
+ unlink filename_new (* same, so skip it *)
+ else (
+ (* different, overwrite old one *)
+ (try chmod filename 0o644 with Unix_error _ -> ());
+ rename filename_new filename;
+ chmod filename 0o444;
+ printf "written %s\n%!" filename;
+ )
- let close = output_to "python/bindtests.py" in
- generate_python_bindtests ();
- close ();
+let perror msg = function
+ | Unix_error (err, _, _) ->
+ eprintf "%s: %s\n" msg (error_message err)
+ | exn ->
+ eprintf "%s: %s\n" msg (Printexc.to_string exn)
- let close = output_to "ruby/ext/guestfs/_guestfs.c" in
- generate_ruby_c ();
- close ();
+(* Main program. *)
+let () =
+ let lock_fd =
+ try openfile "HACKING" [O_RDWR] 0
+ with
+ | Unix_error (ENOENT, _, _) ->
+ eprintf "\
+You are probably running this from the wrong directory.
+Run it from the top source directory using the command
+ src/generator.ml
+";
+ exit 1
+ | exn ->
+ perror "open: HACKING" exn;
+ exit 1 in
+
+ (* Acquire a lock so parallel builds won't try to run the generator
+ * twice at the same time. Subsequent builds will wait for the first
+ * one to finish. Note the lock is released implicitly when the
+ * program exits.
+ *)
+ (try lockf lock_fd F_LOCK 1
+ with exn ->
+ perror "lock: HACKING" exn;
+ exit 1);
- let close = output_to "ruby/bindtests.rb" in
- generate_ruby_bindtests ();
- close ();
+ check_functions ();
- let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in
- generate_java_java ();
- close ();
+ output_to "src/guestfs_protocol.x" generate_xdr;
+ output_to "src/guestfs-structs.h" generate_structs_h;
+ output_to "src/guestfs-actions.h" generate_actions_h;
+ output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
+ output_to "src/actions.c" generate_client_actions;
+ output_to "src/bindtests.c" generate_bindtests;
+ output_to "src/guestfs-structs.pod" generate_structs_pod;
+ output_to "src/guestfs-actions.pod" generate_actions_pod;
+ output_to "src/guestfs-availability.pod" generate_availability_pod;
+ output_to "src/MAX_PROC_NR" generate_max_proc_nr;
+ output_to "src/libguestfs.syms" generate_linker_script;
+ output_to "daemon/actions.h" generate_daemon_actions_h;
+ output_to "daemon/stubs.c" generate_daemon_actions;
+ output_to "daemon/names.c" generate_daemon_names;
+ output_to "daemon/optgroups.c" generate_daemon_optgroups_c;
+ output_to "daemon/optgroups.h" generate_daemon_optgroups_h;
+ output_to "capitests/tests.c" generate_tests;
+ output_to "fish/cmds.c" generate_fish_cmds;
+ output_to "fish/completion.c" generate_fish_completion;
+ output_to "fish/guestfish-actions.pod" generate_fish_actions_pod;
+ output_to "ocaml/guestfs.mli" generate_ocaml_mli;
+ output_to "ocaml/guestfs.ml" generate_ocaml_ml;
+ output_to "ocaml/guestfs_c_actions.c" generate_ocaml_c;
+ output_to "ocaml/bindtests.ml" generate_ocaml_bindtests;
+ output_to "ocaml/guestfs_inspector.mli" generate_ocaml_inspector_mli;
+ output_to "ocaml/guestfs_inspector.ml" generate_ocaml_inspector_ml;
+ output_to "perl/Guestfs.xs" generate_perl_xs;
+ output_to "perl/lib/Sys/Guestfs.pm" generate_perl_pm;
+ output_to "perl/bindtests.pl" generate_perl_bindtests;
+ output_to "python/guestfs-py.c" generate_python_c;
+ output_to "python/guestfs.py" generate_python_py;
+ output_to "python/bindtests.py" generate_python_bindtests;
+ output_to "ruby/ext/guestfs/_guestfs.c" generate_ruby_c;
+ output_to "ruby/bindtests.rb" generate_ruby_bindtests;
+ output_to "java/com/redhat/et/libguestfs/GuestFS.java" generate_java_java;
List.iter (
fun (typ, jtyp) ->
let cols = cols_of_struct typ in
let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
- let close = output_to filename in
- generate_java_struct jtyp cols;
- close ();
+ output_to filename (generate_java_struct jtyp cols);
) java_structs;
- let close = output_to "java/Makefile.inc" in
- generate_java_makefile_inc ();
- close ();
-
- let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in
- generate_java_c ();
- close ();
-
- let close = output_to "java/Bindtests.java" in
- generate_java_bindtests ();
- close ();
-
- let close = output_to "haskell/Guestfs.hs" in
- generate_haskell_hs ();
- close ();
-
- let close = output_to "haskell/Bindtests.hs" in
- generate_haskell_bindtests ();
- close ();
-
- let close = output_to "src/MAX_PROC_NR" in
- generate_max_proc_nr ();
- close ();
+ output_to "java/Makefile.inc" generate_java_makefile_inc;
+ output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c;
+ output_to "java/Bindtests.java" generate_java_bindtests;
+ output_to "haskell/Guestfs.hs" generate_haskell_hs;
+ output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
+ output_to "csharp/Libguestfs.cs" generate_csharp;
(* Always generate this file last, and unconditionally. It's used
* by the Makefile to know when we must re-run the generator.
*)
let chan = open_out "src/stamp-generator" in
fprintf chan "1\n";
- close_out chan
+ close_out chan;
+
+ printf "generated %d lines of code\n" !lines