| String of string (* const char *name, cannot be NULL *)
| Device of string (* /dev device name, cannot be NULL *)
| Pathname of string (* file name, cannot be NULL *)
+ | Dev_or_Path of string (* /dev device name or Pathname, cannot be NULL *)
| OptString of string (* const char *name, may be NULL *)
| StringList of string(* list of strings (each string cannot be NULL) *)
| Bool of string (* boolean *)
* Apart from that, long descriptions are just perldoc paragraphs.
*)
+(* Generate a random UUID (used in tests). *)
+let uuidgen () =
+ let chan = Unix.open_process_in "uuidgen" in
+ let uuid = input_line chan in
+ (match Unix.close_process_in chan with
+ | Unix.WEXITED 0 -> ()
+ | Unix.WEXITED _ ->
+ failwith "uuidgen: process exited with non-zero status"
+ | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
+ failwith "uuidgen: process signalled or stopped by signal"
+ );
+ uuid
+
(* These test functions are used in the language binding tests. *)
let test_all_args = [
as end of string). For those you need to use the C<guestfs_read_file>
or C<guestfs_download> functions which have a more complex interface.");
- ("ll", (RString "listing", [String "directory"]), 5, [],
+ ("ll", (RString "listing", [Pathname "directory"]), 5, [],
[], (* XXX Tricky to test because it depends on the exact format
* of the 'ls -l' command, which changes between F10 and F11.
*)
This command is mostly useful for interactive sessions. It
is I<not> intended that you try to parse the output string.");
- ("ls", (RStringList "listing", [String "directory"]), 6, [],
+ ("ls", (RStringList "listing", [Pathname "directory"]), 6, [],
[InitBasicFS, Always, TestOutputList (
[["touch"; "/new"];
["touch"; "/newer"];
as end of line). For those you need to use the C<guestfs_read_file>
function which has a more complex interface.");
- ("aug_init", (RErr, [String "root"; Int "flags"]), 16, [],
+ ("aug_init", (RErr, [Pathname "root"; Int "flags"]), 16, [],
[], (* XXX Augeas code needs tests. *)
"create a new Augeas handle",
"\
This command removes all LVM logical volumes, volume groups
and physical volumes.");
- ("file", (RString "description", [Pathname "path"]), 49, [],
+ ("file", (RString "description", [Dev_or_Path "path"]), 49, [],
[InitSquashFS, Always, TestOutput (
[["file"; "/empty"]], "empty");
InitSquashFS, Always, TestOutput (
See also C<guestfs_download>.");
- ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
+ ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [],
[InitBasicFS, Always, TestOutput (
(* Pick a file from cwd which isn't likely to change. *)
[["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
To upload an uncompressed tarball, use C<guestfs_tar_in>.");
- ("tgz_out", (RErr, [String "directory"; FileOut "tarball"]), 72, [],
+ ("tgz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 72, [],
[],
"pack directory into compressed tarball",
"\
C<device>.");
("set_e2uuid", (RErr, [Device "device"; String "uuid"]), 82, [],
- [InitBasicFS, Always, TestOutput (
- [["set_e2uuid"; "/dev/sda1"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"];
- ["get_e2uuid"; "/dev/sda1"]], "a3a61220-882b-4f61-89f4-cf24dcc7297d");
- InitBasicFS, Always, TestOutput (
- [["set_e2uuid"; "/dev/sda1"; "clear"];
- ["get_e2uuid"; "/dev/sda1"]], "");
- (* We can't predict what UUIDs will be, so just check the commands run. *)
- InitBasicFS, Always, TestRun (
- [["set_e2uuid"; "/dev/sda1"; "random"]]);
- InitBasicFS, Always, TestRun (
- [["set_e2uuid"; "/dev/sda1"; "time"]])],
+ (let uuid = uuidgen () in
+ [InitBasicFS, Always, TestOutput (
+ [["set_e2uuid"; "/dev/sda1"; uuid];
+ ["get_e2uuid"; "/dev/sda1"]], uuid);
+ InitBasicFS, Always, TestOutput (
+ [["set_e2uuid"; "/dev/sda1"; "clear"];
+ ["get_e2uuid"; "/dev/sda1"]], "");
+ (* We can't predict what UUIDs will be, so just check the commands run. *)
+ InitBasicFS, Always, TestRun (
+ [["set_e2uuid"; "/dev/sda1"; "random"]]);
+ InitBasicFS, Always, TestRun (
+ [["set_e2uuid"; "/dev/sda1"; "time"]])]),
"set the ext2/3/4 filesystem UUID",
"\
This sets the ext2/3/4 filesystem UUID of the filesystem on
See also: C<guestfs_scrub_device>.");
- ("grub_install", (RErr, [String "root"; Device "device"]), 86, [],
+ ("grub_install", (RErr, [Pathname "root"; Device "device"]), 86, [],
(* Test disabled because grub-install incompatible with virtio-blk driver.
* See also: https://bugzilla.redhat.com/show_bug.cgi?id=479760
*)
This command installs GRUB (the Grand Unified Bootloader) on
C<device>, with the root directory being C<root>.");
- ("cp", (RErr, [String "src"; String "dest"]), 87, [],
+ ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
[InitBasicFS, Always, TestOutput (
[["write_file"; "/old"; "file content"; "0"];
["cp"; "/old"; "/new"];
This copies a file from C<src> to C<dest> where C<dest> is
either a destination filename or destination directory.");
- ("cp_a", (RErr, [String "src"; String "dest"]), 88, [],
+ ("cp_a", (RErr, [Pathname "src"; Pathname "dest"]), 88, [],
[InitBasicFS, Always, TestOutput (
[["mkdir"; "/olddir"];
["mkdir"; "/newdir"];
This copies a file or directory from C<src> to C<dest>
recursively using the C<cp -a> command.");
- ("mv", (RErr, [String "src"; String "dest"]), 89, [],
+ ("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
[InitBasicFS, Always, TestOutput (
[["write_file"; "/old"; "file content"; "0"];
["mv"; "/old"; "/new"];
daemon responds to the ping message, without affecting the daemon
or attached block device(s) in any other way.");
- ("equal", (RBool "equality", [String "file1"; String "file2"]), 93, [],
+ ("equal", (RBool "equality", [Pathname "file1"; Pathname "file2"]), 93, [],
[InitBasicFS, Always, TestOutputTrue (
[["write_file"; "/file1"; "contents of a file"; "0"];
["cp"; "/file1"; "/file2"];
In any case, it is always safe to call C<guestfs_e2fsck_f> before
calling this function.");
- ("find", (RStringList "names", [String "directory"]), 107, [],
+ ("find", (RStringList "names", [Pathname "directory"]), 107, [],
[InitBasicFS, Always, TestOutputList (
[["find"; "/"]], ["lost+found"]);
InitBasicFS, Always, TestOutputList (
See also: C<guestfs_command_lines>");
- ("glob_expand", (RStringList "paths", [String "pattern"]), 113, [],
+ ("glob_expand", (RStringList "paths", [Pathname "pattern"]), 113, [],
+ (* Use Pathname here, and hence ABS_PATH (pattern,... in generated
+ * code in stubs.c, since all valid glob patterns must start with "/".
+ * There is no concept of "cwd" in libguestfs, hence no "."-relative names.
+ *)
[InitBasicFS, Always, TestOutputList (
[["mkdir_p"; "/a/b/c"];
["touch"; "/a/b/c/d"];
It is an interface to the L<scrub(1)> program. See that
manual page for more details.");
- ("scrub_file", (RErr, [String "file"]), 115, [],
+ ("scrub_file", (RErr, [Pathname "file"]), 115, [],
[InitBasicFS, Always, TestRun (
[["write_file"; "/file"; "content"; "0"];
["scrub_file"; "/file"]])],
It is an interface to the L<scrub(1)> program. See that
manual page for more details.");
- ("scrub_freespace", (RErr, [String "dir"]), 116, [],
+ ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [],
[], (* XXX needs testing *)
"scrub (securely wipe) free space",
"\
filesystem as initrd. We I<only> support the newer initramfs
format (compressed cpio files).");
- ("mount_loop", (RErr, [String "file"; String "mountpoint"]), 129, [],
+ ("mount_loop", (RErr, [Pathname "file"; Pathname "mountpoint"]), 129, [],
[],
"mount a file using the loop device",
"\
a limitation of the kernel or swap tools.");
("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [],
- [InitEmpty, Always, TestRun (
- [["sfdiskM"; "/dev/sda"; ","];
- ["mkswap_U"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"; "/dev/sda1"]])],
+ (let uuid = uuidgen () in
+ [InitEmpty, Always, TestRun (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["mkswap_U"; uuid; "/dev/sda1"]])]),
"create a swap partition with an explicit UUID",
"\
Create a swap partition on C<device> with UUID C<uuid>.");
This call returns the previous umask.");
- ("readdir", (RStructList ("entries", "dirent"), [String "dir"]), 138, [],
+ ("readdir", (RStructList ("entries", "dirent"), [Pathname "dir"]), 138, [],
[],
"read directories entries",
"\
a list of devices. This one returns a hash table (map) of
device name to directory where the device is mounted.");
- ("mkmountpoint", (RErr, [Pathname "path"]), 148, [],
+ ("mkmountpoint", (RErr, [String "exemptpath"]), 148, [],
+ (* This is a special case: while you would expect a parameter
+ * of type "Pathname", that doesn't work, because it implies
+ * NEED_ROOT in the generated calling code in stubs.c, and
+ * this function cannot use NEED_ROOT.
+ *)
[],
"create a mountpoint",
"\
Return the canonicalized absolute pathname of C<path>. The
returned path has no C<.>, C<..> or symbolic link path elements.");
- ("ln", (RErr, [String "target"; String "linkname"]), 164, [],
+ ("ln", (RErr, [String "target"; Pathname "linkname"]), 164, [],
[InitBasicFS, Always, TestOutputStruct (
[["touch"; "/a"];
["ln"; "/a"; "/b"];
"\
This command creates a hard link using the C<ln> command.");
- ("ln_f", (RErr, [String "target"; String "linkname"]), 165, [],
+ ("ln_f", (RErr, [String "target"; Pathname "linkname"]), 165, [],
[InitBasicFS, Always, TestOutputStruct (
[["touch"; "/a"];
["touch"; "/b"];
This command creates a hard link using the C<ln -f> command.
The C<-f> option removes the link (C<linkname>) if it exists already.");
- ("ln_s", (RErr, [String "target"; String "linkname"]), 166, [],
+ ("ln_s", (RErr, [String "target"; Pathname "linkname"]), 166, [],
[InitBasicFS, Always, TestOutputStruct (
[["touch"; "/a"];
["ln_s"; "a"; "/b"];
"\
This command creates a symbolic link using the C<ln -s> command.");
- ("ln_sf", (RErr, [String "target"; String "linkname"]), 167, [],
+ ("ln_sf", (RErr, [String "target"; Pathname "linkname"]), 167, [],
[InitBasicFS, Always, TestOutput (
[["mkdir_p"; "/a/b"];
["touch"; "/a/b/c"];
device or partition named C<device>.
See C<guestfs_swapon_device>.");
- ("swapon_file", (RErr, [String "file"]), 172, [],
+ ("swapon_file", (RErr, [Pathname "file"]), 172, [],
[InitBasicFS, Always, TestRun (
[["fallocate"; "/swap"; "8388608"];
["mkswap_file"; "/swap"];
This command enables swap to a file.
See C<guestfs_swapon_device> for other notes.");
- ("swapoff_file", (RErr, [String "file"]), 173, [],
+ ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
[], (* XXX tested by swapon_file *)
"disable swap on file",
"\
labeled swap partition.");
("swapon_uuid", (RErr, [String "uuid"]), 176, [],
- [InitEmpty, Always, TestRun (
- [["mkswap_U"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"; "/dev/sdb"];
- ["swapon_uuid"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"];
- ["swapoff_uuid"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"]])],
+ (let uuid = uuidgen () in
+ [InitEmpty, Always, TestRun (
+ [["mkswap_U"; uuid; "/dev/sdb"];
+ ["swapon_uuid"; uuid];
+ ["swapoff_uuid"; uuid]])]),
"enable swap on swap partition by UUID",
"\
This command enables swap to a swap partition with the given UUID.
See the documentation about SELINUX in L<guestfs(3)>,
and C<guestfs_setcon>");
+ ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [],
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ","];
+ ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"];
+ ["mount"; "/dev/sda1"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "make a filesystem with block size",
+ "\
+This call is similar to C<guestfs_mkfs>, but it allows you to
+control the block size of the resulting filesystem. Supported
+block sizes depend on the filesystem type, but typically they
+are C<1024>, C<2048> or C<4096> only.");
+
+ ("mke2journal", (RErr, [Int "blocksize"; Device "device"]), 188, [],
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ",100 ,"];
+ ["mke2journal"; "4096"; "/dev/sda1"];
+ ["mke2fs_J"; "ext2"; "4096"; "/dev/sda2"; "/dev/sda1"];
+ ["mount"; "/dev/sda2"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "make ext2/3/4 external journal",
+ "\
+This creates an ext2 external journal on C<device>. It is equivalent
+to the command:
+
+ mke2fs -O journal_dev -b blocksize device");
+
+ ("mke2journal_L", (RErr, [Int "blocksize"; String "label"; Device "device"]), 189, [],
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ",100 ,"];
+ ["mke2journal_L"; "4096"; "JOURNAL"; "/dev/sda1"];
+ ["mke2fs_JL"; "ext2"; "4096"; "/dev/sda2"; "JOURNAL"];
+ ["mount"; "/dev/sda2"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")],
+ "make ext2/3/4 external journal with label",
+ "\
+This creates an ext2 external journal on C<device> with label C<label>.");
+
+ ("mke2journal_U", (RErr, [Int "blocksize"; String "uuid"; Device "device"]), 190, [],
+ (let uuid = uuidgen () in
+ [InitEmpty, Always, TestOutput (
+ [["sfdiskM"; "/dev/sda"; ",100 ,"];
+ ["mke2journal_U"; "4096"; uuid; "/dev/sda1"];
+ ["mke2fs_JU"; "ext2"; "4096"; "/dev/sda2"; uuid];
+ ["mount"; "/dev/sda2"; "/"];
+ ["write_file"; "/new"; "new file contents"; "0"];
+ ["cat"; "/new"]], "new file contents")]),
+ "make ext2/3/4 external journal with UUID",
+ "\
+This creates an ext2 external journal on C<device> with UUID C<uuid>.");
+
+ ("mke2fs_J", (RErr, [String "fstype"; Int "blocksize"; Device "device"; Device "journal"]), 191, [],
+ [],
+ "make ext2/3/4 filesystem with external journal",
+ "\
+This creates an ext2/3/4 filesystem on C<device> with
+an external journal on C<journal>. It is equivalent
+to the command:
+
+ mke2fs -t fstype -b blocksize -J device=<journal> <device>
+
+See also C<guestfs_mke2journal>.");
+
+ ("mke2fs_JL", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "label"]), 192, [],
+ [],
+ "make ext2/3/4 filesystem with external journal",
+ "\
+This creates an ext2/3/4 filesystem on C<device> with
+an external journal on the journal labeled C<label>.
+
+See also C<guestfs_mke2journal_L>.");
+
+ ("mke2fs_JU", (RErr, [String "fstype"; Int "blocksize"; Device "device"; String "uuid"]), 193, [],
+ [],
+ "make ext2/3/4 filesystem with external journal",
+ "\
+This creates an ext2/3/4 filesystem on C<device> with
+an external journal on the journal with UUID C<uuid>.
+
+See also C<guestfs_mke2journal_U>.");
+
]
let all_functions = non_daemon_functions @ daemon_functions
"inotify_event", "INotifyEvent";
]
+(* What structs are actually returned. *)
+type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
+
+(* Returns a list of RStruct/RStructList structs that are returned
+ * by any function. Each element of returned list is a pair:
+ *
+ * (structname, RStructOnly)
+ * == there exists function which returns RStruct (_, structname)
+ * (structname, RStructListOnly)
+ * == there exists function which returns RStructList (_, structname)
+ * (structname, RStructAndList)
+ * == there are functions returning both RStruct (_, structname)
+ * and RStructList (_, structname)
+ *)
+let rstructs_used =
+ (* ||| is a "logical OR" for rstructs_used_t *)
+ let (|||) a b =
+ match a, b with
+ | RStructAndList, _
+ | _, RStructAndList -> RStructAndList
+ | RStructOnly, RStructListOnly
+ | RStructListOnly, RStructOnly -> RStructAndList
+ | RStructOnly, RStructOnly -> RStructOnly
+ | RStructListOnly, RStructListOnly -> RStructListOnly
+ in
+
+ let h = Hashtbl.create 13 in
+
+ (* if elem->oldv exists, update entry using ||| operator,
+ * else just add elem->newv to the hash
+ *)
+ let update elem newv =
+ try let oldv = Hashtbl.find h elem in
+ Hashtbl.replace h elem (newv ||| oldv)
+ with Not_found -> Hashtbl.add h elem newv
+ in
+
+ List.iter (
+ fun (_, style, _, _, _, _, _) ->
+ match fst style with
+ | RStruct (_, structname) -> update structname RStructOnly
+ | RStructList (_, structname) -> update structname RStructListOnly
+ | _ -> ()
+ ) all_functions;
+
+ (* return key->values as a list of (key,value) *)
+ Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
+
+(* debug:
+let () =
+ List.iter (
+ function
+ | sn, RStructOnly -> printf "%s RStructOnly\n" sn
+ | sn, RStructListOnly -> printf "%s RStructListOnly\n" sn
+ | sn, RStructAndList -> printf "%s RStructAndList\n" sn
+ ) rstructs_used
+*)
+
(* Used for testing language bindings. *)
type callt =
| CallString of string
loop 0 xs
let name_of_argt = function
- | Pathname n | Device n | String n | OptString n | StringList n | Bool n | Int n
+ | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | Bool n | Int n
| FileIn n | FileOut n -> n
let java_name_of_struct typ =
pr "struct %s_args {\n" name;
List.iter (
function
- | Pathname n | Device n | String n -> pr " string %s<>;\n" n
+ | Pathname n | Device n | Dev_or_Path n | String n -> pr " string %s<>;\n" n
| OptString n -> pr " str *%s;\n" n
| StringList n -> pr " str %s<>;\n" n
| Bool n -> pr " bool %s;\n" n
| args ->
List.iter (
function
- | Pathname n | Device n | String n ->
+ | Pathname n | Device n | Dev_or_Path n | String n ->
pr " args.%s = (char *) %s;\n" n n
| OptString n ->
pr " args.%s = %s ? (char **) &%s : NULL;\n" n n n
pr " struct guestfs_%s_args args;\n" name;
List.iter (
function
- (* FIXME: eventually, make String "const", too *)
- | Pathname n | Device n -> pr " const char *%s;\n" n
- | String n
+ | Device n | Dev_or_Path n
+ | Pathname n
+ | String n -> ()
| OptString n -> pr " char *%s;\n" n
| StringList n -> pr " char **%s;\n" n
| Bool n -> pr " int %s;\n" n
pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
pr " return;\n";
pr " }\n";
+ let pr_args n =
+ pr " char *%s = args.%s;\n" n n
+ in
List.iter (
function
| Pathname n ->
- pr " NEED_ROOT (goto done);\n";
+ pr_args n;
pr " ABS_PATH (%s, goto done);\n" n;
- | Device n ->
- pr " %s = args.%s;\n" n n;
+ | Device n ->
+ pr_args n;
pr " RESOLVE_DEVICE (%s, goto done);" n;
- | String n -> pr " %s = args.%s;\n" n n
+ | Dev_or_Path n ->
+ pr_args n;
+ pr " REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);" n;
+ | String n -> pr_args n
| OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
| StringList n ->
pr " %s = realloc (args.%s.%s_val,\n" n n n;
pr "\n"
);
+ (* this is used at least for do_equal *)
+ if List.exists (function Pathname _ -> true | _ -> false) (snd style) then (
+ (* Emit NEED_ROOT just once, even when there are two or
+ more Pathname args *)
+ pr " NEED_ROOT (goto done);\n";
+ );
+
(* Don't want to call the impl with any FileIn or FileOut
* parameters, since these go "outside" the RPC protocol.
*)
| OptString n, "NULL" -> ()
| Pathname n, arg
| Device n, arg
+ | Dev_or_Path n, arg
| String n, arg
| OptString n, arg ->
pr " const char *%s = \"%s\";\n" n (c_quote arg);
function
| OptString _, "NULL" -> pr ", NULL"
| Pathname n, _
- | Device n, _
+ | Device n, _ | Dev_or_Path n, _
| String n, _
| OptString n, _ ->
pr ", %s" n
List.iter (
function
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| OptString n
| FileIn n
fun i ->
function
| Pathname name
- | Device name | String name -> pr " %s = argv[%d];\n" name i
+ | Device name | Dev_or_Path name | String name -> pr " %s = argv[%d];\n" name i
| OptString name ->
pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
name i i
pr " %s" name;
List.iter (
function
- | Pathname n | Device n | String n -> pr " %s" n
+ | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
| OptString n -> pr " %s" n
| StringList n -> pr " '%s ...'" n
| Bool _ -> pr " true|false"
List.iter (
function
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| OptString n ->
next ();
List.iter (
function
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| FileIn n
| FileOut n ->
function
| StringList n ->
pr " ocaml_guestfs_free_strings (%s);\n" n;
- | Pathname _ | Device _ | String _ | OptString _ | Bool _ | Int _
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ | Bool _ | Int _
| FileIn _ | FileOut _ -> ()
) (snd style);
pr "%s : t -> " name;
List.iter (
function
- | Pathname _ | Device _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
| OptString _ -> pr "string option -> "
| StringList _ -> pr "string array -> "
| Bool _ -> pr "bool -> "
iteri (
fun i ->
function
- (* FIXME: ? *)
- | Pathname n | Device n | String n | FileIn n | FileOut n ->
+ | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
pr " char *%s;\n" n
| OptString n ->
(* http://www.perlmonks.org/?node_id=554277
let do_cleanups () =
List.iter (
function
- | Pathname _ | Device _ | String _ | OptString _ | Bool _ | Int _
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ | Bool _ | Int _
| FileIn _ | FileOut _ -> ()
| StringList n -> pr " free (%s);\n" n
) (snd style)
if !comma then pr ", ";
comma := true;
match arg with
- | Pathname n | Device n | String n
+ | Pathname n | Device n | Dev_or_Path n | String n
| OptString n | Bool n | Int n | FileIn n | FileOut n ->
pr "$%s" n
| StringList n ->
";
+ let emit_put_list_function typ =
+ pr "static PyObject *\n";
+ pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
+ pr "{\n";
+ pr " PyObject *list;\n";
+ pr " int i;\n";
+ pr "\n";
+ pr " list = PyList_New (%ss->len);\n" typ;
+ pr " for (i = 0; i < %ss->len; ++i)\n" typ;
+ pr " PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
+ pr " return list;\n";
+ pr "};\n";
+ pr "\n"
+ in
+
(* Structures, turned into Python dictionaries. *)
List.iter (
fun (typ, cols) ->
pr "};\n";
pr "\n";
- pr "static PyObject *\n";
- pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
- pr "{\n";
- pr " PyObject *list;\n";
- pr " int i;\n";
- pr "\n";
- pr " list = PyList_New (%ss->len);\n" typ;
- pr " for (i = 0; i < %ss->len; ++i)\n" typ;
- pr " PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
- pr " return list;\n";
- pr "};\n";
- pr "\n"
) structs;
+ (* Emit a put_TYPE_list function definition only if that function is used. *)
+ List.iter (
+ function
+ | typ, (RStructListOnly | RStructAndList) ->
+ (* generate the function for typ *)
+ emit_put_list_function typ
+ | typ, _ -> () (* empty *)
+ ) rstructs_used;
+
(* Python wrapper functions. *)
List.iter (
fun (name, style, _, _, _, _, _) ->
List.iter (
function
- | Pathname n | Device n | String n | FileIn n | FileOut n ->
+ | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
pr " const char *%s;\n" n
| OptString n -> pr " const char *%s;\n" n
| StringList n ->
pr " if (!PyArg_ParseTuple (args, (char *) \"O";
List.iter (
function
- | Pathname _ | Device _ | String _ | FileIn _ | FileOut _ -> pr "s"
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
| OptString _ -> pr "z"
| StringList _ -> pr "O"
| Bool _ -> pr "i" (* XXX Python has booleans? *)
pr " &py_g";
List.iter (
function
- | Pathname n | Device n | String n | FileIn n | FileOut n -> pr ", &%s" n
+ | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
| OptString n -> pr ", &%s" n
| StringList n -> pr ", &py_%s" n
| Bool n -> pr ", &%s" n
pr " g = get_handle (py_g);\n";
List.iter (
function
- | Pathname _ | Device _ | String _
+ | Pathname _ | Device _ | Dev_or_Path _ | String _
| FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
| StringList n ->
pr " %s = get_string_list (py_%s);\n" n n;
List.iter (
function
- | Pathname _ | Device _ | String _
+ | Pathname _ | Device _ | Dev_or_Path _ | String _
| FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
| StringList n ->
pr " free (%s);\n" n
List.iter (
function
- | Pathname n | Device n | String n | FileIn n | FileOut n ->
+ | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
pr " Check_Type (%sv, T_STRING);\n" n;
pr " const char *%s = StringValueCStr (%sv);\n" n n;
pr " if (!%s)\n" n;
List.iter (
function
- | Pathname _ | Device _ | String _
+ | Pathname _ | Device _ | Dev_or_Path _ | String _
| FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
| StringList n ->
pr " free (%s);\n" n
match arg with
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| OptString n
| FileIn n
List.iter (
function
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| OptString n
| FileIn n
List.iter (
function
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| OptString n
| FileIn n
List.iter (
function
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| FileIn n
| FileOut n ->
List.iter (
function
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| FileIn n
| FileOut n ->
function
| FileIn n
| FileOut n
- | Pathname n | Device n | String n -> pr "withCString %s $ \\%s -> " n n
+ | Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n
| OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
| StringList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
| Bool _ | Int _ -> ()
| Bool n -> sprintf "(fromBool %s)" n
| Int n -> sprintf "(fromIntegral %s)" n
| FileIn n | FileOut n
- | Pathname n | Device n | String n | OptString n | StringList n -> n
+ | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n -> n
) (snd style) in
pr "withForeignPtr h (\\p -> c_%s %s)\n" name
(String.concat " " ("p" :: args));
List.iter (
fun arg ->
(match arg with
- | Pathname _ | Device _ | String _ -> pr "%s" string
+ | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
| OptString _ -> if hs then pr "Maybe String" else pr "CString"
| StringList _ -> if hs then pr "[String]" else pr "Ptr CString"
| Bool _ -> pr "%s" bool
List.iter (
function
| Pathname n
- | Device n
+ | Device n | Dev_or_Path n
| String n
| FileIn n
| FileOut n -> pr " printf (\"%%s\\n\", %s);\n" n
git.annexia.org / libguestfs.git / blobdiff