#!/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
(* This script generates a large amount of code and documentation for
* 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.
- *
- * 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.
- *
+ * 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. '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";;
+#load "xml-light.cma";;
+open Unix
open Printf
type style = ret * args
| Dev_or_Path of string (* /dev device name or Pathname, cannot be NULL *)
| OptString of string (* const char *name, may be NULL *)
| StringList of string(* list of strings (each string cannot be NULL) *)
+ | DeviceList of string(* list of Device names (each cannot be NULL) *)
| Bool of string (* boolean *)
| Int of string (* int (smallish ints, signed, <= 31 bits) *)
+ | 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.
| 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 *)
(* You can supply zero or as many tests as you want per API call.
*
* Note that the test environment has 3 block devices, of size 500MB,
* 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc), and
- * a fourth squashfs block device with some known files on it (/dev/sdd).
+ * a fourth ISO block device with some known files on it (/dev/sdd).
*
* Note for partitioning purposes, the 500MB device has 1015 cylinders.
* Number of cylinders was 63 for IDE emulated disks with precisely
* the same size. How exactly this is calculated is a mystery.
*
- * The squashfs block device (/dev/sdd) comes from images/test.sqsh.
+ * The ISO block device (/dev/sdd) comes from images/test.iso.
*
* To be able to run the tests in a reasonable amount of time,
* the virtual machine and block devices are reused between tests.
*)
| InitBasicFSonLVM
- (* /dev/sdd (the squashfs, see images/ directory in source)
+ (* /dev/sdd (the ISO, see images/ directory in source)
* is mounted on /
*)
- | InitSquashFS
+ | InitISOFS
(* Sequence of commands for testing. *)
and seq = cmd list
(* 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";
]
("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, [],
[],
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"];
C<$major.$minor.$release$extra>
I<Note:> Don't use this call to test for availability
-of features. Distro backports makes this unreliable.");
+of features. Distro backports makes this unreliable. Use
+C<guestfs_available> instead.");
("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
[InitNone, Always, TestOutputTrue (
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.");
+
]
(* 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"];
to create a new zero-length file.");
("cat", (RString "content", [Pathname "path"]), 4, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutput (
+ [InitISOFS, Always, TestOutput (
[["cat"; "/known-2"]], "abcdef\n")],
"list the contents of a file",
"\
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)",
"\
of the L<lvs(8)> command. The \"full\" version includes all fields.");
("read_lines", (RStringList "lines", [Pathname "path"]), 15, [],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["read_lines"; "/known-4"]], ["abc"; "def"; "ghi"]);
- InitSquashFS, Always, TestOutputList (
+ InitISOFS, Always, TestOutputList (
[["read_lines"; "/empty"]], [])],
"read file as lines",
"\
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>.");
- ("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",
"\
yourself (Augeas support makes this relatively easy).");
("exists", (RBool "existsflag", [Pathname "path"]), 36, [],
- [InitSquashFS, Always, TestOutputTrue (
+ [InitISOFS, Always, TestOutputTrue (
[["exists"; "/empty"]]);
- InitSquashFS, Always, TestOutputTrue (
+ InitISOFS, Always, TestOutputTrue (
[["exists"; "/directory"]])],
"test if file or directory exists",
"\
See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
("is_file", (RBool "fileflag", [Pathname "path"]), 37, [],
- [InitSquashFS, Always, TestOutputTrue (
+ [InitISOFS, Always, TestOutputTrue (
[["is_file"; "/known-1"]]);
- InitSquashFS, Always, TestOutputFalse (
+ InitISOFS, Always, TestOutputFalse (
[["is_file"; "/directory"]])],
"test if file exists",
"\
See also C<guestfs_stat>.");
("is_dir", (RBool "dirflag", [Pathname "path"]), 38, [],
- [InitSquashFS, Always, TestOutputFalse (
+ [InitISOFS, Always, TestOutputFalse (
[["is_dir"; "/known-3"]]);
- InitSquashFS, Always, TestOutputTrue (
+ InitISOFS, Always, TestOutputTrue (
[["is_dir"; "/directory"]])],
"test if file exists",
"\
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"; StringList "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"];
("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"];
pass C<lines> as a single element list, when the single element being
the string C<,> (comma).
-See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>");
+See also: C<guestfs_sfdisk_l>, C<guestfs_sfdisk_N>,
+C<guestfs_part_init>");
("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
[InitBasicFS, Always, TestOutput (
("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
[InitEmpty, Always, TestOutputListOfDevices (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext2"; "/dev/sda1"];
["mount"; "/dev/sda1"; "/"];
["mounts"]], ["/dev/sda1"]);
InitEmpty, Always, TestOutputList (
- [["sfdiskM"; "/dev/sda"; ","];
+ [["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext2"; "/dev/sda1"];
["mount"; "/dev/sda1"; "/"];
["umount"; "/"];
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",
"\
and physical volumes.");
("file", (RString "description", [Dev_or_Path "path"]), 49, [],
- [InitSquashFS, Always, TestOutput (
+ [InitISOFS, Always, TestOutput (
[["file"; "/empty"]], "empty");
- InitSquashFS, Always, TestOutput (
+ InitISOFS, Always, TestOutput (
[["file"; "/known-1"]], "ASCII text");
- InitSquashFS, Always, TestLastFail (
+ InitISOFS, Always, TestLastFail (
[["file"; "/notexists"]])],
"determine file type",
"\
See also: C<guestfs_sh_lines>");
("stat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 52, [],
- [InitSquashFS, Always, TestOutputStruct (
+ [InitISOFS, Always, TestOutputStruct (
[["stat"; "/empty"]], [CompareWithInt ("size", 0)])],
"get file information",
"\
This is the same as the C<stat(2)> system call.");
("lstat", (RStruct ("statbuf", "stat"), [Pathname "path"]), 53, [],
- [InitSquashFS, Always, TestOutputStruct (
+ [InitISOFS, Always, TestOutputStruct (
[["lstat"; "/empty"]], [CompareWithInt ("size", 0)])],
"get file information for a symbolic link",
"\
This is the same as the C<lstat(2)> system call.");
("statvfs", (RStruct ("statbuf", "statvfs"), [Pathname "path"]), 54, [],
- [InitSquashFS, Always, TestOutputStruct (
- [["statvfs"; "/"]], [CompareWithInt ("namemax", 256)])],
+ [InitISOFS, Always, TestOutputStruct (
+ [["statvfs"; "/"]], [CompareWithInt ("namemax", 255)])],
"get file system statistics",
"\
Returns file system statistics for any mounted file system.
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>
See also C<guestfs_upload>, C<guestfs_cat>.");
("checksum", (RString "checksum", [String "csumtype"; Pathname "path"]), 68, [],
- [InitSquashFS, Always, TestOutput (
+ [InitISOFS, Always, TestOutput (
[["checksum"; "crc"; "/known-3"]], "2891671662");
- InitSquashFS, Always, TestLastFail (
+ InitISOFS, Always, TestLastFail (
[["checksum"; "crc"; "/notexists"]]);
- InitSquashFS, Always, TestOutput (
+ InitISOFS, Always, TestOutput (
[["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c");
- InitSquashFS, Always, TestOutput (
+ InitISOFS, Always, TestOutput (
[["checksum"; "sha1"; "/known-3"]], "b7ebccc3ee418311091c3eda0a45b83c0a770f15");
- InitSquashFS, Always, TestOutput (
+ InitISOFS, Always, TestOutput (
[["checksum"; "sha224"; "/known-3"]], "d2cd1774b28f3659c14116be0a6dc2bb5c4b350ce9cd5defac707741");
- InitSquashFS, Always, TestOutput (
+ InitISOFS, Always, TestOutput (
[["checksum"; "sha256"; "/known-3"]], "75bb71b90cd20cb13f86d2bea8dad63ac7194e7517c3b52b8d06ff52d3487d30");
- InitSquashFS, Always, TestOutput (
+ InitISOFS, Always, TestOutput (
[["checksum"; "sha384"; "/known-3"]], "5fa7883430f357b5d7b7271d3a1d2872b51d73cba72731de6863d3dea55f30646af2799bef44d5ea776a5ec7941ac640");
- InitSquashFS, Always, TestOutput (
+ InitISOFS, Always, TestOutput (
[["checksum"; "sha512"; "/known-3"]], "2794062c328c6b216dca90443b7f7134c5f40e56bd0ed7853123275a09982a6f992e6ca682f9d2fba34a4c5e870d8fe077694ff831e3032a004ee077e00603f6")],
"compute MD5, SHAx or CRC checksum of file",
"\
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"];
(let uuid = uuidgen () in
[InitBasicFS, Always, TestOutput (
[["set_e2uuid"; "/dev/sda1"; uuid];
- ["get_e2uuid"; "/dev/sda1"]], uuid);
+ ["get_e2uuid"; "/dev/sda1"]], uuid);
InitBasicFS, Always, TestOutput (
[["set_e2uuid"; "/dev/sda1"; "clear"];
- ["get_e2uuid"; "/dev/sda1"]], "");
+ ["get_e2uuid"; "/dev/sda1"]], "");
(* We can't predict what UUIDs will be, so just check the commands run. *)
InitBasicFS, Always, TestRun (
[["set_e2uuid"; "/dev/sda1"; "random"]]);
The external L<cmp(1)> program is used for the comparison.");
("strings", (RStringList "stringsout", [Pathname "path"]), 94, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["strings"; "/known-5"]], ["abcdefghi"; "jklmnopqr"]);
- InitSquashFS, Always, TestOutputList (
+ InitISOFS, Always, TestOutputList (
[["strings"; "/empty"]], [])],
"print the printable strings in a file",
"\
the list of printable strings found.");
("strings_e", (RStringList "stringsout", [String "encoding"; Pathname "path"]), 95, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [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"];
The returned strings are transcoded to UTF-8.");
("hexdump", (RString "dump", [Pathname "path"]), 96, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutput (
+ [InitISOFS, Always, TestOutput (
[["hexdump"; "/known-4"]], "00000000 61 62 63 0a 64 65 66 0a 67 68 69 |abc.def.ghi|\n0000000b\n");
(* Test for RHBZ#501888c2 regression which caused large hexdump
* commands to segfault.
*)
- InitSquashFS, Always, TestRun (
+ InitISOFS, Always, TestRun (
[["hexdump"; "/100krandom"]])],
"dump a file in hexadecimal",
"\
This runs C<hexdump -C> on the given C<path>. The result is
the human-readable, canonical hex dump of the file.");
- ("zerofree", (RErr, [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"];
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"];
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"];
["scrub_file"; "/file"]])],
It is an interface to the L<scrub(1)> program. See that
manual page for more details.");
- ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [],
+ ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [Optional "scrub"],
[], (* XXX needs testing *)
"scrub (securely wipe) free space",
"\
See also: L<mkdtemp(3)>");
("wc_l", (RInt "lines", [Pathname "path"]), 118, [],
- [InitSquashFS, Always, TestOutputInt (
+ [InitISOFS, Always, TestOutputInt (
[["wc_l"; "/10klines"]], 10000)],
"count lines in a file",
"\
C<wc -l> external command.");
("wc_w", (RInt "words", [Pathname "path"]), 119, [],
- [InitSquashFS, Always, TestOutputInt (
+ [InitISOFS, Always, TestOutputInt (
[["wc_w"; "/10klines"]], 10000)],
"count words in a file",
"\
C<wc -w> external command.");
("wc_c", (RInt "chars", [Pathname "path"]), 120, [],
- [InitSquashFS, Always, TestOutputInt (
+ [InitISOFS, Always, TestOutputInt (
[["wc_c"; "/100kallspaces"]], 102400)],
"count characters in a file",
"\
C<wc -c> external command.");
("head", (RStringList "lines", [Pathname "path"]), 121, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
"return first 10 lines of a file",
"\
a list of strings.");
("head_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 122, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
- InitSquashFS, Always, TestOutputList (
+ InitISOFS, Always, TestOutputList (
[["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
- InitSquashFS, Always, TestOutputList (
+ InitISOFS, Always, TestOutputList (
[["head_n"; "0"; "/10klines"]], [])],
"return first N lines of a file",
"\
If the parameter C<nrlines> is zero, this returns an empty list.");
("tail", (RStringList "lines", [Pathname "path"]), 123, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
"return last 10 lines of a file",
"\
a list of strings.");
("tail_n", (RStringList "lines", [Int "nrlines"; Pathname "path"]), 124, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
- InitSquashFS, Always, TestOutputList (
+ InitISOFS, Always, TestOutputList (
[["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
- InitSquashFS, Always, TestOutputList (
+ InitISOFS, Always, TestOutputList (
[["tail_n"; "0"; "/10klines"]], [])],
"return last N lines of a file",
"\
Use C<statvfs> from programs.");
("du", (RInt64 "sizekb", [Pathname "path"]), 127, [],
- [InitSquashFS, Always, TestOutputInt (
- [["du"; "/directory"]], 0 (* squashfs doesn't have blocks *))],
+ [InitISOFS, Always, TestOutputInt (
+ [["du"; "/directory"]], 2 (* ISO fs blocksize is 2K *))],
"estimate file space usage",
"\
This command runs the C<du -s> command to estimate file space
(ie. units of 1024 bytes).");
("initrd_list", (RStringList "filenames", [Pathname "path"]), 128, [],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3";"known-4"; "known-5"])],
"list files in an initrd",
"\
("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"; ","];
- ["mkswap_U"; uuid; "/dev/sda1"]])]),
+ [["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 *)
device major and minor numbers, only used when creating block
and character special devices.");
- ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [],
+ ("mkfifo", (RErr, [Int "mode"; Pathname "path"]), 134, [Optional "mknod"],
[InitBasicFS, Always, TestOutputStruct (
[["mkfifo"; "0o777"; "/node"];
["stat"; "/node"]], [CompareWithInt ("mode", 0o10755)])],
mode C<mode>. It is just a convenient wrapper around
C<guestfs_mknod>.");
- ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [],
+ ("mknod_b", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; Pathname "path"]), 135, [Optional "mknod"],
[InitBasicFS, Always, TestOutputStruct (
[["mknod_b"; "0o777"; "99"; "66"; "/node"];
["stat"; "/node"]], [CompareWithInt ("mode", 0o60755)])],
mode C<mode> and device major/minor C<devmajor> and C<devminor>.
It is just a convenient wrapper around C<guestfs_mknod>.");
- ("mknod_c", (RErr, [Int "mode"; Int "devmajor"; Int "devminor"; 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)])],
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 "method"; Pathname "path"]), 140, [DeprecatedBy "file"],
+ ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"],
[],
"determine file type inside a compressed 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",
"\
for full details.");
("read_file", (RBufferOut "content", [Pathname "path"]), 150, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputBuffer (
+ [InitISOFS, Always, TestOutputBuffer (
[["read_file"; "/known-4"]], "abc\ndef\nghi")],
"read a file",
"\
in the total size of file that can be handled.");
("grep", (RStringList "lines", [String "regex"; Pathname "path"]), 151, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["grep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"]);
- InitSquashFS, Always, TestOutputList (
+ InitISOFS, Always, TestOutputList (
[["grep"; "nomatch"; "/test-grep.txt"]], [])],
"return lines matching a pattern",
"\
matching lines.");
("egrep", (RStringList "lines", [String "regex"; Pathname "path"]), 152, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["egrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
"return lines matching a pattern",
"\
matching lines.");
("fgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 153, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["fgrep"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"])],
"return lines matching a pattern",
"\
matching lines.");
("grepi", (RStringList "lines", [String "regex"; Pathname "path"]), 154, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["grepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
"return lines matching a pattern",
"\
matching lines.");
("egrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 155, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["egrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
"return lines matching a pattern",
"\
matching lines.");
("fgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 156, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["fgrepi"; "abc"; "/test-grep.txt"]], ["abc"; "abc123"; "ABC"])],
"return lines matching a pattern",
"\
matching lines.");
("zgrep", (RStringList "lines", [String "regex"; Pathname "path"]), 157, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["zgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
"return lines matching a pattern",
"\
matching lines.");
("zegrep", (RStringList "lines", [String "regex"; Pathname "path"]), 158, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["zegrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
"return lines matching a pattern",
"\
matching lines.");
("zfgrep", (RStringList "lines", [String "pattern"; Pathname "path"]), 159, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["zfgrep"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"])],
"return lines matching a pattern",
"\
matching lines.");
("zgrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 160, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["zgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
"return lines matching a pattern",
"\
matching lines.");
("zegrepi", (RStringList "lines", [String "regex"; Pathname "path"]), 161, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["zegrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
"return lines matching a pattern",
"\
matching lines.");
("zfgrepi", (RStringList "lines", [String "pattern"; Pathname "path"]), 162, [ProtocolLimitWarning],
- [InitSquashFS, Always, TestOutputList (
+ [InitISOFS, Always, TestOutputList (
[["zfgrepi"; "abc"; "/test-grep.txt.gz"]], ["abc"; "abc123"; "ABC"])],
"return lines matching a pattern",
"\
This calls the external C<zfgrep -i> program and returns the
matching lines.");
- ("realpath", (RString "rpath", [Pathname "path"]), 163, [],
- [InitSquashFS, Always, TestOutput (
+ ("realpath", (RString "rpath", [Pathname "path"]), 163, [Optional "realpath"],
+ [InitISOFS, Always, TestOutput (
[["realpath"; "/../directory"]], "/directory")],
"canonicalized absolute pathname",
"\
("swapon_label", (RErr, [String "label"]), 174, [],
[InitEmpty, Always, TestRun (
- [["sfdiskM"; "/dev/sdb"; ","];
+ [["part_disk"; "/dev/sdb"; "mbr"];
["mkswap_L"; "swapit"; "/dev/sdb1"];
["swapon_label"; "swapit"];
["swapoff_label"; "swapit"];
This command disables the libguestfs appliance swap on
labeled swap partition.");
- ("swapon_uuid", (RErr, [String "uuid"]), 176, [],
+ ("swapon_uuid", (RErr, [String "uuid"]), 176, [Optional "linuxfsuuid"],
(let uuid = uuidgen () in
[InitEmpty, Always, TestRun (
[["mkswap_U"; uuid; "/dev/sdb"];
- ["swapon_uuid"; uuid];
- ["swapoff_uuid"; uuid]])]),
+ ["swapon_uuid"; uuid];
+ ["swapoff_uuid"; uuid]])]),
"enable swap on swap partition by UUID",
"\
This command enables swap to a swap partition with the given UUID.
See C<guestfs_swapon_device> for other notes.");
- ("swapoff_uuid", (RErr, [String "uuid"]), 177, [],
+ ("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, [],
- [InitSquashFS, Always, TestRun (
+ ("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"];
"\
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"];
- ["cat"; "/new"]], "new file contents")]),
+ ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
+ ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
+ ["mount"; "/dev/sda2"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")]),
"make ext2/3/4 external journal with UUID",
"\
This creates an ext2 external journal on C<device> with UUID C<uuid>.");
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, [Optional "linuxmodules"],
+ [InitNone, Always, TestRun [["modprobe"; "fat"]]],
+ "load a kernel module",
+ "\
+This loads a kernel module in the appliance.
+
+The kernel module must have been whitelisted when libguestfs
+was built (see C<appliance/kmod.whitelist.in> in the source).");
+
+ ("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 concatenate the list of C<words> passed with single spaces between
+them and returns the resulting string.
+
+You can use this command to test the connection through to the daemon.
+
+See also C<guestfs_ping_daemon>.");
+
+ ("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>.
+
+This command works the same way as C<guestfs_find> with the
+following exceptions:
+
+=over 4
+
+=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 block device type corresponding to
+a mounted device called C<device>.
+
+Usually the result is the name of the Linux VFS module that
+is used to mount this device (probably determined automatically
+if you used the C<guestfs_mount> call).");
+
+ ("truncate", (RErr, [Pathname "path"]), 199, [],
+ [InitBasicFS, Always, TestOutputStruct (
+ [["write_file"; "/test"; "some stuff so size is not zero"; "0"];
+ ["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 file is smaller than C<size> then
+the file is extended to the required size with null bytes.");
+
+ ("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>. See also C<guestfs_mkdir>.");
+
+ ("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 symbol 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.");
+
+ ("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 PC BIOSes to determine which
+partition to boot from. It is by no means universally recognized,
+and in any case if your operating system installed a boot
+sector on the device itself, then that takes precedence.");
+
+ ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [],
+ [InitEmpty, Always, TestRun (
+ [["part_disk"; "/dev/sda"; "gpt"];
+ ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])],
+ "set partition name",
+ "\
+This sets the partition name on partition numbered C<partnum> on
+device C<device>. Note that partitions are numbered from 1.
+
+The partition name can only be set on certain types of partition
+table. This works on C<gpt> but not on C<mbr> partitions.");
+
+ ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [],
+ [], (* XXX Add a regression test for this. *)
+ "list partitions on a device",
+ "\
+This command parses the partition table on C<device> and
+returns the list of partitions found.
+
+The fields in the returned structure are:
+
+=over 4
+
+=item B<part_num>
+
+Partition number, counting from 1.
+
+=item B<part_start>
+
+Start of the partition I<in bytes>. To get sectors you have to
+divide by the device's sector size, see C<guestfs_blockdev_getss>.
+
+=item B<part_end>
+
+End of the partition in bytes.
+
+=item B<part_size>
+
+Size of the partition in bytes.
+
+=back");
+
+ ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [],
+ [InitEmpty, Always, TestOutput (
+ [["part_disk"; "/dev/sda"; "gpt"];
+ ["part_get_parttype"; "/dev/sda"]], "gpt")],
+ "get the partition table type",
+ "\
+This command examines the partition table on C<device> and
+returns the partition table type (format) being used.
+
+Common return values include: C<msdos> (a DOS/Windows style MBR
+partition table), C<gpt> (a GPT/EFI-style partition table). Other
+values are possible, although unusual. See C<guestfs_part_init>
+for a full list.");
+
+ ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
+ [InitBasicFS, Always, TestOutputBuffer (
+ [["fill"; "0x63"; "10"; "/test"];
+ ["read_file"; "/test"]], "cccccccccc")],
+ "fill a file with octets",
+ "\
+This command creates a new file called C<path>. The initial
+content of the file is C<len> octets of C<c>, where C<c>
+must be a number in the range C<[0..255]>.
+
+To fill a file with zero bytes (sparsely), it is
+much more efficient to use C<guestfs_truncate_size>.");
+
+ ("available", (RErr, [StringList "groups"]), 216, [],
+ [InitNone, Always, TestRun [["available"; ""]]],
+ "test availability of some parts of the API",
+ "\
+This command is used to check the availability of some
+groups of functionality in the appliance, which not all builds of
+the libguestfs appliance will be able to provide.
+
+The libguestfs groups, and the functions that those
+groups correspond to, are listed in L<guestfs(3)/AVAILABILITY>.
+
+The argument C<groups> is a list of group names, eg:
+C<[\"inotify\", \"augeas\"]> would check for the availability of
+the Linux inotify functions and Augeas (configuration file
+editing) functions.
+
+The command returns no error if I<all> requested groups are available.
+
+It fails with an error if one or more of the requested
+groups is unavailable in the appliance.
+
+If an unknown group name is included in the
+list of groups then an error is always returned.
+
+I<Notes:>
+
+=over 4
+
+=item *
+
+You must call C<guestfs_launch> before calling this function.
+
+The reason is because we don't know what groups are
+supported by the appliance/daemon until it is running and can
+be queried.
+
+=item *
+
+If a group of functions is available, this does not necessarily
+mean that they will work. You still have to check for errors
+when calling individual API functions even if they are
+available.
+
+=item *
+
+It is usually the job of distro packagers to build
+complete functionality into the libguestfs appliance.
+Upstream libguestfs, if built from source with all
+requirements satisfied, will support everything.
+
+=item *
+
+This call was added in version C<1.0.80>. In previous
+versions of libguestfs all you could do would be to speculatively
+execute a command to find out if the daemon implemented it.
+See also C<guestfs_version>.
+
+=back");
+
+ ("dd", (RErr, [Dev_or_Path "src"; Dev_or_Path "dest"]), 217, [],
+ [InitBasicFS, Always, TestOutputBuffer (
+ [["write_file"; "/src"; "hello, world"; "0"];
+ ["dd"; "/src"; "/dest"];
+ ["read_file"; "/dest"]], "hello, world")],
+ "copy from source to destination using dd",
+ "\
+This command copies from one source device or file C<src>
+to another destination device or file C<dest>. Normally you
+would use this to copy to or from a device or partition, for
+example to duplicate a filesystem.
+
+If the destination is a device, it must be as large or larger
+than the source file or device, otherwise the copy will fail.
+This command cannot do partial copies.");
+
]
let all_functions = non_daemon_functions @ daemon_functions
"in_cookie", FUInt32;
"in_name", FString;
];
+
+ (* Partition table entry. *)
+ "partition", [
+ "part_num", FInt32;
+ "part_start", FBytes;
+ "part_end", FBytes;
+ "part_size", FBytes;
+ ];
] (* end of structs *)
(* Ugh, Java has to be different ..
"version", "Version";
"xattr", "XAttr";
"inotify_event", "INotifyEvent";
+ "partition", "Partition";
]
(* What structs are actually returned. *)
* == 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
(* Used to memoize the result of pod2text. *)
v
with
_ -> Hashtbl.create 13
+let pod2text_memo_updated () =
+ let chan = open_out pod2text_memo_filename in
+ output_value chan pod2text_memo;
+ close_out chan
(* Useful functions.
* Note we don't want to use any external OCaml libraries which
* makes this a bit harder than it should be.
*)
+module StringMap = Map.Make (String)
+
let failwithf fs = ksprintf failwith fs
+let unique = let i = ref 0 in fun () -> incr i; !i
+
let replace_char s c1 c2 =
let s2 = String.copy s in
let r = ref false in
in
loop 0 xs
+let count_chars c str =
+ let count = ref 0 in
+ for i = 0 to String.length str - 1 do
+ if c = String.unsafe_get str i then incr count
+ done;
+ !count
+
let name_of_argt = function
- | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | Bool n | Int n
+ | Pathname n | Device n | Dev_or_Path n | String n | OptString n
+ | StringList n | DeviceList n | Bool n | Int n | Int64 n
| FileIn n | FileOut n -> n
let java_name_of_struct typ =
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 =
if n = "i" || n = "n" then
failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;
if n = "argv" || n = "args" then
- failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name
+ failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name;
+
+ (* List Haskell, OCaml and C keywords here.
+ * http://www.haskell.org/haskellwiki/Keywords
+ * http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#operator-char
+ * http://en.wikipedia.org/wiki/C_syntax#Reserved_keywords
+ * Formatted via: cat c haskell ocaml|sort -u|grep -vE '_|^val$' \
+ * |perl -pe 's/(.+)/"$1";/'|fmt -70
+ * Omitting _-containing words, since they're handled above.
+ * Omitting the OCaml reserved word, "val", is ok,
+ * and saves us from renaming several parameters.
+ *)
+ let reserved = [
+ "and"; "as"; "asr"; "assert"; "auto"; "begin"; "break"; "case";
+ "char"; "class"; "const"; "constraint"; "continue"; "data";
+ "default"; "deriving"; "do"; "done"; "double"; "downto"; "else";
+ "end"; "enum"; "exception"; "extern"; "external"; "false"; "float";
+ "for"; "forall"; "foreign"; "fun"; "function"; "functor"; "goto";
+ "hiding"; "if"; "import"; "in"; "include"; "infix"; "infixl";
+ "infixr"; "inherit"; "initializer"; "inline"; "instance"; "int";
+ "land"; "lazy"; "let"; "long"; "lor"; "lsl"; "lsr"; "lxor";
+ "match"; "mdo"; "method"; "mod"; "module"; "mutable"; "new";
+ "newtype"; "object"; "of"; "open"; "or"; "private"; "qualified";
+ "rec"; "register"; "restrict"; "return"; "short"; "sig"; "signed";
+ "sizeof"; "static"; "struct"; "switch"; "then"; "to"; "true"; "try";
+ "type"; "typedef"; "union"; "unsigned"; "virtual"; "void";
+ "volatile"; "when"; "where"; "while";
+ ] in
+ if List.mem n reserved then
+ failwithf "%s has param/ret using reserved word %s" name n;
in
(match fst style with
) all_functions
(* 'pr' prints to the current output file. *)
-let chan = ref stdout
-let pr fs = ksprintf (output_string !chan) fs
+let chan = ref Pervasives.stdout
+let lines = ref 0
+let pr fs =
+ ksprintf
+ (fun str ->
+ let i = count_chars '\n' str in
+ lines := !lines + i;
+ output_string !chan str
+ ) fs
+
+let copyright_years =
+ let this_year = 1900 + (localtime (time ())).tm_year in
+ if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
(* Generate a header block in a number of standard styles. *)
-type comment_style = CStyle | HashStyle | OCamlStyle | HaskellStyle
-type license = GPLv2 | LGPLv2
+type comment_style =
+ CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
+type license = GPLv2plus | LGPLv2plus
-let generate_header comment license =
+let generate_header ?(extra_inputs = []) comment license =
+ let inputs = "src/generator.ml" :: extra_inputs in
let c = match comment with
- | CStyle -> pr "/* "; " *"
- | HashStyle -> pr "# "; "#"
- | OCamlStyle -> pr "(* "; " *"
- | HaskellStyle -> pr "{- "; " " in
+ | CStyle -> pr "/* "; " *"
+ | CPlusPlusStyle -> pr "// "; "//"
+ | HashStyle -> pr "# "; "#"
+ | OCamlStyle -> pr "(* "; " *"
+ | HaskellStyle -> pr "{- "; " " in
pr "libguestfs generated file\n";
- pr "%s WARNING: THIS FILE IS GENERATED BY 'src/generator.ml'.\n" c;
+ pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
+ List.iter (pr "%s %s\n" c) inputs;
pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c;
pr "%s\n" c;
- pr "%s Copyright (C) 2009 Red Hat Inc.\n" c;
+ pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years;
pr "%s\n" c;
(match license with
- | GPLv2 ->
+ | GPLv2plus ->
pr "%s This program is free software; you can redistribute it and/or modify\n" c;
pr "%s it under the terms of the GNU General Public License as published by\n" c;
pr "%s the Free Software Foundation; either version 2 of the License, or\n" c;
pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c;
pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c;
- | LGPLv2 ->
+ | LGPLv2plus ->
pr "%s This library is free software; you can redistribute it and/or\n" c;
pr "%s modify it under the terms of the GNU Lesser General Public\n" c;
pr "%s License as published by the Free Software Foundation; either\n" c;
);
(match comment with
| CStyle -> pr " */\n"
+ | CPlusPlusStyle
| HashStyle -> ()
| OCamlStyle -> pr " *)\n"
| HaskellStyle -> pr "-}\n"
pr "\n"
) structs
+and generate_availability_pod () =
+ (* Availability documentation. *)
+ pr "=over 4\n";
+ pr "\n";
+ List.iter (
+ fun (group, functions) ->
+ pr "=item B<%s>\n" group;
+ pr "\n";
+ pr "The following functions:\n";
+ List.iter (pr "L</guestfs_%s>\n") functions;
+ pr "\n"
+ ) optgroups;
+ pr "=back\n";
+ pr "\n"
+
(* Generate the protocol (XDR) file, 'guestfs_protocol.x' and
* indirectly 'guestfs_protocol.h' and 'guestfs_protocol.c'.
*
* This header is NOT exported to clients, but see also generate_structs_h.
*)
and generate_xdr () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
(* This has to be defined to get around a limitation in Sun's rpcgen. *)
pr "typedef string str<>;\n";
pr "struct %s_args {\n" name;
List.iter (
function
- | Pathname n | Device n | Dev_or_Path n | String n -> pr " string %s<>;\n" n
+ | Pathname n | Device n | Dev_or_Path n | String n ->
+ pr " string %s<>;\n" n
| OptString n -> pr " str *%s;\n" n
- | StringList n -> pr " str %s<>;\n" n
+ | StringList n | DeviceList n -> pr " str %s<>;\n" n
| Bool n -> pr " bool %s;\n" n
| Int n -> pr " int %s;\n" n
+ | Int64 n -> pr " hyper %s;\n" n
| FileIn _ | FileOut _ -> ()
) args;
pr "};\n\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
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:"handle"
+ 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 <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 perrorf guestfs_perrorf
#define safe_malloc guestfs_safe_malloc
#define safe_realloc guestfs_safe_realloc
-#define safe_strdup guestfs_safe_strdup
+//#define safe_strdup guestfs_safe_strdup
#define safe_memdup guestfs_safe_memdup
/* Check the return message from a call for validity. */
static int
check_reply_header (guestfs_h *g,
const struct guestfs_message_header *hdr,
- int proc_nr, int serial)
+ unsigned int proc_nr, unsigned int serial)
{
if (hdr->prog != GUESTFS_PROGRAM) {
error (g, \"wrong program (%%d/%%d)\", hdr->prog, GUESTFS_PROGRAM);
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. *)
- List.iter (
- fun (shortname, style, _, _, _, _, _) ->
- let name = "guestfs_" ^ shortname in
+ (* Generate code to generate guestfish call traces. *)
+ let trace_call shortname style =
+ pr " if (guestfs__get_trace (g)) {\n";
- (* 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";
+ let needs_i =
+ List.exists (function
+ | StringList _ | DeviceList _ -> true
+ | _ -> false) (snd style) in
+ if needs_i then (
+ pr " int i;\n";
+ pr "\n"
+ );
- (* Generate the reply callback function. *)
- pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
- 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";
+ pr " printf (\"%s\");\n" shortname;
+ List.iter (
+ function
+ | String n (* strings *)
+ | Device n
+ | Pathname n
+ | Dev_or_Path n
+ | FileIn n
+ | FileOut 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
- (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";
- );
+ (* For non-daemon functions, generate a wrapper around each function. *)
+ List.iter (
+ fun (shortname, style, _, _, _, _, _) ->
+ let name = "guestfs_" ^ shortname in
- pr " done:\n";
- pr " ctx->cb_sequence = 1;\n";
- pr "}\n\n";
+ generate_prototype ~extern:false ~semicolon:false ~newline:true
+ ~handle:"g" name style;
+ pr "{\n";
+ 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;
+
+ (* Client-side stubs for each function. *)
+ List.iter (
+ fun (shortname, style, _, _, _, _, _) ->
+ let name = "guestfs_" ^ shortname in
(* Generate the action stub. *)
generate_prototype ~extern:false ~semicolon:false ~newline:true
| _ -> 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";
+ trace_call shortname style;
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";
+ 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 = (char *) %s;\n" n n
| OptString n ->
pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
- | StringList n ->
+ | StringList n | DeviceList n ->
pr " args.%s.%s_val = (char **) %s;\n" n n n;
pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
| Bool n ->
pr " args.%s = %s;\n" n n
| Int n ->
pr " args.%s = %s;\n" n n
+ | Int64 n ->
+ pr " args.%s = %s;\n" n n
| FileIn _ | FileOut _ -> ()
) 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";
(* 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
| Pathname n
| String n -> ()
| OptString n -> pr " char *%s;\n" n
- | StringList n -> pr " char **%s;\n" n
+ | StringList n | DeviceList n -> pr " char **%s;\n" n
| Bool n -> pr " int %s;\n" n
| Int n -> pr " int %s;\n" n
+ | Int64 n -> pr " int64_t %s;\n" n
| FileIn _ | FileOut _ -> ()
) args
);
let pr_args n =
pr " char *%s = args.%s;\n" n n
in
+ let pr_list_handling_code n =
+ pr " %s = realloc (args.%s.%s_val,\n" n n n;
+ pr " sizeof (char *) * (args.%s.%s_len+1));\n" n n;
+ pr " if (%s == NULL) {\n" n;
+ pr " reply_with_perror (\"realloc\");\n";
+ pr " goto done;\n";
+ pr " }\n";
+ pr " %s[args.%s.%s_len] = NULL;\n" n n n;
+ pr " args.%s.%s_val = %s;\n" n n n;
+ in
List.iter (
function
| Pathname n ->
pr " ABS_PATH (%s, goto done);\n" n;
| Device n ->
pr_args n;
- pr " RESOLVE_DEVICE (%s, goto done);" n;
+ pr " RESOLVE_DEVICE (%s, goto done);\n" n;
| Dev_or_Path n ->
pr_args n;
- pr " REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);" n;
+ pr " REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);\n" n;
| String n -> pr_args n
| OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
| StringList n ->
- pr " %s = realloc (args.%s.%s_val,\n" n n n;
- pr " sizeof (char *) * (args.%s.%s_len+1));\n" n n;
- pr " if (%s == NULL) {\n" n;
- pr " reply_with_perror (\"realloc\");\n";
- pr " goto done;\n";
+ pr_list_handling_code n;
+ | DeviceList n ->
+ pr_list_handling_code n;
+ pr " /* Ensure that each is a device,\n";
+ pr " * and perform device name translation. */\n";
+ pr " { int pvi; for (pvi = 0; physvols[pvi] != NULL; ++pvi)\n";
+ pr " RESOLVE_DEVICE (physvols[pvi], goto done);\n";
pr " }\n";
- pr " %s[args.%s.%s_len] = NULL;\n" n n n;
- pr " args.%s.%s_val = %s;\n" n n n;
| Bool n -> pr " %s = args.%s;\n" n n
| Int n -> pr " %s = args.%s;\n" n n
+ | Int64 n -> pr " %s = args.%s;\n" n n
| FileIn _ | FileOut _ -> ()
) args;
pr "\n"
);
+
(* this is used at least for do_equal *)
if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
(* Emit NEED_ROOT just once, even when there are two or
generate_c_call_args (fst style, args');
pr ";\n";
- pr " if (r == %s)\n" error_code;
- pr " /* do_%s has already called reply_with_error */\n" name;
- pr " goto done;\n";
- pr "\n";
+ (match fst style with
+ | RErr | RInt _ | RInt64 _ | RBool _
+ | RConstString _ | RConstOptString _
+ | RString _ | RStringList _ | RHashtable _
+ | RStruct (_, _) | RStructList (_, _) ->
+ pr " if (r == %s)\n" error_code;
+ pr " /* do_%s has already called reply_with_error */\n" name;
+ pr " goto done;\n";
+ pr "\n"
+ | RBufferOut _ ->
+ pr " /* size == 0 && r == NULL could be a non-error case (just\n";
+ pr " * an ordinary zero-length buffer), so be careful ...\n";
+ pr " */\n";
+ pr " if (size == 1 && r == %s)\n" error_code;
+ pr " /* do_%s has already called reply_with_error */\n" name;
+ pr " goto done;\n";
+ pr "\n"
+ );
(* If there are any FileOut parameters, then the impl must
* send its own reply.
pr " 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 " 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;
fprintf (stderr, \"%%s\\n\", msg);
}
-static void print_strings (char * const * const argv)
+/* FIXME: nearly identical code appears in fish.c */
+static void print_strings (char *const *argv)
{
int argc;
}
/*
-static void print_table (char * const * const argv)
+static void print_table (char const *const *argv)
{
int i;
*)
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.sqsh\") == -1) {
- printf (\"guestfs_add_drive_ro ../images/test.sqsh FAILED\\n\");
- exit (1);
+ if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
+ printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
+ exit (EXIT_FAILURE);
}
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);
- }
-
/* Cancel previous alarm. */
alarm (0);
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 " unlink (\"test3.img\");\n";
pr "\n";
- 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 test_name test_name;
+ (* Optional functions should only be tested if the relevant
+ * support is available in the daemon.
+ *)
+ List.iter (
+ function
+ | Optional group ->
+ pr " {\n";
+ pr " const char *groups[] = { \"%s\", NULL };\n" group;
+ pr " int r;\n";
+ pr " suppress_error = 1;\n";
+ pr " r = guestfs_available (g, (char **) groups);\n";
+ pr " suppress_error = 0;\n";
+ pr " if (r == -1) {\n";
+ pr " printf (\" %%s skipped (reason: group %%s not available in daemon)\\n\", \"%s\", groups[0]);\n" test_name;
+ pr " return 0;\n";
+ pr " }\n";
+ pr " }\n";
+ | _ -> ()
+ ) flags;
+
(match prereq with
| Disabled ->
pr " printf (\" %%s skipped (reason: test disabled in generator)\\n\", \"%s\");\n" test_name
[["blockdev_setrw"; "/dev/sda"];
["umount_all"];
["lvm_remove_all"];
- ["sfdiskM"; "/dev/sda"; ","]]
+ ["part_disk"; "/dev/sda"; "mbr"]]
| InitBasicFS ->
pr " /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name;
List.iter (generate_test_command_call test_name)
[["blockdev_setrw"; "/dev/sda"];
["umount_all"];
["lvm_remove_all"];
- ["sfdiskM"; "/dev/sda"; ","];
+ ["part_disk"; "/dev/sda"; "mbr"];
["mkfs"; "ext2"; "/dev/sda1"];
["mount"; "/dev/sda1"; "/"]]
| InitBasicFSonLVM ->
[["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"; "/"]]
- | InitSquashFS ->
- pr " /* InitSquashFS for %s */\n" test_name;
+ | InitISOFS ->
+ pr " /* InitISOFS for %s */\n" test_name;
List.iter (generate_test_command_call test_name)
[["blockdev_setrw"; "/dev/sda"];
["umount_all"];
["lvm_remove_all"];
- ["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"]]
+ ["mount_ro"; "/dev/sdd"; "/"]]
);
let get_seq_last = function
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;
| OptString n, arg ->
pr " const char *%s = \"%s\";\n" n (c_quote arg);
| Int _, _
+ | Int64 _, _
| Bool _, _
| FileIn _, _ | FileOut _, _ -> ()
- | StringList n, arg ->
+ | 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 (
fun i str ->
pr " const char *%s_%d = \"%s\";\n" n i (c_quote str);
) strs;
- pr " const char *%s[] = {\n" n;
+ pr " const char *const %s[] = {\n" n;
iteri (
fun i _ -> pr " %s_%d,\n" n i
) strs;
pr ", %s" n
| FileIn _, arg | FileOut _, arg ->
pr ", \"%s\"" (c_quote arg)
- | StringList n, _ ->
- pr ", %s" n
+ | StringList n, _ | DeviceList n, _ ->
+ pr ", (char **) %s" n
| Int _, arg ->
let i =
try int_of_string arg
with Failure "int_of_string" ->
failwithf "%s: expecting an int, but got '%s'" test_name arg in
pr ", %d" i
+ | 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 (
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 \"fish.h\"\n";
pr "\n";
match snd style with
| [] -> name2
| args ->
- sprintf "%s <%s>"
- name2 (String.concat "> <" (List.map name_of_argt args)) in
+ sprintf "%s %s"
+ name2 (String.concat " " (List.map name_of_argt args)) in
let warnings =
if List.mem ProtocolLimitWarning flags then
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 " || 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 " else\n"
) all_functions;
pr " display_builtin_command (cmd);\n";
pr "}\n";
pr "\n";
+ let emit_print_list_function typ =
+ pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
+ typ typ typ;
+ pr "{\n";
+ pr " unsigned int i;\n";
+ pr "\n";
+ pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
+ pr " printf (\"[%%d] = {\\n\", i);\n";
+ pr " print_%s_indent (&%ss->val[i], \" \");\n" typ typ;
+ pr " printf (\"}\\n\");\n";
+ pr " }\n";
+ pr "}\n";
+ pr "\n";
+ in
+
(* print_* functions *)
List.iter (
fun (typ, cols) ->
pr "static void print_%s_indent (struct guestfs_%s *%s, const char *indent)\n" typ typ typ;
pr "{\n";
if needs_i then (
- pr " int i;\n";
+ pr " unsigned int i;\n";
pr "\n"
);
List.iter (
| 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"
) cols;
pr "}\n";
pr "\n";
- 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";
- pr "static void print_%s_list (struct guestfs_%s_list *%ss)\n"
- typ typ typ;
- pr "{\n";
- pr " int i;\n";
- pr "\n";
- pr " for (i = 0; i < %ss->len; ++i) {\n" typ;
- pr " printf (\"[%%d] = {\\n\", i);\n";
- pr " print_%s_indent (&%ss->val[i], \" \");\n" typ typ;
- pr " printf (\"}\\n\");\n";
- pr " }\n";
- pr "}\n";
- pr "\n";
) structs;
+ (* Emit a print_TYPE_list function definition only if that function is used. *)
+ List.iter (
+ function
+ | typ, (RStructListOnly | RStructAndList) ->
+ (* generate the function for typ *)
+ emit_print_list_function typ
+ | typ, _ -> () (* empty *)
+ ) (rstructs_used_by all_functions);
+
+ (* Emit a print_TYPE function definition only if that function is used. *)
+ List.iter (
+ function
+ | 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_by all_functions);
+
(* run_<action> actions *)
List.iter (
fun (name, style, _, flags, _, _, _) ->
);
List.iter (
function
- | Pathname n
- | Device n | Dev_or_Path n
+ | Device n
| String n
| OptString n
| FileIn n
| FileOut n -> pr " const char *%s;\n" n
- | StringList n -> pr " char **%s;\n" n
+ | Pathname n
+ | Dev_or_Path n -> pr " char *%s;\n" n
+ | StringList n | DeviceList n -> pr " char **%s;\n" n
| Bool n -> pr " int %s;\n" n
| Int n -> pr " int %s;\n" n
+ | Int64 n -> pr " int64_t %s;\n" n
) (snd style);
(* Check and convert parameters. *)
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
| FileIn name ->
- pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n"
+ pr " %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdin\";\n"
name i i
| FileOut name ->
- pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
+ pr " %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdout\";\n"
name i i
- | StringList name ->
- pr " %s = parse_string_list (argv[%d]);\n" name i
+ | StringList name | DeviceList name ->
+ pr " %s = parse_string_list (argv[%d]);\n" name i;
+ pr " if (%s == NULL) return -1;\n" name;
| Bool name ->
pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
| Int name ->
pr " %s = atoi (argv[%d]);\n" name i
+ | Int64 name ->
+ pr " %s = atoll (argv[%d]);\n" name i
) (snd style);
(* Call C API function. *)
generate_c_call_args ~handle:"g" style;
pr ";\n";
+ List.iter (
+ function
+ | Device name | String name
+ | OptString name | FileIn name | FileOut name | Bool name
+ | Int name | Int64 name -> ()
+ | Pathname name | Dev_or_Path name ->
+ pr " free (%s);\n" name
+ | StringList name | DeviceList name ->
+ pr " free_strings (%s);\n" name
+ ) (snd style);
+
(* Check return value for errors and display command results. *)
(match fst style with
| RErr -> pr " return r;\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";
(* Readline completion for guestfish. *)
and generate_fish_completion () =
- generate_header CStyle GPLv2;
+ generate_header CStyle GPLv2plus;
let all_functions =
List.filter (
while ((name = commands[index]) != NULL) {
index++;
- if (strncasecmp (name, text, len) == 0)
+ if (STRCASEEQLEN (name, text, len))
return strdup (name);
}
function
| Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
| OptString n -> pr " %s" n
- | StringList n -> pr " '%s ...'" n
+ | 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
) (snd style);
pr "\n";
| OptString n ->
next ();
pr "const char *%s" n
- | StringList n ->
+ | StringList n | DeviceList n ->
next ();
- if not in_daemon then pr "char * const* const %s" n
- else pr "char **%s" 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)
(* 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>
";
(* 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 (
pr " const char *%s =\n" n;
pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
n n
- | StringList 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
List.iter (
function
- | StringList n ->
+ | StringList n | DeviceList n ->
pr " ocaml_guestfs_free_strings (%s);\n" n;
- | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ | Bool _ | Int _
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
+ | Bool _ | Int _ | Int64 _
| FileIn _ | FileOut _ -> ()
) (snd style);
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 (
function
| Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
| OptString _ -> pr "string option -> "
- | StringList _ -> pr "string array -> "
+ | StringList _ | DeviceList _ -> pr "string array -> "
| Bool _ -> pr "bool -> "
| Int _ -> pr "int -> "
+ | 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\"
* to add 1 to the ST(x) operator.
*)
pr " char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
- | StringList n -> pr " char **%s;\n" n
+ | 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 _
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _
+ | Bool _ | Int _ | Int64 _
| FileIn _ | FileOut _ -> ()
- | StringList n -> pr " free (%s);\n" n
+ | StringList n | DeviceList n -> pr " free (%s);\n" n
) (snd style)
in
(* 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 ();
=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 ->
pr "$%s" n
- | StringList n ->
+ | StringList n | DeviceList n ->
pr "\\@%s" n
) (snd style);
pr ");"
(* Generate Python C module. *)
and generate_python_c () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
+#include <Python.h>
+
#include <stdio.h>
#include <stdlib.h>
#include <assert.h>
-#include <Python.h>
-
#include \"guestfs.h\"
typedef struct {
}
/* This list should be freed (but not the strings) after use. */
-static const char **
+static char **
get_string_list (PyObject *obj)
{
int i, len;
- const char **r;
+ char **r;
assert (obj);
typ name;
pr " else {\n";
pr " Py_INCREF (Py_None);\n";
- pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
+ pr " PyDict_SetItemString (dict, \"%s\", Py_None);\n" name;
pr " }\n"
| name, FChar ->
pr " PyDict_SetItemString (dict, \"%s\",\n" name;
(* generate the function for typ *)
emit_put_list_function typ
| typ, _ -> () (* empty *)
- ) rstructs_used;
+ ) (rstructs_used_by all_functions);
(* Python wrapper functions. *)
List.iter (
| Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
pr " const char *%s;\n" n
| OptString n -> pr " const char *%s;\n" n
- | StringList n ->
+ | StringList n | DeviceList n ->
pr " PyObject *py_%s;\n" n;
- pr " const char **%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";
function
| Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
| OptString _ -> pr "z"
- | StringList _ -> pr "O"
+ | 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?
+ *)
) (snd style);
pr ":guestfs_%s\",\n" name;
pr " &py_g";
function
| Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
| OptString n -> pr ", &%s" n
- | StringList n -> pr ", &py_%s" n
+ | StringList n | DeviceList n -> pr ", &py_%s" n
| Bool n -> pr ", &%s" n
| Int n -> pr ", &%s" n
+ | Int64 n -> pr ", &%s" n
) (snd style);
pr "))\n";
List.iter (
function
| Pathname _ | Device _ | Dev_or_Path _ | String _
- | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
- | StringList n ->
+ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
+ | StringList n | DeviceList n ->
pr " %s = get_string_list (py_%s);\n" n n;
pr " if (!%s) return NULL;\n" n
) (snd style);
List.iter (
function
| Pathname _ | Device _ | Dev_or_Path _ | String _
- | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
- | StringList n ->
+ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
+ | 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
# 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;
- let chan = open_out pod2text_memo_filename in
- output_value chan pod2text_memo;
- close_out chan;
+ pod2text_memo_updated ();
lines
(* Generate ruby bindings. *)
and generate_ruby_c () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
#include <stdio.h>
pr " \"%s\", \"%s\");\n" n name
| OptString n ->
pr " const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
- | StringList n ->
+ | StringList n | DeviceList n ->
pr " char **%s;\n" n;
pr " Check_Type (%sv, T_ARRAY);\n" n;
pr " {\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 _ -> ()
- | StringList n ->
+ | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> ()
+ | StringList n | DeviceList n ->
pr " free (%s);\n" n
) (snd style);
(* 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
- | StringList 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
- | StringList 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
- | StringList 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 =
| RErr | RBool _ | RInt _ | RInt64 _ | RConstString _
| RConstOptString _
| RString _ | RBufferOut _ | RStruct _ | RHashtable _ -> false) ||
- List.exists (function StringList _ -> true | _ -> false) (snd style) in
+ List.exists (function
+ | StringList _ -> true
+ | DeviceList _ -> true
+ | _ -> false) (snd style) in
if needs_i then
pr " int i;\n";
* a NULL parameter.
*)
pr " %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
- | StringList n ->
+ | StringList n | DeviceList n ->
pr " %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
pr " %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
pr " for (i = 0; i < %s_len; ++i) {\n" n;
pr " }\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
- | StringList n ->
+ | StringList n | DeviceList n ->
pr " for (i = 0; i < %s_len; ++i) {\n" n;
pr " jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
n;
pr " }\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
| FileOut n
| Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n
| OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
- | StringList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
- | Bool _ | Int _ -> ()
+ | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
+ | 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 -> n
+ | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n
) (snd style) in
pr "withForeignPtr h (\\p -> c_%s %s)\n" name
(String.concat " " ("p" :: args));
(match arg with
| Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
| OptString _ -> if hs then pr "Maybe String" else pr "CString"
- | StringList _ -> if hs then pr "[String]" else pr "Ptr CString"
+ | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
| Bool _ -> pr "%s" bool
| Int _ -> pr "%s" int
+ | 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 ->
+ pr ", [In] string %s" n
+ | StringList n | DeviceList n ->
+ pr ", [In] string[] %s" n
+ | Bool n ->
+ pr ", bool %s" n
+ | Int n ->
+ pr ", int %s" n
+ | Int64 n ->
+ pr ", long %s" n
+ ) (snd style);
+ pr ");\n"
+
+ and generate_public_prototype () =
+ pr " public %s %s (" (csharp_return_type ()) name;
+ let comma = ref false in
+ let next () =
+ if !comma then pr ", ";
+ comma := true
+ in
+ List.iter (
+ function
+ | Pathname n | Device n | Dev_or_Path n | String n | OptString n
+ | FileIn n | FileOut n ->
+ next (); pr "string %s" n
+ | StringList n | DeviceList n ->
+ next (); pr "string[] %s" n
+ | Bool n ->
+ next (); pr "bool %s" n
+ | Int n ->
+ next (); pr "int %s" n
+ | Int64 n ->
+ next (); pr "long %s" n
+ ) (snd style);
+ pr ")\n"
+
+ and generate_call () =
+ pr "guestfs_%s (_handle" name;
+ List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
+ pr ");\n";
+ in
+
+ pr " [DllImport (\"%s\")]\n" library;
+ generate_extern_prototype ();
+ pr "\n";
+ pr " /// <summary>\n";
+ pr " /// %s\n" shortdesc;
+ pr " /// </summary>\n";
+ generate_public_prototype ();
+ pr " {\n";
+ pr " %s r;\n" (c_return_type ());
+ pr " r = ";
+ generate_call ();
+ pr " if (r %s)\n" (c_error_comparison ());
+ pr " throw new Error (\"%s: \" + guestfs_last_error (_handle));\n"
+ name;
+ (match fst style with
+ | RErr -> ()
+ | RBool _ ->
+ pr " return r != 0 ? true : false;\n"
+ | RHashtable _ ->
+ pr " Hashtable rr = new Hashtable ();\n";
+ pr " for (int i = 0; i < r.Length; i += 2)\n";
+ pr " rr.Add (r[i], r[i+1]);\n";
+ pr " return rr;\n"
+ | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
+ | RString _ | RBufferOut _ | RStruct _ | RStringList _
+ | RStructList _ ->
+ pr " return r;\n"
+ );
+ pr " }\n";
+ pr "\n";
+ ) all_functions_sorted;
+
+ pr " }
+}
+"
+
and generate_bindtests () =
- generate_header CStyle LGPLv2;
+ generate_header CStyle LGPLv2plus;
pr "\
#include <stdio.h>
#include <string.h>
#include \"guestfs.h\"
+#include \"guestfs-internal.h\"
+#include \"guestfs-internal-actions.h\"
#include \"guestfs_protocol.h\"
#define error guestfs_error
#define safe_malloc guestfs_safe_malloc
static void
-print_strings (char * const* const argv)
+print_strings (char *const *argv)
{
int 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
| FileIn n
| FileOut n -> pr " printf (\"%%s\\n\", %s);\n" n
| OptString n -> pr " printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
- | StringList n -> pr " print_strings (%s);\n" n
+ | StringList n | DeviceList n -> pr " print_strings (%s);\n" n
| Bool n -> pr " printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
| Int n -> pr " printf (\"%%d\\n\", %s);\n" n
+ | 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
) args
)
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"
) args
)
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"
) args
)
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
) args
)
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
) args
)
"
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"
) args
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"];
call "test0" [CallString "abc"; CallOptString None;
CallStringList []; CallBool false;
- CallInt 0; CallString "123"; CallString "456"];
+ CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
call "test0" [CallString ""; CallOptString (Some "def");
CallStringList []; CallBool false;
- CallInt 0; CallString "123"; CallString "456"];
+ CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
call "test0" [CallString ""; CallOptString (Some "");
CallStringList []; CallBool false;
- CallInt 0; CallString "123"; CallString "456"];
+ CallInt 0; CallInt64 0L; CallString "123"; CallString "456"];
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"];
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"];
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"];
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"];
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"];
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"];
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"];
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"];
call "test0" [CallString "abc"; CallOptString (Some "def");
CallStringList ["1"]; CallBool false;
- CallInt 0; CallString ""; CallString ""]
+ CallInt 0; CallInt64 0L; CallString ""; CallString ""]
(* XXX Add here tests of the return and error functions. *)
-(* This is used to generate the src/MAX_PROC_NR file which
- * contains the maximum procedure number, a surrogate for the
- * ABI version number. See src/Makefile.am for the details.
+(* Code to generator bindings for virt-inspector. Currently only
+ * implemented for OCaml code (for virt-p2v 2.0).
*)
-and generate_max_proc_nr () =
- let proc_nrs = List.map (
- fun (_, _, proc_nr, _, _, _, _) -> proc_nr
- ) daemon_functions in
+let rng_input = "inspector/virt-inspector.rng"
- let max_proc_nr = List.fold_left max 0 proc_nrs in
-
- pr "%d\n" max_proc_nr
+(* Read the input file and parse it into internal structures. This is
+ * by no means a complete RELAX NG parser, but is just enough to be
+ * able to parse the specific input file.
+ *)
+type rng =
+ | Element of string * rng list (* <element name=name/> *)
+ | Attribute of string * rng list (* <attribute name=name/> *)
+ | Interleave of rng list (* <interleave/> *)
+ | ZeroOrMore of rng (* <zeroOrMore/> *)
+ | OneOrMore of rng (* <oneOrMore/> *)
+ | Optional of rng (* <optional/> *)
+ | Choice of string list (* <choice><value/>*</choice> *)
+ | Value of string (* <value>str</value> *)
+ | Text (* <text/> *)
+
+let rec string_of_rng = function
+ | Element (name, xs) ->
+ "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
+ | Attribute (name, xs) ->
+ "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))"
+ | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")"
+ | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")"
+ | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")"
+ | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")"
+ | Choice values -> "Choice [" ^ String.concat ", " values ^ "]"
+ | Value value -> "Value \"" ^ value ^ "\""
+ | Text -> "Text"
+
+and string_of_rng_list xs =
+ String.concat ", " (List.map string_of_rng xs)
+
+let rec parse_rng ?defines context = function
+ | [] -> []
+ | Xml.Element ("element", ["name", name], children) :: rest ->
+ Element (name, parse_rng ?defines context children)
+ :: parse_rng ?defines context rest
+ | Xml.Element ("attribute", ["name", name], children) :: rest ->
+ Attribute (name, parse_rng ?defines context children)
+ :: parse_rng ?defines context rest
+ | Xml.Element ("interleave", [], children) :: rest ->
+ Interleave (parse_rng ?defines context children)
+ :: parse_rng ?defines context rest
+ | Xml.Element ("zeroOrMore", [], [child]) :: rest ->
+ let rng = parse_rng ?defines context [child] in
+ (match rng with
+ | [child] -> ZeroOrMore child :: parse_rng ?defines context rest
+ | _ ->
+ failwithf "%s: <zeroOrMore> contains more than one child element"
+ context
+ )
+ | Xml.Element ("oneOrMore", [], [child]) :: rest ->
+ let rng = parse_rng ?defines context [child] in
+ (match rng with
+ | [child] -> OneOrMore child :: parse_rng ?defines context rest
+ | _ ->
+ failwithf "%s: <oneOrMore> contains more than one child element"
+ context
+ )
+ | Xml.Element ("optional", [], [child]) :: rest ->
+ let rng = parse_rng ?defines context [child] in
+ (match rng with
+ | [child] -> Optional child :: parse_rng ?defines context rest
+ | _ ->
+ failwithf "%s: <optional> contains more than one child element"
+ context
+ )
+ | Xml.Element ("choice", [], children) :: rest ->
+ let values = List.map (
+ function Xml.Element ("value", [], [Xml.PCData value]) -> value
+ | _ ->
+ failwithf "%s: can't handle anything except <value> in <choice>"
+ context
+ ) children in
+ Choice values
+ :: parse_rng ?defines context rest
+ | Xml.Element ("value", [], [Xml.PCData value]) :: rest ->
+ Value value :: parse_rng ?defines context rest
+ | Xml.Element ("text", [], []) :: rest ->
+ Text :: parse_rng ?defines context rest
+ | Xml.Element ("ref", ["name", name], []) :: rest ->
+ (* Look up the reference. Because of limitations in this parser,
+ * we can't handle arbitrarily nested <ref> yet. You can only
+ * use <ref> from inside <start>.
+ *)
+ (match defines with
+ | None ->
+ failwithf "%s: contains <ref>, but no refs are defined yet" context
+ | Some map ->
+ let rng = StringMap.find name map in
+ rng @ parse_rng ?defines context rest
+ )
+ | x :: _ ->
+ failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x)
+
+let grammar =
+ let xml = Xml.parse_file rng_input in
+ match xml with
+ | Xml.Element ("grammar", _,
+ Xml.Element ("start", _, gram) :: defines) ->
+ (* The <define/> elements are referenced in the <start> section,
+ * so build a map of those first.
+ *)
+ let defines = List.fold_left (
+ fun map ->
+ function Xml.Element ("define", ["name", name], defn) ->
+ StringMap.add name defn map
+ | _ ->
+ failwithf "%s: expected <define name=name/>" rng_input
+ ) StringMap.empty defines in
+ let defines = StringMap.mapi parse_rng defines in
+
+ (* Parse the <start> clause, passing the defines. *)
+ parse_rng ~defines "<start>" gram
+ | _ ->
+ failwithf "%s: input is not <grammar><start/><define>*</grammar>"
+ rng_input
+
+let name_of_field = function
+ | Element (name, _) | Attribute (name, _)
+ | ZeroOrMore (Element (name, _))
+ | OneOrMore (Element (name, _))
+ | Optional (Element (name, _)) -> name
+ | Optional (Attribute (name, _)) -> name
+ | Text -> (* an unnamed field in an element *)
+ "data"
+ | rng ->
+ failwithf "name_of_field failed at: %s" (string_of_rng rng)
+
+(* At the moment this function only generates OCaml types. However we
+ * should parameterize it later so it can generate types/structs in a
+ * variety of languages.
+ *)
+let generate_types xs =
+ (* A simple type is one that can be printed out directly, eg.
+ * "string option". A complex type is one which has a name and has
+ * to be defined via another toplevel definition, eg. a struct.
+ *
+ * generate_type generates code for either simple or complex types.
+ * In the simple case, it returns the string ("string option"). In
+ * the complex case, it returns the name ("mountpoint"). In the
+ * complex case it has to print out the definition before returning,
+ * so it should only be called when we are at the beginning of a
+ * new line (BOL context).
+ *)
+ let rec generate_type = function
+ | Text -> (* string *)
+ "string", true
+ | Choice values -> (* [`val1|`val2|...] *)
+ "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true
+ | ZeroOrMore rng -> (* <rng> list *)
+ let t, is_simple = generate_type rng in
+ t ^ " list (* 0 or more *)", is_simple
+ | OneOrMore rng -> (* <rng> list *)
+ let t, is_simple = generate_type rng in
+ t ^ " list (* 1 or more *)", is_simple
+ (* virt-inspector hack: bool *)
+ | Optional (Attribute (name, [Value "1"])) ->
+ "bool", true
+ | Optional rng -> (* <rng> list *)
+ let t, is_simple = generate_type rng in
+ t ^ " option", is_simple
+ (* type name = { fields ... } *)
+ | Element (name, fields) when is_attrs_interleave fields ->
+ generate_type_struct name (get_attrs_interleave fields)
+ | Element (name, [field]) (* type name = field *)
+ | Attribute (name, [field]) ->
+ let t, is_simple = generate_type field in
+ if is_simple then (t, true)
+ else (
+ pr "type %s = %s\n" name t;
+ name, false
+ )
+ | Element (name, fields) -> (* type name = { fields ... } *)
+ generate_type_struct name fields
+ | rng ->
+ failwithf "generate_type failed at: %s" (string_of_rng rng)
+
+ and is_attrs_interleave = function
+ | [Interleave _] -> true
+ | Attribute _ :: fields -> is_attrs_interleave fields
+ | Optional (Attribute _) :: fields -> is_attrs_interleave fields
+ | _ -> false
+
+ and get_attrs_interleave = function
+ | [Interleave fields] -> fields
+ | ((Attribute _) as field) :: fields
+ | ((Optional (Attribute _)) as field) :: fields ->
+ field :: get_attrs_interleave fields
+ | _ -> assert false
+
+ and generate_types xs =
+ List.iter (fun x -> ignore (generate_type x)) xs
+
+ and generate_type_struct name fields =
+ (* Calculate the types of the fields first. We have to do this
+ * before printing anything so we are still in BOL context.
+ *)
+ let types = List.map fst (List.map generate_type fields) in
-let output_to filename =
- let filename_new = filename ^ ".new" in
- chan := open_out filename_new;
- let close () =
- close_out !chan;
- chan := stdout;
-
- (* Is the new file different from the current file? *)
- if Sys.file_exists filename && files_equal filename filename_new then
- Unix.unlink filename_new (* same, so skip it *)
- else (
- (* different, overwrite old one *)
- (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ());
- Unix.rename filename_new filename;
- Unix.chmod filename 0o444;
- printf "written %s\n%!" filename;
- )
+ (* Special case of a struct containing just a string and another
+ * field. Turn it into an assoc list.
+ *)
+ match types with
+ | ["string"; other] ->
+ let fname1, fname2 =
+ match fields with
+ | [f1; f2] -> name_of_field f1, name_of_field f2
+ | _ -> assert false in
+ pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2;
+ name, false
+
+ | types ->
+ pr "type %s = {\n" name;
+ List.iter (
+ fun (field, ftype) ->
+ let fname = name_of_field field in
+ pr " %s_%s : %s;\n" name fname ftype
+ ) (List.combine fields types);
+ pr "}\n";
+ (* Return the name of this type, and
+ * false because it's not a simple type.
+ *)
+ name, false
in
- close
-
-(* Main program. *)
-let () =
- check_functions ();
- 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
- );
+ generate_types xs
- let close = output_to "src/guestfs_protocol.x" in
- generate_xdr ();
- 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-structs.h" in
- generate_structs_h ();
- close ();
+ (* Generate an intermediate tuple from all the fields first.
+ * If the type is just a string + another field, then we will
+ * return this directly, otherwise it is turned into a record.
+ *
+ * RELAX NG note: This code treats <interleave> and plain lists of
+ * fields the same. In other words, it doesn't bother enforcing
+ * any ordering of fields in the XML.
+ *)
+ pr "let parse_%s x =\n" name;
+ pr " let t = (\n ";
+ let comma = ref false in
+ List.iter (
+ fun x ->
+ if !comma then pr ",\n ";
+ comma := true;
+ match x with
+ | Optional (Attribute (fname, [field])), pa ->
+ pr "%s x" pa
+ | Optional (Element (fname, [field])), pa ->
+ pr "%s (optional_child %S x)" pa fname
+ | Attribute (fname, [Text]), _ ->
+ pr "attribute %S x" fname
+ | (ZeroOrMore _ | OneOrMore _), pa ->
+ pr "%s x" pa
+ | Text, pa ->
+ pr "%s x" pa
+ | (field, pa) ->
+ let fname = name_of_field field in
+ pr "%s (child %S x)" pa fname
+ ) (List.combine fields pas);
+ pr "\n ) in\n";
+
+ (match fields with
+ | [Element (_, [Text]) | Attribute (_, [Text]); _] ->
+ pr " t\n"
+
+ | _ ->
+ pr " (Obj.magic t : %s)\n" name
+(*
+ List.iter (
+ function
+ | (Optional (Attribute (fname, [field])), pa) ->
+ pr " %s_%s =\n" name fname;
+ pr " %s x;\n" pa
+ | (Optional (Element (fname, [field])), pa) ->
+ pr " %s_%s =\n" name fname;
+ pr " (let x = optional_child %S x in\n" fname;
+ pr " %s x);\n" pa
+ | (field, pa) ->
+ let fname = name_of_field field in
+ pr " %s_%s =\n" name fname;
+ pr " (let x = child %S x in\n" fname;
+ pr " %s x);\n" pa
+ ) (List.combine fields pas);
+ pr "}\n"
+*)
+ );
+ sprintf "parse_%s" name
+ in
- let close = output_to "src/guestfs-actions.h" in
- generate_actions_h ();
- close ();
+ generate_parsers xs
- let close = output_to "src/guestfs-actions.c" in
- generate_client_actions ();
- close ();
+(* Generate ocaml/guestfs_inspector.mli. *)
+let generate_ocaml_inspector_mli () =
+ generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
- let close = output_to "daemon/actions.h" in
- generate_daemon_actions_h ();
- close ();
+ pr "\
+(** This is an OCaml language binding to the external [virt-inspector]
+ program.
- let close = output_to "daemon/stubs.c" in
- generate_daemon_actions ();
- close ();
+ For more information, please read the man page [virt-inspector(1)].
+*)
- let close = output_to "daemon/names.c" in
- generate_daemon_names ();
- close ();
+";
- let close = output_to "capitests/tests.c" in
- generate_tests ();
- close ();
+ generate_types grammar;
+ pr "(** The nested information returned from the {!inspect} function. *)\n";
+ pr "\n";
- let close = output_to "src/guestfs-bindtests.c" in
- generate_bindtests ();
- close ();
+ pr "\
+val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems
+(** To inspect a libvirt domain called [name], pass a singleton
+ list: [inspect [name]]. When using libvirt only, you may
+ optionally pass a libvirt URI using [inspect ~connect:uri ...].
+
+ To inspect a disk image or images, pass a list of the filenames
+ of the disk images: [inspect filenames]
+
+ This function inspects the given guest or disk images and
+ returns a list of operating system(s) found and a large amount
+ of information about them. In the vast majority of cases,
+ a virtual machine only contains a single operating system.
+
+ If the optional [~xml] parameter is given, then this function
+ skips running the external virt-inspector program and just
+ parses the given XML directly (which is expected to be XML
+ produced from a previous run of virt-inspector). The list of
+ names and connect URI are ignored in this case.
+
+ This function can throw a wide variety of exceptions, for example
+ if the external virt-inspector program cannot be found, or if
+ it doesn't generate valid XML.
+*)
+"
- let close = output_to "fish/cmds.c" in
- generate_fish_cmds ();
- close ();
+(* Generate ocaml/guestfs_inspector.ml. *)
+let generate_ocaml_inspector_ml () =
+ generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus;
- let close = output_to "fish/completion.c" in
- generate_fish_completion ();
- close ();
+ pr "open Unix\n";
+ pr "\n";
- let close = output_to "guestfs-structs.pod" in
- generate_structs_pod ();
- close ();
+ generate_types grammar;
+ pr "\n";
- let close = output_to "guestfs-actions.pod" in
- generate_actions_pod ();
- close ();
+ pr "\
+(* Misc functions which are used by the parser code below. *)
+let first_child = function
+ | Xml.Element (_, _, c::_) -> c
+ | Xml.Element (name, _, []) ->
+ failwith (\"expected <\" ^ name ^ \"/> to have a child node\")
+ | Xml.PCData str ->
+ failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
+
+let string_child_or_empty = function
+ | Xml.Element (_, _, [Xml.PCData s]) -> s
+ | Xml.Element (_, _, []) -> \"\"
+ | Xml.Element (x, _, _) ->
+ failwith (\"expected XML tag with a single PCDATA child, but got \" ^
+ x ^ \" instead\")
+ | Xml.PCData str ->
+ failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\")
+
+let optional_child name xml =
+ let children = Xml.children xml in
+ try
+ Some (List.find (function
+ | Xml.Element (n, _, _) when n = name -> true
+ | _ -> false) children)
+ with
+ Not_found -> None
- let close = output_to "guestfish-actions.pod" in
- generate_fish_actions_pod ();
- close ();
+let child name xml =
+ match optional_child name xml with
+ | Some c -> c
+ | None ->
+ failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\")
- let close = output_to "ocaml/guestfs.mli" in
- generate_ocaml_mli ();
- close ();
+let attribute name xml =
+ try Xml.attrib xml name
+ with Xml.No_attribute _ ->
+ failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\")
- let close = output_to "ocaml/guestfs.ml" in
- generate_ocaml_ml ();
- close ();
+";
- let close = output_to "ocaml/guestfs_c_actions.c" in
- generate_ocaml_c ();
- close ();
+ generate_parsers grammar;
+ pr "\n";
- let close = output_to "ocaml/bindtests.ml" in
- generate_ocaml_bindtests ();
- close ();
+ pr "\
+(* Run external virt-inspector, then use parser to parse the XML. *)
+let inspect ?connect ?xml names =
+ let xml =
+ match xml with
+ | None ->
+ if names = [] then invalid_arg \"inspect: no names given\";
+ let cmd = [ \"virt-inspector\"; \"--xml\" ] @
+ (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @
+ names in
+ let cmd = List.map Filename.quote cmd in
+ let cmd = String.concat \" \" cmd in
+ let chan = open_process_in cmd in
+ let xml = Xml.parse_in chan in
+ (match close_process_in chan with
+ | WEXITED 0 -> ()
+ | WEXITED _ -> failwith \"external virt-inspector command failed\"
+ | WSIGNALED i | WSTOPPED i ->
+ failwith (\"external virt-inspector command died or stopped on sig \" ^
+ string_of_int i)
+ );
+ xml
+ | Some doc ->
+ Xml.parse_string doc in
+ parse_operatingsystems xml
+"
- let close = output_to "perl/Guestfs.xs" in
- generate_perl_xs ();
- close ();
+(* This is used to generate the src/MAX_PROC_NR file which
+ * contains the maximum procedure number, a surrogate for the
+ * ABI version number. See src/Makefile.am for the details.
+ *)
+and generate_max_proc_nr () =
+ let proc_nrs = List.map (
+ fun (_, _, proc_nr, _, _, _, _) -> proc_nr
+ ) daemon_functions in
- let close = output_to "perl/lib/Sys/Guestfs.pm" in
- generate_perl_pm ();
- close ();
+ let max_proc_nr = List.fold_left max 0 proc_nrs in
- let close = output_to "perl/bindtests.pl" in
- generate_perl_bindtests ();
- close ();
+ pr "%d\n" max_proc_nr
- let close = output_to "python/guestfs-py.c" in
- generate_python_c ();
- close ();
+let output_to filename k =
+ let filename_new = filename ^ ".new" in
+ chan := open_out filename_new;
+ k ();
+ close_out !chan;
+ chan := Pervasives.stdout;
- let close = output_to "python/guestfs.py" in
- generate_python_py ();
- close ();
+ (* Is the new file different from the current file? *)
+ if Sys.file_exists filename && files_equal filename filename_new then
+ unlink filename_new (* same, so skip it *)
+ else (
+ (* different, overwrite old one *)
+ (try chmod filename 0o644 with Unix_error _ -> ());
+ rename filename_new filename;
+ chmod filename 0o444;
+ printf "written %s\n%!" filename;
+ )
- let close = output_to "python/bindtests.py" in
- generate_python_bindtests ();
- close ();
+let perror msg = function
+ | Unix_error (err, _, _) ->
+ eprintf "%s: %s\n" msg (error_message err)
+ | exn ->
+ eprintf "%s: %s\n" msg (Printexc.to_string exn)
- let close = output_to "ruby/ext/guestfs/_guestfs.c" in
- generate_ruby_c ();
- close ();
+(* Main program. *)
+let () =
+ let lock_fd =
+ try openfile "HACKING" [O_RDWR] 0
+ with
+ | Unix_error (ENOENT, _, _) ->
+ eprintf "\
+You are probably running this from the wrong directory.
+Run it from the top source directory using the command
+ src/generator.ml
+";
+ exit 1
+ | exn ->
+ perror "open: HACKING" exn;
+ exit 1 in
+
+ (* Acquire a lock so parallel builds won't try to run the generator
+ * twice at the same time. Subsequent builds will wait for the first
+ * one to finish. Note the lock is released implicitly when the
+ * program exits.
+ *)
+ (try lockf lock_fd F_LOCK 1
+ with exn ->
+ perror "lock: HACKING" exn;
+ exit 1);
- let close = output_to "ruby/bindtests.rb" in
- generate_ruby_bindtests ();
- close ();
+ check_functions ();
- let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in
- generate_java_java ();
- close ();
+ output_to "src/guestfs_protocol.x" generate_xdr;
+ output_to "src/guestfs-structs.h" generate_structs_h;
+ output_to "src/guestfs-actions.h" generate_actions_h;
+ output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
+ output_to "src/guestfs-actions.c" generate_client_actions;
+ output_to "src/guestfs-bindtests.c" generate_bindtests;
+ output_to "src/guestfs-structs.pod" generate_structs_pod;
+ output_to "src/guestfs-actions.pod" generate_actions_pod;
+ output_to "src/guestfs-availability.pod" generate_availability_pod;
+ output_to "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;
+ output_to "src/MAX_PROC_NR" generate_max_proc_nr;
(* Always generate this file last, and unconditionally. It's used
* by the Makefile to know when we must re-run the generator.
*)
let chan = open_out "src/stamp-generator" in
fprintf chan "1\n";
- close_out chan
+ close_out chan;
+
+ printf "generated %d lines of code\n" !lines
git.annexia.org / libguestfs.git / blobdiff