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

@@ -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
 

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

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

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. *)

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);

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

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 =

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
 

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;