Introduce a new type of option to allow a value out of a fixed choice, much like Arg.Symbol. --- mllib/getopt-c.c | 86 ++++++++++++++++++++++++++++++++++++++++++++ mllib/getopt.ml | 21 ++++++++++- mllib/getopt.mli | 5 +++ sysprep/sysprep_operation.ml | 2 +- 4 files changed, 112 insertions(+), 2 deletions(-) diff --git a/mllib/getopt-c.c b/mllib/getopt-c.c index 3efd5d3..2ea115d 100644 --- a/mllib/getopt-c.c +++ b/mllib/getopt-c.c @@ -103,6 +103,69 @@ find_spec (value specsv, int specs_len, char opt) CAMLreturnT (int, ret); } +static bool +list_mem (value listv, const char *val) +{ + CAMLparam1 (listv); + CAMLlocal1 (hd); + bool found = false; + + while (listv != Val_emptylist) { + hd = Field (listv, 0); + if (STREQ (String_val (hd), val)) { + found = true; + break; + } + listv = Field (listv, 1); + } + + CAMLreturnT (bool, found); +} + +static bool +vector_has_dashdash_opt (value vectorv, const char *opt) +{ + CAMLparam1 (vectorv); + bool found = false; + int len, i; + + len = Wosize_val (vectorv); + + for (i = 0; i < len; ++i) { + const char *key = String_val (Field (vectorv, i)); + + ++key; + if (key[0] == '-') + ++key; + + if (STREQ (opt, key)) { + found = true; + break; + } + } + + CAMLreturnT (bool, found); +} + +static void +list_print (FILE *stream, value listv) +{ + CAMLparam1 (listv); + CAMLlocal1 (hd); + bool first = true; + + while (listv != Val_emptylist) { + hd = Field (listv, 0); + if (!first) + fprintf (stream, ", "); + fprintf (stream, "%s", String_val (hd)); + first = false; + listv = Field (listv, 1); + } + + CAMLreturn0; +} + static void do_call1 (value funv, value paramv) { @@ -206,6 +269,7 @@ guestfs_int_mllib_getopt_parse (value argsv, value specsv, value anon_funv, valu case 4: /* Set_string of string * string ref */ case 5: /* Int of string * (int -> unit) */ case 6: /* Set_int of string * int ref */ + case 7: /* Symbol of string * string list * (string -> unit) */ has_arg = 1; break; @@ -306,6 +370,28 @@ guestfs_int_mllib_getopt_parse (value argsv, value specsv, value anon_funv, valu caml_modify (&Field (Field (actionv, 1), 0), Val_int (num)); break; + case 7: /* Symbol of string * string list * (string -> unit) */ + v = Field (actionv, 1); + if (!list_mem (v, optarg)) { + if (c != 0) { + fprintf (stderr, _("%s: '%s' is not allowed for -%c; allowed values are:\n"), + guestfs_int_program_name, optarg, c); + } else { + fprintf (stderr, _("%s: '%s' is not allowed for %s%s; allowed values are:\n"), + guestfs_int_program_name, optarg, + vector_has_dashdash_opt (specv, longopts[option_index].name) ? "--" : "-", + longopts[option_index].name); + } + fprintf (stderr, " "); + list_print (stderr, v); + fprintf (stderr, "\n"); + show_error (EXIT_FAILURE); + } + v = Field (actionv, 2); + v2 = caml_copy_string (optarg); + do_call1 (v, v2); + break; + default: error (EXIT_FAILURE, 0, "internal error: unhandled Tag_val (actionv) = %d", diff --git a/mllib/getopt.ml b/mllib/getopt.ml index 550baa4..ea1efe9 100644 --- a/mllib/getopt.ml +++ b/mllib/getopt.ml @@ -28,6 +28,7 @@ type spec = | Set_string of string * string ref | Int of string * (int -> unit) | Set_int of string * int ref + | Symbol of string * string list * (string -> unit) type keys = string list type doc = string @@ -81,7 +82,8 @@ let show_help h () = | String (arg, _) | Set_string (arg, _) | Int (arg, _) - | Set_int (arg, _) -> Some arg in + | Set_int (arg, _) + | Symbol (arg, _, _) -> Some arg in (match arg with | None -> () | Some arg -> @@ -150,11 +152,28 @@ let create specs ?anon_fun usage_msg = invalid_arg (sprintf "invalid option key: '%s'" key) in + let validate_spec = function + | Unit _ -> () + | Set _ -> () + | Clear _ -> () + | String _ -> () + | Set_string _ -> () + | Int _ -> () + | Set_int _ -> () + | Symbol (_, elements, _) -> + List.iter ( + fun e -> + if String.length e == 0 || is_prefix e "-" then + invalid_arg (sprintf "invalid element in Symbol: '%s'" e); + ) elements; + in + List.iter ( fun (keys, spec, doc) -> if keys == [] then invalid_arg "empty keys for Getopt spec"; List.iter validate_key keys; + validate_spec spec; ) specs; let t = diff --git a/mllib/getopt.mli b/mllib/getopt.mli index 2a8bada..8049a60 100644 --- a/mllib/getopt.mli +++ b/mllib/getopt.mli @@ -39,6 +39,11 @@ type spec = (* Option requiring an integer value as argument; the first element in the tuple is the documentation string of the argument, and the second is the reference to be set. *) + | Symbol of string * string list * (string -> unit) + (* Option requiring an argument among a fixed set; the first + element in the tuple is the documentation string of the + argument, the second is the list of allowed strings, + and the third is the function to call. *) type keys = string list type doc = string diff --git a/sysprep/sysprep_operation.ml b/sysprep/sysprep_operation.ml index b4d650f..24e72fe 100644 --- a/sysprep/sysprep_operation.ml +++ b/sysprep/sysprep_operation.ml @@ -222,7 +222,7 @@ let dump_pod_options () = | (op_name, { extra_argspec = (arg_names, (Getopt.String _ | Getopt.Set_string _ | Getopt.Int _ | - Getopt.Set_int _), + Getopt.Set_int _ | Getopt.Symbol _), _); extra_pod_argval = Some arg_val; extra_pod_description = pod }) -> -- 2.7.4

On Mon, Jul 18, 2016 at 01:18:02PM +0200, Pino Toscano wrote: ACK, although it would be nice if you could either rebase these on top of mine or review my getopt patches (v2). Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-builder quickly builds VMs from scratch http://libguestfs.org/virt-builder.1.html