diff options
| -rwxr-xr-x | src/generator.ml | 159 |
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; |