diff --git a/mllib/getopt-c.c b/mllib/getopt-c.c index cc065e315..2d1a47e85 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 7dfd3ea03..53929e66c 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) module OptionName = struct type option_name = S of char | L of string | M of string @@ -93,7 +94,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 -> @@ -168,11 +170,29 @@ let create specs ?anon_fun usage_msg = s) | _ -> () 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 + List.iter validate_key keys; + validate_spec spec; ) specs; let t = { diff --git a/mllib/getopt.mli b/mllib/getopt.mli index dc5068ae7..2cae19bb8 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. *) module OptionName : sig type option_name = diff --git a/sysprep/sysprep_operation.ml b/sysprep/sysprep_operation.ml index 4ccd03c90..b2286f642 100644 --- a/sysprep/sysprep_operation.ml +++ b/sysprep/sysprep_operation.ml @@ -224,7 +224,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 }) ->