thr3ads.net - Libguestfs - [Libguestfs] [PATCH 3/3] builder: improve the handling of list formats [Jul 2016]

If this information is useful, please help other people find it:
Share via:

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

head link

[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

head link

[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

head link

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

head link

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

Seemingly Similar Threads

Search for more possibly parallel threads

Libguestfs - Jul 2016 - [PATCH 3/3] builder: improve the handling of list formats

[Libguestfs] [PATCH 1/3] mllib: Getopt: point to man page as additional help

[Libguestfs] [PATCH 2/3] mllib: Getopt: add Getopt.Symbol

[Libguestfs] [PATCH 3/3] builder: improve the handling of list formats

Re: [Libguestfs] [PATCH 1/3] mllib: Getopt: point to man page as additional help

Re: [Libguestfs] [PATCH 3/3] builder: improve the handling of list formats

Seemingly Similar Threads