Pino Toscano
2016-Jul-18 11:18 UTC
[Libguestfs] [PATCH 1/3] mllib: Getopt: point to man page as additional help
On error, point also to the man page of the current tool in addition to
'$TOOL --help'.
---
mllib/getopt-c.c | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/mllib/getopt-c.c b/mllib/getopt-c.c
index bf40f91..3efd5d3 100644
--- a/mllib/getopt-c.c
+++ b/mllib/getopt-c.c
@@ -69,8 +69,8 @@ cleanup_option_list (void *ptr)
static void __attribute__((noreturn))
show_error (int status)
{
- fprintf (stderr, _("Try `%s --help' for more information.\n"),
- guestfs_int_program_name);
+ fprintf (stderr, _("Try `%s --help' or consult %s(1) for more
information.\n"),
+ guestfs_int_program_name, guestfs_int_program_name);
exit (status);
}
--
2.7.4
Pino Toscano
2016-Jul-18 11:18 UTC
[Libguestfs] [PATCH 2/3] mllib: Getopt: add Getopt.Symbol
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
Pino Toscano
2016-Jul-18 11:18 UTC
[Libguestfs] [PATCH 3/3] builder: improve the handling of list formats
Store them directly in List_entries, an adding helper function to
convert from string.
Also use Getopt.Symbol for them, so there is no need to manually reject
invalid formats.
---
builder/cmdline.ml | 21 +++++++++++----------
builder/cmdline.mli | 2 +-
builder/list_entries.ml | 19 ++++++++++++++++---
builder/list_entries.mli | 16 +++++++++++++++-
4 files changed, 43 insertions(+), 15 deletions(-)
diff --git a/builder/cmdline.ml b/builder/cmdline.ml
index 846c2e3..0667994 100644
--- a/builder/cmdline.ml
+++ b/builder/cmdline.ml
@@ -42,7 +42,7 @@ type cmdline = {
delete_on_failure : bool;
format : string option;
gpg : string;
- list_format : [`Short|`Long|`Json];
+ list_format : List_entries.format;
memsize : int option;
network : bool;
ops : Customize_cmdline.ops;
@@ -88,15 +88,13 @@ let parse_cmdline () let format = ref "" in
let gpg = ref "gpg" in
- let list_format = ref `Short in
- let list_set_long () = list_format := `Long in
+ let list_format = ref List_entries.Short in
+ let list_set_long () = list_format := List_entries.Long in
let list_set_format arg - list_format := match arg with
- | "short" -> `Short
- | "long" -> `Long
- | "json" -> `Json
- | fmt ->
- error (f_"invalid --list-format type '%s', see the man
page") fmt in
+ (* Do not catch the Invalid_argument that list_format_of_string
+ * throws on invalid input, as it is already checked by the
+ * Getopt handling of Symbol. *)
+ list_format := List_entries.list_format_of_string arg in
let machine_readable = ref false in
@@ -118,6 +116,9 @@ let parse_cmdline () let sync = ref true in
let warn_if_partition = ref true in
+ let formats = List_entries.list_formats
+ and formats_string = String.concat "|" List_entries.list_formats in
+
let argspec = [
[ "--arch" ], Getopt.Set_string ("arch", arch),
s_"Set the output architecture";
[ "--attach" ], Getopt.String ("iso", attach_disk),
s_"Attach data disk/ISO during install";
@@ -144,7 +145,7 @@ let parse_cmdline () [ "--gpg" ],
Getopt.Set_string ("gpg", gpg), s_"Set GPG
binary/command";
[ "-l"; "--list" ], Getopt.Unit list_mode,
s_"List available templates";
[ "--long" ], Getopt.Unit list_set_long, s_"Shortcut
for --list-format long";
- [ "--list-format" ], Getopt.String ("short|long|json",
list_set_format),
+ [ "--list-format" ], Getopt.Symbol (formats_string, formats,
list_set_format),
s_"Set the format for --list
(default: short)";
[ "--machine-readable" ], Getopt.Set machine_readable,
s_"Make output machine readable";
[ "-m"; "--memsize" ], Getopt.Int
("mb", set_memsize), s_"Set memory size";
diff --git a/builder/cmdline.mli b/builder/cmdline.mli
index 854db61..a0517a2 100644
--- a/builder/cmdline.mli
+++ b/builder/cmdline.mli
@@ -30,7 +30,7 @@ type cmdline = {
delete_on_failure : bool;
format : string option;
gpg : string;
- list_format : [`Short|`Long|`Json];
+ list_format : List_entries.format;
memsize : int option;
network : bool;
ops : Customize_cmdline.ops;
diff --git a/builder/list_entries.ml b/builder/list_entries.ml
index 2f053e8..2a1aef4 100644
--- a/builder/list_entries.ml
+++ b/builder/list_entries.ml
@@ -21,11 +21,24 @@ open Common_utils
open Printf
+type format + | Short
+ | Long
+ | Json
+
+let list_formats = [ "short"; "long"; "json" ]
+
+let list_format_of_string = function
+ | "short" -> Short
+ | "long" -> Long
+ | "json" -> Json
+ | fmt -> invalid_arg fmt
+
let rec list_entries ~list_format ~sources index match list_format with
- | `Short -> list_entries_short index
- | `Long -> list_entries_long ~sources index
- | `Json -> list_entries_json ~sources index
+ | Short -> list_entries_short index
+ | Long -> list_entries_long ~sources index
+ | Json -> list_entries_json ~sources index
and list_entries_short index List.iter (
diff --git a/builder/list_entries.mli b/builder/list_entries.mli
index a3f35d3..008b906 100644
--- a/builder/list_entries.mli
+++ b/builder/list_entries.mli
@@ -16,4 +16,18 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
-val list_entries : list_format:([ `Short | `Long | `Json ]) ->
sources:Sources.source list -> Index.index -> unit
+type format + | Short
+ | Long
+ | Json
+
+val list_formats : string list
+(** The string representation of the available formats. *)
+
+val list_format_of_string : string -> format
+(** Convert from a string to the corresponding format.
+
+ Throw [Invalid_argument] if the string does not match any
+ valid format. *)
+
+val list_entries : list_format:format -> sources:Sources.source list ->
Index.index -> unit
--
2.7.4
Richard W.M. Jones
2016-Jul-18 11:37 UTC
Re: [Libguestfs] [PATCH 1/3] mllib: Getopt: point to man page as additional help
On Mon, Jul 18, 2016 at 01:18:00PM +0200, Pino Toscano wrote:> On error, point also to the man page of the current tool in addition to > '$TOOL --help'. > --- > mllib/getopt-c.c | 4 ++-- > 1 file changed, 2 insertions(+), 2 deletions(-) > > diff --git a/mllib/getopt-c.c b/mllib/getopt-c.c > index bf40f91..3efd5d3 100644 > --- a/mllib/getopt-c.c > +++ b/mllib/getopt-c.c > @@ -69,8 +69,8 @@ cleanup_option_list (void *ptr) > static void __attribute__((noreturn)) > show_error (int status) > { > - fprintf (stderr, _("Try `%s --help' for more information.\n"), > - guestfs_int_program_name); > + fprintf (stderr, _("Try `%s --help' or consult %s(1) for more information.\n"), > + guestfs_int_program_name, guestfs_int_program_name); > exit (status); > }ACK. Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com libguestfs lets you edit virtual machines. Supports shell scripting, bindings from many languages. http://libguestfs.org
Richard W.M. Jones
2016-Jul-18 11:39 UTC
Re: [Libguestfs] [PATCH 3/3] builder: improve the handling of list formats
On Mon, Jul 18, 2016 at 01:18:02PM +0200, Pino Toscano wrote:> Store them directly in List_entries, an adding helper function to > convert from string. > > Also use Getopt.Symbol for them, so there is no need to manually reject > invalid formats. > --- > builder/cmdline.ml | 21 +++++++++++---------- > builder/cmdline.mli | 2 +- > builder/list_entries.ml | 19 ++++++++++++++++--- > builder/list_entries.mli | 16 +++++++++++++++- > 4 files changed, 43 insertions(+), 15 deletions(-) > > diff --git a/builder/cmdline.ml b/builder/cmdline.ml > index 846c2e3..0667994 100644 > --- a/builder/cmdline.ml > +++ b/builder/cmdline.ml > @@ -42,7 +42,7 @@ type cmdline = { > delete_on_failure : bool; > format : string option; > gpg : string; > - list_format : [`Short|`Long|`Json]; > + list_format : List_entries.format; > memsize : int option; > network : bool; > ops : Customize_cmdline.ops; > @@ -88,15 +88,13 @@ let parse_cmdline () > let format = ref "" in > let gpg = ref "gpg" in > > - let list_format = ref `Short in > - let list_set_long () = list_format := `Long in > + let list_format = ref List_entries.Short in > + let list_set_long () = list_format := List_entries.Long in > let list_set_format arg > - list_format := match arg with > - | "short" -> `Short > - | "long" -> `Long > - | "json" -> `Json > - | fmt -> > - error (f_"invalid --list-format type '%s', see the man page") fmt in > + (* Do not catch the Invalid_argument that list_format_of_string > + * throws on invalid input, as it is already checked by the > + * Getopt handling of Symbol. *) > + list_format := List_entries.list_format_of_string arg in > > let machine_readable = ref false in > > @@ -118,6 +116,9 @@ let parse_cmdline () > let sync = ref true in > let warn_if_partition = ref true in > > + let formats = List_entries.list_formats > + and formats_string = String.concat "|" List_entries.list_formats in > + > let argspec = [ > [ "--arch" ], Getopt.Set_string ("arch", arch), s_"Set the output architecture"; > [ "--attach" ], Getopt.String ("iso", attach_disk), s_"Attach data disk/ISO during install"; > @@ -144,7 +145,7 @@ let parse_cmdline () > [ "--gpg" ], Getopt.Set_string ("gpg", gpg), s_"Set GPG binary/command"; > [ "-l"; "--list" ], Getopt.Unit list_mode, s_"List available templates"; > [ "--long" ], Getopt.Unit list_set_long, s_"Shortcut for --list-format long"; > - [ "--list-format" ], Getopt.String ("short|long|json", list_set_format), > + [ "--list-format" ], Getopt.Symbol (formats_string, formats, list_set_format), > s_"Set the format for --list (default: short)"; > [ "--machine-readable" ], Getopt.Set machine_readable, s_"Make output machine readable"; > [ "-m"; "--memsize" ], Getopt.Int ("mb", set_memsize), s_"Set memory size"; > diff --git a/builder/cmdline.mli b/builder/cmdline.mli > index 854db61..a0517a2 100644 > --- a/builder/cmdline.mli > +++ b/builder/cmdline.mli > @@ -30,7 +30,7 @@ type cmdline = { > delete_on_failure : bool; > format : string option; > gpg : string; > - list_format : [`Short|`Long|`Json]; > + list_format : List_entries.format; > memsize : int option; > network : bool; > ops : Customize_cmdline.ops; > diff --git a/builder/list_entries.ml b/builder/list_entries.ml > index 2f053e8..2a1aef4 100644 > --- a/builder/list_entries.ml > +++ b/builder/list_entries.ml > @@ -21,11 +21,24 @@ open Common_utils > > open Printf > > +type format > + | Short > + | Long > + | Json > + > +let list_formats = [ "short"; "long"; "json" ] > + > +let list_format_of_string = function > + | "short" -> Short > + | "long" -> Long > + | "json" -> Json > + | fmt -> invalid_arg fmt > + > let rec list_entries ~list_format ~sources index > match list_format with > - | `Short -> list_entries_short index > - | `Long -> list_entries_long ~sources index > - | `Json -> list_entries_json ~sources index > + | Short -> list_entries_short index > + | Long -> list_entries_long ~sources index > + | Json -> list_entries_json ~sources index > > and list_entries_short index > List.iter ( > diff --git a/builder/list_entries.mli b/builder/list_entries.mli > index a3f35d3..008b906 100644 > --- a/builder/list_entries.mli > +++ b/builder/list_entries.mli > @@ -16,4 +16,18 @@ > * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. > *) > > -val list_entries : list_format:([ `Short | `Long | `Json ]) -> sources:Sources.source list -> Index.index -> unit > +type format > + | Short > + | Long > + | Json > + > +val list_formats : string list > +(** The string representation of the available formats. *) > + > +val list_format_of_string : string -> format > +(** Convert from a string to the corresponding format. > + > + Throw [Invalid_argument] if the string does not match any > + valid format. *) > + > +val list_entries : list_format:format -> sources:Sources.source list -> Index.index -> unit > -- > 2.7.4 >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