and argt =
| String of string (* const char *name, cannot be NULL *)
| OptString of string (* const char *name, may be NULL *)
+ | StringList of string(* list of strings (each string cannot be NULL) *)
| Bool of string (* boolean *)
| Int of string (* int (smallish ints, signed, <= 31 bits) *)
type flags =
| ProtocolLimitWarning (* display warning about protocol size limits *)
+ | DangerWillRobinson (* flags particularly dangerous commands *)
| FishAlias of string (* provide an alias for this cmd in guestfish *)
| FishAction of string (* call this function in guestfish *)
| NotInFish (* do not export via guestfish *)
+let protocol_limit_warning =
+ "Because of the message protocol, there is a transfer limit
+of somewhere between 2MB and 4MB. To transfer large files you should use
+FTP."
+
+let danger_will_robinson =
+ "B<This command is dangerous. Without careful use you
+can easily destroy all your data>."
+
(* 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 10M, 20M
- * and 30M (respectively /dev/sda, /dev/sdb, /dev/sdc). To run the
- * tests in a reasonable amount of time, the virtual machine and
- * block devices are reused between tests. So don't try testing
- * kill_subprocess :-x
+ * Note that the test environment has 3 block devices, of size 500MB,
+ * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc).
+ * Note for partitioning purposes, the 500MB device has 63 cylinders.
+ *
+ * To be able to run the tests in a reasonable amount of time,
+ * the virtual machine and block devices are reused between tests.
+ * So don't try testing kill_subprocess :-x
+ *
+ * Between each test we umount-all and lvm-remove-all.
*
* Don't assume anything about the previous contents of the block
* devices. Use 'Init*' to create some initial scenarios.
*)
-type tests = test list
+type tests = (test_init * test) list
and test =
(* Run the command sequence and just expect nothing to fail. *)
- | TestRun of test_init * seq
+ | TestRun of seq
(* Run the command sequence and expect the output of the final
* command to be the string.
*)
- | TestOutput of test_init * seq * string
+ | TestOutput of seq * string
(* Run the command sequence and expect the output of the final
* command to be the list of strings.
*)
- | TestOutputList of test_init * seq * string list
+ | TestOutputList of seq * string list
(* Run the command sequence and expect the output of the final
* command to be the integer.
*)
- | TestOutputInt of test_init * seq * int
+ | TestOutputInt of seq * int
(* Run the command sequence and expect the output of the final
* command to be a true value (!= 0 or != NULL).
*)
- | TestOutputTrue of test_init * seq
+ | TestOutputTrue of seq
(* Run the command sequence and expect the output of the final
* command to be a false value (== 0 or == NULL, but not an error).
*)
- | TestOutputFalse of test_init * seq
+ | TestOutputFalse of seq
(* Run the command sequence and expect the output of the final
* command to be a list of the given length (but don't care about
* content).
*)
- | TestOutputLength of test_init * seq * int
+ | TestOutputLength of seq * int
(* Run the command sequence and expect the final command (only)
* to fail.
*)
- | TestLastFail of test_init * seq
+ | TestLastFail of seq
(* Some initial scenarios for testing. *)
and test_init =
- (* Do nothing, block devices could contain random stuff. *)
+ (* Do nothing, block devices could contain random stuff including
+ * LVM PVs, and some filesystems might be mounted. This is usually
+ * a bad idea.
+ *)
| InitNone
+ (* Block devices are empty and no filesystems are mounted. *)
+ | InitEmpty
(* /dev/sda contains a single partition /dev/sda1, which is formatted
* as ext2, empty [except for lost+found] and mounted on /.
* /dev/sdb and /dev/sdc may have random content.
* No LVM.
*)
- | InitEmpty
+ | InitBasicFS
(* /dev/sda:
* /dev/sda1 (is a PV):
- * /dev/VG/LV:
+ * /dev/VG/LV (size 8MB):
* formatted as ext2, empty [except for lost+found], mounted on /
* /dev/sdb and /dev/sdc may have random content.
*)
- | InitEmptyLVM
+ | InitBasicFSonLVM
(* Sequence of commands for testing. *)
and seq = cmd list
let daemon_functions = [
("mount", (RErr, [String "device"; String "mountpoint"]), 1, [],
- [TestOutput (
- InitNone,
- [["sfdisk"];
+ [InitEmpty, TestOutput (
+ [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
["mkfs"; "ext2"; "/dev/sda1"];
["mount"; "/dev/sda1"; "/"];
["write_file"; "/new"; "new file contents"; "0"];
call, in order to improve reliability.");
("sync", (RErr, []), 2, [],
- [ TestRun (InitNone, [["sync"]])],
+ [ InitEmpty, TestRun [["sync"]]],
"sync disks, writes are flushed through to the disk image",
"\
This syncs the disk, so that any writes are flushed through to the
closing the handle.");
("touch", (RErr, [String "path"]), 3, [],
- [TestOutputTrue (
- InitEmpty,
+ [InitBasicFS, TestOutputTrue (
[["touch"; "/new"];
["exists"; "/new"]])],
"update file timestamps or create a new file",
to create a new zero-length file.");
("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
- [TestOutput (
- InitEmpty,
+ [InitBasicFS, TestOutput (
[["write_file"; "/new"; "new file contents"; "0"];
["cat"; "/new"]], "new file contents")],
"list the contents of a file",
is I<not> intended that you try to parse the output string.");
("ls", (RStringList "listing", [String "directory"]), 6, [],
- [TestOutputList (
- InitEmpty,
+ [InitBasicFS, TestOutputList (
[["touch"; "/new"];
["touch"; "/newer"];
["touch"; "/newest"];
should probably use C<guestfs_readdir> instead.");
("list_devices", (RStringList "devices", []), 7, [],
- [TestOutputList (
- InitNone,
+ [InitEmpty, TestOutputList (
[["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
"list the block devices",
"\
The full block device names are returned, eg. C</dev/sda>");
("list_partitions", (RStringList "partitions", []), 8, [],
- [TestOutputList (
- InitEmpty,
+ [InitBasicFS, TestOutputList (
[["list_partitions"]], ["/dev/sda1"]);
- TestOutputList (
- InitEmpty,
- [["sfdisk"];
+ InitEmpty, TestOutputList (
+ [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
["list_partitions"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
"list the partitions",
"\
call C<guestfs_lvs>.");
("pvs", (RStringList "physvols", []), 9, [],
- [TestOutputList (
- InitEmptyLVM,
+ [InitBasicFSonLVM, TestOutputList (
[["pvs"]], ["/dev/sda1"]);
- TestOutputList (
- InitNone,
- [["sfdisk"];
+ InitEmpty, TestOutputList (
+ [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
["pvcreate"; "/dev/sda1"];
["pvcreate"; "/dev/sda2"];
["pvcreate"; "/dev/sda3"];
See also C<guestfs_pvs_full>.");
("vgs", (RStringList "volgroups", []), 10, [],
- [TestOutputList (
- InitEmptyLVM,
+ [InitBasicFSonLVM, TestOutputList (
[["vgs"]], ["VG"]);
- TestOutputList (
- InitNone,
- [["sfdisk"];
+ InitEmpty, TestOutputList (
+ [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
["pvcreate"; "/dev/sda1"];
["pvcreate"; "/dev/sda2"];
["pvcreate"; "/dev/sda3"];
See also C<guestfs_vgs_full>.");
("lvs", (RStringList "logvols", []), 11, [],
- [TestOutputList (
- InitEmptyLVM,
+ [InitBasicFSonLVM, TestOutputList (
[["lvs"]], ["/dev/VG/LV"]);
- TestOutputList (
- InitNone,
- [["sfdisk"];
+ InitEmpty, TestOutputList (
+ [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
["pvcreate"; "/dev/sda1"];
["pvcreate"; "/dev/sda2"];
["pvcreate"; "/dev/sda3"];
["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
["vgcreate"; "VG2"; "/dev/sda3"];
- ["lvcreate"; "LV1"; "VG1"; "5000"];
- ["lvcreate"; "LV2"; "VG1"; "5000"];
- ["lvcreate"; "LV3"; "VG2"; "5000"];
- ["lvs"]], ["LV1"; "LV2"; "LV3"])],
+ ["lvcreate"; "LV1"; "VG1"; "50"];
+ ["lvcreate"; "LV2"; "VG1"; "50"];
+ ["lvcreate"; "LV3"; "VG2"; "50"];
+ ["lvs"]], ["/dev/VG1/LV1"; "/dev/VG1/LV2"; "/dev/VG2/LV3"])],
"list the LVM logical volumes (LVs)",
"\
List all the logical volumes detected. This is the equivalent
See also C<guestfs_lvs_full>.");
("pvs_full", (RPVList "physvols", []), 12, [],
- [TestOutputLength (
- InitEmptyLVM,
+ [InitBasicFSonLVM, TestOutputLength (
[["pvs"]], 1)],
"list the LVM physical volumes (PVs)",
"\
of the L<pvs(8)> command. The \"full\" version includes all fields.");
("vgs_full", (RVGList "volgroups", []), 13, [],
- [TestOutputLength (
- InitEmptyLVM,
+ [InitBasicFSonLVM, TestOutputLength (
[["pvs"]], 1)],
"list the LVM volume groups (VGs)",
"\
of the L<vgs(8)> command. The \"full\" version includes all fields.");
("lvs_full", (RLVList "logvols", []), 14, [],
- [TestOutputLength (
- InitEmptyLVM,
+ [InitBasicFSonLVM, TestOutputLength (
[["pvs"]], 1)],
"list the LVM logical volumes (LVs)",
"\
of the L<lvs(8)> command. The \"full\" version includes all fields.");
("read_lines", (RStringList "lines", [String "path"]), 15, [],
- [TestOutputList (
- InitEmpty,
+ [InitBasicFS, TestOutputList (
[["write_file"; "/new"; "line1\r\nline2\nline3"; "0"];
["read_lines"; "/new"]], ["line1"; "line2"; "line3"]);
- TestOutputList (
- InitEmpty,
+ InitBasicFS, TestOutputList (
[["write_file"; "/new"; ""; "0"];
["read_lines"; "/new"]], [])],
"read file as lines",
C<path/*> and sorting the resulting nodes into alphabetical order.");
("rm", (RErr, [String "path"]), 29, [],
- [TestRun (
- InitEmpty,
+ [InitBasicFS, TestRun
[["touch"; "/new"];
- ["rm"; "/new"]]);
- TestLastFail (
- InitEmpty,
- [["rm"; "/new"]]);
- TestLastFail (
- InitEmpty,
+ ["rm"; "/new"]];
+ InitBasicFS, TestLastFail
+ [["rm"; "/new"]];
+ InitBasicFS, TestLastFail
[["mkdir"; "/new"];
- ["rm"; "/new"]])],
+ ["rm"; "/new"]]],
"remove a file",
"\
Remove the single file C<path>.");
("rmdir", (RErr, [String "path"]), 30, [],
- [TestRun (
- InitEmpty,
+ [InitBasicFS, TestRun
[["mkdir"; "/new"];
- ["rmdir"; "/new"]]);
- TestLastFail (
- InitEmpty,
- [["rmdir"; "/new"]]);
- TestLastFail (
- InitEmpty,
+ ["rmdir"; "/new"]];
+ InitBasicFS, TestLastFail
+ [["rmdir"; "/new"]];
+ InitBasicFS, TestLastFail
[["touch"; "/new"];
- ["rmdir"; "/new"]])],
+ ["rmdir"; "/new"]]],
"remove a directory",
"\
Remove the single directory C<path>.");
("rm_rf", (RErr, [String "path"]), 31, [],
- [TestOutputFalse (
- InitEmpty,
+ [InitBasicFS, TestOutputFalse
[["mkdir"; "/new"];
["mkdir"; "/new/foo"];
["touch"; "/new/foo/bar"];
["rm_rf"; "/new"];
- ["exists"; "/new"]])],
+ ["exists"; "/new"]]],
"remove a file or directory recursively",
"\
Remove the file or directory C<path>, recursively removing the
command.");
("mkdir", (RErr, [String "path"]), 32, [],
- [TestOutputTrue (
- InitEmpty,
+ [InitBasicFS, TestOutputTrue
[["mkdir"; "/new"];
- ["is_dir"; "/new"]])],
+ ["is_dir"; "/new"]];
+ InitBasicFS, TestLastFail
+ [["mkdir"; "/new/foo/bar"]]],
"create a directory",
"\
Create a directory named C<path>.");
("mkdir_p", (RErr, [String "path"]), 33, [],
- [TestOutputTrue (
- InitEmpty,
+ [InitBasicFS, TestOutputTrue
[["mkdir_p"; "/new/foo/bar"];
- ["is_dir"; "/new/foo/bar"]]);
- TestOutputTrue (
- InitEmpty,
+ ["is_dir"; "/new/foo/bar"]];
+ InitBasicFS, TestOutputTrue
[["mkdir_p"; "/new/foo/bar"];
- ["is_dir"; "/new/foo"]]);
- TestOutputTrue (
- InitEmpty,
+ ["is_dir"; "/new/foo"]];
+ InitBasicFS, TestOutputTrue
[["mkdir_p"; "/new/foo/bar"];
- ["is_dir"; "/new"]])],
+ ["is_dir"; "/new"]]],
"create a directory and parents",
"\
Create a directory named C<path>, creating any parent directories
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).");
+
+ ("exists", (RBool "existsflag", [String "path"]), 36, [],
+ [InitBasicFS, TestOutputTrue (
+ [["touch"; "/new"];
+ ["exists"; "/new"]]);
+ InitBasicFS, TestOutputTrue (
+ [["mkdir"; "/new"];
+ ["exists"; "/new"]])],
+ "test if file or directory exists",
+ "\
+This returns C<true> if and only if there is a file, directory
+(or anything) with the given C<path> name.
+
+See also C<guestfs_is_file>, C<guestfs_is_dir>, C<guestfs_stat>.");
+
+ ("is_file", (RBool "fileflag", [String "path"]), 37, [],
+ [InitBasicFS, TestOutputTrue (
+ [["touch"; "/new"];
+ ["is_file"; "/new"]]);
+ InitBasicFS, TestOutputFalse (
+ [["mkdir"; "/new"];
+ ["is_file"; "/new"]])],
+ "test if file exists",
+ "\
+This returns C<true> if and only if there is a file
+with the given C<path> name. Note that it returns false for
+other objects like directories.
+
+See also C<guestfs_stat>.");
+
+ ("is_dir", (RBool "dirflag", [String "path"]), 38, [],
+ [InitBasicFS, TestOutputFalse (
+ [["touch"; "/new"];
+ ["is_dir"; "/new"]]);
+ InitBasicFS, TestOutputTrue (
+ [["mkdir"; "/new"];
+ ["is_dir"; "/new"]])],
+ "test if file exists",
+ "\
+This returns C<true> if and only if there is a directory
+with the given C<path> name. Note that it returns false for
+other objects like files.
+
+See also C<guestfs_stat>.");
+
+ ("pvcreate", (RErr, [String "device"]), 39, [],
+ [InitEmpty, TestOutputList (
+ [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
+ ["pvcreate"; "/dev/sda1"];
+ ["pvcreate"; "/dev/sda2"];
+ ["pvcreate"; "/dev/sda3"];
+ ["pvs"]], ["/dev/sda1"; "/dev/sda2"; "/dev/sda3"])],
+ "create an LVM physical volume",
+ "\
+This creates an LVM physical volume on the named C<device>,
+where C<device> should usually be a partition name such
+as C</dev/sda1>.");
+
+ ("vgcreate", (RErr, [String "volgroup"; StringList "physvols"]), 40, [],
+ [InitEmpty, TestOutputList (
+ [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
+ ["pvcreate"; "/dev/sda1"];
+ ["pvcreate"; "/dev/sda2"];
+ ["pvcreate"; "/dev/sda3"];
+ ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
+ ["vgcreate"; "VG2"; "/dev/sda3"];
+ ["vgs"]], ["VG1"; "VG2"])],
+ "create an LVM volume group",
+ "\
+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, [],
+ [InitEmpty, TestOutputList (
+ [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ",10 ,20 ,"];
+ ["pvcreate"; "/dev/sda1"];
+ ["pvcreate"; "/dev/sda2"];
+ ["pvcreate"; "/dev/sda3"];
+ ["vgcreate"; "VG1"; "/dev/sda1 /dev/sda2"];
+ ["vgcreate"; "VG2"; "/dev/sda3"];
+ ["lvcreate"; "LV1"; "VG1"; "50"];
+ ["lvcreate"; "LV2"; "VG1"; "50"];
+ ["lvcreate"; "LV3"; "VG2"; "50"];
+ ["lvcreate"; "LV4"; "VG2"; "50"];
+ ["lvcreate"; "LV5"; "VG2"; "50"];
+ ["lvs"]],
+ ["/dev/VG1/LV1"; "/dev/VG1/LV2";
+ "/dev/VG2/LV3"; "/dev/VG2/LV4"; "/dev/VG2/LV5"])],
+ "create an LVM volume group",
+ "\
+This creates an LVM volume group called C<logvol>
+on the volume group C<volgroup>, with C<size> megabytes.");
+
+ ("mkfs", (RErr, [String "fstype"; String "device"]), 42, [],
+ [InitEmpty, TestOutput (
+ [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+ ["mkfs"; "ext2"; "/dev/sda1"];
+ ["mount"; "/dev/sda1"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "make a filesystem",
+ "\
+This creates a filesystem on C<device> (usually a partition
+of LVM logical volume). The filesystem type is C<fstype>, for
+example C<ext3>.");
+
+ ("sfdisk", (RErr, [String "device";
+ Int "cyls"; Int "heads"; Int "sectors";
+ StringList "lines"]), 43, [DangerWillRobinson],
+ [],
+ "create partitions on a block device",
+ "\
+This is a direct interface to the L<sfdisk(8)> program for creating
+partitions on block devices.
+
+C<device> should be a block device, for example C</dev/sda>.
+
+C<cyls>, C<heads> and C<sectors> are the number of cylinders, heads
+and sectors on the device, which are passed directly to sfdisk as
+the I<-C>, I<-H> and I<-S> parameters. If you pass C<0> for any
+of these, then the corresponding parameter is omitted. Usually for
+'large' disks, you can just pass C<0> for these, but for small
+(floppy-sized) disks, sfdisk (or rather, the kernel) cannot work
+out the right geometry and you will need to tell it.
+
+C<lines> is a list of lines that we feed to C<sfdisk>. For more
+information refer to the L<sfdisk(8)> manpage.
+
+To create a single partition occupying the whole disk, you would
+pass C<lines> as a single element list, when the single element being
+the string C<,> (comma).");
+
+ ("write_file", (RErr, [String "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning],
+ [InitEmpty, TestOutput (
+ [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+ ["mkfs"; "ext2"; "/dev/sda1"];
+ ["mount"; "/dev/sda1"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "create a file",
+ "\
+This call creates a file called C<path>. The contents of the
+file is the string C<content> (which can contain any 8 bit data),
+with length C<size>.
+
+As a special case, if C<size> is C<0>
+then the length is calculated using C<strlen> (so in this case
+the content cannot contain embedded ASCII NULs).");
+
+ ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"],
+ [InitEmpty, TestOutputList (
+ [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+ ["mkfs"; "ext2"; "/dev/sda1"];
+ ["mount"; "/dev/sda1"; "/"];
+ ["mounts"]], ["/dev/sda1"]);
+ InitEmpty, TestOutputList (
+ [["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+ ["mkfs"; "ext2"; "/dev/sda1"];
+ ["mount"; "/dev/sda1"; "/"];
+ ["umount"; "/"];
+ ["mounts"]], [])],
+ "unmount a filesystem",
+ "\
+This unmounts the given filesystem. The filesystem may be
+specified either by its mountpoint (path) or the device which
+contains the filesystem.");
+
+ ("mounts", (RStringList "devices", []), 46, [],
+ [InitBasicFS, TestOutputList (
+ [["mounts"]], ["/dev/sda1"])],
+ "show mounted filesystems",
+ "\
+This returns the list of currently mounted filesystems. It returns
+the list of devices (eg. C</dev/sda1>, C</dev/VG/LV>).
+
+Some internal mounts are not shown.");
+
+ ("umount_all", (RErr, []), 47, [FishAlias "unmount-all"],
+ [InitBasicFS, TestOutputList (
+ [["umount_all"];
+ ["mounts"]], [])],
+ "unmount all filesystems",
+ "\
+This unmounts all mounted filesystems.
+
+Some internal mounts are not unmounted by this call.");
+
+ ("lvm_remove_all", (RErr, []), 48, [DangerWillRobinson],
+ [],
+ "remove all LVM LVs, VGs and PVs",
+ "\
+This command removes all LVM logical volumes, volume groups
+and physical volumes.");
+
]
let all_functions = non_daemon_functions @ daemon_functions
s' ^ s2 ^ replace_str s'' s1 s2
)
+let rec string_split sep str =
+ let len = String.length str in
+ let seplen = String.length sep in
+ let i = find str sep in
+ if i = -1 then [str]
+ else (
+ let s' = String.sub str 0 i in
+ let s'' = String.sub str (i+seplen) (len-i-seplen) in
+ s' :: string_split sep s''
+ )
+
let rec find_map f = function
| [] -> raise Not_found
| x :: xs ->
in
loop 0 xs
-let name_of_argt = function String n | OptString n | Bool n | Int n -> n
+let mapi f xs =
+ let rec loop i = function
+ | [] -> []
+ | x :: xs -> let r = f i x in r :: loop (i+1) xs
+ in
+ loop 0 xs
+
+let name_of_argt = function
+ | String n | OptString n | StringList n | Bool n | Int n -> n
(* Check function names etc. for consistency. *)
let check_functions () =
List.iter (fun arg -> check_arg_ret_name (name_of_argt arg)) (snd style)
) all_functions;
+ (* Check short descriptions. *)
+ List.iter (
+ fun (name, _, _, _, _, shortdesc, _) ->
+ if shortdesc.[0] <> Char.lowercase shortdesc.[0] then
+ failwithf "short description of %s should begin with lowercase." name;
+ let c = shortdesc.[String.length shortdesc-1] in
+ if c = '\n' || c = '.' then
+ failwithf "short description of %s should not end with . or \\n." name
+ ) all_functions;
+
(* Check long dscriptions. *)
List.iter (
fun (name, _, _, _, _, _, longdesc) ->
I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
);
if List.mem ProtocolLimitWarning flags then
- pr "Because of the message protocol, there is a transfer limit
-of somewhere between 2MB and 4MB. To transfer large files you should use
-FTP.\n\n";
+ pr "%s\n\n" protocol_limit_warning;
+ if List.mem DangerWillRobinson flags then
+ pr "%s\n\n" danger_will_robinson;
) all_functions_sorted
and generate_structs_pod () =
function
| String n -> pr " string %s<>;\n" n
| OptString n -> pr " str *%s;\n" n
+ | StringList n -> pr " str %s<>;\n" n
| Bool n -> pr " bool %s;\n" n
| Int n -> pr " int %s;\n" n
) args;
pr " args.%s = (char *) %s;\n" n n
| OptString n ->
pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
+ | StringList n ->
+ pr " args.%s.%s_val = (char **) %s;\n" n n n;
+ pr " for (args.%s.%s_len = 0; %s[args.%s.%s_len]; args.%s.%s_len++) ;\n" n n n n n n n;
| Bool n ->
pr " args.%s = %s;\n" n n
| Int n ->
function
| String n
| OptString n -> pr " const char *%s;\n" n
+ | StringList n -> pr " char **%s;\n" n
| Bool n -> pr " int %s;\n" n
| Int n -> pr " int %s;\n" n
) args
function
| String n -> pr " %s = args.%s;\n" n n
| OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
+ | StringList n ->
+ pr " args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
+ pr " args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
+ pr " %s = args.%s.%s_val;\n" n n n
| Bool n -> pr " %s = args.%s;\n" n n
| Int n -> pr " %s = args.%s;\n" n n
) args;
pr ";\n";
pr " if (r == %s)\n" error_code;
- pr " /* do_%s has already called reply_with_error, so just return */\n" name;
- pr " return;\n";
+ pr " /* do_%s has already called reply_with_error */\n" name;
+ pr " goto done;\n";
pr "\n";
(match fst style with
pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
);
+ (* Free the args. *)
+ (match snd style with
+ | [] ->
+ pr "done: ;\n";
+ | _ ->
+ pr "done:\n";
+ pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_args, (char *) &args);\n"
+ name
+ );
+
pr "}\n\n";
) daemon_functions;
and generate_tests () =
generate_header CStyle GPLv2;
- pr "#include <stdio.h>\n";
- pr "#include <stdlib.h>\n";
- pr "#include <string.h>\n";
- pr "\n";
- pr "#include \"guestfs.h\"\n";
+ pr "\
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+#include <sys/types.h>
+#include <fcntl.h>
+
+#include \"guestfs.h\"
+
+static guestfs_h *g;
+static int suppress_error = 0;
+
+static void print_error (guestfs_h *g, void *data, const char *msg)
+{
+ if (!suppress_error)
+ fprintf (stderr, \"%%s\\n\", msg);
+}
+
+static void print_strings (char * const * const argv)
+{
+ int argc;
+
+ for (argc = 0; argv[argc] != NULL; ++argc)
+ printf (\"\\t%%s\\n\", argv[argc]);
+}
+
+";
+
+ let test_names =
+ List.map (
+ fun (name, _, _, _, tests, _, _) ->
+ mapi (generate_one_test name) tests
+ ) all_functions in
+ let test_names = List.concat test_names in
+ let nr_tests = List.length test_names in
+
+ pr "\
+int main (int argc, char *argv[])
+{
+ char c = 0;
+ int failed = 0;
+ const char *srcdir;
+ int fd;
+ char buf[256];
+
+ g = guestfs_create ();
+ if (g == NULL) {
+ printf (\"guestfs_create FAILED\\n\");
+ exit (1);
+ }
+
+ guestfs_set_error_handler (g, print_error, NULL);
+
+ srcdir = getenv (\"srcdir\");
+ if (!srcdir) srcdir = \".\";
+ guestfs_set_path (g, srcdir);
+
+ snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);
+ fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
+ if (fd == -1) {
+ perror (buf);
+ exit (1);
+ }
+ if (lseek (fd, %d, SEEK_SET) == -1) {
+ perror (\"lseek\");
+ close (fd);
+ unlink (buf);
+ exit (1);
+ }
+ if (write (fd, &c, 1) == -1) {
+ perror (\"write\");
+ close (fd);
+ unlink (buf);
+ exit (1);
+ }
+ if (close (fd) == -1) {
+ perror (buf);
+ unlink (buf);
+ exit (1);
+ }
+ if (guestfs_add_drive (g, buf) == -1) {
+ printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
+ exit (1);
+ }
+
+ snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);
+ fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
+ if (fd == -1) {
+ perror (buf);
+ exit (1);
+ }
+ if (lseek (fd, %d, SEEK_SET) == -1) {
+ perror (\"lseek\");
+ close (fd);
+ unlink (buf);
+ exit (1);
+ }
+ if (write (fd, &c, 1) == -1) {
+ perror (\"write\");
+ close (fd);
+ unlink (buf);
+ exit (1);
+ }
+ if (close (fd) == -1) {
+ perror (buf);
+ unlink (buf);
+ exit (1);
+ }
+ if (guestfs_add_drive (g, buf) == -1) {
+ printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
+ exit (1);
+ }
+
+ snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);
+ fd = open (buf, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
+ if (fd == -1) {
+ perror (buf);
+ exit (1);
+ }
+ if (lseek (fd, %d, SEEK_SET) == -1) {
+ perror (\"lseek\");
+ close (fd);
+ unlink (buf);
+ exit (1);
+ }
+ if (write (fd, &c, 1) == -1) {
+ perror (\"write\");
+ close (fd);
+ unlink (buf);
+ exit (1);
+ }
+ if (close (fd) == -1) {
+ perror (buf);
+ unlink (buf);
+ exit (1);
+ }
+ if (guestfs_add_drive (g, buf) == -1) {
+ printf (\"guestfs_add_drive %%s FAILED\\n\", buf);
+ exit (1);
+ }
+
+ if (guestfs_launch (g) == -1) {
+ printf (\"guestfs_launch FAILED\\n\");
+ exit (1);
+ }
+ if (guestfs_wait_ready (g) == -1) {
+ printf (\"guestfs_wait_ready FAILED\\n\");
+ exit (1);
+ }
+
+" (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024);
+
+ iteri (
+ fun i test_name ->
+ pr " printf (\"%3d/%3d %s\\n\");\n" (i+1) nr_tests test_name;
+ pr " if (%s () == -1) {\n" test_name;
+ pr " printf (\"%s FAILED\\n\");\n" test_name;
+ pr " failed++;\n";
+ pr " }\n";
+ ) test_names;
pr "\n";
+ pr " guestfs_close (g);\n";
+ pr " snprintf (buf, sizeof buf, \"%%s/test1.img\", srcdir);\n";
+ pr " unlink (buf);\n";
+ pr " snprintf (buf, sizeof buf, \"%%s/test2.img\", srcdir);\n";
+ pr " unlink (buf);\n";
+ pr " snprintf (buf, sizeof buf, \"%%s/test3.img\", srcdir);\n";
+ pr " unlink (buf);\n";
+ pr "\n";
+ pr " if (failed > 0) {\n";
+ pr " printf (\"***** %%d / %d tests FAILED *****\\n\", failed);\n"
+ nr_tests;
+ pr " exit (1);\n";
+ pr " }\n";
+ pr "\n";
- pr "int main (int argc, char *argv[])\n";
- pr "{\n";
pr " exit (0);\n";
pr "}\n"
+and generate_one_test name i (init, test) =
+ let test_name = sprintf "test_%s_%d" name i in
+
+ pr "static int %s (void)\n" test_name;
+ pr "{\n";
+
+ (match init with
+ | InitNone -> ()
+ | InitEmpty ->
+ pr " /* InitEmpty for %s (%d) */\n" name i;
+ List.iter (generate_test_command_call test_name)
+ [["umount_all"];
+ ["lvm_remove_all"]]
+ | InitBasicFS ->
+ pr " /* InitBasicFS for %s (%d): create ext2 on /dev/sda1 */\n" name i;
+ List.iter (generate_test_command_call test_name)
+ [["umount_all"];
+ ["lvm_remove_all"];
+ ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+ ["mkfs"; "ext2"; "/dev/sda1"];
+ ["mount"; "/dev/sda1"; "/"]]
+ | InitBasicFSonLVM ->
+ pr " /* InitBasicFSonLVM for %s (%d): create ext2 on /dev/VG/LV */\n"
+ name i;
+ List.iter (generate_test_command_call test_name)
+ [["umount_all"];
+ ["lvm_remove_all"];
+ ["sfdisk"; "/dev/sda"; "0"; "0"; "0"; ","];
+ ["pvcreate"; "/dev/sda1"];
+ ["vgcreate"; "VG"; "/dev/sda1"];
+ ["lvcreate"; "LV"; "VG"; "8"];
+ ["mkfs"; "ext2"; "/dev/VG/LV"];
+ ["mount"; "/dev/VG/LV"; "/"]]
+ );
+
+ let get_seq_last = function
+ | [] ->
+ failwithf "%s: you cannot use [] (empty list) when expecting a command"
+ test_name
+ | seq ->
+ let seq = List.rev seq in
+ List.rev (List.tl seq), List.hd seq
+ in
+
+ (match test with
+ | TestRun seq ->
+ pr " /* TestRun for %s (%d) */\n" name i;
+ List.iter (generate_test_command_call test_name) seq
+ | TestOutput (seq, expected) ->
+ pr " /* TestOutput for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ let test () =
+ pr " if (strcmp (r, \"%s\") != 0) {\n" (c_quote expected);
+ pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r);\n" test_name (c_quote expected);
+ pr " return -1;\n";
+ pr " }\n"
+ in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call ~test test_name last
+ | TestOutputList (seq, expected) ->
+ pr " /* TestOutputList for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ let test () =
+ iteri (
+ fun i str ->
+ pr " if (!r[%d]) {\n" i;
+ pr " fprintf (stderr, \"%s: short list returned from command\\n\");\n" test_name;
+ pr " print_strings (r);\n";
+ pr " return -1;\n";
+ pr " }\n";
+ pr " if (strcmp (r[%d], \"%s\") != 0) {\n" i (c_quote str);
+ pr " fprintf (stderr, \"%s: expected \\\"%s\\\" but got \\\"%%s\\\"\\n\", r[%d]);\n" test_name (c_quote str) i;
+ pr " return -1;\n";
+ pr " }\n"
+ ) expected;
+ pr " if (r[%d] != NULL) {\n" (List.length expected);
+ pr " fprintf (stderr, \"%s: extra elements returned from command\\n\");\n"
+ test_name;
+ pr " print_strings (r);\n";
+ pr " return -1;\n";
+ pr " }\n"
+ in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call ~test test_name last
+ | TestOutputInt (seq, expected) ->
+ pr " /* TestOutputInt for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ let test () =
+ pr " if (r != %d) {\n" expected;
+ pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\", r);\n"
+ test_name expected;
+ pr " return -1;\n";
+ pr " }\n"
+ in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call ~test test_name last
+ | TestOutputTrue seq ->
+ pr " /* TestOutputTrue for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ let test () =
+ pr " if (!r) {\n";
+ pr " fprintf (stderr, \"%s: expected true, got false\\n\");\n"
+ test_name;
+ pr " return -1;\n";
+ pr " }\n"
+ in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call ~test test_name last
+ | TestOutputFalse seq ->
+ pr " /* TestOutputFalse for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ let test () =
+ pr " if (r) {\n";
+ pr " fprintf (stderr, \"%s: expected false, got true\\n\");\n"
+ test_name;
+ pr " return -1;\n";
+ pr " }\n"
+ in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call ~test test_name last
+ | TestOutputLength (seq, expected) ->
+ pr " /* TestOutputLength for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ let test () =
+ pr " int j;\n";
+ pr " for (j = 0; j < %d; ++j)\n" expected;
+ pr " if (r[j] == NULL) {\n";
+ pr " fprintf (stderr, \"%s: short list returned\\n\");\n"
+ test_name;
+ pr " print_strings (r);\n";
+ pr " return -1;\n";
+ pr " }\n";
+ pr " if (r[j] != NULL) {\n";
+ pr " fprintf (stderr, \"%s: long list returned\\n\");\n"
+ test_name;
+ pr " print_strings (r);\n";
+ pr " return -1;\n";
+ pr " }\n"
+ in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call ~test test_name last
+ | TestLastFail seq ->
+ pr " /* TestLastFail for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ List.iter (generate_test_command_call test_name) seq;
+ generate_test_command_call test_name ~expect_error:true last
+ );
+
+ pr " return 0;\n";
+ pr "}\n";
+ pr "\n";
+ test_name
+
+(* Generate the code to run a command, leaving the result in 'r'.
+ * If you expect to get an error then you should set expect_error:true.
+ *)
+and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
+ match cmd with
+ | [] -> assert false
+ | name :: args ->
+ (* Look up the command to find out what args/ret it has. *)
+ let style =
+ try
+ let _, style, _, _, _, _, _ =
+ List.find (fun (n, _, _, _, _, _, _) -> n = name) all_functions in
+ style
+ with Not_found ->
+ failwithf "%s: in test, command %s was not found" test_name name in
+
+ if List.length (snd style) <> List.length args then
+ failwithf "%s: in test, wrong number of args given to %s"
+ test_name name;
+
+ pr " {\n";
+
+ List.iter (
+ function
+ | String _, _
+ | OptString _, _
+ | Int _, _
+ | Bool _, _ -> ()
+ | StringList n, arg ->
+ pr " char *%s[] = {\n" n;
+ let strs = string_split " " arg in
+ List.iter (
+ fun str -> pr " \"%s\",\n" (c_quote str)
+ ) strs;
+ pr " NULL\n";
+ pr " };\n";
+ ) (List.combine (snd style) args);
+
+ let error_code =
+ match fst style with
+ | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
+ | RConstString _ -> pr " const char *r;\n"; "NULL"
+ | RString _ -> pr " char *r;\n"; "NULL"
+ | RStringList _ ->
+ pr " char **r;\n";
+ pr " int i;\n";
+ "NULL"
+ | RIntBool _ ->
+ pr " struct guestfs_int_bool *r;\n";
+ "NULL"
+ | RPVList _ ->
+ pr " struct guestfs_lvm_pv_list *r;\n";
+ "NULL"
+ | RVGList _ ->
+ pr " struct guestfs_lvm_vg_list *r;\n";
+ "NULL"
+ | RLVList _ ->
+ pr " struct guestfs_lvm_lv_list *r;\n";
+ "NULL" in
+
+ pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
+ pr " r = guestfs_%s (g" name;
+
+ (* Generate the parameters. *)
+ List.iter (
+ function
+ | String _, arg -> pr ", \"%s\"" (c_quote arg)
+ | OptString _, arg ->
+ if arg = "NULL" then pr ", NULL" else pr ", \"%s\"" (c_quote arg)
+ | StringList n, _ ->
+ pr ", %s" n
+ | Int _, arg ->
+ let i =
+ try int_of_string arg
+ with Failure "int_of_string" ->
+ failwithf "%s: expecting an int, but got '%s'" test_name arg in
+ pr ", %d" i
+ | Bool _, arg ->
+ let b = bool_of_string arg in pr ", %d" (if b then 1 else 0)
+ ) (List.combine (snd style) args);
+
+ pr ");\n";
+ if not expect_error then
+ pr " if (r == %s)\n" error_code
+ else
+ pr " if (r != %s)\n" error_code;
+ pr " return -1;\n";
+
+ (* Insert the test code. *)
+ (match test with
+ | None -> ()
+ | Some f -> f ()
+ );
+
+ (match fst style with
+ | RErr | RInt _ | RBool _ | RConstString _ -> ()
+ | RString _ -> pr " free (r);\n"
+ | RStringList _ ->
+ pr " for (i = 0; r[i] != NULL; ++i)\n";
+ pr " free (r[i]);\n";
+ pr " free (r);\n"
+ | RIntBool _ ->
+ pr " guestfs_free_int_bool (r);\n"
+ | RPVList _ ->
+ pr " guestfs_free_lvm_pv_list (r);\n"
+ | RVGList _ ->
+ pr " guestfs_free_lvm_vg_list (r);\n"
+ | RLVList _ ->
+ pr " guestfs_free_lvm_lv_list (r);\n"
+ );
+
+ pr " }\n"
+
+and c_quote str =
+ let str = replace_str str "\r" "\\r" in
+ let str = replace_str str "\n" "\\n" in
+ let str = replace_str str "\t" "\\t" in
+ str
+
(* Generate a lot of different functions for guestfish. *)
and generate_fish_cmds () =
generate_header CStyle GPLv2;
let warnings =
if List.mem ProtocolLimitWarning flags then
- "\n\nBecause of the message protocol, there is a transfer limit
-of somewhere between 2MB and 4MB. To transfer large files you should use
-FTP."
+ ("\n\n" ^ protocol_limit_warning)
else "" in
+ (* For DangerWillRobinson commands, we should probably have
+ * guestfish prompt before allowing you to use them (especially
+ * in interactive mode). XXX
+ *)
+ let warnings =
+ warnings ^
+ if List.mem DangerWillRobinson flags then
+ ("\n\n" ^ danger_will_robinson)
+ else "" in
+
let describe_alias =
if name <> alias then
sprintf "\n\nYou can use '%s' as an alias for this command." alias
);
List.iter (
function
- | String n -> pr " const char *%s;\n" n
+ | String n
| OptString n -> pr " const char *%s;\n" n
+ | StringList n -> pr " char **%s;\n" n
| Bool n -> pr " int %s;\n" n
| Int n -> pr " int %s;\n" n
) (snd style);
| OptString name ->
pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
name i i
+ | StringList name ->
+ pr " %s = parse_string_list (argv[%d]);\n" name i
| Bool name ->
pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i
| Int name ->
function
| String n -> pr " %s" n
| OptString n -> pr " %s" n
+ | StringList n -> pr " %s,..." n
| Bool _ -> pr " true|false"
| Int n -> pr " %s" n
) (snd style);
pr "\n";
pr "\n";
- pr "%s\n\n" longdesc
+ pr "%s\n\n" longdesc;
+
+ if List.mem ProtocolLimitWarning flags then
+ pr "%s\n\n" protocol_limit_warning;
+
+ if List.mem DangerWillRobinson flags then
+ pr "%s\n\n" danger_will_robinson
) all_functions_sorted
(* Generate a C function prototype. *)
function
| String n -> next (); pr "const char *%s" n
| OptString n -> next (); pr "const char *%s" n
+ | StringList n -> next (); pr "char * const* const %s" n
| Bool n -> next (); pr "int %s" n
| Int n -> next (); pr "int %s" n
) (snd style);
if !comma then pr ", ";
comma := true;
match arg with
- | String n -> pr "%s" n
- | OptString n -> pr "%s" n
- | Bool n -> pr "%s" n
+ | String n
+ | OptString n
+ | StringList n
+ | Bool n
| Int n -> pr "%s" n
) (snd style);
pr ")"
List.iter (
fun (name, style, _, _, _, _, _) ->
+ let params =
+ "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in
+
pr "CAMLprim value\n";
- pr "ocaml_guestfs_%s (value gv" name;
- List.iter (
- fun arg -> pr ", value %sv" (name_of_argt arg)
- ) (snd style);
+ pr "ocaml_guestfs_%s (value %s" name (List.hd params);
+ List.iter (pr ", value %s") (List.tl params);
pr ")\n";
pr "{\n";
- pr " CAMLparam%d (gv" (1 + (List.length (snd style)));
- List.iter (
- fun arg -> pr ", %sv" (name_of_argt arg)
- ) (snd style);
- pr ");\n";
+
+ (match params with
+ | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
+ pr " CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
+ pr " CAMLxparam%d (%s);\n"
+ (List.length rest) (String.concat ", " rest)
+ | ps ->
+ pr " CAMLparam%d (%s);\n" (List.length ps) (String.concat ", " ps)
+ );
pr " CAMLlocal1 (rv);\n";
pr "\n";
pr " const char *%s =\n" n;
pr " %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
n n
+ | StringList n ->
+ pr " char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
| Bool n ->
pr " int %s = Bool_val (%sv);\n" n n
| Int n ->
generate_call_args ~handle:"g" style;
pr ";\n";
pr " caml_leave_blocking_section ();\n";
+
+ List.iter (
+ function
+ | StringList n ->
+ pr " ocaml_guestfs_free_strings (%s);\n" n;
+ | String _ | OptString _ | Bool _ | Int _ -> ()
+ ) (snd style);
+
pr " if (r == %s)\n" error_code;
pr " ocaml_guestfs_raise_error (g, \"%s\");\n" name;
pr "\n";
pr " CAMLreturn (rv);\n";
pr "}\n";
- pr "\n"
+ pr "\n";
+
+ if List.length params > 5 then (
+ pr "CAMLprim value\n";
+ pr "ocaml_guestfs_%s_byte (value *argv, int argn)\n" name;
+ pr "{\n";
+ pr " return ocaml_guestfs_%s (argv[0]" name;
+ iteri (fun i _ -> pr ", argv[%d]" i) (List.tl params);
+ pr ");\n";
+ pr "}\n";
+ pr "\n"
+ )
) all_functions
and generate_ocaml_lvm_structure_decls () =
function
| String _ -> pr "string -> "
| OptString _ -> pr "string option -> "
+ | StringList _ -> pr "string array -> "
| Bool _ -> pr "bool -> "
| Int _ -> pr "int -> "
) (snd style);
| RVGList _ -> pr "lvm_vg array"
| RLVList _ -> pr "lvm_lv array"
);
- if is_external then pr " = \"ocaml_guestfs_%s\"" name;
+ if is_external then (
+ pr " = ";
+ if List.length (snd style) + 1 > 5 then
+ pr "\"ocaml_guestfs_%s_byte\" " name;
+ pr "\"ocaml_guestfs_%s\"" name
+ );
pr "\n"
(* Generate Perl xs code, a sort of crazy variation of C with macros. *)
#endif
}
-/* XXX Not thread-safe, and in general not safe if the caller is
- * issuing multiple requests in parallel (on different guestfs
- * handles). We should use the guestfs_h handle passed to the
- * error handle to distinguish these cases.
- */
-static char *last_error = NULL;
+/* http://www.perlmonks.org/?node_id=680842 */
+static char **
+XS_unpack_charPtrPtr (SV *arg) {
+ char **ret;
+ AV *av;
+ I32 i;
-static void
-error_handler (guestfs_h *g,
- void *data,
- const char *msg)
-{
- if (last_error != NULL) free (last_error);
- last_error = strdup (msg);
+ if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
+ croak (\"array reference expected\");
+ }
+
+ av = (AV *)SvRV (arg);
+ ret = (char **)malloc (av_len (av) + 1 + 1);
+
+ for (i = 0; i <= av_len (av); i++) {
+ SV **elem = av_fetch (av, i, 0);
+
+ if (!elem || !*elem)
+ croak (\"missing element in list\");
+
+ ret[i] = SvPV_nolen (*elem);
+ }
+
+ ret[i] = NULL;
+
+ return ret;
}
MODULE = Sys::Guestfs PACKAGE = Sys::Guestfs
RETVAL = guestfs_create ();
if (!RETVAL)
croak (\"could not create guestfs handle\");
- guestfs_set_error_handler (RETVAL, error_handler, NULL);
+ guestfs_set_error_handler (RETVAL, NULL, NULL);
OUTPUT:
RETVAL
function
| String n -> pr " char *%s;\n" n
| OptString n -> pr " char *%s;\n" n
+ | StringList n -> pr " char **%s;\n" n
| Bool n -> pr " int %s;\n" n
| Int n -> pr " int %s;\n" n
) (snd style);
+
+ let do_cleanups () =
+ List.iter (
+ function
+ | String _
+ | OptString _
+ | Bool _
+ | Int _ -> ()
+ | StringList n -> pr " free (%s);\n" n
+ ) (snd style)
+ in
+
(* Code. *)
(match fst style with
| RErr ->
pr " PPCODE:\n";
pr " if (guestfs_%s " name;
generate_call_args ~handle:"g" style;
- pr " == -1)\n";
- pr " croak (\"%s: %%s\", last_error);\n" name
+ pr " == -1) {\n";
+ do_cleanups ();
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " }\n"
| RInt n
| RBool n ->
pr "PREINIT:\n";
pr " %s = guestfs_%s " n name;
generate_call_args ~handle:"g" style;
pr ";\n";
- pr " if (%s == -1)\n" n;
- pr " croak (\"%s: %%s\", last_error);\n" name;
+ pr " if (%s == -1) {\n" n;
+ do_cleanups ();
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " }\n";
pr " RETVAL = newSViv (%s);\n" n;
pr " OUTPUT:\n";
pr " RETVAL\n"
pr " %s = guestfs_%s " n name;
generate_call_args ~handle:"g" style;
pr ";\n";
- pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", last_error);\n" name;
+ pr " if (%s == NULL) {\n" n;
+ do_cleanups ();
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " }\n";
pr " RETVAL = newSVpv (%s, 0);\n" n;
pr " OUTPUT:\n";
pr " RETVAL\n"
pr " %s = guestfs_%s " n name;
generate_call_args ~handle:"g" style;
pr ";\n";
- pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", last_error);\n" name;
+ pr " if (%s == NULL) {\n" n;
+ do_cleanups ();
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " }\n";
pr " RETVAL = newSVpv (%s, 0);\n" n;
pr " free (%s);\n" n;
pr " OUTPUT:\n";
pr " %s = guestfs_%s " n name;
generate_call_args ~handle:"g" style;
pr ";\n";
- pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", last_error);\n" name;
+ pr " if (%s == NULL) {\n" n;
+ do_cleanups ();
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " }\n";
pr " for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
pr " EXTEND (SP, n);\n";
pr " for (i = 0; i < n; ++i) {\n";
pr " r = guestfs_%s " name;
generate_call_args ~handle:"g" style;
pr ";\n";
- pr " if (r == NULL)\n";
- pr " croak (\"%s: %%s\", last_error);\n" name;
+ pr " if (r == NULL) {\n";
+ do_cleanups ();
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " }\n";
pr " EXTEND (SP, 2);\n";
pr " PUSHs (sv_2mortal (newSViv (r->i)));\n";
pr " PUSHs (sv_2mortal (newSViv (r->b)));\n";
| RLVList n ->
generate_perl_lvm_code "lv" lv_cols name style n;
);
+
+ do_cleanups ();
+
pr "\n"
) all_functions
generate_call_args ~handle:"g" style;
pr ";\n";
pr " if (%s == NULL)\n" n;
- pr " croak (\"%s: %%s\", last_error);\n" name;
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
pr " EXTEND (SP, %s->len);\n" n;
pr " for (i = 0; i < %s->len; ++i) {\n" n;
pr " hv = newHV ();\n";
pr "\n\n";
pr "%s\n\n" longdesc;
if List.mem ProtocolLimitWarning flags then
- pr "Because of the message protocol, there is a transfer limit
-of somewhere between 2MB and 4MB. To transfer large files you should use
-FTP.\n\n";
+ pr "%s\n\n" protocol_limit_warning;
+ if List.mem DangerWillRobinson flags then
+ pr "%s\n\n" danger_will_robinson
) all_functions_sorted;
(* End of file. *)
fun arg ->
if !comma then pr ", ";
comma := true;
- pr "%s" (name_of_argt arg)
+ match arg with
+ | String n | OptString n | Bool n | Int n ->
+ pr "$%s" n
+ | StringList n ->
+ pr "\\@%s" n
) (snd style);
pr ");"
+(* Generate Python C module. *)
+and generate_python_c () =
+ generate_header CStyle LGPLv2;
+
+ pr "\
+#include <stdio.h>
+#include <stdlib.h>
+#include <assert.h>
+
+#include <Python.h>
+
+#include \"guestfs.h\"
+
+typedef struct {
+ PyObject_HEAD
+ guestfs_h *g;
+} Pyguestfs_Object;
+
+static guestfs_h *
+get_handle (PyObject *obj)
+{
+ assert (obj);
+ assert (obj != Py_None);
+ return ((Pyguestfs_Object *) obj)->g;
+}
+
+static PyObject *
+put_handle (guestfs_h *g)
+{
+ assert (g);
+ return
+ PyCObject_FromVoidPtrAndDesc ((void *) g, (char *) \"guestfs_h\", NULL);
+}
+
+/* This list should be freed (but not the strings) after use. */
+static const char **
+get_string_list (PyObject *obj)
+{
+ int i, len;
+ const char **r;
+
+ assert (obj);
+
+ if (!PyList_Check (obj)) {
+ PyErr_SetString (PyExc_RuntimeError, \"expecting a list parameter\");
+ return NULL;
+ }
+
+ len = PyList_Size (obj);
+ r = malloc (sizeof (char *) * (len+1));
+ if (r == NULL) {
+ PyErr_SetString (PyExc_RuntimeError, \"get_string_list: out of memory\");
+ return NULL;
+ }
+
+ for (i = 0; i < len; ++i)
+ r[i] = PyString_AsString (PyList_GetItem (obj, i));
+ r[len] = NULL;
+
+ return r;
+}
+
+static PyObject *
+put_string_list (char * const * const argv)
+{
+ PyObject *list;
+ int argc, i;
+
+ for (argc = 0; argv[argc] != NULL; ++argc)
+ ;
+
+ list = PyList_New (argc);
+ for (i = 0; i < argc; ++i)
+ PyList_SetItem (list, i, PyString_FromString (argv[i]));
+
+ return list;
+}
+
+static void
+free_strings (char **argv)
+{
+ int argc;
+
+ for (argc = 0; argv[argc] != NULL; ++argc)
+ free (argv[argc]);
+ free (argv);
+}
+
+static PyObject *
+py_guestfs_create (PyObject *self, PyObject *args)
+{
+ guestfs_h *g;
+
+ g = guestfs_create ();
+ if (g == NULL) {
+ PyErr_SetString (PyExc_RuntimeError,
+ \"guestfs.create: failed to allocate handle\");
+ return NULL;
+ }
+ guestfs_set_error_handler (g, NULL, NULL);
+ return put_handle (g);
+}
+
+static PyObject *
+py_guestfs_close (PyObject *self, PyObject *args)
+{
+ PyObject *py_g;
+ guestfs_h *g;
+
+ if (!PyArg_ParseTuple (args, (char *) \"O:guestfs_close\", &py_g))
+ return NULL;
+ g = get_handle (py_g);
+
+ guestfs_close (g);
+
+ Py_INCREF (Py_None);
+ return Py_None;
+}
+
+";
+
+ (* LVM structures, turned into Python dictionaries. *)
+ List.iter (
+ fun (typ, cols) ->
+ pr "static PyObject *\n";
+ pr "put_lvm_%s (struct guestfs_lvm_%s *%s)\n" typ typ typ;
+ pr "{\n";
+ pr " PyObject *dict;\n";
+ pr "\n";
+ pr " dict = PyDict_New ();\n";
+ List.iter (
+ function
+ | name, `String ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyString_FromString (%s->%s));\n"
+ typ name
+ | name, `UUID ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyString_FromStringAndSize (%s->%s, 32));\n"
+ typ name
+ | name, `Bytes ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyLong_FromUnsignedLongLong (%s->%s));\n"
+ typ name
+ | name, `Int ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyLong_FromLongLong (%s->%s));\n"
+ typ name
+ | name, `OptPercent ->
+ pr " if (%s->%s >= 0)\n" typ name;
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyFloat_FromDouble ((double) %s->%s));\n"
+ typ name;
+ pr " else {\n";
+ pr " Py_INCREF (Py_None);\n";
+ pr " PyDict_SetItemString (dict, \"%s\", Py_None);" name;
+ pr " }\n"
+ ) cols;
+ pr " return dict;\n";
+ pr "};\n";
+ pr "\n";
+
+ pr "static PyObject *\n";
+ pr "put_lvm_%s_list (struct guestfs_lvm_%s_list *%ss)\n" typ typ typ;
+ pr "{\n";
+ pr " PyObject *list;\n";
+ pr " int i;\n";
+ pr "\n";
+ pr " list = PyList_New (%ss->len);\n" typ;
+ pr " for (i = 0; i < %ss->len; ++i)\n" typ;
+ pr " PyList_SetItem (list, i, put_lvm_%s (&%ss->val[i]));\n" typ typ;
+ pr " return list;\n";
+ pr "};\n";
+ pr "\n"
+ ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
+
+ (* Python wrapper functions. *)
+ List.iter (
+ fun (name, style, _, _, _, _, _) ->
+ pr "static PyObject *\n";
+ pr "py_guestfs_%s (PyObject *self, PyObject *args)\n" name;
+ pr "{\n";
+
+ pr " PyObject *py_g;\n";
+ pr " guestfs_h *g;\n";
+ pr " PyObject *py_r;\n";
+
+ let error_code =
+ match fst style with
+ | RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
+ | RConstString _ -> pr " const char *r;\n"; "NULL"
+ | RString _ -> pr " char *r;\n"; "NULL"
+ | RStringList _ -> pr " char **r;\n"; "NULL"
+ | RIntBool _ -> pr " struct guestfs_int_bool *r;\n"; "NULL"
+ | RPVList n -> pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
+ | RVGList n -> pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
+ | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL" in
+
+ List.iter (
+ function
+ | String n -> pr " const char *%s;\n" n
+ | OptString n -> pr " const char *%s;\n" n
+ | StringList n ->
+ pr " PyObject *py_%s;\n" n;
+ pr " const char **%s;\n" n
+ | Bool n -> pr " int %s;\n" n
+ | Int n -> pr " int %s;\n" n
+ ) (snd style);
+
+ pr "\n";
+
+ (* Convert the parameters. *)
+ pr " if (!PyArg_ParseTuple (args, (char *) \"O";
+ List.iter (
+ function
+ | String _ -> pr "s"
+ | OptString _ -> pr "z"
+ | StringList _ -> pr "O"
+ | Bool _ -> pr "i" (* XXX Python has booleans? *)
+ | Int _ -> pr "i"
+ ) (snd style);
+ pr ":guestfs_%s\",\n" name;
+ pr " &py_g";
+ List.iter (
+ function
+ | String n -> pr ", &%s" n
+ | OptString n -> pr ", &%s" n
+ | StringList n -> pr ", &py_%s" n
+ | Bool n -> pr ", &%s" n
+ | Int n -> pr ", &%s" n
+ ) (snd style);
+
+ pr "))\n";
+ pr " return NULL;\n";
+
+ pr " g = get_handle (py_g);\n";
+ List.iter (
+ function
+ | String _ | OptString _ | Bool _ | Int _ -> ()
+ | StringList n ->
+ pr " %s = get_string_list (py_%s);\n" n n;
+ pr " if (!%s) return NULL;\n" n
+ ) (snd style);
+
+ pr "\n";
+
+ pr " r = guestfs_%s " name;
+ generate_call_args ~handle:"g" style;
+ pr ";\n";
+
+ List.iter (
+ function
+ | String _ | OptString _ | Bool _ | Int _ -> ()
+ | StringList n ->
+ pr " free (%s);\n" n
+ ) (snd style);
+
+ pr " if (r == %s) {\n" error_code;
+ pr " PyErr_SetString (PyExc_RuntimeError, guestfs_last_error (g));\n";
+ pr " return NULL;\n";
+ pr " }\n";
+ pr "\n";
+
+ (match fst style with
+ | RErr ->
+ pr " Py_INCREF (Py_None);\n";
+ pr " py_r = Py_None;\n"
+ | RInt _
+ | RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
+ | RConstString _ -> pr " py_r = PyString_FromString (r);\n"
+ | RString _ ->
+ pr " py_r = PyString_FromString (r);\n";
+ pr " free (r);\n"
+ | RStringList _ ->
+ pr " py_r = put_string_list (r);\n";
+ pr " free_strings (r);\n"
+ | RIntBool _ ->
+ pr " py_r = PyTuple_New (2);\n";
+ pr " PyTuple_SetItem (py_r, 0, PyInt_FromLong ((long) r->i));\n";
+ pr " PyTuple_SetItem (py_r, 1, PyInt_FromLong ((long) r->b));\n";
+ pr " guestfs_free_int_bool (r);\n"
+ | RPVList n ->
+ pr " py_r = put_lvm_pv_list (r);\n";
+ pr " guestfs_free_lvm_pv_list (r);\n"
+ | RVGList n ->
+ pr " py_r = put_lvm_vg_list (r);\n";
+ pr " guestfs_free_lvm_vg_list (r);\n"
+ | RLVList n ->
+ pr " py_r = put_lvm_lv_list (r);\n";
+ pr " guestfs_free_lvm_lv_list (r);\n"
+ );
+
+ pr " return py_r;\n";
+ pr "}\n";
+ pr "\n"
+ ) all_functions;
+
+ (* Table of functions. *)
+ pr "static PyMethodDef methods[] = {\n";
+ pr " { (char *) \"create\", py_guestfs_create, METH_VARARGS, NULL },\n";
+ pr " { (char *) \"close\", py_guestfs_close, METH_VARARGS, NULL },\n";
+ List.iter (
+ fun (name, _, _, _, _, _, _) ->
+ pr " { (char *) \"%s\", py_guestfs_%s, METH_VARARGS, NULL },\n"
+ name name
+ ) all_functions;
+ pr " { NULL, NULL, 0, NULL }\n";
+ pr "};\n";
+ pr "\n";
+
+ (* Init function. *)
+ pr "\
+void
+initlibguestfsmod (void)
+{
+ static int initialized = 0;
+
+ if (initialized) return;
+ Py_InitModule ((char *) \"libguestfsmod\", methods);
+ initialized = 1;
+}
+"
+
+(* Generate Python module. *)
+and generate_python_py () =
+ generate_header HashStyle LGPLv2;
+
+ pr "import libguestfsmod\n";
+ pr "\n";
+ pr "class GuestFS:\n";
+ pr " def __init__ (self):\n";
+ pr " self._o = libguestfsmod.create ()\n";
+ pr "\n";
+ pr " def __del__ (self):\n";
+ pr " libguestfsmod.close (self._o)\n";
+ pr "\n";
+
+ List.iter (
+ fun (name, style, _, _, _, _, _) ->
+ pr " def %s " name;
+ generate_call_args ~handle:"self" style;
+ pr ":\n";
+ pr " return libguestfsmod.%s " name;
+ generate_call_args ~handle:"self._o" style;
+ pr "\n";
+ pr "\n";
+ ) all_functions
+
let output_to filename =
let filename_new = filename ^ ".new" in
chan := open_out filename_new;
let close = output_to "perl/lib/Sys/Guestfs.pm" in
generate_perl_pm ();
close ();
+
+ let close = output_to "python/guestfs-py.c" in
+ generate_python_c ();
+ close ();
+
+ let close = output_to "python/guestfs.py" in
+ generate_python_py ();
+ close ();
git.annexia.org / libguestfs.git / blobdiff