curl specific error types

src/format/opamTypes.mli

@@ -54,9 +54,22 @@ type dl_fail_reason = string option * string
     usage is: the first argument is displayed on normal mode (nothing
     if [None]), and the second one on verbose mode. *)
 
+(** Tool download failure infos *)
+type 'a dl_tool_failure = {
+  dl_exit_code : int;
+  dl_url : string;
+  dl_reason : 'a;
+}
+
+type curl_error =
+  | Curl_empty_response
+  | Curl_error_response of string
+  | Curl_generic_error of dl_fail_reason
+
 (** Download failure kind *)
 type dl_failure =
   | Generic_failure of dl_fail_reason
+  | Curl_failure of curl_error dl_tool_failure
 
 (** Download result *)
 type 'a download =

src/format/opamTypesBase.ml

@@ -335,3 +335,14 @@ let char_of_separator = function
 
 let get_dl_failure_reason = function
   | Generic_failure r -> r
+  | Curl_failure { dl_exit_code; dl_url; dl_reason } ->
+    let head_msg =
+      Printf.sprintf "curl failure while downloading %s\nExited with code %d\n"
+        dl_url dl_exit_code
+    in
+    match dl_reason with
+    | Curl_empty_response ->
+      Some "curl failure", head_msg^"Empty response"
+    | Curl_error_response e ->
+      Some "curl failure", head_msg^"Returned code "^e
+    | Curl_generic_error r -> r

src/repository/opamDownload.ml

@@ -15,7 +15,7 @@ open OpamProcess.Job.Op
 let log fmt = OpamConsole.log "CURL" fmt
 
 exception Download_fail of dl_failure
-let fail (s,l) = raise (Download_fail (Generic_failure (s,l)))
+let fail failure = raise (Download_fail failure)
 
 let user_agent =
   CString (Printf.sprintf "opam/%s" (OpamVersion.(to_string current)))
@@ -94,27 +94,34 @@ let tool_return url ret =
   match Lazy.force OpamRepositoryConfig.(!r.download_tool) with
   | _, `Default ->
     if OpamProcess.is_failure ret then
-      fail (Some "Download command failed",
+      fail (Generic_failure (Some "Download command failed",
                 Printf.sprintf "Download command failed: %s"
-                  (OpamProcess.result_summary ret))
+                  (OpamProcess.result_summary ret)))
     else Done ()
   | _, `Curl ->
-    if OpamProcess.is_failure ret then
-      fail (Some "Curl failed", Printf.sprintf "Curl failed: %s"
-                  (OpamProcess.result_summary ret));
-    match ret.OpamProcess.r_stdout with
-    | [] ->
-      fail (Some "curl empty response",
-                Printf.sprintf "curl: empty response while downloading %s"
-                  (OpamUrl.to_string url))
-    | l  ->
-      let code = List.hd (List.rev l) in
-      let num = try int_of_string code with Failure _ -> 999 in
-      if num >= 400 then
-        fail (Some ("curl error code " ^ code),
-                  Printf.sprintf "curl: code %s while downloading %s"
-                    code (OpamUrl.to_string url))
-      else Done ()
+    let error =
+      if OpamProcess.is_failure ret then
+        Some (Curl_generic_error
+                (Some "Curl failed",
+                 Printf.sprintf "Curl failed: %s"
+                   (OpamProcess.result_summary ret)))
+      else match ret.OpamProcess.r_stdout with
+        | [] -> Some Curl_empty_response
+      | l  ->
+        let code = List.hd (List.rev l) in
+        let num = try int_of_string code with Failure _ -> 999 in
+        if num >= 400
+        then Some (Curl_error_response code)
+        else None
+    in
+    match error with
+    | Some dl_reason ->
+      fail (Curl_failure
+              { dl_exit_code = ret.OpamProcess.r_code;
+                dl_url = OpamUrl.to_string url;
+                dl_reason;
+              })
+    | None -> Done ()
 
 let download_command ~compress ?checksum ~url ~dst () =
   let cmd, args =
@@ -157,17 +164,17 @@ let really_download
   download_command ~compress ?checksum ~url ~dst:tmp_dst ()
   @@+ fun () ->
   if not (Sys.file_exists tmp_dst) then
-    fail (Some "Downloaded file not found",
-          "Download command succeeded, but resulting file not found")
+    fail (Generic_failure (Some "Downloaded file not found",
+          "Download command succeeded, but resulting file not found"))
   else if Sys.file_exists dst && not overwrite then
     OpamSystem.internal_error "The downloaded file will overwrite %s." dst;
   if validate &&
      OpamRepositoryConfig.(!r.force_checksums <> Some false) then
     OpamStd.Option.iter (fun cksum ->
         if not (OpamHash.check_file tmp_dst cksum) then
-          fail (Some "Bad checksum",
+          fail (Generic_failure (Some "Bad checksum",
                     Printf.sprintf "Bad checksum, expected %s"
-                      (OpamHash.to_string cksum)))
+                      (OpamHash.to_string cksum))))
       checksum;
   OpamSystem.mv tmp_dst dst;
   Done ()

src/repository/opamHTTP.ml

@@ -80,6 +80,7 @@ module B = struct
            match e with
            | OpamDownload.Download_fail (Generic_failure (s, l)) ->
              Generic_failure (s, str l)
+           | OpamDownload.Download_fail failure -> failure
            | _ ->
              Generic_failure (Some "Download failed", str "download failed")
          in