[Libguestfs] [PATCH 5/9] ocaml: Avoid Warning 52 for URI.parse_uri function.
Richard W.M. Jones
rjones at redhat.com
Wed Oct 4 12:56:26 UTC 2017
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
More information about the Libguestfs
mailing list