[Libguestfs] [PATCH 4/5] mltools: curl: turn Curl.run to raise exceptions

[Pino Toscano]

Add a new Curl_failed exception, and raise it when Curl.run fails,
instead of exiting directly with error.  This allows users of Curl to
handle failed downloads gracefully.

Add wrappers to the "main" functions of virt-builder, virt-v2v, and
virt-v2v-copy-to-local to catch Curl_failed, and show a better message
for them.
---
 builder/builder.ml      |  9 ++++++++-
 common/mltools/curl.ml  | 15 ++++++++++++++-
 common/mltools/curl.mli |  3 +++
 v2v/copy_to_local.ml    |  9 ++++++++-
 v2v/v2v.ml              |  9 ++++++++-
 5 files changed, 41 insertions(+), 4 deletions(-)

diff --git a/builder/builder.ml b/builder/builder.ml
index c7cbcaedb..651db83f0 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -791,4 +791,11 @@ let main () =
 
   Option.may print_string stats
 
-let () = run_main_and_handle_errors main
+let () =
+  let main_wrap () =
+    try main ()
+    with
+    | Curl.Curl_failed (code, url) ->
+      error (f_"curl error: failed to download ‘%s’, error code %d") url code
+  in
+  run_main_and_handle_errors main_wrap
diff --git a/common/mltools/curl.ml b/common/mltools/curl.ml
index 6dba97534..eb32a4748 100644
--- a/common/mltools/curl.ml
+++ b/common/mltools/curl.ml
@@ -40,6 +40,8 @@ let args_of_proxy = function
   | SystemProxy ->     []
   | ForcedProxy url -> [ "proxy", Some url; "noproxy", Some "" ]
 
+exception Curl_failed of (int * string) (* exit code, URL *)
+
 let create ?(curl = "curl") ?(proxy = SystemProxy) ?tmpdir args =
   let args = safe_args @ args_of_proxy proxy @ args in
   { curl = curl; args = args; tmpdir = tmpdir }
@@ -71,8 +73,19 @@ let run { curl; args; tmpdir } =
   close_out chan;
 
   let cmd = sprintf "%s -q --config %s" (quote curl) (quote config_file) in
-  let lines = external_command ~echo_cmd:false cmd in
+  let lines, exitcode = external_command_code ~echo_cmd:false cmd in
   Unix.unlink config_file;
+  if exitcode <> 0 then (
+    let url =
+      try
+        List.find_map (
+          function
+          | "url", Some url -> Some url
+          | _, _ -> None
+        ) args
+      with Not_found -> s_"(unknown)" in
+    raise (Curl_failed (exitcode, url))
+  );
   lines
 
 let to_string { curl; args } =
diff --git a/common/mltools/curl.mli b/common/mltools/curl.mli
index a3e98dc68..34507b4a2 100644
--- a/common/mltools/curl.mli
+++ b/common/mltools/curl.mli
@@ -27,6 +27,9 @@ type proxy =
   | SystemProxy           (** Use the system settings. *)
   | ForcedProxy of string (** The proxy is forced to the specified URL. *)
 
+exception Curl_failed of (int * string) (* exit code, URL *)
+(** Exception thrown by [run] when the download fails. *)
+
 val create : ?curl:string -> ?proxy:proxy -> ?tmpdir:string -> args -> t
 (** Create a curl command handle.
 
diff --git a/v2v/copy_to_local.ml b/v2v/copy_to_local.ml
index 408cbdebc..e2749fa0c 100644
--- a/v2v/copy_to_local.ml
+++ b/v2v/copy_to_local.ml
@@ -311,4 +311,11 @@ and parse_libvirt_xml guest_name xml =
   let xml = Xml.to_string doc ~format:true in
   get_disks (), dcpath, xml
 
-let () = run_main_and_handle_errors main
+let () =
+  let main_wrap () =
+    try main ()
+    with
+    | Curl.Curl_failed (code, url) ->
+      error (f_"curl error: failed to download ‘%s’, error code %d") url code
+  in
+  run_main_and_handle_errors main_wrap
diff --git a/v2v/v2v.ml b/v2v/v2v.ml
index 277d8f2c7..1b3ec0b6c 100644
--- a/v2v/v2v.ml
+++ b/v2v/v2v.ml
@@ -870,4 +870,11 @@ and rcaps_from_source source =
     rcaps_video = video;
   }
 
-let () = run_main_and_handle_errors main
+let () =
+  let main_wrap () =
+    try main ()
+    with
+    | Curl.Curl_failed (code, url) ->
+      error (f_"curl error: failed to download ‘%s’, error code %d") url code
+  in
+  run_main_and_handle_errors main_wrap
-- 
2.20.1