*)
| RErr
(* "RInt" as a return value means an int which is -1 for error
- * or any value >= 0 on success.
+ * or any value >= 0 on success. Only use this for smallish
+ * positive ints (0 <= i < 2^30).
*)
| RInt of string
+ (* "RInt64" is the same as RInt, but is guaranteed to be able
+ * to return a full 64 bit value, _except_ that -1 means error
+ * (so -1 cannot be a valid, non-error return value).
+ *)
+ | RInt64 of string
(* "RBool" is a bool return value which can be true/false or
* -1 for error.
*)
| RPVList of string
| RVGList of string
| RLVList of string
+ (* Stat buffers. *)
+ | RStat of string
+ | RStatVFS of string
+ (* Key-value pairs of untyped strings. Turns into a hashtable or
+ * dictionary in languages which support it. DON'T use this as a
+ * general "bucket" for results. Prefer a stronger typed return
+ * value if one is available, or write a custom struct. Don't use
+ * this if the list could potentially be very long, since it is
+ * inefficient. Keys should be unique. NULLs are not permitted.
+ *)
+ | RHashtable of string
+
and args = argt list (* Function parameters, guestfs handle is implicit. *)
(* Note in future we should allow a "variable args" parameter as
* 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.
+ * Between each test we umount-all and lvm-remove-all (except InitNone).
*
* Don't assume anything about the previous contents of the block
* devices. Use 'Init*' to create some initial scenarios.
* content).
*)
| TestOutputLength of seq * int
+ (* Run the command sequence and expect the output of the final
+ * command to be a structure.
+ *)
+ | TestOutputStruct of seq * test_field_compare list
(* Run the command sequence and expect the final command (only)
* to fail.
*)
| TestLastFail of seq
+and test_field_compare =
+ | CompareWithInt of string * int
+ | CompareWithString of string * string
+ | CompareFieldsIntEq of string * string
+ | CompareFieldsStrEq of string * string
+
(* Some initial scenarios for testing. *)
and test_init =
(* Do nothing, block devices could contain random stuff including
See also C<guestfs_lvs_full>.");
("pvs_full", (RPVList "physvols", []), 12, [],
- [InitBasicFSonLVM, TestOutputLength (
- [["pvs"]], 1)],
+ [], (* XXX how to test? *)
"list the LVM physical volumes (PVs)",
"\
List all the physical volumes detected. This is the equivalent
of the L<pvs(8)> command. The \"full\" version includes all fields.");
("vgs_full", (RVGList "volgroups", []), 13, [],
- [InitBasicFSonLVM, TestOutputLength (
- [["pvs"]], 1)],
+ [], (* XXX how to test? *)
"list the LVM volume groups (VGs)",
"\
List all the volumes groups detected. This is the equivalent
of the L<vgs(8)> command. The \"full\" version includes all fields.");
("lvs_full", (RLVList "logvols", []), 14, [],
- [InitBasicFSonLVM, TestOutputLength (
- [["pvs"]], 1)],
+ [], (* XXX how to test? *)
"list the LVM logical volumes (LVs)",
"\
List all the logical volumes detected. This is the equivalent
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")],
+ [InitBasicFS, TestOutput (
+ [["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents");
+ InitBasicFS, TestOutput (
+ [["write_file"; "/new"; "\nnew file contents\n"; "0"];
+ ["cat"; "/new"]], "\nnew file contents\n");
+ InitBasicFS, TestOutput (
+ [["write_file"; "/new"; "\n\n"; "0"];
+ ["cat"; "/new"]], "\n\n");
+ InitBasicFS, TestOutput (
+ [["write_file"; "/new"; ""; "0"];
+ ["cat"; "/new"]], "");
+ InitBasicFS, TestOutput (
+ [["write_file"; "/new"; "\n\n\n"; "0"];
+ ["cat"; "/new"]], "\n\n\n");
+ InitBasicFS, TestOutput (
+ [["write_file"; "/new"; "\n"; "0"];
+ ["cat"; "/new"]], "\n")],
"create a file",
"\
This call creates a file called C<path>. The contents of the
particular that the filename is not prepended to the output
(the C<-b> option).");
+ ("command", (RString "output", [StringList "arguments"]), 50, [],
+ [], (* XXX how to test? *)
+ "run a command from the guest filesystem",
+ "\
+This call runs a command from the guest filesystem. The
+filesystem must be mounted, and must contain a compatible
+operating system (ie. something Linux, with the same
+or compatible processor architecture).
+
+The single parameter is an argv-style list of arguments.
+The first element is the name of the program to run.
+Subsequent elements are parameters. The list must be
+non-empty (ie. must contain a program name).
+
+The C<$PATH> environment variable will contain at least
+C</usr/bin> and C</bin>. If you require a program from
+another location, you should provide the full path in the
+first parameter.
+
+Shared libraries and data files required by the program
+must be available on filesystems which are mounted in the
+correct places. It is the caller's responsibility to ensure
+all filesystems that are needed are mounted at the right
+locations.");
+
+ ("command_lines", (RStringList "lines", [StringList "arguments"]), 51, [],
+ [], (* XXX how to test? *)
+ "run a command, returning lines",
+ "\
+This is the same as C<guestfs_command>, but splits the
+result into a list of lines.");
+
+ ("stat", (RStat "statbuf", [String "path"]), 52, [],
+ [InitBasicFS, TestOutputStruct (
+ [["touch"; "/new"];
+ ["stat"; "/new"]], [CompareWithInt ("size", 0)])],
+ "get file information",
+ "\
+Returns file information for the given C<path>.
+
+This is the same as the C<stat(2)> system call.");
+
+ ("lstat", (RStat "statbuf", [String "path"]), 53, [],
+ [InitBasicFS, TestOutputStruct (
+ [["touch"; "/new"];
+ ["lstat"; "/new"]], [CompareWithInt ("size", 0)])],
+ "get file information for a symbolic link",
+ "\
+Returns file information for the given C<path>.
+
+This is the same as C<guestfs_stat> except that if C<path>
+is a symbolic link, then the link is stat-ed, not the file it
+refers to.
+
+This is the same as the C<lstat(2)> system call.");
+
+ ("statvfs", (RStatVFS "statbuf", [String "path"]), 54, [],
+ [InitBasicFS, TestOutputStruct (
+ [["statvfs"; "/"]], [CompareWithInt ("bfree", 487702);
+ CompareWithInt ("blocks", 490020);
+ CompareWithInt ("bsize", 1024)])],
+ "get file system statistics",
+ "\
+Returns file system statistics for any mounted file system.
+C<path> should be a file or directory in the mounted file system
+(typically it is the mount point itself, but it doesn't need to be).
+
+This is the same as the C<statvfs(2)> system call.");
+
+ ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
+ [], (* XXX test *)
+ "get ext2/ext3 superblock details",
+ "\
+This returns the contents of the ext2 or ext3 filesystem superblock
+on C<device>.
+
+It is the same as running C<tune2fs -l device>. See L<tune2fs(8)>
+manpage for more details. The list of fields returned isn't
+clearly defined, and depends on both the version of C<tune2fs>
+that libguestfs was built against, and the filesystem itself.");
+
+ ("blockdev_setro", (RErr, [String "device"]), 56, [],
+ [InitEmpty, TestOutputTrue (
+ [["blockdev_setro"; "/dev/sda"];
+ ["blockdev_getro"; "/dev/sda"]])],
+ "set block device to read-only",
+ "\
+Sets the block device named C<device> to read-only.
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_setrw", (RErr, [String "device"]), 57, [],
+ [InitEmpty, TestOutputFalse (
+ [["blockdev_setrw"; "/dev/sda"];
+ ["blockdev_getro"; "/dev/sda"]])],
+ "set block device to read-write",
+ "\
+Sets the block device named C<device> to read-write.
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_getro", (RBool "ro", [String "device"]), 58, [],
+ [InitEmpty, TestOutputTrue (
+ [["blockdev_setro"; "/dev/sda"];
+ ["blockdev_getro"; "/dev/sda"]])],
+ "is block device set to read-only",
+ "\
+Returns a boolean indicating if the block device is read-only
+(true if read-only, false if not).
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_getss", (RInt "sectorsize", [String "device"]), 59, [],
+ [InitEmpty, TestOutputInt (
+ [["blockdev_getss"; "/dev/sda"]], 512)],
+ "get sectorsize of block device",
+ "\
+This returns the size of sectors on a block device.
+Usually 512, but can be larger for modern devices.
+
+(Note, this is not the size in sectors, use C<guestfs_blockdev_getsz>
+for that).
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_getbsz", (RInt "blocksize", [String "device"]), 60, [],
+ [InitEmpty, TestOutputInt (
+ [["blockdev_getbsz"; "/dev/sda"]], 4096)],
+ "get blocksize of block device",
+ "\
+This returns the block size of a device.
+
+(Note this is different from both I<size in blocks> and
+I<filesystem block size>).
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_setbsz", (RErr, [String "device"; Int "blocksize"]), 61, [],
+ [], (* XXX test *)
+ "set blocksize of block device",
+ "\
+This sets the block size of a device.
+
+(Note this is different from both I<size in blocks> and
+I<filesystem block size>).
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_getsz", (RInt64 "sizeinsectors", [String "device"]), 62, [],
+ [InitEmpty, TestOutputInt (
+ [["blockdev_getsz"; "/dev/sda"]], 1024000)],
+ "get total size of device in 512-byte sectors",
+ "\
+This returns the size of the device in units of 512-byte sectors
+(even if the sectorsize isn't 512 bytes ... weird).
+
+See also C<guestfs_blockdev_getss> for the real sector size of
+the device, and C<guestfs_blockdev_getsize64> for the more
+useful I<size in bytes>.
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_getsize64", (RInt64 "sizeinbytes", [String "device"]), 63, [],
+ [InitEmpty, TestOutputInt (
+ [["blockdev_getsize64"; "/dev/sda"]], 524288000)],
+ "get total size of device in bytes",
+ "\
+This returns the size of the device in bytes.
+
+See also C<guestfs_blockdev_getsz>.
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_flushbufs", (RErr, [String "device"]), 64, [],
+ [InitEmpty, TestRun
+ [["blockdev_flushbufs"; "/dev/sda"]]],
+ "flush device buffers",
+ "\
+This tells the kernel to flush internal buffers associated
+with C<device>.
+
+This uses the L<blockdev(8)> command.");
+
+ ("blockdev_rereadpt", (RErr, [String "device"]), 65, [],
+ [InitEmpty, TestRun
+ [["blockdev_rereadpt"; "/dev/sda"]]],
+ "reread partition table",
+ "\
+Reread the partition table on C<device>.
+
+This uses the L<blockdev(8)> command.");
+
]
let all_functions = non_daemon_functions @ daemon_functions
"modules", `String;
]
+(* Column names and types from stat structures.
+ * NB. Can't use things like 'st_atime' because glibc header files
+ * define some of these as macros. Ugh.
+ *)
+let stat_cols = [
+ "dev", `Int;
+ "ino", `Int;
+ "mode", `Int;
+ "nlink", `Int;
+ "uid", `Int;
+ "gid", `Int;
+ "rdev", `Int;
+ "size", `Int;
+ "blksize", `Int;
+ "blocks", `Int;
+ "atime", `Int;
+ "mtime", `Int;
+ "ctime", `Int;
+]
+let statvfs_cols = [
+ "bsize", `Int;
+ "frsize", `Int;
+ "blocks", `Int;
+ "bfree", `Int;
+ "bavail", `Int;
+ "files", `Int;
+ "ffree", `Int;
+ "favail", `Int;
+ "fsid", `Int;
+ "flag", `Int;
+ "namemax", `Int;
+]
+
(* Useful functions.
* Note we don't want to use any external OCaml libraries which
* makes this a bit harder than it should be.
done;
if not !r then s else s2
+let isspace c =
+ c = ' '
+ (* || c = '\f' *) || c = '\n' || c = '\r' || c = '\t' (* || c = '\v' *)
+
+let triml ?(test = isspace) str =
+ let i = ref 0 in
+ let n = ref (String.length str) in
+ while !n > 0 && test str.[!i]; do
+ decr n;
+ incr i
+ done;
+ if !i = 0 then str
+ else String.sub str !i !n
+
+let trimr ?(test = isspace) str =
+ let n = ref (String.length str) in
+ while !n > 0 && test str.[!n-1]; do
+ decr n
+ done;
+ if !n = String.length str then str
+ else String.sub str 0 !n
+
+let trim ?(test = isspace) str =
+ trimr ~test (triml ~test str)
+
let rec find s sub =
let len = String.length s in
let sublen = String.length sub in
let name_of_argt = function
| String n | OptString n | StringList n | Bool n | Int n -> n
+let seq_of_test = function
+ | TestRun s | TestOutput (s, _) | TestOutputList (s, _)
+ | TestOutputInt (s, _) | TestOutputTrue s | TestOutputFalse s
+ | TestOutputLength (s, _) | TestOutputStruct (s, _)
+ | TestLastFail s -> s
+
(* Check function names etc. for consistency. *)
let check_functions () =
let contains_uppercase str =
failwithf "%s param/ret %s should not contain '-' or '_'"
name n;
if n = "value" then
- failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" n
+ failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" n;
+ 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" n
in
(match fst style with
| RErr -> ()
- | RInt n | RBool n | RConstString n | RString n
- | RStringList n | RPVList n | RVGList n | RLVList n ->
+ | RInt n | RInt64 n | RBool n | RConstString n | RString n
+ | RStringList n | RPVList n | RVGList n | RLVList n
+ | RStat n | RStatVFS n
+ | RHashtable n ->
check_arg_ret_name n
| RIntBool (n,m) ->
check_arg_ret_name n;
failwithf "%s and %s have conflicting procedure numbers (%d, %d)"
name1 name2 nr1 nr2
in
- loop proc_nrs
+ loop proc_nrs;
+
+ (* Check tests. *)
+ List.iter (
+ function
+ (* Ignore functions that have no tests. We generate a
+ * warning when the user does 'make check' instead.
+ *)
+ | name, _, _, _, [], _, _ -> ()
+ | name, _, _, _, tests, _, _ ->
+ let funcs =
+ List.map (
+ fun (_, test) ->
+ match seq_of_test test with
+ | [] ->
+ failwithf "%s has a test containing an empty sequence" name
+ | cmds -> List.map List.hd cmds
+ ) tests in
+ let funcs = List.flatten funcs in
+
+ let tested = List.mem name funcs in
+
+ if not tested then
+ failwithf "function %s has tests but does not test itself" name
+ ) all_functions
(* 'pr' prints to the current output file. *)
let chan = ref stdout
pr "This function returns 0 on success or -1 on error.\n\n"
| RInt _ ->
pr "On error this function returns -1.\n\n"
+ | RInt64 _ ->
+ pr "On error this function returns -1.\n\n"
| RBool _ ->
pr "This function returns a C truth value on success or -1 on error.\n\n"
| RConstString _ ->
- pr "This function returns a string or NULL on error.
+ pr "This function returns a string, or NULL on error.
The string is owned by the guest handle and must I<not> be freed.\n\n"
| RString _ ->
- pr "This function returns a string or NULL on error.
+ pr "This function returns a string, or NULL on error.
I<The caller must free the returned string after use>.\n\n"
| RStringList _ ->
pr "This function returns a NULL-terminated array of strings
(like L<environ(3)>), or NULL if there was an error.
I<The caller must free the strings and the array after use>.\n\n"
| RIntBool _ ->
- pr "This function returns a C<struct guestfs_int_bool *>.
+ pr "This function returns a C<struct guestfs_int_bool *>,
+or NULL if there was an error.
I<The caller must call C<guestfs_free_int_bool> after use>.\n\n"
| RPVList _ ->
- pr "This function returns a C<struct guestfs_lvm_pv_list *>.
+ pr "This function returns a C<struct guestfs_lvm_pv_list *>
+(see E<lt>guestfs-structs.hE<gt>),
+or NULL if there was an error.
I<The caller must call C<guestfs_free_lvm_pv_list> after use>.\n\n"
| RVGList _ ->
- pr "This function returns a C<struct guestfs_lvm_vg_list *>.
+ pr "This function returns a C<struct guestfs_lvm_vg_list *>
+(see E<lt>guestfs-structs.hE<gt>),
+or NULL if there was an error.
I<The caller must call C<guestfs_free_lvm_vg_list> after use>.\n\n"
| RLVList _ ->
- pr "This function returns a C<struct guestfs_lvm_lv_list *>.
+ pr "This function returns a C<struct guestfs_lvm_lv_list *>
+(see E<lt>guestfs-structs.hE<gt>),
+or NULL if there was an error.
I<The caller must call C<guestfs_free_lvm_lv_list> after use>.\n\n"
+ | RStat _ ->
+ pr "This function returns a C<struct guestfs_stat *>
+(see L<stat(2)> and E<lt>guestfs-structs.hE<gt>),
+or NULL if there was an error.
+I<The caller must call C<free> after use>.\n\n"
+ | RStatVFS _ ->
+ pr "This function returns a C<struct guestfs_statvfs *>
+(see L<statvfs(2)> and E<lt>guestfs-structs.hE<gt>),
+or NULL if there was an error.
+I<The caller must call C<free> after use>.\n\n"
+ | RHashtable _ ->
+ pr "This function returns a NULL-terminated array of
+strings, or NULL if there was an error.
+The array of strings will always have length C<2n+1>, where
+C<n> keys and values alternate, followed by the trailing NULL entry.
+I<The caller must free the strings and the array after use>.\n\n"
);
if List.mem ProtocolLimitWarning flags then
pr "%s\n\n" protocol_limit_warning;
pr "\n";
) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
+ (* Stat internal structures. *)
+ List.iter (
+ function
+ | typ, cols ->
+ pr "struct guestfs_int_%s {\n" typ;
+ List.iter (function
+ | name, `Int -> pr " hyper %s;\n" name
+ ) cols;
+ pr "};\n";
+ pr "\n";
+ ) ["stat", stat_cols; "statvfs", statvfs_cols];
+
List.iter (
fun (shortname, style, _, _, _, _, _) ->
let name = "guestfs_" ^ shortname in
pr "struct %s_ret {\n" name;
pr " int %s;\n" n;
pr "};\n\n"
+ | RInt64 n ->
+ pr "struct %s_ret {\n" name;
+ pr " hyper %s;\n" n;
+ pr "};\n\n"
| RBool n ->
pr "struct %s_ret {\n" name;
pr " bool %s;\n" n;
pr "struct %s_ret {\n" name;
pr " guestfs_lvm_int_lv_list %s;\n" n;
pr "};\n\n"
+ | RStat n ->
+ pr "struct %s_ret {\n" name;
+ pr " guestfs_int_stat %s;\n" n;
+ pr "};\n\n"
+ | RStatVFS n ->
+ pr "struct %s_ret {\n" name;
+ pr " guestfs_int_statvfs %s;\n" n;
+ pr "};\n\n"
+ | RHashtable n ->
+ pr "struct %s_ret {\n" name;
+ pr " str %s<>;\n" n;
+ pr "};\n\n"
);
) daemon_functions;
pr " struct guestfs_lvm_%s *val;\n" typ;
pr "};\n";
pr "\n"
- ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
+ ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
+
+ (* Stat structures. *)
+ List.iter (
+ function
+ | typ, cols ->
+ pr "struct guestfs_%s {\n" typ;
+ List.iter (
+ function
+ | name, `Int -> pr " int64_t %s;\n" name
+ ) cols;
+ pr "};\n";
+ pr "\n"
+ ) ["stat", stat_cols; "statvfs", statvfs_cols]
(* Generate the guestfs-actions.h file. *)
and generate_actions_h () =
| RErr -> ()
| RConstString _ ->
failwithf "RConstString cannot be returned from a daemon function"
- | RInt _
+ | RInt _ | RInt64 _
| RBool _ | RString _ | RStringList _
| RIntBool _
- | RPVList _ | RVGList _ | RLVList _ ->
+ | RPVList _ | RVGList _ | RLVList _
+ | RStat _ | RStatVFS _
+ | RHashtable _ ->
pr " struct %s_ret ret;\n" name
);
pr "};\n\n";
| RErr -> ()
| RConstString _ ->
failwithf "RConstString cannot be returned from a daemon function"
- | RInt _
+ | RInt _ | RInt64 _
| RBool _ | RString _ | RStringList _
| RIntBool _
- | RPVList _ | RVGList _ | RLVList _ ->
+ | RPVList _ | RVGList _ | RLVList _
+ | RStat _ | RStatVFS _
+ | RHashtable _ ->
pr " if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
pr " error (g, \"%s: failed to parse reply\");\n" name;
pr " return;\n";
let error_code =
match fst style with
- | RErr | RInt _ | RBool _ -> "-1"
+ | RErr | RInt _ | RInt64 _ | RBool _ -> "-1"
| RConstString _ ->
failwithf "RConstString cannot be returned from a daemon function"
| RString _ | RStringList _ | RIntBool _
- | RPVList _ | RVGList _ | RLVList _ ->
+ | RPVList _ | RVGList _ | RLVList _
+ | RStat _ | RStatVFS _
+ | RHashtable _ ->
"NULL" in
pr "{\n";
(match fst style with
| RErr -> pr " return 0;\n"
- | RInt n
- | RBool n -> pr " return rv.ret.%s;\n" n
+ | RInt n | RInt64 n | RBool n ->
+ pr " return rv.ret.%s;\n" n
| RConstString _ ->
failwithf "RConstString cannot be returned from a daemon function"
| RString n ->
pr " return rv.ret.%s; /* caller will free */\n" n
- | RStringList n ->
+ | RStringList n | RHashtable n ->
pr " /* caller will free this, but we need to add a NULL entry */\n";
pr " rv.ret.%s.%s_val =" n n;
pr " safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
| RIntBool _ ->
pr " /* caller with free this */\n";
pr " return safe_memdup (g, &rv.ret, sizeof (rv.ret));\n"
- | RPVList n ->
- pr " /* caller will free this */\n";
- pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
- | RVGList n ->
- pr " /* caller will free this */\n";
- pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
- | RLVList n ->
+ | RPVList n | RVGList n | RLVList n
+ | RStat n | RStatVFS n ->
pr " /* caller will free this */\n";
pr " return safe_memdup (g, &rv.ret.%s, sizeof (rv.ret.%s));\n" n n
);
let error_code =
match fst style with
| RErr | RInt _ -> pr " int r;\n"; "-1"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1"
| RBool _ -> pr " int r;\n"; "-1"
| RConstString _ ->
failwithf "RConstString cannot be returned from a daemon function"
| RString _ -> pr " char *r;\n"; "NULL"
- | RStringList _ -> pr " char **r;\n"; "NULL"
+ | RStringList _ | RHashtable _ -> pr " char **r;\n"; "NULL"
| RIntBool _ -> pr " guestfs_%s_ret *r;\n" name; "NULL"
| RPVList _ -> pr " guestfs_lvm_int_pv_list *r;\n"; "NULL"
| RVGList _ -> pr " guestfs_lvm_int_vg_list *r;\n"; "NULL"
- | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
+ | RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL"
+ | RStat _ -> pr " guestfs_int_stat *r;\n"; "NULL"
+ | RStatVFS _ -> pr " guestfs_int_statvfs *r;\n"; "NULL" in
(match snd style with
| [] -> ()
(match fst style with
| RErr -> pr " reply (NULL, NULL);\n"
- | RInt n ->
- pr " struct guestfs_%s_ret ret;\n" name;
- pr " ret.%s = r;\n" n;
- pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
- | RBool n ->
+ | RInt n | RInt64 n | RBool n ->
pr " struct guestfs_%s_ret ret;\n" name;
pr " ret.%s = r;\n" n;
pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
pr " ret.%s = r;\n" n;
pr " reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name;
pr " free (r);\n"
- | RStringList n ->
+ | RStringList n | RHashtable n ->
pr " struct guestfs_%s_ret ret;\n" name;
pr " ret.%s.%s_len = count_strings (r);\n" n n;
pr " ret.%s.%s_val = r;\n" n n;
| RIntBool _ ->
pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name;
pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) r);\n" name
- | RPVList n ->
- pr " struct guestfs_%s_ret ret;\n" name;
- pr " ret.%s = *r;\n" n;
- pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
- pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
- | RVGList n ->
- pr " struct guestfs_%s_ret ret;\n" name;
- pr " ret.%s = *r;\n" n;
- pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
- pr " xdr_free ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name
- | RLVList n ->
+ | RPVList n | RVGList n | RLVList n
+ | RStat n | RStatVFS n ->
pr " struct guestfs_%s_ret ret;\n" name;
pr " ret.%s = *r;\n" n;
pr " reply ((xdrproc_t) xdr_guestfs_%s_ret, (char *) &ret);\n" name;
printf (\"\\t%%s\\n\", argv[argc]);
}
+/*
+static void print_table (char * const * const argv)
+{
+ int i;
+
+ for (i = 0; argv[i] != NULL; i += 2)
+ printf (\"%%s: %%s\\n\", argv[i], argv[i+1]);
+}
+*/
+
+static void no_test_warnings (void)
+{
";
+ List.iter (
+ function
+ | name, _, _, _, [], _, _ ->
+ pr " fprintf (stderr, \"warning: \\\"guestfs_%s\\\" has no tests\\n\");\n" name
+ | name, _, _, _, tests, _, _ -> ()
+ ) all_functions;
+
+ pr "}\n";
+ pr "\n";
+
+ (* Generate the actual tests. Note that we generate the tests
+ * in reverse order, deliberately, so that (in general) the
+ * newest tests run first. This makes it quicker and easier to
+ * debug them.
+ *)
let test_names =
List.map (
fun (name, _, _, _, tests, _, _) ->
mapi (generate_one_test name) tests
- ) all_functions in
+ ) (List.rev all_functions) in
let test_names = List.concat test_names in
let nr_tests = List.length test_names in
const char *srcdir;
int fd;
char buf[256];
+ int nr_tests, test_num = 0;
+
+ no_test_warnings ();
g = guestfs_create ();
if (g == NULL) {
exit (1);
}
-" (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024);
+ nr_tests = %d;
+
+" (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
iteri (
fun i test_name ->
- pr " printf (\"%3d/%3d %s\\n\");\n" (i+1) nr_tests test_name;
+ pr " test_num++;\n";
+ pr " printf (\"%%3d/%%3d %s\\n\", test_num, nr_tests);\n" test_name;
pr " if (%s () == -1) {\n" test_name;
pr " printf (\"%s FAILED\\n\");\n" test_name;
pr " failed++;\n";
pr "\n";
pr " if (failed > 0) {\n";
- pr " printf (\"***** %%d / %d tests FAILED *****\\n\", failed);\n"
- nr_tests;
+ pr " printf (\"***** %%d / %%d tests FAILED *****\\n\", failed, nr_tests);\n";
pr " exit (1);\n";
pr " }\n";
pr "\n";
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"
+ pr " fprintf (stderr, \"%s: expected %d but got %%d\\n\","
test_name expected;
+ pr " (int) r);\n";
pr " return -1;\n";
pr " }\n"
in
in
List.iter (generate_test_command_call test_name) seq;
generate_test_command_call ~test test_name last
+ | TestOutputStruct (seq, checks) ->
+ pr " /* TestOutputStruct for %s (%d) */\n" name i;
+ let seq, last = get_seq_last seq in
+ let test () =
+ List.iter (
+ function
+ | CompareWithInt (field, expected) ->
+ pr " if (r->%s != %d) {\n" field expected;
+ pr " fprintf (stderr, \"%s: %s was %%d, expected %d\\n\",\n"
+ test_name field expected;
+ pr " (int) r->%s);\n" field;
+ pr " return -1;\n";
+ pr " }\n"
+ | CompareWithString (field, expected) ->
+ pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected;
+ pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n"
+ test_name field expected;
+ pr " r->%s);\n" field;
+ pr " return -1;\n";
+ pr " }\n"
+ | CompareFieldsIntEq (field1, field2) ->
+ pr " if (r->%s != r->%s) {\n" field1 field2;
+ pr " fprintf (stderr, \"%s: %s (%%d) <> %s (%%d)\\n\",\n"
+ test_name field1 field2;
+ pr " (int) r->%s, (int) r->%s);\n" field1 field2;
+ pr " return -1;\n";
+ pr " }\n"
+ | CompareFieldsStrEq (field1, field2) ->
+ pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2;
+ pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n"
+ test_name field1 field2;
+ pr " r->%s, r->%s);\n" field1 field2;
+ pr " return -1;\n";
+ pr " }\n"
+ ) checks
+ 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
let error_code =
match fst style with
| RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1"
| RConstString _ -> pr " const char *r;\n"; "NULL"
| RString _ -> pr " char *r;\n"; "NULL"
- | RStringList _ ->
+ | RStringList _ | RHashtable _ ->
pr " char **r;\n";
pr " int i;\n";
"NULL"
| RIntBool _ ->
- pr " struct guestfs_int_bool *r;\n";
- "NULL"
+ pr " struct guestfs_int_bool *r;\n"; "NULL"
| RPVList _ ->
- pr " struct guestfs_lvm_pv_list *r;\n";
- "NULL"
+ pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
| RVGList _ ->
- pr " struct guestfs_lvm_vg_list *r;\n";
- "NULL"
+ pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
| RLVList _ ->
- pr " struct guestfs_lvm_lv_list *r;\n";
- "NULL" in
+ pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
+ | RStat _ ->
+ pr " struct guestfs_stat *r;\n"; "NULL"
+ | RStatVFS _ ->
+ pr " struct guestfs_statvfs *r;\n"; "NULL" in
pr " suppress_error = %d;\n" (if expect_error then 1 else 0);
pr " r = guestfs_%s (g" name;
);
(match fst style with
- | RErr | RInt _ | RBool _ | RConstString _ -> ()
+ | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _ -> ()
| RString _ -> pr " free (r);\n"
- | RStringList _ ->
+ | RStringList _ | RHashtable _ ->
pr " for (i = 0; r[i] != NULL; ++i)\n";
pr " free (r[i]);\n";
pr " free (r);\n"
pr " guestfs_free_lvm_vg_list (r);\n"
| RLVList _ ->
pr " guestfs_free_lvm_lv_list (r);\n"
+ | RStat _ | RStatVFS _ ->
+ pr " free (r);\n"
);
pr " }\n"
pr "\n";
) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
+ (* print_{stat,statvfs} functions *)
+ List.iter (
+ function
+ | typ, cols ->
+ pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ;
+ pr "{\n";
+ List.iter (
+ function
+ | name, `Int ->
+ pr " printf (\"%s: %%\" PRIi64 \"\\n\", %s->%s);\n" name typ name
+ ) cols;
+ pr "}\n";
+ pr "\n";
+ ) ["stat", stat_cols; "statvfs", statvfs_cols];
+
(* run_<action> actions *)
List.iter (
fun (name, style, _, flags, _, _, _) ->
| RErr
| RInt _
| RBool _ -> pr " int r;\n"
+ | RInt64 _ -> pr " int64_t r;\n"
| RConstString _ -> pr " const char *r;\n"
| RString _ -> pr " char *r;\n"
- | RStringList _ -> pr " char **r;\n"
+ | RStringList _ | RHashtable _ -> pr " char **r;\n"
| RIntBool _ -> pr " struct guestfs_int_bool *r;\n"
| RPVList _ -> pr " struct guestfs_lvm_pv_list *r;\n"
| RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
| RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
+ | RStat _ -> pr " struct guestfs_stat *r;\n"
+ | RStatVFS _ -> pr " struct guestfs_statvfs *r;\n"
);
List.iter (
function
| RErr -> pr " return r;\n"
| RInt _ ->
pr " if (r == -1) return -1;\n";
- pr " if (r) printf (\"%%d\\n\", r);\n";
+ pr " printf (\"%%d\\n\", r);\n";
+ pr " return 0;\n"
+ | RInt64 _ ->
+ pr " if (r == -1) return -1;\n";
+ pr " printf (\"%%\" PRIi64 \"\\n\", r);\n";
pr " return 0;\n"
| RBool _ ->
pr " if (r == -1) return -1;\n";
pr " print_lv_list (r);\n";
pr " guestfs_free_lvm_lv_list (r);\n";
pr " return 0;\n"
+ | RStat _ ->
+ pr " if (r == NULL) return -1;\n";
+ pr " print_stat (r);\n";
+ pr " free (r);\n";
+ pr " return 0;\n"
+ | RStatVFS _ ->
+ pr " if (r == NULL) return -1;\n";
+ pr " print_statvfs (r);\n";
+ pr " free (r);\n";
+ pr " return 0;\n"
+ | RHashtable _ ->
+ pr " if (r == NULL) return -1;\n";
+ pr " print_table (r);\n";
+ pr " free_strings (r);\n";
+ pr " return 0;\n"
);
pr "}\n";
pr "\n"
pr "}\n";
pr "\n"
+(* Readline completion for guestfish. *)
+and generate_fish_completion () =
+ generate_header CStyle GPLv2;
+
+ let all_functions =
+ List.filter (
+ fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
+ ) all_functions in
+
+ pr "\
+#include <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#ifdef HAVE_LIBREADLINE
+#include <readline/readline.h>
+#endif
+
+#include \"fish.h\"
+
+#ifdef HAVE_LIBREADLINE
+
+static const char *commands[] = {
+";
+
+ (* Get the commands and sort them, including the aliases. *)
+ let commands =
+ List.map (
+ fun (name, _, _, flags, _, _, _) ->
+ let name2 = replace_char name '_' '-' in
+ let alias =
+ try find_map (function FishAlias n -> Some n | _ -> None) flags
+ with Not_found -> name in
+
+ if name <> alias then [name2; alias] else [name2]
+ ) all_functions in
+ let commands = List.flatten commands in
+ let commands = List.sort compare commands in
+
+ List.iter (pr " \"%s\",\n") commands;
+
+ pr " NULL
+};
+
+static char *
+generator (const char *text, int state)
+{
+ static int index, len;
+ const char *name;
+
+ if (!state) {
+ index = 0;
+ len = strlen (text);
+ }
+
+ while ((name = commands[index]) != NULL) {
+ index++;
+ if (strncasecmp (name, text, len) == 0)
+ return strdup (name);
+ }
+
+ return NULL;
+}
+
+#endif /* HAVE_LIBREADLINE */
+
+char **do_completion (const char *text, int start, int end)
+{
+ char **matches = NULL;
+
+#ifdef HAVE_LIBREADLINE
+ if (start == 0)
+ matches = rl_completion_matches (text, generator);
+#endif
+
+ return matches;
+}
+";
+
(* Generate the POD documentation for guestfish. *)
and generate_fish_actions_pod () =
let all_functions_sorted =
(match fst style with
| RErr -> pr "int "
| RInt _ -> pr "int "
+ | RInt64 _ -> pr "int64_t "
| RBool _ -> pr "int "
| RConstString _ -> pr "const char *"
| RString _ -> pr "char *"
- | RStringList _ -> pr "char **"
+ | RStringList _ | RHashtable _ -> pr "char **"
| RIntBool _ ->
if not in_daemon then pr "struct guestfs_int_bool *"
else pr "guestfs_%s_ret *" name
| RLVList _ ->
if not in_daemon then pr "struct guestfs_lvm_lv_list *"
else pr "guestfs_lvm_int_lv_list *"
+ | RStat _ ->
+ if not in_daemon then pr "struct guestfs_stat *"
+ else pr "guestfs_int_stat *"
+ | RStatVFS _ ->
+ if not in_daemon then pr "struct guestfs_statvfs *"
+ else pr "guestfs_int_statvfs *"
);
pr "%s%s (" prefix name;
if handle = None && List.length (snd style) = 0 then
";
generate_ocaml_lvm_structure_decls ();
+ generate_ocaml_stat_structure_decls ();
+
(* The actions. *)
List.iter (
fun (name, style, _, _, _, shortdesc, _) ->
generate_ocaml_lvm_structure_decls ();
+ generate_ocaml_stat_structure_decls ();
+
(* The actions. *)
List.iter (
fun (name, style, _, _, _, shortdesc, _) ->
and generate_ocaml_c () =
generate_header CStyle LGPLv2;
- pr "#include <stdio.h>\n";
- pr "#include <stdlib.h>\n";
- pr "#include <string.h>\n";
- pr "\n";
- pr "#include <caml/config.h>\n";
- pr "#include <caml/alloc.h>\n";
- pr "#include <caml/callback.h>\n";
- pr "#include <caml/fail.h>\n";
- pr "#include <caml/memory.h>\n";
- pr "#include <caml/mlvalues.h>\n";
- pr "#include <caml/signals.h>\n";
- pr "\n";
- pr "#include <guestfs.h>\n";
- pr "\n";
- pr "#include \"guestfs_c.h\"\n";
- pr "\n";
+ pr "\
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include <caml/config.h>
+#include <caml/alloc.h>
+#include <caml/callback.h>
+#include <caml/fail.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+#include <caml/signals.h>
+
+#include <guestfs.h>
+
+#include \"guestfs_c.h\"
+
+/* Copy a hashtable of string pairs into an assoc-list. We return
+ * the list in reverse order, but hashtables aren't supposed to be
+ * ordered anyway.
+ */
+static CAMLprim value
+copy_table (char * const * argv)
+{
+ CAMLparam0 ();
+ CAMLlocal5 (rv, pairv, kv, vv, cons);
+ int i;
+
+ rv = Val_int (0);
+ for (i = 0; argv[i] != NULL; i += 2) {
+ kv = caml_copy_string (argv[i]);
+ vv = caml_copy_string (argv[i+1]);
+ pairv = caml_alloc (2, 0);
+ Store_field (pairv, 0, kv);
+ Store_field (pairv, 1, vv);
+ cons = caml_alloc (2, 0);
+ Store_field (cons, 1, rv);
+ rv = cons;
+ Store_field (cons, 0, pairv);
+ }
+
+ CAMLreturn (rv);
+}
+
+";
(* LVM struct copy functions. *)
List.iter (
pr "\n";
) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
+ (* Stat copy functions. *)
+ List.iter (
+ fun (typ, cols) ->
+ pr "static CAMLprim value\n";
+ pr "copy_%s (const struct guestfs_%s *%s)\n" typ typ typ;
+ pr "{\n";
+ pr " CAMLparam0 ();\n";
+ pr " CAMLlocal2 (rv, v);\n";
+ pr "\n";
+ pr " rv = caml_alloc (%d, 0);\n" (List.length cols);
+ iteri (
+ fun i col ->
+ (match col with
+ | name, `Int ->
+ pr " v = caml_copy_int64 (%s->%s);\n" typ name
+ );
+ pr " Store_field (rv, %d, v);\n" i
+ ) cols;
+ pr " CAMLreturn (rv);\n";
+ pr "}\n";
+ pr "\n";
+ ) ["stat", stat_cols; "statvfs", statvfs_cols];
+
+ (* The wrappers. *)
List.iter (
fun (name, style, _, _, _, _, _) ->
let params =
match fst style with
| RErr -> pr " int r;\n"; "-1"
| RInt _ -> pr " int r;\n"; "-1"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1"
| RBool _ -> pr " int r;\n"; "-1"
| RConstString _ -> pr " const char *r;\n"; "NULL"
| RString _ -> pr " char *r;\n"; "NULL"
pr " char **r;\n";
"NULL"
| RIntBool _ ->
- pr " struct guestfs_int_bool *r;\n";
- "NULL"
+ pr " struct guestfs_int_bool *r;\n"; "NULL"
| RPVList _ ->
- pr " struct guestfs_lvm_pv_list *r;\n";
- "NULL"
+ pr " struct guestfs_lvm_pv_list *r;\n"; "NULL"
| RVGList _ ->
- pr " struct guestfs_lvm_vg_list *r;\n";
- "NULL"
+ pr " struct guestfs_lvm_vg_list *r;\n"; "NULL"
| RLVList _ ->
- pr " struct guestfs_lvm_lv_list *r;\n";
+ pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
+ | RStat _ ->
+ pr " struct guestfs_stat *r;\n"; "NULL"
+ | RStatVFS _ ->
+ pr " struct guestfs_statvfs *r;\n"; "NULL"
+ | RHashtable _ ->
+ pr " int i;\n";
+ pr " char **r;\n";
"NULL" in
pr "\n";
(match fst style with
| RErr -> pr " rv = Val_unit;\n"
| RInt _ -> pr " rv = Val_int (r);\n"
+ | RInt64 _ ->
+ pr " rv = caml_copy_int64 (r);\n"
| RBool _ -> pr " rv = Val_bool (r);\n"
| RConstString _ -> pr " rv = caml_copy_string (r);\n"
| RString _ ->
| RLVList _ ->
pr " rv = copy_lvm_lv_list (r);\n";
pr " guestfs_free_lvm_lv_list (r);\n";
+ | RStat _ ->
+ pr " rv = copy_stat (r);\n";
+ pr " free (r);\n";
+ | RStatVFS _ ->
+ pr " rv = copy_statvfs (r);\n";
+ pr " free (r);\n";
+ | RHashtable _ ->
+ pr " rv = copy_table (r);\n";
+ pr " for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
+ pr " free (r);\n";
);
pr " CAMLreturn (rv);\n";
pr "\n"
) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
+and generate_ocaml_stat_structure_decls () =
+ List.iter (
+ fun (typ, cols) ->
+ pr "type %s = {\n" typ;
+ List.iter (
+ function
+ | name, `Int -> pr " %s : int64;\n" name
+ ) cols;
+ pr "}\n";
+ pr "\n"
+ ) ["stat", stat_cols; "statvfs", statvfs_cols]
+
and generate_ocaml_prototype ?(is_external = false) name style =
if is_external then pr "external " else pr "val ";
pr "%s : t -> " name;
(match fst style with
| RErr -> pr "unit" (* all errors are turned into exceptions *)
| RInt _ -> pr "int"
+ | RInt64 _ -> pr "int64"
| RBool _ -> pr "bool"
| RConstString _ -> pr "string"
| RString _ -> pr "string"
| RPVList _ -> pr "lvm_pv array"
| RVGList _ -> pr "lvm_vg array"
| RLVList _ -> pr "lvm_lv array"
+ | RStat _ -> pr "stat"
+ | RStatVFS _ -> pr "statvfs"
+ | RHashtable _ -> pr "(string * string) list"
);
if is_external then (
pr " = ";
(match fst style with
| RErr -> pr "void\n"
| RInt _ -> pr "SV *\n"
+ | RInt64 _ -> pr "SV *\n"
| RBool _ -> pr "SV *\n"
| RConstString _ -> pr "SV *\n"
| RString _ -> pr "SV *\n"
| RStringList _
| RIntBool _
- | RPVList _ | RVGList _ | RLVList _ ->
+ | RPVList _ | RVGList _ | RLVList _
+ | RStat _ | RStatVFS _
+ | RHashtable _ ->
pr "void\n" (* all lists returned implictly on the stack *)
);
(* Call and arguments. *)
| OptString _
| Bool _
| Int _ -> ()
- | StringList n -> pr " free (%s);\n" n
+ | StringList n -> pr " free (%s);\n" n
) (snd style)
in
(* Code. *)
(match fst style with
| RErr ->
+ pr "PREINIT:\n";
+ pr " int r;\n";
pr " PPCODE:\n";
- pr " if (guestfs_%s " name;
+ pr " r = guestfs_%s " name;
generate_call_args ~handle:"g" style;
- pr " == -1) {\n";
+ pr ";\n";
do_cleanups ();
+ pr " if (r == -1)\n";
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;
do_cleanups ();
+ pr " if (%s == -1)\n" n;
pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
- pr " }\n";
pr " RETVAL = newSViv (%s);\n" n;
pr " OUTPUT:\n";
pr " RETVAL\n"
+ | RInt64 n ->
+ pr "PREINIT:\n";
+ pr " int64_t %s;\n" n;
+ pr " CODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_call_args ~handle:"g" style;
+ pr ";\n";
+ do_cleanups ();
+ pr " if (%s == -1)\n" n;
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " RETVAL = my_newSVll (%s);\n" n;
+ pr " OUTPUT:\n";
+ pr " RETVAL\n"
| RConstString n ->
pr "PREINIT:\n";
pr " const char *%s;\n" n;
pr " %s = guestfs_%s " n name;
generate_call_args ~handle:"g" style;
pr ";\n";
- pr " if (%s == NULL) {\n" n;
do_cleanups ();
+ pr " if (%s == NULL)\n" n;
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;
do_cleanups ();
+ pr " if (%s == NULL)\n" n;
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 " RETVAL\n"
- | RStringList n ->
+ | RStringList n | RHashtable n ->
pr "PREINIT:\n";
pr " char **%s;\n" n;
pr " int i, n;\n";
pr " %s = guestfs_%s " n name;
generate_call_args ~handle:"g" style;
pr ";\n";
- pr " if (%s == NULL) {\n" n;
do_cleanups ();
+ pr " if (%s == NULL)\n" n;
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";
do_cleanups ();
+ pr " if (r == NULL)\n";
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";
pr " guestfs_free_int_bool (r);\n";
| RPVList n ->
- generate_perl_lvm_code "pv" pv_cols name style n;
+ generate_perl_lvm_code "pv" pv_cols name style n do_cleanups
| RVGList n ->
- generate_perl_lvm_code "vg" vg_cols name style n;
+ generate_perl_lvm_code "vg" vg_cols name style n do_cleanups
| RLVList n ->
- generate_perl_lvm_code "lv" lv_cols name style n;
+ generate_perl_lvm_code "lv" lv_cols name style n do_cleanups
+ | RStat n ->
+ generate_perl_stat_code "stat" stat_cols name style n do_cleanups
+ | RStatVFS n ->
+ generate_perl_stat_code
+ "statvfs" statvfs_cols name style n do_cleanups
);
- do_cleanups ();
-
pr "\n"
) all_functions
-and generate_perl_lvm_code typ cols name style n =
+and generate_perl_lvm_code typ cols name style n do_cleanups =
pr "PREINIT:\n";
pr " struct guestfs_lvm_%s_list *%s;\n" typ n;
pr " int i;\n";
pr " %s = guestfs_%s " n name;
generate_call_args ~handle:"g" style;
pr ";\n";
+ do_cleanups ();
pr " if (%s == NULL)\n" n;
pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
pr " EXTEND (SP, %s->len);\n" n;
pr " }\n";
pr " guestfs_free_lvm_%s_list (%s);\n" typ n
+and generate_perl_stat_code typ cols name style n do_cleanups =
+ pr "PREINIT:\n";
+ pr " struct guestfs_%s *%s;\n" typ n;
+ pr " PPCODE:\n";
+ pr " %s = guestfs_%s " n name;
+ generate_call_args ~handle:"g" style;
+ pr ";\n";
+ do_cleanups ();
+ pr " if (%s == NULL)\n" n;
+ pr " croak (\"%s: %%s\", guestfs_last_error (g));\n" name;
+ pr " EXTEND (SP, %d);\n" (List.length cols);
+ List.iter (
+ function
+ | name, `Int ->
+ pr " PUSHs (sv_2mortal (my_newSVll (%s->%s)));\n" n name
+ ) cols;
+ pr " free (%s);\n" n
+
(* Generate Sys/Guestfs.pm. *)
and generate_perl_pm () =
generate_header HashStyle LGPLv2;
| RErr -> ()
| RBool n
| RInt n
+ | RInt64 n
| RConstString n
| RString n -> pr "$%s = " n
| RIntBool (n, m) -> pr "($%s, $%s) = " n m
| RPVList n
| RVGList n
| RLVList n -> pr "@%s = " n
+ | RStat n
+ | RStatVFS n
+ | RHashtable n -> pr "%%%s = " n
);
pr "$h->%s (" name;
let comma = ref false in
return list;
}
+static PyObject *
+put_table (char * const * const argv)
+{
+ PyObject *list, *item;
+ int argc, i;
+
+ for (argc = 0; argv[argc] != NULL; ++argc)
+ ;
+
+ list = PyList_New (argc >> 1);
+ for (i = 0; i < argc; i += 2) {
+ PyObject *item;
+ item = PyTuple_New (2);
+ PyTuple_SetItem (item, 0, PyString_FromString (argv[i]));
+ PyTuple_SetItem (item, 1, PyString_FromString (argv[i+1]));
+ PyList_SetItem (list, i >> 1, item);
+ }
+
+ return list;
+}
+
static void
free_strings (char **argv)
{
pr "\n"
) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
+ (* Stat structures, turned into Python dictionaries. *)
+ List.iter (
+ fun (typ, cols) ->
+ pr "static PyObject *\n";
+ pr "put_%s (struct guestfs_%s *%s)\n" typ typ typ;
+ pr "{\n";
+ pr " PyObject *dict;\n";
+ pr "\n";
+ pr " dict = PyDict_New ();\n";
+ List.iter (
+ function
+ | name, `Int ->
+ pr " PyDict_SetItemString (dict, \"%s\",\n" name;
+ pr " PyLong_FromLongLong (%s->%s));\n"
+ typ name
+ ) cols;
+ pr " return dict;\n";
+ pr "};\n";
+ pr "\n";
+ ) ["stat", stat_cols; "statvfs", statvfs_cols];
+
(* Python wrapper functions. *)
List.iter (
fun (name, style, _, _, _, _, _) ->
let error_code =
match fst style with
| RErr | RInt _ | RBool _ -> pr " int r;\n"; "-1"
+ | RInt64 _ -> pr " int64_t r;\n"; "-1"
| RConstString _ -> pr " const char *r;\n"; "NULL"
| RString _ -> pr " char *r;\n"; "NULL"
- | RStringList _ -> pr " char **r;\n"; "NULL"
+ | RStringList _ | RHashtable _ -> 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
+ | RLVList n -> pr " struct guestfs_lvm_lv_list *r;\n"; "NULL"
+ | RStat n -> pr " struct guestfs_stat *r;\n"; "NULL"
+ | RStatVFS n -> pr " struct guestfs_statvfs *r;\n"; "NULL" in
List.iter (
function
pr " py_r = Py_None;\n"
| RInt _
| RBool _ -> pr " py_r = PyInt_FromLong ((long) r);\n"
+ | RInt64 _ -> pr " py_r = PyLong_FromLongLong (r);\n"
| RConstString _ -> pr " py_r = PyString_FromString (r);\n"
| RString _ ->
pr " py_r = PyString_FromString (r);\n";
| RLVList n ->
pr " py_r = put_lvm_lv_list (r);\n";
pr " guestfs_free_lvm_lv_list (r);\n"
+ | RStat n ->
+ pr " py_r = put_stat (r);\n";
+ pr " free (r);\n"
+ | RStatVFS n ->
+ pr " py_r = put_statvfs (r);\n";
+ pr " free (r);\n"
+ | RHashtable n ->
+ pr " py_r = put_table (r);\n";
+ pr " free_strings (r);\n"
);
pr " return py_r;\n";
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";
+ pr "\
+u\"\"\"Python bindings for libguestfs
+
+import guestfs
+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
+for examining and modifying virtual machine disk images.
+
+Amongst the things this is good for: making batch configuration
+changes to guests, getting disk used/free statistics (see also:
+virt-df), migrating between virtualization systems (see also:
+virt-p2v), performing partial backups, performing partial guest
+clones, cloning guests and changing registry/UUID/hostname info, and
+much else besides.
+
+Libguestfs uses Linux kernel and qemu code, and can access any type of
+guest filesystem that Linux and qemu can, including but not limited
+to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
+schemes, qcow, qcow2, vmdk.
+
+Libguestfs provides ways to enumerate guest storage (eg. partitions,
+LVs, what filesystem is in each LV, etc.). It can also run commands
+in the context of the guest. Also you can access filesystems over FTP.
+
+Errors which happen while using the API are turned into Python
+RuntimeError exceptions.
+
+To create a guestfs handle you usually have to perform the following
+sequence of calls:
+
+# Create the handle, call add_drive at least once, and possibly
+# several times if the guest has multiple block devices:
+g = guestfs.GuestFS ()
+g.add_drive (\"guest.img\")
+
+# 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 ()
+
+\"\"\"
+
+import libguestfsmod
+
+class GuestFS:
+ \"\"\"Instances of this class are libguestfs API handles.\"\"\"
+
+ def __init__ (self):
+ \"\"\"Create a new libguestfs handle.\"\"\"
+ self._o = libguestfsmod.create ()
+
+ def __del__ (self):
+ libguestfsmod.close (self._o)
+
+";
List.iter (
- fun (name, style, _, _, _, _, _) ->
+ fun (name, style, _, flags, _, _, longdesc) ->
+ let doc = replace_str longdesc "C<guestfs_" "C<g." in
+ let doc =
+ match fst style with
+ | RErr | RInt _ | RInt64 _ | RBool _ | RConstString _
+ | RString _ -> doc
+ | RStringList _ ->
+ doc ^ "\n\nThis function returns a list of strings."
+ | RIntBool _ ->
+ doc ^ "\n\nThis function returns a tuple (int, bool).\n"
+ | RPVList _ ->
+ doc ^ "\n\nThis function returns a list of PVs. Each PV is represented as a dictionary."
+ | RVGList _ ->
+ doc ^ "\n\nThis function returns a list of VGs. Each VG is represented as a dictionary."
+ | RLVList _ ->
+ doc ^ "\n\nThis function returns a list of LVs. Each LV is represented as a dictionary."
+ | RStat _ ->
+ doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the stat structure."
+ | RStatVFS _ ->
+ doc ^ "\n\nThis function returns a dictionary, with keys matching the various fields in the statvfs structure."
+ | RHashtable _ ->
+ doc ^ "\n\nThis function returns a dictionary." in
+ let doc =
+ if List.mem ProtocolLimitWarning flags then
+ doc ^ "\n\n" ^ protocol_limit_warning
+ else doc in
+ let doc =
+ if List.mem DangerWillRobinson flags then
+ doc ^ "\n\n" ^ danger_will_robinson
+ else doc in
+ let doc = pod2text ~width:60 name doc in
+ let doc = List.map (fun line -> replace_str line "\\" "\\\\") doc in
+ let doc = String.concat "\n " doc in
+
pr " def %s " name;
generate_call_args ~handle:"self" style;
pr ":\n";
+ pr " u\"\"\"%s\"\"\"\n" doc;
pr " return libguestfsmod.%s " name;
generate_call_args ~handle:"self._o" style;
pr "\n";
pr "\n";
) all_functions
+(* Useful if you need the longdesc POD text as plain text. Returns a
+ * list of lines.
+ *)
+and pod2text ~width name longdesc =
+ let filename, chan = Filename.open_temp_file "gen" ".tmp" in
+ fprintf chan "=head1 %s\n\n%s\n" name longdesc;
+ close_out chan;
+ let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
+ let chan = Unix.open_process_in cmd in
+ let lines = ref [] in
+ let rec loop i =
+ let line = input_line chan in
+ if i = 1 then (* discard the first line of output *)
+ loop (i+1)
+ else (
+ let line = triml line in
+ lines := line :: !lines;
+ loop (i+1)
+ ) in
+ let lines = try loop 1 with End_of_file -> List.rev !lines in
+ Unix.unlink filename;
+ match Unix.close_process_in chan with
+ | Unix.WEXITED 0 -> lines
+ | Unix.WEXITED i ->
+ failwithf "pod2text: process exited with non-zero status (%d)" i
+ | Unix.WSIGNALED i | Unix.WSTOPPED i ->
+ failwithf "pod2text: process signalled or stopped by signal %d" i
+
let output_to filename =
let filename_new = filename ^ ".new" in
chan := open_out filename_new;
generate_fish_cmds ();
close ();
+ let close = output_to "fish/completion.c" in
+ generate_fish_completion ();
+ close ();
+
let close = output_to "guestfs-structs.pod" in
generate_structs_pod ();
close ();
git.annexia.org / libguestfs.git / blobdiff