summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard Jones <rjones@redhat.com>2009-04-10 10:26:10 +0100
committerRichard Jones <rjones@redhat.com>2009-04-10 10:26:10 +0100
commit469224a9eca9b575063e6a1ca1b1d97adb3448cb (patch)
tree2788e72473696b78c77a8ac2f67f5f2416151242
parent7c71920ab4f1b1beea3e1a38b91e2d81922d6cfb (diff)
downloadlibguestfs-469224a9eca9b575063e6a1ca1b1d97adb3448cb.tar.gz
libguestfs-469224a9eca9b575063e6a1ca1b1d97adb3448cb.tar.xz
libguestfs-469224a9eca9b575063e6a1ca1b1d97adb3448cb.zip
Just use plain lists for argument representation.
-rwxr-xr-xsrc/generator.ml159
1 files changed, 66 insertions, 93 deletions
diff --git a/src/generator.ml b/src/generator.ml
index 54c691b7..b0a71589 100755
--- a/src/generator.ml
+++ b/src/generator.ml
@@ -63,12 +63,7 @@ and ret =
| RPVList of string
| RVGList of string
| RLVList of string
-and args =
- (* 0 arguments, 1 argument, etc. The guestfs_h param is implicit. *)
- | P0
- | P1 of argt
- | P2 of argt * argt
- | P3 of argt * argt * argt
+and args = argt list (* Function parameters, guestfs handle is implicit. *)
and argt =
| String of string (* const char *name, cannot be NULL *)
| OptString of string (* const char *name, may be NULL *)
@@ -90,7 +85,7 @@ type flags =
*)
let non_daemon_functions = [
- ("launch", (Err, P0), -1, [FishAlias "run"; FishAction "launch"],
+ ("launch", (Err, []), -1, [FishAlias "run"; FishAction "launch"],
"launch the qemu subprocess",
"\
Internally libguestfs is implemented by running a virtual machine
@@ -99,7 +94,7 @@ using L<qemu(1)>.
You should call this after configuring the handle
(eg. adding drives) but before performing any actions.");
- ("wait_ready", (Err, P0), -1, [NotInFish],
+ ("wait_ready", (Err, []), -1, [NotInFish],
"wait until the qemu subprocess launches",
"\
Internally libguestfs is implemented by running a virtual machine
@@ -108,12 +103,12 @@ using L<qemu(1)>.
You should call this after C<guestfs_launch> to wait for the launch
to complete.");
- ("kill_subprocess", (Err, P0), -1, [],
+ ("kill_subprocess", (Err, []), -1, [],
"kill the qemu subprocess",
"\
This kills the qemu subprocess. You should never need to call this.");
- ("add_drive", (Err, P1 (String "filename")), -1, [FishAlias "add"],
+ ("add_drive", (Err, [String "filename"]), -1, [FishAlias "add"],
"add an image to examine or modify",
"\
This function adds a virtual machine disk image C<filename> to the
@@ -129,14 +124,14 @@ image).
This is equivalent to the qemu parameter C<-drive file=filename>.");
- ("add_cdrom", (Err, P1 (String "filename")), -1, [FishAlias "cdrom"],
+ ("add_cdrom", (Err, [String "filename"]), -1, [FishAlias "cdrom"],
"add a CD-ROM disk image to examine",
"\
This function adds a virtual CD-ROM disk image to the guest.
This is equivalent to the qemu parameter C<-cdrom filename>.");
- ("config", (Err, P2 (String "qemuparam", OptString "qemuvalue")), -1, [],
+ ("config", (Err, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
"add qemu parameters",
"\
This can be used to add arbitrary qemu command line parameters
@@ -148,7 +143,7 @@ The first character of C<param> string must be a C<-> (dash).
C<value> can be NULL.");
- ("set_path", (Err, P1 (String "path")), -1, [FishAlias "path"],
+ ("set_path", (Err, [String "path"]), -1, [FishAlias "path"],
"set the search path",
"\
Set the path that libguestfs searches for kernel and initrd.img.
@@ -161,7 +156,7 @@ must make sure it remains valid for the lifetime of the handle.
Setting C<path> to C<NULL> restores the default path.");
- ("get_path", (RConstString "path", P0), -1, [],
+ ("get_path", (RConstString "path", []), -1, [],
"get the search path",
"\
Return the current search path.
@@ -169,19 +164,19 @@ Return the current search path.
This is always non-NULL. If it wasn't set already, then this will
return the default path.");
- ("set_autosync", (Err, P1 (Bool "autosync")), -1, [FishAlias "autosync"],
+ ("set_autosync", (Err, [Bool "autosync"]), -1, [FishAlias "autosync"],
"set autosync mode",
"\
If C<autosync> is true, this enables autosync. Libguestfs will make a
best effort attempt to run C<guestfs_sync> when the handle is closed
(also if the program exits without closing handles).");
- ("get_autosync", (RBool "autosync", P0), -1, [],
+ ("get_autosync", (RBool "autosync", []), -1, [],
"get autosync mode",
"\
Get the autosync flag.");
- ("set_verbose", (Err, P1 (Bool "verbose")), -1, [FishAlias "verbose"],
+ ("set_verbose", (Err, [Bool "verbose"]), -1, [FishAlias "verbose"],
"set verbose mode",
"\
If C<verbose> is true, this turns on verbose messages (to C<stderr>).
@@ -189,14 +184,14 @@ If C<verbose> is true, this turns on verbose messages (to C<stderr>).
Verbose messages are disabled unless the environment variable
C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
- ("get_verbose", (RBool "verbose", P0), -1, [],
+ ("get_verbose", (RBool "verbose", []), -1, [],
"get verbose mode",
"\
This returns the verbose messages flag.")
]
let daemon_functions = [
- ("mount", (Err, P2 (String "device", String "mountpoint")), 1, [],
+ ("mount", (Err, [String "device"; String "mountpoint"]), 1, [],
"mount a guest disk at a position in the filesystem",
"\
Mount a guest disk at a position in the filesystem. Block devices
@@ -216,7 +211,7 @@ on the underlying device.
The filesystem options C<sync> and C<noatime> are set with this
call, in order to improve reliability.");
- ("sync", (Err, P0), 2, [],
+ ("sync", (Err, []), 2, [],
"sync disks, writes are flushed through to the disk image",
"\
This syncs the disk, so that any writes are flushed through to the
@@ -225,14 +220,14 @@ underlying disk image.
You should always call this if you have modified a disk image, before
closing the handle.");
- ("touch", (Err, P1 (String "path")), 3, [],
+ ("touch", (Err, [String "path"]), 3, [],
"update file timestamps or create a new file",
"\
Touch acts like the L<touch(1)> command. It can be used to
update the timestamps on a file, or, if the file does not exist,
to create a new zero-length file.");
- ("cat", (RString "content", P1 (String "path")), 4, [ProtocolLimitWarning],
+ ("cat", (RString "content", [String "path"]), 4, [ProtocolLimitWarning],
"list the contents of a file",
"\
Return the contents of the file named C<path>.
@@ -242,7 +237,7 @@ Note that this function cannot correctly handle binary files
as end of string). For those you need to use the C<guestfs_read_file>
function which has a more complex interface.");
- ("ll", (RString "listing", P1 (String "directory")), 5, [],
+ ("ll", (RString "listing", [String "directory"]), 5, [],
"list the files in a directory (long format)",
"\
List the files in C<directory> (relative to the root directory,
@@ -251,7 +246,7 @@ there is no cwd) in the format of 'ls -la'.
This command is mostly useful for interactive sessions. It
is I<not> intended that you try to parse the output string.");
- ("ls", (RStringList "listing", P1 (String "directory")), 6, [],
+ ("ls", (RStringList "listing", [String "directory"]), 6, [],
"list the files in a directory",
"\
List the files in C<directory> (relative to the root directory,
@@ -261,14 +256,14 @@ hidden files are shown.
This command is mostly useful for interactive sessions. Programs
should probably use C<guestfs_readdir> instead.");
- ("list_devices", (RStringList "devices", P0), 7, [],
+ ("list_devices", (RStringList "devices", []), 7, [],
"list the block devices",
"\
List all the block devices.
The full block device names are returned, eg. C</dev/sda>");
- ("list_partitions", (RStringList "partitions", P0), 8, [],
+ ("list_partitions", (RStringList "partitions", []), 8, [],
"list the partitions",
"\
List all the partitions detected on all block devices.
@@ -278,7 +273,7 @@ The full partition device names are returned, eg. C</dev/sda1>
This does not return logical volumes. For that you will need to
call C<guestfs_lvs>.");
- ("pvs", (RStringList "physvols", P0), 9, [],
+ ("pvs", (RStringList "physvols", []), 9, [],
"list the LVM physical volumes (PVs)",
"\
List all the physical volumes detected. This is the equivalent
@@ -289,7 +284,7 @@ PVs (eg. C</dev/sda2>).
See also C<guestfs_pvs_full>.");
- ("vgs", (RStringList "volgroups", P0), 10, [],
+ ("vgs", (RStringList "volgroups", []), 10, [],
"list the LVM volume groups (VGs)",
"\
List all the volumes groups detected. This is the equivalent
@@ -300,7 +295,7 @@ detected (eg. C<VolGroup00>).
See also C<guestfs_vgs_full>.");
- ("lvs", (RStringList "logvols", P0), 11, [],
+ ("lvs", (RStringList "logvols", []), 11, [],
"list the LVM logical volumes (LVs)",
"\
List all the logical volumes detected. This is the equivalent
@@ -311,25 +306,25 @@ This returns a list of the logical volume device names
See also C<guestfs_lvs_full>.");
- ("pvs_full", (RPVList "physvols", P0), 12, [],
+ ("pvs_full", (RPVList "physvols", []), 12, [],
"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", P0), 13, [],
+ ("vgs_full", (RVGList "volgroups", []), 13, [],
"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", P0), 14, [],
+ ("lvs_full", (RLVList "logvols", []), 14, [],
"list the LVM logical volumes (LVs)",
"\
List all the logical volumes detected. This is the equivalent
of the L<lvs(8)> command. The \"full\" version includes all fields.");
- ("read_lines", (RStringList "lines", P1 (String "path")), 15, [],
+ ("read_lines", (RStringList "lines", [String "path"]), 15, [],
"read file as lines",
"\
Return the contents of the file named C<path>.
@@ -342,7 +337,7 @@ Note that this function cannot correctly handle binary files
as end of line). For those you need to use the C<guestfs_read_file>
function which has a more complex interface.");
- ("aug_init", (Err, P2 (String "root", Int "flags")), 16, [],
+ ("aug_init", (Err, [String "root"; Int "flags"]), 16, [],
"create a new Augeas handle",
"\
Create a new Augeas handle for editing configuration files.
@@ -392,7 +387,7 @@ To close the handle, you can call C<guestfs_aug_close>.
To find out more about Augeas, see L<http://augeas.net/>.");
- ("aug_close", (Err, P0), 26, [],
+ ("aug_close", (Err, []), 26, [],
"close the current Augeas handle",
"\
Close the current Augeas handle and free up any resources
@@ -400,7 +395,7 @@ used by it. After calling this, you have to call
C<guestfs_aug_init> again before you can use any other
Augeas functions.");
- ("aug_defvar", (RInt "nrnodes", P2 (String "name", OptString "expr")), 17, [],
+ ("aug_defvar", (RInt "nrnodes", [String "name"; OptString "expr"]), 17, [],
"define an Augeas variable",
"\
Defines an Augeas variable C<name> whose value is the result
@@ -410,7 +405,7 @@ undefined.
On success this returns the number of nodes in C<expr>, or
C<0> if C<expr> evaluates to something which is not a nodeset.");
- ("aug_defnode", (RIntBool ("nrnodes", "created"), P3 (String "name", String "expr", String "val")), 18, [],
+ ("aug_defnode", (RIntBool ("nrnodes", "created"), [String "name"; String "expr"; String "val"]), 18, [],
"define an Augeas node",
"\
Defines a variable C<name> whose value is the result of
@@ -424,18 +419,18 @@ On success this returns a pair containing the
number of nodes in the nodeset, and a boolean flag
if a node was created.");
- ("aug_get", (RString "val", P1 (String "path")), 19, [],
+ ("aug_get", (RString "val", [String "path"]), 19, [],
"look up the value of an Augeas path",
"\
Look up the value associated with C<path>. If C<path>
matches exactly one node, the C<value> is returned.");
- ("aug_set", (Err, P2 (String "path", String "val")), 20, [],
+ ("aug_set", (Err, [String "path"; String "val"]), 20, [],
"set Augeas path to value",
"\
Set the value associated with C<path> to C<value>.");
- ("aug_insert", (Err, P3 (String "path", String "label", Bool "before")), 21, [],
+ ("aug_insert", (Err, [String "path"; String "label"; Bool "before"]), 21, [],
"insert a sibling Augeas node",
"\
Create a new sibling C<label> for C<path>, inserting it into
@@ -446,27 +441,27 @@ C<path> must match exactly one existing node in the tree, and
C<label> must be a label, ie. not contain C</>, C<*> or end
with a bracketed index C<[N]>.");
- ("aug_rm", (RInt "nrnodes", P1 (String "path")), 22, [],
+ ("aug_rm", (RInt "nrnodes", [String "path"]), 22, [],
"remove an Augeas path",
"\
Remove C<path> and all of its children.
On success this returns the number of entries which were removed.");
- ("aug_mv", (Err, P2 (String "src", String "dest")), 23, [],
+ ("aug_mv", (Err, [String "src"; String "dest"]), 23, [],
"move Augeas node",
"\
Move the node C<src> to C<dest>. C<src> must match exactly
one node. C<dest> is overwritten if it exists.");
- ("aug_match", (RStringList "matches", P1 (String "path")), 24, [],
+ ("aug_match", (RStringList "matches", [String "path"]), 24, [],
"return Augeas nodes which match path",
"\
Returns a list of paths which match the path expression C<path>.
The returned paths are sufficiently qualified so that they match
exactly one node in the current tree.");
- ("aug_save", (Err, P0), 25, [],
+ ("aug_save", (Err, []), 25, [],
"write all pending Augeas changes to disk",
"\
This writes all pending changes to disk.
@@ -474,7 +469,7 @@ This writes all pending changes to disk.
The flags which were passed to C<guestfs_aug_init> affect exactly
how files are saved.");
- ("aug_load", (Err, P0), 27, [],
+ ("aug_load", (Err, []), 27, [],
"load files into the tree",
"\
Load files into the tree.
@@ -482,7 +477,7 @@ Load files into the tree.
See C<aug_load> in the Augeas documentation for the full gory
details.");
- ("aug_ls", (RStringList "matches", P1 (String "path")), 28, [],
+ ("aug_ls", (RStringList "matches", [String "path"]), 28, [],
"list Augeas nodes under a path",
"\
This is just a shortcut for listing C<guestfs_aug_match>
@@ -625,28 +620,6 @@ let iteri f xs =
let chan = ref stdout
let pr fs = ksprintf (output_string !chan) fs
-let iter_args f = function
- | P0 -> ()
- | P1 arg1 -> f arg1
- | P2 (arg1, arg2) -> f arg1; f arg2
- | P3 (arg1, arg2, arg3) -> f arg1; f arg2; f arg3
-
-let iteri_args f = function
- | P0 -> ()
- | P1 arg1 -> f 0 arg1
- | P2 (arg1, arg2) -> f 0 arg1; f 1 arg2
- | P3 (arg1, arg2, arg3) -> f 0 arg1; f 1 arg2; f 2 arg3
-
-let map_args f = function
- | P0 -> []
- | P1 arg1 -> [f arg1]
- | P2 (arg1, arg2) ->
- let n1 = f arg1 in let n2 = f arg2 in [n1; n2]
- | P3 (arg1, arg2, arg3) ->
- let n1 = f arg1 in let n2 = f arg2 in let n3 = f arg3 in [n1; n2; n3]
-
-let nr_args = function | P0 -> 0 | P1 _ -> 1 | P2 _ -> 2 | P3 _ -> 3
-
let name_of_argt = function String n | OptString n | Bool n | Int n -> n
(* Check function names etc. for consistency. *)
@@ -854,10 +827,10 @@ and generate_xdr () =
let name = "guestfs_" ^ shortname in
(match snd style with
- | P0 -> ()
+ | [] -> ()
| args ->
pr "struct %s_args {\n" name;
- iter_args (
+ List.iter (
function
| String n -> pr " string %s<>;\n" n
| OptString n -> pr " str *%s;\n" n
@@ -1091,7 +1064,7 @@ and generate_client_actions () =
pr "{\n";
(match snd style with
- | P0 -> ()
+ | [] -> ()
| _ -> pr " struct %s_args args;\n" name
);
@@ -1109,11 +1082,11 @@ and generate_client_actions () =
pr "\n";
(match snd style with
- | P0 ->
+ | [] ->
pr " serial = dispatch (g, GUESTFS_PROC_%s, NULL, NULL);\n"
(String.uppercase shortname)
| args ->
- iter_args (
+ List.iter (
function
| String n ->
pr " args.%s = (char *) %s;\n" n n
@@ -1241,10 +1214,10 @@ and generate_daemon_actions () =
| RLVList _ -> pr " guestfs_lvm_int_lv_list *r;\n"; "NULL" in
(match snd style with
- | P0 -> ()
+ | [] -> ()
| args ->
pr " struct guestfs_%s_args args;\n" name;
- iter_args (
+ List.iter (
function
| String n
| OptString n -> pr " const char *%s;\n" n
@@ -1255,7 +1228,7 @@ and generate_daemon_actions () =
pr "\n";
(match snd style with
- | P0 -> ()
+ | [] -> ()
| args ->
pr " memset (&args, 0, sizeof args);\n";
pr "\n";
@@ -1263,7 +1236,7 @@ and generate_daemon_actions () =
pr " reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
pr " return;\n";
pr " }\n";
- iter_args (
+ List.iter (
function
| String n -> pr " %s = args.%s;\n" n n
| OptString n -> pr " %s = args.%s ? *args.%s : NULL;\n" n n n
@@ -1560,10 +1533,10 @@ and generate_fish_cmds () =
let longdesc = replace_str longdesc "C<guestfs_" "C<" in
let synopsis =
match snd style with
- | P0 -> name2
+ | [] -> name2
| args ->
sprintf "%s <%s>"
- name2 (String.concat "> <" (map_args name_of_argt args)) in
+ name2 (String.concat "> <" (List.map name_of_argt args)) in
let warnings =
if List.mem ProtocolLimitWarning flags then
@@ -1649,7 +1622,7 @@ FTP."
| RVGList _ -> pr " struct guestfs_lvm_vg_list *r;\n"
| RLVList _ -> pr " struct guestfs_lvm_lv_list *r;\n"
);
- iter_args (
+ List.iter (
function
| String n -> pr " const char *%s;\n" n
| OptString n -> pr " const char *%s;\n" n
@@ -1658,14 +1631,14 @@ FTP."
) (snd style);
(* Check and convert parameters. *)
- let argc_expected = nr_args (snd style) in
+ let argc_expected = List.length (snd style) in
pr " if (argc != %d) {\n" argc_expected;
pr " fprintf (stderr, \"%%s should have %d parameter(s)\\n\", cmd);\n"
argc_expected;
pr " fprintf (stderr, \"type 'help %%s' for help on %%s\\n\", cmd, cmd);\n";
pr " return -1;\n";
pr " }\n";
- iteri_args (
+ iteri (
fun i ->
function
| String name -> pr " %s = argv[%d];\n" name i
@@ -1785,7 +1758,7 @@ and generate_fish_actions_pod () =
pr "\n";
pr "\n";
pr " %s" name;
- iter_args (
+ List.iter (
function
| String n -> pr " %s" n
| OptString n -> pr " %s" n
@@ -1825,7 +1798,7 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
else pr "guestfs_lvm_int_lv_list *"
);
pr "%s%s (" prefix name;
- if handle = None && nr_args (snd style) = 0 then
+ if handle = None && List.length (snd style) = 0 then
pr "void"
else (
let comma = ref false in
@@ -1839,7 +1812,7 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
);
comma := true
in
- iter_args (
+ List.iter (
function
| String n -> next (); pr "const char *%s" n
| OptString n -> next (); pr "const char *%s" n
@@ -1859,7 +1832,7 @@ and generate_call_args ?handle style =
| None -> ()
| Some handle -> pr "%s" handle; comma := true
);
- iter_args (
+ List.iter (
fun arg ->
if !comma then pr ", ";
comma := true;
@@ -2015,13 +1988,13 @@ and generate_ocaml_c () =
fun (name, style, _, _, _, _) ->
pr "CAMLprim value\n";
pr "ocaml_guestfs_%s (value gv" name;
- iter_args (
+ List.iter (
fun arg -> pr ", value %sv" (name_of_argt arg)
) (snd style);
pr ")\n";
pr "{\n";
- pr " CAMLparam%d (gv" (1 + (nr_args (snd style)));
- iter_args (
+ pr " CAMLparam%d (gv" (1 + (List.length (snd style)));
+ List.iter (
fun arg -> pr ", %sv" (name_of_argt arg)
) (snd style);
pr ");\n";
@@ -2033,7 +2006,7 @@ and generate_ocaml_c () =
pr " caml_failwith (\"%s: used handle after closing it\");\n" name;
pr "\n";
- iter_args (
+ List.iter (
function
| String n ->
pr " const char *%s = String_val (%sv);\n" n n
@@ -2132,7 +2105,7 @@ and generate_ocaml_lvm_structure_decls () =
and generate_ocaml_prototype ?(is_external = false) name style =
if is_external then pr "external " else pr "val ";
pr "%s : t -> " name;
- iter_args (
+ List.iter (
function
| String _ -> pr "string -> "
| OptString _ -> pr "string option -> "
@@ -2251,7 +2224,7 @@ DESTROY (g)
generate_call_args ~handle:"g" style;
pr "\n";
pr " guestfs_h *g;\n";
- iter_args (
+ List.iter (
function
| String n -> pr " char *%s;\n" n
| OptString n -> pr " char *%s;\n" n
@@ -2514,7 +2487,7 @@ and generate_perl_prototype name style =
);
pr "$h->%s (" name;
let comma = ref false in
- iter_args (
+ List.iter (
fun arg ->
if !comma then pr ", ";
comma := true;