6:18 a.m.
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