[Libguestfs] [PATCH 5/9] ocaml: Avoid Warning 52 for URI.parse_uri function.

This avoids warning 52 in OCaml code such as: try URI.parse_uri arg with Invalid_argument "URI.parse_uri" -> ... which prints: Warning 52: Code should not depend on the actual values of this constructor's arguments. They are only for information and may change in future versions. (See manual section 8.5) In the long term we need to change fish/uri.c so that we can throw proper errors. --- builder/downloader.ml | 2 +- builder/sources.ml | 2 +- common/mltools/URI.ml | 5 +++++ common/mltools/URI.mli | 10 +++++++++- common/mltools/uri-c.c | 7 +++++-- customize/customize_main.ml | 2 +- get-kernel/get_kernel.ml | 2 +- resize/resize.ml | 4 ++-- sysprep/main.ml | 2 +- 9 files changed, 26 insertions(+), 10 deletions(-) diff --git a/builder/downloader.ml b/builder/downloader.ml index 3e776fdc2..b1119bae4 100644 --- a/builder/downloader.ml +++ b/builder/downloader.ml @@ -68,7 +68,7 @@ let rec download t ?template ?progress_bar ?(proxy = Curl.SystemProxy) uri = and download_to t ?(progress_bar = false) ~proxy uri filename = let parseduri = try URI.parse_uri uri - with Invalid_argument "URI.parse_uri" -> + with URI.Parse_failed -> error (f_"error parsing URI '%s'. Look for error messages printed above.") uri in diff --git a/builder/sources.ml b/builder/sources.ml index 93609bef6..d6de15968 100644 --- a/builder/sources.ml +++ b/builder/sources.ml @@ -51,7 +51,7 @@ let parse_conf file = let k = try Some (URI.parse_uri (List.assoc ("gpgkey", None) fields)) with | Not_found -> None - | Invalid_argument "URI.parse_uri" as ex -> + | URI.Parse_failed as ex -> debug "'%s' has invalid gpgkey URI" n; raise ex in match k with diff --git a/common/mltools/URI.ml b/common/mltools/URI.ml index c143ae2b9..0f51b612b 100644 --- a/common/mltools/URI.ml +++ b/common/mltools/URI.ml @@ -24,4 +24,9 @@ type uri = { password : string option; } +exception Parse_failed + external parse_uri : string -> uri = "guestfs_int_mllib_parse_uri" + +let () = + Callback.register_exception "URI.Parse_failed" Parse_failed diff --git a/common/mltools/URI.mli b/common/mltools/URI.mli index 0692f955f..1ef941268 100644 --- a/common/mltools/URI.mli +++ b/common/mltools/URI.mli @@ -26,5 +26,13 @@ type uri = { password : string option; (** password *) } +exception Parse_failed + val parse_uri : string -> uri -(** See [fish/uri.h]. *) +(** See [fish/uri.h]. + + This can raise {!Parse_failed}. + + Unfortunately we cannot be specific about the actual error + (although [fish/uri.c] should print something). XXX We should + be able to fetch and throw a real exception with the error. *) diff --git a/common/mltools/uri-c.c b/common/mltools/uri-c.c index 3e539c50e..b068c2960 100644 --- a/common/mltools/uri-c.c +++ b/common/mltools/uri-c.c @@ -26,6 +26,7 @@ #include <locale.h> #include <caml/alloc.h> +#include <caml/callback.h> #include <caml/fail.h> #include <caml/memory.h> #include <caml/mlvalues.h> @@ -45,8 +46,10 @@ guestfs_int_mllib_parse_uri (value argv /* arg value, not an array! */) int r; r = parse_uri (String_val (argv), &uri); - if (r == -1) - caml_invalid_argument ("URI.parse_uri"); + if (r == -1) { + value *exn = caml_named_value ("URI.Parse_failed"); + caml_raise (*exn); + } /* Convert the struct into an OCaml tuple. */ rv = caml_alloc_tuple (5); diff --git a/customize/customize_main.ml b/customize/customize_main.ml index aad6ebe65..8bd197b83 100644 --- a/customize/customize_main.ml +++ b/customize/customize_main.ml @@ -59,7 +59,7 @@ let main () = let add_file arg = let uri = try URI.parse_uri arg - with Invalid_argument "URI.parse_uri" -> + with URI.Parse_failed -> error (f_"error parsing URI '%s'. Look for error messages printed above.") arg in let format = match !format with "auto" -> None | fmt -> Some fmt in diff --git a/get-kernel/get_kernel.ml b/get-kernel/get_kernel.ml index 03e1a13c1..10ead853f 100644 --- a/get-kernel/get_kernel.ml +++ b/get-kernel/get_kernel.ml @@ -40,7 +40,7 @@ let parse_cmdline () = error (f_"--add option can only be given once"); let uri = try URI.parse_uri arg - with Invalid_argument "URI.parse_uri" -> + with URI.Parse_failed -> error (f_"error parsing URI '%s'. Look for error messages printed above.") arg in file := Some uri and set_domain dom = diff --git a/resize/resize.ml b/resize/resize.ml index 49fdfd538..f428f3ebe 100644 --- a/resize/resize.ml +++ b/resize/resize.ml @@ -313,14 +313,14 @@ read the man page virt-resize(1). (* infile can be a URI. *) let infile = try (infile, URI.parse_uri infile) - with Invalid_argument "URI.parse_uri" -> + with URI.Parse_failed -> error (f_"error parsing URI ‘%s’. Look for error messages printed above.") infile in (* outfile can be a URI. *) let outfile = try (outfile, URI.parse_uri outfile) - with Invalid_argument "URI.parse_uri" -> + with URI.Parse_failed -> error (f_"error parsing URI ‘%s’. Look for error messages printed above.") outfile in diff --git a/sysprep/main.ml b/sysprep/main.ml index 75aba578b..3ba0c7b82 100644 --- a/sysprep/main.ml +++ b/sysprep/main.ml @@ -55,7 +55,7 @@ let main () = let add_file arg = let uri = try URI.parse_uri arg - with Invalid_argument "URI.parse_uri" -> + with URI.Parse_failed -> error (f_"error parsing URI ‘%s’. Look for error messages printed above.") arg in let format = match !format with "auto" -> None | fmt -> Some fmt in push_front (uri, format) files; -- 2.13.2