| String of string (* const char *name, cannot be NULL *)
| Device of string (* /dev device name, cannot be NULL *)
| Pathname of string (* file name, cannot be NULL *)
+ | Dev_or_Path of string (* /dev device name or Pathname, cannot be NULL *)
| OptString of string (* const char *name, may be NULL *)
| StringList of string(* list of strings (each string cannot be NULL) *)
+ | DeviceList of string(* list of Device names (each cannot be NULL) *)
| Bool of string (* boolean *)
| Int of string (* int (smallish ints, signed, <= 31 bits) *)
(* These are treated as filenames (simple string parameters) in
*
* 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
* Apart from that, long descriptions are just perldoc paragraphs.
*)
+(* Generate a random UUID (used in tests). *)
+let uuidgen () =
+ let chan = Unix.open_process_in "uuidgen" in
+ let uuid = input_line chan in
+ (match Unix.close_process_in chan with
+ | Unix.WEXITED 0 -> ()
+ | Unix.WEXITED _ ->
+ failwith "uuidgen: process exited with non-zero status"
+ | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
+ failwith "uuidgen: process signalled or stopped by signal"
+ );
+ uuid
+
(* These test functions are used in the language binding tests. *)
let test_all_args = [
("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"];
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.");
+
]
(* daemon_functions are any functions which cause some action
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",
"\
as end of string). For those you need to use the C<guestfs_read_file>
or C<guestfs_download> functions which have a more complex interface.");
- ("ll", (RString "listing", [String "directory"]), 5, [],
+ ("ll", (RString "listing", [Pathname "directory"]), 5, [],
[], (* XXX Tricky to test because it depends on the exact format
* of the 'ls -l' command, which changes between F10 and F11.
*)
This command is mostly useful for interactive sessions. It
is I<not> intended that you try to parse the output string.");
- ("ls", (RStringList "listing", [String "directory"]), 6, [],
+ ("ls", (RStringList "listing", [Pathname "directory"]), 6, [],
[InitBasicFS, Always, TestOutputList (
[["touch"; "/new"];
["touch"; "/newer"];
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",
"\
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",
"\
where C<device> should usually be a partition name such
as C</dev/sda1>.");
- ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
+ ("vgcreate", (RErr, [String "volgroup"; DeviceList "physvols"]), 40, [],
[InitEmpty, Always, TestOutputList (
[["sfdiskM"; "/dev/sda"; ",100 ,200 ,"];
["pvcreate"; "/dev/sda1"];
This command removes all LVM logical volumes, volume groups
and physical volumes.");
- ("file", (RString "description", [Pathname "path"]), 49, [],
- [InitSquashFS, Always, TestOutput (
+ ("file", (RString "description", [Dev_or_Path "path"]), 49, [],
+ [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.
See also C<guestfs_download>.");
- ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
+ ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [],
[InitBasicFS, Always, TestOutput (
(* Pick a file from cwd which isn't likely to change. *)
[["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
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 upload an uncompressed tarball, use C<guestfs_tar_in>.");
- ("tgz_out", (RErr, [String "directory"; FileOut "tarball"]), 72, [],
+ ("tgz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 72, [],
[],
"pack directory into compressed tarball",
"\
C<device>.");
("set_e2uuid", (RErr, [Device "device"; String "uuid"]), 82, [],
- [InitBasicFS, Always, TestOutput (
- [["set_e2uuid"; "/dev/sda1"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"];
- ["get_e2uuid"; "/dev/sda1"]], "a3a61220-882b-4f61-89f4-cf24dcc7297d");
- InitBasicFS, Always, TestOutput (
- [["set_e2uuid"; "/dev/sda1"; "clear"];
- ["get_e2uuid"; "/dev/sda1"]], "");
- (* We can't predict what UUIDs will be, so just check the commands run. *)
- InitBasicFS, Always, TestRun (
- [["set_e2uuid"; "/dev/sda1"; "random"]]);
- InitBasicFS, Always, TestRun (
- [["set_e2uuid"; "/dev/sda1"; "time"]])],
+ (let uuid = uuidgen () in
+ [InitBasicFS, Always, TestOutput (
+ [["set_e2uuid"; "/dev/sda1"; uuid];
+ ["get_e2uuid"; "/dev/sda1"]], uuid);
+ InitBasicFS, Always, TestOutput (
+ [["set_e2uuid"; "/dev/sda1"; "clear"];
+ ["get_e2uuid"; "/dev/sda1"]], "");
+ (* We can't predict what UUIDs will be, so just check the commands run. *)
+ InitBasicFS, Always, TestRun (
+ [["set_e2uuid"; "/dev/sda1"; "random"]]);
+ InitBasicFS, Always, TestRun (
+ [["set_e2uuid"; "/dev/sda1"; "time"]])]),
"set the ext2/3/4 filesystem UUID",
"\
This sets the ext2/3/4 filesystem UUID of the filesystem on
This command installs GRUB (the Grand Unified Bootloader) on
C<device>, with the root directory being C<root>.");
- ("cp", (RErr, [String "src"; String "dest"]), 87, [],
+ ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
[InitBasicFS, Always, TestOutput (
[["write_file"; "/old"; "file content"; "0"];
["cp"; "/old"; "/new"];
This copies a file from C<src> to C<dest> where C<dest> is
either a destination filename or destination directory.");
- ("cp_a", (RErr, [String "src"; String "dest"]), 88, [],
+ ("cp_a", (RErr, [Pathname "src"; Pathname "dest"]), 88, [],
[InitBasicFS, Always, TestOutput (
[["mkdir"; "/olddir"];
["mkdir"; "/newdir"];
This copies a file or directory from C<src> to C<dest>
recursively using the C<cp -a> command.");
- ("mv", (RErr, [String "src"; String "dest"]), 89, [],
+ ("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
[InitBasicFS, Always, TestOutput (
[["write_file"; "/old"; "file content"; "0"];
["mv"; "/old"; "/new"];
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",
"\
It is an interface to the L<scrub(1)> program. See that
manual page for more details.");
- ("scrub_file", (RErr, [String "file"]), 115, [],
+ ("scrub_file", (RErr, [Pathname "file"]), 115, [],
[InitBasicFS, Always, TestRun (
[["write_file"; "/file"; "content"; "0"];
["scrub_file"; "/file"]])],
It is an interface to the L<scrub(1)> program. See that
manual page for more details.");
- ("scrub_freespace", (RErr, [String "dir"]), 116, [],
+ ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [],
[], (* XXX needs testing *)
"scrub (securely wipe) free space",
"\
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",
"\
filesystem as initrd. We I<only> support the newer initramfs
format (compressed cpio files).");
- ("mount_loop", (RErr, [String "file"; String "mountpoint"]), 129, [],
+ ("mount_loop", (RErr, [Pathname "file"; Pathname "mountpoint"]), 129, [],
[],
"mount a file using the loop device",
"\
a limitation of the kernel or swap tools.");
("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [],
- [InitEmpty, Always, TestRun (
- [["sfdiskM"; "/dev/sda"; ","];
- ["mkswap_U"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"; "/dev/sda1"]])],
+ (let uuid = uuidgen () in
+ [InitEmpty, Always, TestRun (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["mkswap_U"; uuid; "/dev/sda1"]])]),
"create a swap partition with an explicit UUID",
"\
Create a swap partition on C<device> with UUID C<uuid>.");
This call returns the previous umask.");
- ("readdir", (RStructList ("entries", "dirent"), [String "dir"]), 138, [],
+ ("readdir", (RStructList ("entries", "dirent"), [Pathname "dir"]), 138, [],
[],
"read directories entries",
"\
See also C<guestfs_sfdisk> and the L<sfdisk(8)> manpage.");
- ("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",
"\
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",
"\
matching lines.");
("realpath", (RString "rpath", [Pathname "path"]), 163, [],
- [InitSquashFS, Always, TestOutput (
+ [InitISOFS, Always, TestOutput (
[["realpath"; "/../directory"]], "/directory")],
"canonicalized absolute pathname",
"\
device or partition named C<device>.
See C<guestfs_swapon_device>.");
- ("swapon_file", (RErr, [String "file"]), 172, [],
+ ("swapon_file", (RErr, [Pathname "file"]), 172, [],
[InitBasicFS, Always, TestRun (
[["fallocate"; "/swap"; "8388608"];
["mkswap_file"; "/swap"];
This command enables swap to a file.
See C<guestfs_swapon_device> for other notes.");
- ("swapoff_file", (RErr, [String "file"]), 173, [],
+ ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
[], (* XXX tested by swapon_file *)
"disable swap on file",
"\
labeled swap partition.");
("swapon_uuid", (RErr, [String "uuid"]), 176, [],
- [InitEmpty, Always, TestRun (
- [["mkswap_U"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"; "/dev/sdb"];
- ["swapon_uuid"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"];
- ["swapoff_uuid"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"]])],
+ (let uuid = uuidgen () in
+ [InitEmpty, Always, TestRun (
+ [["mkswap_U"; uuid; "/dev/sdb"];
+ ["swapon_uuid"; uuid];
+ ["swapoff_uuid"; uuid]])]),
"enable swap on swap partition by UUID",
"\
This command enables swap to a swap partition with the given UUID.
file. To create the file itself, use something like C<guestfs_fallocate>.");
("inotify_init", (RErr, [Int "maxevents"]), 179, [],
- [InitSquashFS, Always, TestRun (
+ [InitISOFS, Always, TestRun (
[["inotify_init"; "0"]])],
"create an inotify handle",
"\
See the documentation about SELINUX in L<guestfs(3)>,
and C<guestfs_setcon>");
+ ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
+ ["mount"; "/dev/sda1"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "make a filesystem with block size",
+ "\
+This call is similar to C<guestfs_mkfs>, but it allows you to
+control the block size of the resulting filesystem. Supported
+block sizes depend on the filesystem type, but typically they
+are C<1024>, C<2048> or C<4096> only.");
+
+ ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ",100 ,"];
+ ["mke2journal"; "4096"; "/dev/sda1"];
+ ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
+ ["mount"; "/dev/sda2"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "make ext2/3/4 external journal",
+ "\
+This creates an ext2 external journal on C<device>. It is equivalent
+to the command:
+
+ mke2fs -O journal_dev -b blocksize device");
+
+ ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ",100 ,"];
+ ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
+ ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
+ ["mount"; "/dev/sda2"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "make ext2/3/4 external journal with label",
+ "\
+This creates an ext2 external journal on C<device> with label C<label>.");
+
+ ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [],
+ (let uuid = uuidgen () in
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ",100 ,"];
+ ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
+ ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
+ ["mount"; "/dev/sda2"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")]),
+ "make ext2/3/4 external journal with UUID",
+ "\
+This creates an ext2 external journal on C<device> with UUID C<uuid>.");
+
+ ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
+ [],
+ "make ext2/3/4 filesystem with external journal",
+ "\
+This creates an ext2/3/4 filesystem on C<device> with
+an external journal on C<journal>. It is equivalent
+to the command:
+
+ mke2fs -t fstype -b blocksize -J device=<journal> <device>
+
+See also C<guestfs_mke2journal>.");
+
+ ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
+ [],
+ "make ext2/3/4 filesystem with external journal",
+ "\
+This creates an ext2/3/4 filesystem on C<device> with
+an external journal on the journal labeled C<label>.
+
+See also C<guestfs_mke2journal_L>.");
+
+ ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [],
+ [],
+ "make ext2/3/4 filesystem with external journal",
+ "\
+This creates an ext2/3/4 filesystem on C<device> with
+an external journal on the journal with UUID C<uuid>.
+
+See also C<guestfs_mke2journal_U>.");
+
+ ("modprobe", (RErr, [String "modulename"]), 194, [],
+ [InitNone, Always, TestRun [["modprobe"; "fat"]]],
+ "load a kernel module",
+ "\
+This loads a kernel module in the appliance.
+
+The kernel module must have been whitelisted when libguestfs
+was built (see C<appliance/kmod.whitelist.in> in the source).");
+
+ ("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>.");
+
]
let all_functions = non_daemon_functions @ daemon_functions
"inotify_event", "INotifyEvent";
]
+(* What structs are actually returned. *)
+type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
+
+(* Returns a list of RStruct/RStructList structs that are returned
+ * by any function. Each element of returned list is a pair:
+ *
+ * (structname, RStructOnly)
+ * == there exists function which returns RStruct (_, structname)
+ * (structname, RStructListOnly)
+ * == there exists function which returns RStructList (_, structname)
+ * (structname, RStructAndList)
+ * == there are functions returning both RStruct (_, structname)
+ * and RStructList (_, structname)
+ *)
+let rstructs_used =
+ (* ||| is a "logical OR" for rstructs_used_t *)
+ let (|||) a b =
+ match a, b with
+ | RStructAndList, _
+ | _, RStructAndList -> RStructAndList
+ | RStructOnly, RStructListOnly
+ | RStructListOnly, RStructOnly -> RStructAndList
+ | RStructOnly, RStructOnly -> RStructOnly
+ | RStructListOnly, RStructListOnly -> RStructListOnly
+ in
+
+ let h = Hashtbl.create 13 in
+
+ (* if elem->oldv exists, update entry using ||| operator,
+ * else just add elem->newv to the hash
+ *)
+ let update elem newv =
+ try let oldv = Hashtbl.find h elem in
+ Hashtbl.replace h elem (newv ||| oldv)
+ with Not_found -> Hashtbl.add h elem newv
+ in
+
+ List.iter (
+ fun (_, style, _, _, _, _, _) ->
+ match fst style with
+ | RStruct (_, structname) -> update structname RStructOnly
+ | RStructList (_, structname) -> update structname RStructListOnly
+ | _ -> ()
+ ) all_functions;
+
+ (* return key->values as a list of (key,value) *)
+ Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
+
+(* debug:
+let () =
+ List.iter (
+ function
+ | sn, RStructOnly -> printf "%s RStructOnly\n" sn
+ | sn, RStructListOnly -> printf "%s RStructListOnly\n" sn
+ | sn, RStructAndList -> printf "%s RStructAndList\n" sn
+ ) rstructs_used
+*)
+
(* Used for testing language bindings. *)
type callt =
| CallString of string
v
with
_ -> Hashtbl.create 13
+let pod2text_memo_updated () =
+ let chan = open_out pod2text_memo_filename in
+ output_value chan pod2text_memo;
+ close_out chan
(* Useful functions.
* Note we don't want to use any external OCaml libraries which
loop 0 xs
let name_of_argt = function
- | Pathname n | Device 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
| FileIn n | FileOut n -> n
let java_name_of_struct typ =
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
pr "struct %s_args {\n" name;
List.iter (
function
- | Pathname n | Device 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
| FileIn _ | FileOut _ -> ()
name style
) all_functions
+(* Generate the guestfs-internal-actions.h file. *)
+and generate_internal_actions_h () =
+ generate_header CStyle LGPLv2;
+ 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;
#include <stdlib.h>
#include \"guestfs.h\"
+#include \"guestfs-internal-actions.h\"
#include \"guestfs_protocol.h\"
#define error guestfs_error
-#define perrorf guestfs_perrorf
-#define safe_malloc guestfs_safe_malloc
+//#define 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. *)
+ (* Generate code to generate guestfish call traces. *)
+ let trace_call shortname style =
+ pr " if (guestfs__get_trace (g)) {\n";
+
+ let needs_i =
+ List.exists (function
+ | StringList _ | DeviceList _ -> true
+ | _ -> false) (snd style) in
+ if needs_i then (
+ pr " int i;\n";
+ pr "\n"
+ );
+
+ pr " printf (\"%s\");\n" shortname;
+ List.iter (
+ function
+ | String n (* strings *)
+ | Device n
+ | Pathname n
+ | Dev_or_Path n
+ | FileIn n
+ | FileOut n ->
+ (* 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
+ ) (snd style);
+ pr " putchar ('\\n');\n";
+ pr " }\n";
+ pr "\n";
+ in
+
+ (* For non-daemon functions, generate a wrapper around each function. *)
List.iter (
fun (shortname, style, _, _, _, _, _) ->
let name = "guestfs_" ^ shortname in
- (* Generate the context struct which stores the high-level
- * state between callback functions.
- *)
- pr "struct %s_ctx {\n" shortname;
- pr " /* This flag is set by the callbacks, so we know we've done\n";
- pr " * the callbacks as expected, and in the right sequence.\n";
- pr " * 0 = not called, 1 = reply_cb called.\n";
- pr " */\n";
- pr " int cb_sequence;\n";
- pr " struct guestfs_message_header hdr;\n";
- pr " struct guestfs_message_error err;\n";
- (match fst style with
- | RErr -> ()
- | RConstString _ | RConstOptString _ ->
- failwithf "RConstString|RConstOptString cannot be used by daemon functions"
- | RInt _ | RInt64 _
- | RBool _ | RString _ | RStringList _
- | RStruct _ | RStructList _
- | RHashtable _ | RBufferOut _ ->
- pr " struct %s_ret ret;\n" name
- );
- pr "};\n";
- pr "\n";
-
- (* Generate the reply callback function. *)
- pr "static void %s_reply_cb (guestfs_h *g, void *data, XDR *xdr)\n" shortname;
+ generate_prototype ~extern:false ~semicolon:false ~newline:true
+ ~handle:"g" name style;
pr "{\n";
- pr " guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
- pr " struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
- pr "\n";
- pr " /* This should definitely not happen. */\n";
- pr " if (ctx->cb_sequence != 0) {\n";
- pr " ctx->cb_sequence = 9999;\n";
- pr " error (g, \"%%s: internal error: reply callback called twice\", \"%s\");\n" name;
- pr " return;\n";
- pr " }\n";
- pr "\n";
- pr " ml->main_loop_quit (ml, g);\n";
- pr "\n";
- pr " if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
- pr " error (g, \"%%s: failed to parse reply header\", \"%s\");\n" name;
- pr " return;\n";
- pr " }\n";
- pr " if (ctx->hdr.status == GUESTFS_STATUS_ERROR) {\n";
- pr " if (!xdr_guestfs_message_error (xdr, &ctx->err)) {\n";
- pr " error (g, \"%%s: failed to parse reply error\", \"%s\");\n"
- name;
- pr " return;\n";
- pr " }\n";
- pr " goto done;\n";
- pr " }\n";
-
- (match fst style with
- | RErr -> ()
- | RConstString _ | RConstOptString _ ->
- failwithf "RConstString|RConstOptString cannot be used by daemon functions"
- | RInt _ | RInt64 _
- | RBool _ | RString _ | RStringList _
- | RStruct _ | RStructList _
- | RHashtable _ | RBufferOut _ ->
- pr " if (!xdr_%s_ret (xdr, &ctx->ret)) {\n" name;
- pr " error (g, \"%%s: failed to parse reply\", \"%s\");\n" name;
- pr " return;\n";
- pr " }\n";
- );
+ trace_call shortname style;
+ pr " return guestfs__%s " shortname;
+ generate_c_call_args ~handle:"g" style;
+ pr ";\n";
+ pr "}\n";
+ pr "\n"
+ ) non_daemon_functions;
- pr " done:\n";
- pr " ctx->cb_sequence = 1;\n";
- pr "}\n\n";
+ (* Client-side stubs for each function. *)
+ List.iter (
+ fun (shortname, style, _, _, _, _, _) ->
+ let name = "guestfs_" ^ shortname in
(* 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 (
function
- | Pathname n | Device n | String n ->
+ | Pathname n | Device n | Dev_or_Path n | String n ->
pr " args.%s = (char *) %s;\n" n n
| OptString n ->
pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
- | StringList n ->
+ | 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
| 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 " *size_r = ret.%s.%s_len;\n" n n;
+ pr " return ret.%s.%s_val; /* caller will free */\n" n n
);
pr "}\n\n"
pr " struct guestfs_%s_args args;\n" name;
List.iter (
function
- | Device n
+ | Device n | Dev_or_Path n
| 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
| FileIn _ | FileOut _ -> ()
pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
pr " return;\n";
pr " }\n";
+ let pr_args n =
+ pr " char *%s = args.%s;\n" n n
+ in
+ let pr_list_handling_code n =
+ pr " %s = realloc (args.%s.%s_val,\n" n n n;
+ pr " sizeof (char *) * (args.%s.%s_len+1));\n" n n;
+ pr " if (%s == NULL) {\n" n;
+ pr " reply_with_perror (\"realloc\");\n";
+ pr " goto done;\n";
+ pr " }\n";
+ pr " %s[args.%s.%s_len] = NULL;\n" n n n;
+ pr " args.%s.%s_val = %s;\n" n n n;
+ in
List.iter (
function
| Pathname n ->
- pr " char *%s = args.%s;\n" n n;
+ pr_args n;
pr " ABS_PATH (%s, goto done);\n" n;
| Device n ->
- pr " char *%s = args.%s;\n" n n;
- pr " RESOLVE_DEVICE (%s, goto done);" n;
- | String n -> pr " char *%s = args.%s;\n" n n
+ pr_args n;
+ pr " RESOLVE_DEVICE (%s, goto done);\n" n;
+ | Dev_or_Path n ->
+ pr_args n;
+ pr " REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);\n" n;
+ | String n -> pr_args n
| OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
| StringList n ->
- pr " %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
| FileIn _ | FileOut _ -> ()
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
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;
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;
exit (1);
}
- if (guestfs_add_drive_ro (g, \"../images/test.sqsh\") == -1) {
- printf (\"guestfs_add_drive_ro ../images/test.sqsh FAILED\\n\");
+ if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
+ printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
exit (1);
}
/* 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 " if (n_failed > 0) {\n";
+ pr " printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
pr " exit (1);\n";
pr " }\n";
pr "\n";
["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
| OptString n, "NULL" -> ()
| Pathname n, arg
| Device n, arg
+ | Dev_or_Path n, arg
| String n, arg
| OptString n, arg ->
pr " const char *%s = \"%s\";\n" n (c_quote arg);
| Int _, _
| Bool _, _
| FileIn _, _ | FileOut _, _ -> ()
- | StringList n, arg ->
+ | 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;
function
| OptString _, "NULL" -> pr ", NULL"
| Pathname n, _
- | Device n, _
+ | Device n, _ | Dev_or_Path n, _
| String n, _
| OptString n, _ ->
pr ", %s" n
| FileIn _, arg | FileOut _, arg ->
pr ", \"%s\"" (c_quote arg)
- | StringList n, _ ->
- pr ", %s" n
+ | StringList n, _ | DeviceList n, _ ->
+ pr ", (char **) %s" n
| Int _, arg ->
let i =
try int_of_string arg
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 (
) 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;
+
+ (* Emit a print_TYPE function definition only if that function is used. *)
+ List.iter (
+ function
+ | typ, RStructOnly ->
+ pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
+ pr "{\n";
+ pr " print_%s_indent (%s, \"\");\n" typ typ;
+ pr "}\n";
+ pr "\n";
+ | typ, _ -> () (* empty *)
+ ) rstructs_used;
+
(* run_<action> actions *)
List.iter (
fun (name, style, _, flags, _, _, _) ->
List.iter (
function
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| OptString n
| FileIn n
| FileOut n -> pr " const 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
) (snd style);
fun i ->
function
| Pathname name
- | Device name | String name -> pr " %s = argv[%d];\n" name i
+ | Device name | Dev_or_Path name | String name -> pr " %s = argv[%d];\n" name i
| OptString name ->
pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
name i i
| FileOut name ->
pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n"
name i i
- | StringList name ->
- pr " %s = parse_string_list (argv[%d]);\n" name i
+ | 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 ->
generate_c_call_args ~handle:"g" style;
pr ";\n";
+ List.iter (
+ function
+ | Pathname name | Device name | Dev_or_Path name | String name
+ | OptString name | FileIn name | FileOut name | Bool name
+ | Int 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"
pr " %s" name;
List.iter (
function
- | Pathname n | Device n | String n -> pr " %s" n
+ | 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
| FileIn n | FileOut n -> pr " (%s|-)" n
List.iter (
function
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String 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
| FileIn n
";
(* 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;
+
(* The wrappers. *)
List.iter (
fun (name, style, _, _, _, _, _) ->
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 "CAMLprim value\n";
pr "ocaml_guestfs_%s (value %s" name (List.hd params);
List.iter (pr ", value %s") (List.tl params);
List.iter (
function
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| FileIn n
| FileOut n ->
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
List.iter (
function
- | StringList n ->
+ | StringList n | DeviceList n ->
pr " ocaml_guestfs_free_strings (%s);\n" n;
- | Pathname _ | Device _ | String _ | OptString _ | Bool _ | Int _
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ | Bool _ | Int _
| 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 "%s : t -> " name;
List.iter (
function
- | Pathname _ | Device _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
| OptString _ -> pr "string option -> "
- | StringList _ -> pr "string array -> "
+ | StringList _ | DeviceList _ -> pr "string array -> "
| Bool _ -> pr "bool -> "
| Int _ -> pr "int -> "
) (snd style);
iteri (
fun i ->
function
- | Pathname n | Device n | String n | FileIn n | FileOut n ->
+ | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
pr " char *%s;\n" n
| OptString n ->
(* http://www.perlmonks.org/?node_id=554277
* 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
) (snd style);
let do_cleanups () =
List.iter (
function
- | Pathname _ | Device _ | String _ | OptString _ | Bool _ | Int _
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ | Bool _ | Int _
| FileIn _ | FileOut _ -> ()
- | StringList n -> pr " free (%s);\n" n
+ | StringList n | DeviceList n -> pr " free (%s);\n" n
) (snd style)
in
my $h = Sys::Guestfs->new ();
$h->add_drive ('guest.img');
$h->launch ();
- $h->wait_ready ();
$h->mount ('/dev/sda1', '/');
$h->touch ('/hello');
$h->sync ();
if !comma then pr ", ";
comma := true;
match arg with
- | Pathname n | Device n | String n
+ | Pathname n | Device n | Dev_or_Path n | String n
| OptString n | Bool n | Int n | FileIn n | FileOut n ->
pr "$%s" n
- | StringList n ->
+ | StringList n | DeviceList n ->
pr "\\@%s" n
) (snd style);
pr ");"
generate_header CStyle LGPLv2;
pr "\
+#include <Python.h>
+
#include <stdio.h>
#include <stdlib.h>
#include <assert.h>
-#include <Python.h>
-
#include \"guestfs.h\"
typedef struct {
}
/* This list should be freed (but not the strings) after use. */
-static const char **
+static char **
get_string_list (PyObject *obj)
{
int i, len;
- const char **r;
+ char **r;
assert (obj);
";
+ let emit_put_list_function typ =
+ pr "static PyObject *\n";
+ pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
+ pr "{\n";
+ pr " PyObject *list;\n";
+ pr " int i;\n";
+ pr "\n";
+ pr " list = PyList_New (%ss->len);\n" typ;
+ pr " for (i = 0; i < %ss->len; ++i)\n" typ;
+ pr " PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
+ pr " return list;\n";
+ pr "};\n";
+ pr "\n"
+ in
+
(* Structures, turned into Python dictionaries. *)
List.iter (
fun (typ, cols) ->
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;
pr "};\n";
pr "\n";
- pr "static PyObject *\n";
- pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
- pr "{\n";
- pr " PyObject *list;\n";
- pr " int i;\n";
- pr "\n";
- pr " list = PyList_New (%ss->len);\n" typ;
- pr " for (i = 0; i < %ss->len; ++i)\n" typ;
- pr " PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
- pr " return list;\n";
- pr "};\n";
- pr "\n"
) structs;
+ (* Emit a put_TYPE_list function definition only if that function is used. *)
+ List.iter (
+ function
+ | typ, (RStructListOnly | RStructAndList) ->
+ (* generate the function for typ *)
+ emit_put_list_function typ
+ | typ, _ -> () (* empty *)
+ ) rstructs_used;
+
(* Python wrapper functions. *)
List.iter (
fun (name, style, _, _, _, _, _) ->
List.iter (
function
- | Pathname n | Device n | String n | FileIn n | FileOut n ->
+ | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
pr " const char *%s;\n" n
| OptString n -> pr " const char *%s;\n" n
- | 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
) (snd style);
pr " if (!PyArg_ParseTuple (args, (char *) \"O";
List.iter (
function
- | Pathname _ | Device _ | String _ | FileIn _ | FileOut _ -> pr "s"
+ | 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"
) (snd style);
pr " &py_g";
List.iter (
function
- | Pathname n | Device n | String n | FileIn n | FileOut n -> pr ", &%s" n
+ | 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
) (snd style);
pr " g = get_handle (py_g);\n";
List.iter (
function
- | Pathname _ | Device _ | String _
+ | Pathname _ | Device _ | Dev_or_Path _ | String _
| FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
- | StringList n ->
+ | 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 _ | String _
+ | Pathname _ | Device _ | Dev_or_Path _ | String _
| FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
- | StringList n ->
+ | StringList n | DeviceList n ->
pr " free (%s);\n" n
) (snd style);
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 ()
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. *)
List.iter (
function
- | Pathname n | Device n | String n | FileIn n | FileOut n ->
+ | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
pr " Check_Type (%sv, T_STRING);\n" n;
pr " const char *%s = StringValueCStr (%sv);\n" n n;
pr " if (!%s)\n" n;
pr " \"%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";
List.iter (
function
- | Pathname _ | Device _ | String _
+ | Pathname _ | Device _ | Dev_or_Path _ | String _
| FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
- | StringList n ->
+ | StringList n | DeviceList n ->
pr " free (%s);\n" n
) (snd style);
match arg with
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| OptString n
| FileIn n
| FileOut n ->
pr "String %s" n
- | StringList n ->
+ | StringList n | DeviceList n ->
pr "String[] %s" n
| Bool n ->
pr "boolean %s" n
List.iter (
function
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| OptString n
| 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
List.iter (
function
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| OptString 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
| 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";
List.iter (
function
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| FileIn n
| FileOut 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;
List.iter (
function
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| FileIn n
| FileOut n ->
| 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;
function
| FileIn n
| FileOut n
- | Pathname n | Device n | String n -> pr "withCString %s $ \\%s -> " n n
+ | Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n
| OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
- | StringList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
+ | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
| Bool _ | Int _ -> ()
) (snd style);
(* Convert integer arguments. *)
| Bool n -> sprintf "(fromBool %s)" n
| Int n -> sprintf "(fromIntegral %s)" n
| FileIn n | FileOut n
- | Pathname n | Device 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));
List.iter (
fun arg ->
(match arg with
- | Pathname _ | Device _ | String _ -> pr "%s" string
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
| OptString _ -> if hs then pr "Maybe String" else pr "CString"
- | StringList _ -> if hs then pr "[String]" else pr "Ptr CString"
+ | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString"
| Bool _ -> pr "%s" bool
| Int _ -> pr "%s" int
| FileIn _ -> pr "%s" string
#include <string.h>
#include \"guestfs.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
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| FileIn n
| FileOut n -> pr " printf (\"%%s\\n\", %s);\n" n
| OptString n -> pr " printf (\"%%s\\n\", %s ? %s : \"null\");\n" n n
- | StringList n -> pr " print_strings (%s);\n" n
+ | StringList n | DeviceList n -> pr " print_strings (%s);\n" n
| Bool n -> pr " printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
| Int n -> pr " printf (\"%%d\\n\", %s);\n" n
) (snd style);
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 ->
) 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
generate_actions_h ();
close ();
+ let close = output_to "src/guestfs-internal-actions.h" in
+ generate_internal_actions_h ();
+ close ();
+
let close = output_to "src/guestfs-actions.c" in
generate_client_actions ();
close ();
git.annexia.org / libguestfs.git / blobdiff