From de5b7164a6cc1143754fa84d798480fcb4e77724 Mon Sep 17 00:00:00 2001 From: Keryan Didier Date: Fri, 12 Jul 2024 11:40:21 +0200 Subject: [PATCH 1/6] Constructor layer for download failures reporting --- src/client/opamAction.ml | 8 ++-- src/client/opamAdminCommand.ml | 2 +- src/client/opamCommands.ml | 7 ++-- src/client/opamPinCommand.ml | 4 +- src/format/opamTypes.mli | 15 +++++-- src/repository/opamDownload.ml | 36 +++++++++-------- src/repository/opamDownload.mli | 2 +- src/repository/opamHTTP.ml | 10 +++-- src/repository/opamLocal.ml | 22 ++++++----- src/repository/opamRepository.ml | 67 +++++++++++++++++++------------- src/repository/opamVCS.ml | 2 +- src/state/opamFileTools.ml | 4 +- src/state/opamUpdate.ml | 4 +- 13 files changed, 106 insertions(+), 77 deletions(-) diff --git a/src/client/opamAction.ml b/src/client/opamAction.ml index da544b35502..cc76aa08e66 100644 --- a/src/client/opamAction.ml +++ b/src/client/opamAction.ml @@ -290,13 +290,13 @@ let download_shared_source st url nvs = OpamProcess.Job.catch (fun e -> let na = match e with - | OpamDownload.Download_fail (s,l) -> (s,l) + | OpamDownload.Download_fail (Generic_failure (s,l)) -> (s,l) | e -> (None, Printexc.to_string e) in Done (Some na)) @@ fun () -> OpamUpdate.download_shared_package_source st url nvs @@| function - | Some (Not_available (s, l)), _ -> + | Some (Not_available (Generic_failure (s, l))), _ -> let msg = OpamStd.Option.default l s in OpamConsole.error "Failed to get sources of %s%s: %s" (labelise OpamPackage.to_string) @@ -306,7 +306,7 @@ let download_shared_source st url nvs = Printf.sprintf " (%s)" (OpamUrl.to_string (OpamFile.URL.url url))) msg; Some (s, l) - | _, ((nv, name, Not_available (s, l)) :: _) -> + | _, ((nv, name, Not_available (Generic_failure (s, l))) :: _) -> let msg = match s with None -> l | Some s -> s in OpamConsole.error "Failed to get extra source \"%s\" of %s: %s" name (OpamPackage.to_string nv) msg; @@ -468,7 +468,7 @@ let prepare_package_source st nv dir = (OpamFile.URL.url urlf :: OpamFile.URL.mirrors urlf) @@| function | Result () | Up_to_date () -> None - | Not_available (_,msg) -> Some (Failure msg) + | Not_available (Generic_failure (_,msg)) -> Some (Failure msg) in List.fold_left (fun job dl -> job @@+ function diff --git a/src/client/opamAdminCommand.ml b/src/client/opamAdminCommand.ml index 9714372eed6..92dc7f26a96 100644 --- a/src/client/opamAdminCommand.ml +++ b/src/client/opamAdminCommand.ml @@ -175,7 +175,7 @@ let package_files_to_cache repo_root cache_dir cache_urls checksums (OpamFile.URL.url urlf :: OpamFile.URL.mirrors urlf) @@| fun r -> match OpamRepository.report_fetch_result nv r with - | Not_available (_,m) -> Some m + | Not_available (Generic_failure (_,m)) -> Some m | Up_to_date () | Result () -> None in error_opt @@| function diff --git a/src/client/opamCommands.ml b/src/client/opamCommands.ml index ff626d7a8b4..3887b03394c 100644 --- a/src/client/opamCommands.ml +++ b/src/client/opamCommands.ml @@ -3336,7 +3336,7 @@ let pin ?(unpin_only=false) cli = ~cache_dir:(OpamRepositoryPath.download_cache OpamStateConfig.(!r.root_dir)) basename pin_cache_dir [] [url] @@| function - | Not_available (_,u) -> + | Not_available (Generic_failure (_,u)) -> OpamConsole.error_and_exit `Sync_error "Could not retrieve %s" u | Result _ | Up_to_date _ -> @@ -3715,7 +3715,7 @@ let source cli = (OpamPackage.to_string nv) dir [] [url]) with - | Not_available (_,u) -> + | Not_available (Generic_failure (_,u)) -> OpamConsole.error_and_exit `Sync_error "%s is not available" u | Result _ | Up_to_date _ -> OpamConsole.formatted_msg @@ -3726,7 +3726,8 @@ let source cli = (let job = let open OpamProcess.Job.Op in OpamUpdate.download_package_source t nv dir @@+ function - | Some (Not_available (_,s)), _ | _, (_, Not_available (_, s)) :: _ -> + | Some (Not_available (Generic_failure (_,s))), _ + | _, (_, Not_available (Generic_failure (_, s))) :: _ -> OpamConsole.error_and_exit `Sync_error "Download failed: %s" s | None, _ | Some (Result _ | Up_to_date _), _ -> OpamAction.prepare_package_source t nv dir @@| function diff --git a/src/client/opamPinCommand.ml b/src/client/opamPinCommand.ml index 3ec2b4731e6..f9a93d554e6 100644 --- a/src/client/opamPinCommand.ml +++ b/src/client/opamPinCommand.ml @@ -87,7 +87,7 @@ let get_source_definition ?version ?subpath ?locked st nv url = | _, _ -> url in OpamUpdate.fetch_dev_package url srcdir ?subpath nv @@| function - | Not_available (_,s) -> raise (Fetch_Fail s) + | Not_available (Generic_failure (_,s)) -> raise (Fetch_Fail s) | Up_to_date _ | Result _ -> let srcdir = OpamFilename.SubPath.(srcdir /? subpath) in match OpamPinned.find_opam_file_in_source ?locked nv.name srcdir with @@ -828,7 +828,7 @@ let scan ~normalise ~recurse ?subpath url = ~cache_dir:(OpamRepositoryPath.download_cache OpamStateConfig.(!r.root_dir)) basename pin_cache_dir [] [url] @@| function - | Not_available (_,u) -> + | Not_available (Generic_failure (_,u)) -> OpamConsole.error_and_exit `Sync_error "Could not retrieve %s" u | Result _ | Up_to_date _ -> diff --git a/src/format/opamTypes.mli b/src/format/opamTypes.mli index 26e818d642d..e69e32e563c 100644 --- a/src/format/opamTypes.mli +++ b/src/format/opamTypes.mli @@ -48,13 +48,20 @@ type std_path = | Lib | Bin | Sbin | Share | Doc | Etc | Man | Toplevel | Stublibs +(** Download failure explanation *) +type dl_fail_reason = string option * string +(** Respectively the short and long version of an error message. The + usage is: the first argument is displayed on normal mode (nothing + if [None]), and the second one on verbose mode. *) + +(** Download failure kind *) +type dl_failure = + | Generic_failure of dl_fail_reason + (** Download result *) type 'a download = | Up_to_date of 'a - | Not_available of string option * string - (** Arguments are respectively the short and long version of an error message. - The usage is: the first argument is displayed on normal mode (nothing - if [None]), and the second one on verbose mode. *) + | Not_available of dl_failure | Result of 'a (** {2 Packages} *) diff --git a/src/repository/opamDownload.ml b/src/repository/opamDownload.ml index 482b12eabcf..be5c7e994b2 100644 --- a/src/repository/opamDownload.ml +++ b/src/repository/opamDownload.ml @@ -14,8 +14,8 @@ open OpamProcess.Job.Op let log fmt = OpamConsole.log "CURL" fmt -exception Download_fail of string option * string -let fail (s,l) = raise (Download_fail (s,l)) +exception Download_fail of dl_failure +let fail (s,l) = raise (Download_fail (Generic_failure (s,l))) let user_agent = CString (Printf.sprintf "opam/%s" (OpamVersion.(to_string current))) @@ -301,8 +301,9 @@ module SWHID = struct let rec aux max_tries = if max_tries <= 0 then Done (Not_available - (Some (fallback_err "max_tries"), - fallback_err "%d attempts tried; aborting" attempts)) + (Generic_failure + (Some (fallback_err "max_tries"), + fallback_err "%d attempts tried; aborting" attempts))) else get_dir hash @@+ function | Some (`Done fetch_url) -> Done (Result fetch_url) @@ -310,7 +311,8 @@ module SWHID = struct Unix.sleep 10; aux (max_tries - 1) | None | Some (`Failed | `Unknown) -> - Done (Not_available (None, fallback_err "Unknown swhid")) + Done (Not_available + (Generic_failure (None, fallback_err "Unknown swhid"))) in aux max_tries @@ -342,21 +344,21 @@ module SWHID = struct let sources = OpamFilename.Op.(dir / "src") in OpamFilename.extract_job archive sources @@| function | Some e -> - Not_available ( + Not_available (Generic_failure ( Some (fallback_err "archive extraction failure"), fallback_err "archive extraction failure %s" (match e with | Failure s -> s | OpamSystem.Process_error pe -> OpamProcess.string_of_result pe - | e -> Printexc.to_string e)) + | e -> Printexc.to_string e))) | None -> (match OpamSWHID.compute sources with | None -> - Not_available ( + Not_available (Generic_failure ( Some (fallback_err "can't check archive validity"), fallback_err - "error on swhid computation, can't check its validity") + "error on swhid computation, can't check its validity")) | Some computed -> if String.equal computed hash then (List.iter (fun (_nv, dst, _sp) -> @@ -365,23 +367,23 @@ module SWHID = struct dirnames; Result (Some "SWH fallback")) else - Not_available ( + Not_available (Generic_failure ( Some (fallback_err "archive not valid"), fallback_err "archive corrupted, opam file swhid %S vs computed %S" - hash computed))) + hash computed)))) else - Done (Not_available + Done (Not_available (Generic_failure (Some (fallback_err "skip retrieval"), - fallback_err "retrieval refused by user")) + fallback_err "retrieval refused by user"))) else - Done (Not_available + Done (Not_available (Generic_failure (Some (fallback_err "unreachable"), - fallback_err "network failure or API down")) + fallback_err "network failure or API down"))) else - Done (Not_available + Done (Not_available (Generic_failure (Some (fallback_err "no retrieval"), fallback_err "Download tool permitting post request (%s) not \ set as download tool" - (OpamStd.Format.pretty_list post_tools))) + (OpamStd.Format.pretty_list post_tools)))) end diff --git a/src/repository/opamDownload.mli b/src/repository/opamDownload.mli index 5d936039c90..69d2bf333d1 100644 --- a/src/repository/opamDownload.mli +++ b/src/repository/opamDownload.mli @@ -13,7 +13,7 @@ open OpamTypes (** Configuration init and handling of downloading commands *) -exception Download_fail of string option * string +exception Download_fail of dl_failure (** downloads a file from an URL, using Curl, Wget, or a custom configured tool, to the given directory. Returns the downloaded filename. diff --git a/src/repository/opamHTTP.ml b/src/repository/opamHTTP.ml index 9c62d0ea231..d24f90341e0 100644 --- a/src/repository/opamHTTP.ml +++ b/src/repository/opamHTTP.ml @@ -75,13 +75,15 @@ module B = struct OpamProcess.Job.catch (fun e -> OpamStd.Exn.fatal e; - let s,l = + let failure = let str = Printf.sprintf "%s (%s)" (OpamUrl.to_string remote_url) in match e with - | OpamDownload.Download_fail (s,l) -> s, str l - | _ -> Some "Download failed", str "download failed" + | OpamDownload.Download_fail (Generic_failure (s, l)) -> + Generic_failure (s, str l) + | _ -> + Generic_failure (Some "Download failed", str "download failed") in - Done (Not_available (s,l))) + Done (Not_available failure)) @@ fun () -> OpamDownload.download ~quiet:true ~overwrite:true ?checksum remote_url dirname @@+ fun local_file -> Done (Result (Some local_file)) diff --git a/src/repository/opamLocal.ml b/src/repository/opamLocal.ml index 77205c0940c..6e67ea53a1c 100644 --- a/src/repository/opamLocal.ml +++ b/src/repository/opamLocal.ml @@ -78,12 +78,12 @@ let rsync ?(args=[]) ?(exclude_vcdirs=true) src dst = ] in if not(remote || Sys.file_exists src) then - Done (Not_available (None, src)) + Done (Not_available (Generic_failure (None, src))) else if src = dst then Done (Up_to_date []) else if overlap src dst then (OpamConsole.error "Cannot sync %s into %s: they overlap" src dst; - Done (Not_available (None, src))) + Done (Not_available (Generic_failure (None, src)))) else ( OpamSystem.mkdir dst; let convert_path = Lazy.force convert_path in @@ -91,7 +91,7 @@ let rsync ?(args=[]) ?(exclude_vcdirs=true) src dst = ( rsync_arg :: args @ exclude_args @ [ "--delete"; "--delete-excluded"; convert_path src; convert_path dst; ]) @@| function - | None -> Not_available (None, src) + | None -> Not_available (Generic_failure (None, src)) | Some [] -> Up_to_date [] | Some lines -> Result lines ) @@ -104,13 +104,15 @@ let rsync_dirs ?args ?exclude_vcdirs url dst = if not (is_remote url) && not (OpamFilename.exists_dir (OpamFilename.Dir.of_string src_s)) then - Done (Not_available (None, Printf.sprintf "Directory %s does not exist" src_s)) + Done (Not_available + (Generic_failure + (None, Printf.sprintf "Directory %s does not exist" src_s))) else rsync ?args ?exclude_vcdirs src_s dst_s @@| function | Not_available _ as na -> na | Result _ -> if OpamFilename.exists_dir dst then Result dst - else Not_available (None, dst_s) + else Not_available (Generic_failure (None, dst_s)) | Up_to_date _ -> Up_to_date dst let rsync_file ?(args=[]) url dst = @@ -118,7 +120,7 @@ let rsync_file ?(args=[]) url dst = let dst_s = OpamFilename.to_string dst in log "rsync_file src=%s dst=%s" src_s dst_s; if not (is_remote url || OpamFilename.(exists (of_string src_s))) then - Done (Not_available (None, src_s)) + Done (Not_available (Generic_failure (None, src_s))) else if src_s = dst_s then Done (Up_to_date dst) else @@ -127,11 +129,11 @@ let rsync_file ?(args=[]) url dst = call_rsync (fun () -> Sys.file_exists dst_s) ( rsync_arg :: args @ [ convert_path src_s; convert_path dst_s ]) @@| function - | None -> Not_available (None, src_s) + | None -> Not_available (Generic_failure (None, src_s)) | Some [] -> Up_to_date dst | Some [_] -> if OpamFilename.exists dst then Result dst - else Not_available (None, src_s) + else Not_available (Generic_failure (None, src_s)) | Some l -> OpamSystem.internal_error "unknown rsync output: {%s}" @@ -223,12 +225,12 @@ module B = struct if OpamFilename.exists filename then res (Some filename) else Not_available - (None, Printf.sprintf + (Generic_failure (None, Printf.sprintf "Could not find target file %s after rsync with %s. \ Perhaps you meant %s/ ?" (OpamUrl.basename remote_url) (OpamUrl.to_string remote_url) - (OpamUrl.to_string remote_url)) + (OpamUrl.to_string remote_url))) let revision _ = Done None diff --git a/src/repository/opamRepository.ml b/src/repository/opamRepository.ml index f321669e707..b01925ab10b 100644 --- a/src/repository/opamRepository.ml +++ b/src/repository/opamRepository.ml @@ -75,7 +75,7 @@ let fetch_from_cache = checksums); OpamFilename.remove file; let m = "cache CONFLICT" in - Done (Not_available (Some m, m)) + Done (Not_available (Generic_failure (Some m, m))) in let dl_from_cache_job root_cache_url checksum file = let url = cache_url root_cache_url checksum in @@ -92,7 +92,8 @@ let fetch_from_cache = | None -> (OpamLocal.rsync_file url file @@| function | Result _ | Up_to_date _-> () - | Not_available (s,l) -> raise (OpamDownload.Download_fail (s,l))) + | Not_available failure -> + raise (OpamDownload.Download_fail failure)) end | #OpamUrl.version_control -> failwith "Version control not allowed as cache URL" @@ -117,12 +118,16 @@ let fetch_from_cache = end else mismatch hit_file with Not_found -> match checksums with - | [] -> let m = "cache miss" in Done (Not_available (Some m, m)) + | [] -> + let m = "cache miss" in + Done (Not_available (Generic_failure (Some m, m))) | checksum::other_checksums -> let local_file = cache_file cache_dir checksum in let tmpfile = OpamFilename.add_extension local_file "tmp" in let rec try_cache_dl = function - | [] -> let m = "cache miss" in Done (Not_available (Some m, m)) + | [] -> + let m = "cache miss" in + Done (Not_available (Generic_failure (Some m, m))) | root_cache_url::other_caches -> OpamProcess.Job.catch (function Failure _ @@ -223,7 +228,7 @@ let pull_from_upstream then ret else let m = "Checksum mismatch" in - Not_available (Some m, m) + Not_available (Generic_failure (Some m, m)) | (Result None | Up_to_date None) as ret -> ret | Not_available _ as na -> na @@ -239,7 +244,7 @@ let pull_from_mirrors label ?full_fetch ?working_dir ?subpath pull_from_upstream label ?full_fetch ?working_dir ?subpath cache_dir destdir checksums url @@+ function - | Not_available (_,s) -> + | Not_available (Generic_failure (_,s)) -> OpamConsole.warning "%s: download of %s failed (%s), trying mirror" label (OpamUrl.to_string url) s; aux mirrors @@ -252,7 +257,7 @@ let pull_from_mirrors label ?full_fetch ?working_dir ?subpath label (OpamUrl.to_string url); OpamFilename.rmdir destdir; let m = "can't check directory checksum" in - url, Not_available (Some m, m) + url, Not_available (Generic_failure (Some m, m)) | ret -> ret (* handle subpathes *) @@ -263,11 +268,14 @@ let pull_tree_t let fallback success = function | None -> success () | Some (Failure s) -> - Done (Not_available (Some s, "Could not extract archive:\n"^s)) + Done (Not_available + (Generic_failure (Some s, "Could not extract archive:\n"^s))) | Some (OpamSystem.Process_error pe) -> - Done (Not_available (Some (OpamProcess.result_summary pe), - OpamProcess.string_of_result pe)) - | Some e -> Done (Not_available (None, Printexc.to_string e)) + Done (Not_available (Generic_failure + (Some (OpamProcess.result_summary pe), + OpamProcess.string_of_result pe))) + | Some e -> Done (Not_available + (Generic_failure (None, Printexc.to_string e))) in match dirnames with | [ label, local_dirname, _subpath ] -> @@ -291,7 +299,8 @@ let pull_tree_t Done (Up_to_date label) with OpamSystem.Process_error r -> Done (Not_available - (Some label, OpamProcess.result_summary r)))) + (Generic_failure + (Some label, OpamProcess.result_summary r))))) dirnames in let text = @@ -310,8 +319,8 @@ let pull_tree_t let failing = OpamStd.List.filter_map (function | Result _ | Up_to_date _ -> None - | Not_available (Some s,l) -> Some (s,l) - | Not_available (None, _) -> assert false + | Not_available (Generic_failure (Some s,l)) -> Some (s,l) + | Not_available _ -> assert false ) (copies ()) in if failing = [] then Done (Up_to_date msg) else @@ -325,7 +334,7 @@ let pull_tree_t Printf.sprintf "%s: %s" nv msg) failing) in - Done (Not_available (Some simple, long))) + Done (Not_available (Generic_failure (Some simple, long)))) in let label = OpamStd.List.concat_map ", " (fun (x,_,_) -> x) dirnames in (match cache_dir with @@ -336,7 +345,7 @@ let pull_tree_t | None -> assert (cache_urls = []); let m = "no cache" in - Done (Not_available (Some m, m))) + Done (Not_available (Generic_failure (Some m, m)))) @@+ function | Up_to_date (archive, _) -> extract_archive archive "cached" @@ -350,9 +359,9 @@ let pull_tree_t if checksums = [] && OpamRepositoryConfig.(!r.force_checksums = Some true) then Done ( - Not_available ( - Some ("missing checksum"), - label ^ ": Missing checksum, and `--require-checksums` was set.")) + Not_available (Generic_failure ( + Some ("missing checksum"), + label ^ ": Missing checksum, and `--require-checksums` was set."))) else OpamFilename.with_tmp_dir_job @@ fun tmpdir -> let extract url archive = @@ -409,7 +418,7 @@ let pull_file label ?cache_dir ?(cache_urls=[]) ?(silent_hits=false) | None -> assert (cache_urls = []); let m = "no cache" in - Done (Not_available (Some m, m))) + Done (Not_available (Generic_failure (Some m, m)))) @@+ function | Up_to_date (f, _) -> if not silent_hits then @@ -428,15 +437,19 @@ let pull_file label ?cache_dir ?(cache_urls=[]) ?(silent_hits=false) then Done ( Not_available - (Some "missing checksum", - label ^ ": Missing checksum, and `--require-checksums` was set.")) + (Generic_failure + (Some "missing checksum", + label ^ ": Missing checksum, and `--require-checksums` \ + was set."))) else OpamFilename.with_tmp_dir_job (fun tmpdir -> pull_from_mirrors label cache_dir tmpdir checksums remote_urls @@| function | _, Up_to_date _ -> assert false | _, Result (Some f) -> OpamFilename.move ~src:f ~dst:file; Result () - | _, Result None -> let m = "is a directory" in Not_available (Some m, m) + | _, Result None -> + let m = "is a directory" in + Not_available (Generic_failure (Some m, m)) | _, (Not_available _ as na) -> na) let pull_file_to_cache label ~cache_dir ?(cache_urls=[]) checksums remote_urls = @@ -453,7 +466,9 @@ let pull_file_to_cache label ~cache_dir ?(cache_urls=[]) checksums remote_urls = @@| function | _, Up_to_date _ -> assert false | url, Result (Some _) -> Result (OpamUrl.to_string url) - | _, Result None -> let m = "is a directory" in Not_available (Some m, m) + | _, Result None -> + let m = "is a directory" in + Not_available (Generic_failure (Some m, m)) | _, (Not_available _ as na) -> na) let packages repo_root = @@ -607,8 +622,8 @@ let report_fetch_result pkg = function (OpamConsole.colorise `green (OpamPackage.to_string pkg)) msg; Up_to_date () - | Not_available (s, l) -> + | Not_available (Generic_failure (s, l)) -> let msg = match s with None -> l | Some s -> s in OpamConsole.msg "[%s] fetching sources failed: %s\n" (OpamConsole.colorise `red (OpamPackage.to_string pkg)) msg; - Not_available (s, l) + Not_available (Generic_failure (s, l)) diff --git a/src/repository/opamVCS.ml b/src/repository/opamVCS.ml index b7ef4f8b754..1aeebf88c42 100644 --- a/src/repository/opamVCS.ml +++ b/src/repository/opamVCS.ml @@ -84,7 +84,7 @@ module Make (VCS: VCS) = struct (OpamFilename.Dir.to_string dirname) (OpamUrl.to_string url) (match e with Failure fw -> fw | _ -> Printexc.to_string e); - Done (Not_available (None, OpamUrl.to_string url))) + Done (Not_available (Generic_failure (None, OpamUrl.to_string url)))) @@ fun () -> if VCS.exists dirname then VCS.clean dirname @@+ fun () -> diff --git a/src/state/opamFileTools.ml b/src/state/opamFileTools.ml index 75f25bc6d4d..6bcd66e1e4b 100644 --- a/src/state/opamFileTools.ml +++ b/src/state/opamFileTools.ml @@ -830,7 +830,7 @@ let t_lint ?check_extra_files ?(check_upstream=false) ?(all=false) t = | `http -> OpamProcess.Job.catch (function | Failure msg -> Done (Some msg) - | OpamDownload.Download_fail (s,l) -> + | OpamDownload.Download_fail (Generic_failure (s,l)) -> Done (Some (OpamStd.Option.default l s)) | e -> Done (Some (Printexc.to_string e))) @@ fun () -> @@ -848,7 +848,7 @@ let t_lint ?check_extra_files ?(check_upstream=false) ?(all=false) t = OpamLocal.rsync_file url filename @@| function | Up_to_date f | Result f -> check_checksum f - | Not_available (_,src) -> + | Not_available (Generic_failure (_,src)) -> Some ("Source not found: "^src) in cond 60 `Error "Upstream check failed" diff --git a/src/state/opamUpdate.ml b/src/state/opamUpdate.ml index 9fdf0f36750..6ab7e2b4355 100644 --- a/src/state/opamUpdate.ml +++ b/src/state/opamUpdate.ml @@ -578,13 +578,13 @@ let download_package_source_t st url nv_dirs = dirnames checksums (OpamFile.URL.url url :: OpamFile.URL.mirrors url)) @@+ function - | Not_available (_s,_l) as source_result + | Not_available _failure as source_result when OpamFile.Config.swh_fallback st.switch_global.config -> (OpamDownload.SWHID.archive_fallback url dirnames @@| function | Result None -> Some source_result | Result (Some r) -> Some (Result r) - | Not_available (s,l) -> Some (Not_available (s,l)) + | Not_available failure -> Some (Not_available failure) | Up_to_date _ -> assert false) | source_result -> Done (Some source_result) in From 7529b336ba447be033ab14953bae66861049325a Mon Sep 17 00:00:00 2001 From: Keryan Didier Date: Fri, 12 Jul 2024 17:50:18 +0200 Subject: [PATCH 2/6] abstract error strings through a function --- src/client/opamAction.ml | 10 +++++++--- src/client/opamAdminCommand.ml | 4 +++- src/client/opamCommands.ml | 11 +++++++---- src/client/opamPinCommand.ml | 7 +++++-- src/format/opamTypesBase.ml | 3 +++ src/format/opamTypesBase.mli | 3 +++ src/repository/opamRepository.ml | 5 +++-- src/state/opamFileTools.ml | 3 ++- 8 files changed, 33 insertions(+), 13 deletions(-) diff --git a/src/client/opamAction.ml b/src/client/opamAction.ml index cc76aa08e66..ed83e0c0eb6 100644 --- a/src/client/opamAction.ml +++ b/src/client/opamAction.ml @@ -296,7 +296,8 @@ let download_shared_source st url nvs = Done (Some na)) @@ fun () -> OpamUpdate.download_shared_package_source st url nvs @@| function - | Some (Not_available (Generic_failure (s, l))), _ -> + | Some (Not_available failure), _ -> + let s, l = OpamTypesBase.get_dl_failure_reason failure in let msg = OpamStd.Option.default l s in OpamConsole.error "Failed to get sources of %s%s: %s" (labelise OpamPackage.to_string) @@ -306,7 +307,8 @@ let download_shared_source st url nvs = Printf.sprintf " (%s)" (OpamUrl.to_string (OpamFile.URL.url url))) msg; Some (s, l) - | _, ((nv, name, Not_available (Generic_failure (s, l))) :: _) -> + | _, ((nv, name, Not_available failure) :: _) -> + let s, l = OpamTypesBase.get_dl_failure_reason failure in let msg = match s with None -> l | Some s -> s in OpamConsole.error "Failed to get extra source \"%s\" of %s: %s" name (OpamPackage.to_string nv) msg; @@ -468,7 +470,9 @@ let prepare_package_source st nv dir = (OpamFile.URL.url urlf :: OpamFile.URL.mirrors urlf) @@| function | Result () | Up_to_date () -> None - | Not_available (Generic_failure (_,msg)) -> Some (Failure msg) + | Not_available failure -> + let _, msg = OpamTypesBase.get_dl_failure_reason failure in + Some (Failure msg) in List.fold_left (fun job dl -> job @@+ function diff --git a/src/client/opamAdminCommand.ml b/src/client/opamAdminCommand.ml index 92dc7f26a96..e7407c10cff 100644 --- a/src/client/opamAdminCommand.ml +++ b/src/client/opamAdminCommand.ml @@ -175,7 +175,9 @@ let package_files_to_cache repo_root cache_dir cache_urls checksums (OpamFile.URL.url urlf :: OpamFile.URL.mirrors urlf) @@| fun r -> match OpamRepository.report_fetch_result nv r with - | Not_available (Generic_failure (_,m)) -> Some m + | Not_available failure -> + let _, m = OpamTypesBase.get_dl_failure_reason failure in + Some m | Up_to_date () | Result () -> None in error_opt @@| function diff --git a/src/client/opamCommands.ml b/src/client/opamCommands.ml index 3887b03394c..f7536447f22 100644 --- a/src/client/opamCommands.ml +++ b/src/client/opamCommands.ml @@ -3336,7 +3336,8 @@ let pin ?(unpin_only=false) cli = ~cache_dir:(OpamRepositoryPath.download_cache OpamStateConfig.(!r.root_dir)) basename pin_cache_dir [] [url] @@| function - | Not_available (Generic_failure (_,u)) -> + | Not_available failure -> + let _, u = OpamTypesBase.get_dl_failure_reason failure in OpamConsole.error_and_exit `Sync_error "Could not retrieve %s" u | Result _ | Up_to_date _ -> @@ -3715,7 +3716,8 @@ let source cli = (OpamPackage.to_string nv) dir [] [url]) with - | Not_available (Generic_failure (_,u)) -> + | Not_available failure -> + let _, u = OpamTypesBase.get_dl_failure_reason failure in OpamConsole.error_and_exit `Sync_error "%s is not available" u | Result _ | Up_to_date _ -> OpamConsole.formatted_msg @@ -3726,8 +3728,9 @@ let source cli = (let job = let open OpamProcess.Job.Op in OpamUpdate.download_package_source t nv dir @@+ function - | Some (Not_available (Generic_failure (_,s))), _ - | _, (_, Not_available (Generic_failure (_, s))) :: _ -> + | Some (Not_available failure), _ + | _, (_, Not_available failure) :: _ -> + let _, s = OpamTypesBase.get_dl_failure_reason failure in OpamConsole.error_and_exit `Sync_error "Download failed: %s" s | None, _ | Some (Result _ | Up_to_date _), _ -> OpamAction.prepare_package_source t nv dir @@| function diff --git a/src/client/opamPinCommand.ml b/src/client/opamPinCommand.ml index f9a93d554e6..33b20c59aa9 100644 --- a/src/client/opamPinCommand.ml +++ b/src/client/opamPinCommand.ml @@ -87,7 +87,9 @@ let get_source_definition ?version ?subpath ?locked st nv url = | _, _ -> url in OpamUpdate.fetch_dev_package url srcdir ?subpath nv @@| function - | Not_available (Generic_failure (_,s)) -> raise (Fetch_Fail s) + | Not_available failure -> + let _, s = OpamTypesBase.get_dl_failure_reason failure in + raise (Fetch_Fail s) | Up_to_date _ | Result _ -> let srcdir = OpamFilename.SubPath.(srcdir /? subpath) in match OpamPinned.find_opam_file_in_source ?locked nv.name srcdir with @@ -828,7 +830,8 @@ let scan ~normalise ~recurse ?subpath url = ~cache_dir:(OpamRepositoryPath.download_cache OpamStateConfig.(!r.root_dir)) basename pin_cache_dir [] [url] @@| function - | Not_available (Generic_failure (_,u)) -> + | Not_available failure -> + let _, u = OpamTypesBase.get_dl_failure_reason failure in OpamConsole.error_and_exit `Sync_error "Could not retrieve %s" u | Result _ | Up_to_date _ -> diff --git a/src/format/opamTypesBase.ml b/src/format/opamTypesBase.ml index b74e32cd977..958569aba27 100644 --- a/src/format/opamTypesBase.ml +++ b/src/format/opamTypesBase.ml @@ -345,3 +345,6 @@ let switch_selections_compare x let switch_selections_equal x y = switch_selections_compare x y = 0 + +let get_dl_failure_reason = function + | Generic_failure r -> r diff --git a/src/format/opamTypesBase.mli b/src/format/opamTypesBase.mli index 068ed269147..bdf46973f2c 100644 --- a/src/format/opamTypesBase.mli +++ b/src/format/opamTypesBase.mli @@ -117,3 +117,6 @@ val char_of_separator: separator -> char (* Switch selections *) val switch_selections_compare : switch_selections -> switch_selections -> int val switch_selections_equal : switch_selections -> switch_selections -> bool + +(* Download error helper functions *) +val get_dl_failure_reason : dl_failure -> dl_fail_reason diff --git a/src/repository/opamRepository.ml b/src/repository/opamRepository.ml index b01925ab10b..cc009557851 100644 --- a/src/repository/opamRepository.ml +++ b/src/repository/opamRepository.ml @@ -622,8 +622,9 @@ let report_fetch_result pkg = function (OpamConsole.colorise `green (OpamPackage.to_string pkg)) msg; Up_to_date () - | Not_available (Generic_failure (s, l)) -> + | Not_available failure as result -> + let s, l = OpamTypesBase.get_dl_failure_reason failure in let msg = match s with None -> l | Some s -> s in OpamConsole.msg "[%s] fetching sources failed: %s\n" (OpamConsole.colorise `red (OpamPackage.to_string pkg)) msg; - Not_available (Generic_failure (s, l)) + result diff --git a/src/state/opamFileTools.ml b/src/state/opamFileTools.ml index 6bcd66e1e4b..aad02051f3f 100644 --- a/src/state/opamFileTools.ml +++ b/src/state/opamFileTools.ml @@ -848,7 +848,8 @@ let t_lint ?check_extra_files ?(check_upstream=false) ?(all=false) t = OpamLocal.rsync_file url filename @@| function | Up_to_date f | Result f -> check_checksum f - | Not_available (Generic_failure (_,src)) -> + | Not_available failure -> + let _, src = OpamTypesBase.get_dl_failure_reason failure in Some ("Source not found: "^src) in cond 60 `Error "Upstream check failed" From dfd7958d9be70d72acd2c0bc74a62563adec6633 Mon Sep 17 00:00:00 2001 From: Keryan Didier Date: Fri, 12 Jul 2024 17:51:33 +0200 Subject: [PATCH 3/6] curl specific error types --- master_changes.md | 1 + src/format/opamTypes.mli | 13 +++++++++ src/format/opamTypesBase.ml | 11 +++++++ src/repository/opamDownload.ml | 53 +++++++++++++++++++--------------- src/repository/opamHTTP.ml | 1 + tests/reftests/download.test | 14 ++++----- 6 files changed, 63 insertions(+), 30 deletions(-) diff --git a/master_changes.md b/master_changes.md index d4953ce85b5..b114ee686ca 100644 --- a/master_changes.md +++ b/master_changes.md @@ -114,6 +114,7 @@ users) ## Internal * Stop using polymorphic comparison when comparing `OpamTypes.switch_selections` [#6102 @kit-ty-kate] + * Structured download error types [#6107 @Keryan-dev] ## Internal: Windows diff --git a/src/format/opamTypes.mli b/src/format/opamTypes.mli index e69e32e563c..ba2fa7987a2 100644 --- a/src/format/opamTypes.mli +++ b/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 = diff --git a/src/format/opamTypesBase.ml b/src/format/opamTypesBase.ml index 958569aba27..058a00bb4c0 100644 --- a/src/format/opamTypesBase.ml +++ b/src/format/opamTypesBase.ml @@ -348,3 +348,14 @@ let switch_selections_equal x y = 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 (s, l) -> s, head_msg^l diff --git a/src/repository/opamDownload.ml b/src/repository/opamDownload.ml index be5c7e994b2..ec5d85c9e86 100644 --- a/src/repository/opamDownload.ml +++ b/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))) @@ -93,27 +93,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 = @@ -156,17 +163,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 () diff --git a/src/repository/opamHTTP.ml b/src/repository/opamHTTP.ml index d24f90341e0..aa236c9d0fd 100644 --- a/src/repository/opamHTTP.ml +++ b/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 diff --git a/tests/reftests/download.test b/tests/reftests/download.test index d39c21cc1b5..0b56f9908d5 100644 --- a/tests/reftests/download.test +++ b/tests/reftests/download.test @@ -66,7 +66,7 @@ Processing 1/1: [foo.1: http] + curl "--another-args" "3" [ERROR] Failed to get sources of foo.1: Curl failed -OpamSolution.Fetch_fail("https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz (Curl failed: \"curl --another-args 3\" exited with code 2)") +OpamSolution.Fetch_fail("curl failure while downloading https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz\nExited with code 2\nCurl failed: \"curl --another-args 3\" exited with code 2") <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -88,9 +88,9 @@ The following actions will be performed: <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> Processing 1/1: [foo.1: http] + curl "--another-args" "3" -[ERROR] Failed to get sources of foo.1: curl error code ***The curl is a lie*** [args: --another-args 3] +[ERROR] Failed to get sources of foo.1: curl failure -OpamSolution.Fetch_fail("https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz (curl: code ***The curl is a lie*** [args: --another-args 3] while downloading https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz)") +OpamSolution.Fetch_fail("curl failure while downloading https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz\nExited with code 0\nReturned code ***The curl is a lie*** [args: --another-args 3]") <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -108,9 +108,9 @@ The following actions will be performed: <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> Processing 1/1: [foo.1: http] + curl "--write-out" "%{http_code}\n" "--retry" "3" "--retry-delay" "2" "--user-agent" "opam/current" "-L" "-o" "${BASEDIR}/OPAM/download/.opam-switch/sources/foo.1/v1.0.0.tar.gz.part" "--" "https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz" -[ERROR] Failed to get sources of foo.1: curl error code ***The curl is a lie*** [args: --write-out %{http_code}\n --retry 3 --retry-delay 2 --user-agent opam/current -L -o ${BASEDIR}/OPAM/download/.opam-switch/sources/foo.1/v1.0.0.tar.gz.part -- https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz] +[ERROR] Failed to get sources of foo.1: curl failure -OpamSolution.Fetch_fail("https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz (curl: code ***The curl is a lie*** [args: --write-out %{http_code}\n --retry 3 --retry-delay 2 --user-agent opam/current -L -o ${BASEDIR}/OPAM/download/.opam-switch/sources/foo.1/v1.0.0.tar.gz.part -- https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz] while downloading https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz)") +OpamSolution.Fetch_fail("curl failure while downloading https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz\nExited with code 0\nReturned code ***The curl is a lie*** [args: --write-out %{http_code}\n --retry 3 --retry-delay 2 --user-agent opam/current -L -o ${BASEDIR}/OPAM/download/.opam-switch/sources/foo.1/v1.0.0.tar.gz.part -- https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz]") <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -128,9 +128,9 @@ The following actions will be performed: <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> Processing 1/1: [foo.1: http] + curl "--another-args" "3" -[ERROR] Failed to get sources of foo.1: curl error code ***The curl is a lie*** [args: --another-args 3] +[ERROR] Failed to get sources of foo.1: curl failure -OpamSolution.Fetch_fail("https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz (curl: code ***The curl is a lie*** [args: --another-args 3] while downloading https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz)") +OpamSolution.Fetch_fail("curl failure while downloading https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz\nExited with code 0\nReturned code ***The curl is a lie*** [args: --another-args 3]") <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> From d73774130557394cdf54bfe5cdb4801da5cd066b Mon Sep 17 00:00:00 2001 From: Keryan Didier Date: Mon, 22 Jul 2024 17:28:28 +0200 Subject: [PATCH 4/6] propagate more straight-forward type --- src/client/opamAction.ml | 20 +++---- src/client/opamAction.mli | 4 +- src/client/opamAdminCommand.ml | 4 +- src/client/opamCommands.ml | 14 +++-- src/client/opamPinCommand.ml | 8 +-- src/client/opamSolution.ml | 4 +- src/format/opamTypes.mli | 10 ++-- src/format/opamTypesBase.ml | 8 ++- src/repository/opamDownload.ml | 97 ++++++++++++++++++-------------- src/repository/opamHTTP.ml | 9 ++- src/repository/opamLocal.ml | 41 +++++++++----- src/repository/opamRepository.ml | 72 ++++++++++++++---------- src/repository/opamVCS.ml | 4 +- src/state/opamFileTools.ml | 9 +-- 14 files changed, 176 insertions(+), 128 deletions(-) diff --git a/src/client/opamAction.ml b/src/client/opamAction.ml index ed83e0c0eb6..70778d72f17 100644 --- a/src/client/opamAction.ml +++ b/src/client/opamAction.ml @@ -290,15 +290,15 @@ let download_shared_source st url nvs = OpamProcess.Job.catch (fun e -> let na = match e with - | OpamDownload.Download_fail (Generic_failure (s,l)) -> (s,l) - | e -> (None, Printexc.to_string e) + | OpamDownload.Download_fail (Generic_failure reason) -> reason + | e -> { short_reason = None; long_reason = Printexc.to_string e } in Done (Some na)) @@ fun () -> OpamUpdate.download_shared_package_source st url nvs @@| function | Some (Not_available failure), _ -> - let s, l = OpamTypesBase.get_dl_failure_reason failure in - let msg = OpamStd.Option.default l s in + let r = OpamTypesBase.get_dl_failure_reason failure in + let msg = OpamStd.Option.default r.long_reason r.short_reason in OpamConsole.error "Failed to get sources of %s%s: %s" (labelise OpamPackage.to_string) (match url, nvs with @@ -306,13 +306,13 @@ let download_shared_source st url nvs = | Some url, _ -> Printf.sprintf " (%s)" (OpamUrl.to_string (OpamFile.URL.url url))) msg; - Some (s, l) + Some r | _, ((nv, name, Not_available failure) :: _) -> - let s, l = OpamTypesBase.get_dl_failure_reason failure in - let msg = match s with None -> l | Some s -> s in + let r = OpamTypesBase.get_dl_failure_reason failure in + let msg = OpamStd.Option.default r.long_reason r.short_reason in OpamConsole.error "Failed to get extra source \"%s\" of %s: %s" name (OpamPackage.to_string nv) msg; - Some (s, l) + Some r | Some (Result msg), _ -> print_full_action msg; None | Some (Up_to_date msg), _ -> @@ -471,8 +471,8 @@ let prepare_package_source st nv dir = @@| function | Result () | Up_to_date () -> None | Not_available failure -> - let _, msg = OpamTypesBase.get_dl_failure_reason failure in - Some (Failure msg) + let r = OpamTypesBase.get_dl_failure_reason failure in + Some (Failure r.long_reason) in List.fold_left (fun job dl -> job @@+ function diff --git a/src/client/opamAction.mli b/src/client/opamAction.mli index f355859e18e..da20400d4d9 100644 --- a/src/client/opamAction.mli +++ b/src/client/opamAction.mli @@ -21,14 +21,14 @@ open OpamStateTypes This doesn't update dev packages that already have a locally cached source. *) val download_package: - rw switch_state -> package -> (string option * string) option OpamProcess.job + rw switch_state -> package -> dl_fail_reason option OpamProcess.job (** [download_same_source_package t url packages] As [download_package], download upstream shared source [url] between [packages]. *) val download_shared_source: rw switch_state -> OpamFile.URL.t option -> package list -> - (string option * string) option OpamProcess.job + dl_fail_reason option OpamProcess.job (** [prepare_package_source t pkg dir] updates the given source [dir] with the extra downloads, overlays and patches from the package's metadata diff --git a/src/client/opamAdminCommand.ml b/src/client/opamAdminCommand.ml index e7407c10cff..192ba0a60ea 100644 --- a/src/client/opamAdminCommand.ml +++ b/src/client/opamAdminCommand.ml @@ -176,8 +176,8 @@ let package_files_to_cache repo_root cache_dir cache_urls (OpamFile.URL.url urlf :: OpamFile.URL.mirrors urlf) @@| fun r -> match OpamRepository.report_fetch_result nv r with | Not_available failure -> - let _, m = OpamTypesBase.get_dl_failure_reason failure in - Some m + let r = OpamTypesBase.get_dl_failure_reason failure in + Some r.long_reason | Up_to_date () | Result () -> None in error_opt @@| function diff --git a/src/client/opamCommands.ml b/src/client/opamCommands.ml index f7536447f22..fe48fe15768 100644 --- a/src/client/opamCommands.ml +++ b/src/client/opamCommands.ml @@ -3337,9 +3337,9 @@ let pin ?(unpin_only=false) cli = OpamStateConfig.(!r.root_dir)) basename pin_cache_dir [] [url] @@| function | Not_available failure -> - let _, u = OpamTypesBase.get_dl_failure_reason failure in + let r = OpamTypesBase.get_dl_failure_reason failure in OpamConsole.error_and_exit `Sync_error - "Could not retrieve %s" u + "Could not retrieve %s" r.long_reason | Result _ | Up_to_date _ -> let pkgs = OpamAuxCommands.opams_of_dir ?locked ~recurse ?subpath @@ -3717,8 +3717,9 @@ let source cli = [url]) with | Not_available failure -> - let _, u = OpamTypesBase.get_dl_failure_reason failure in - OpamConsole.error_and_exit `Sync_error "%s is not available" u + let r = OpamTypesBase.get_dl_failure_reason failure in + OpamConsole.error_and_exit `Sync_error "%s is not available" + r.long_reason | Result _ | Up_to_date _ -> OpamConsole.formatted_msg "Successfully fetched %s development repo to %s\n" @@ -3730,8 +3731,9 @@ let source cli = OpamUpdate.download_package_source t nv dir @@+ function | Some (Not_available failure), _ | _, (_, Not_available failure) :: _ -> - let _, s = OpamTypesBase.get_dl_failure_reason failure in - OpamConsole.error_and_exit `Sync_error "Download failed: %s" s + let r = OpamTypesBase.get_dl_failure_reason failure in + OpamConsole.error_and_exit `Sync_error "Download failed: %s" + r.long_reason | None, _ | Some (Result _ | Up_to_date _), _ -> OpamAction.prepare_package_source t nv dir @@| function | None -> diff --git a/src/client/opamPinCommand.ml b/src/client/opamPinCommand.ml index 33b20c59aa9..646d51580c7 100644 --- a/src/client/opamPinCommand.ml +++ b/src/client/opamPinCommand.ml @@ -88,8 +88,8 @@ let get_source_definition ?version ?subpath ?locked st nv url = in OpamUpdate.fetch_dev_package url srcdir ?subpath nv @@| function | Not_available failure -> - let _, s = OpamTypesBase.get_dl_failure_reason failure in - raise (Fetch_Fail s) + let r = OpamTypesBase.get_dl_failure_reason failure in + raise (Fetch_Fail r.long_reason) | Up_to_date _ | Result _ -> let srcdir = OpamFilename.SubPath.(srcdir /? subpath) in match OpamPinned.find_opam_file_in_source ?locked nv.name srcdir with @@ -831,9 +831,9 @@ let scan ~normalise ~recurse ?subpath url = OpamStateConfig.(!r.root_dir)) basename pin_cache_dir [] [url] @@| function | Not_available failure -> - let _, u = OpamTypesBase.get_dl_failure_reason failure in + let r = OpamTypesBase.get_dl_failure_reason failure in OpamConsole.error_and_exit `Sync_error - "Could not retrieve %s" u + "Could not retrieve %s" r.long_reason | Result _ | Up_to_date _ -> pins_of_dir pin_cache_dir, Some cleanup with e -> OpamStd.Exn.finalise e cleanup diff --git a/src/client/opamSolution.ml b/src/client/opamSolution.ml index 905d53cd82d..c957fa6cc9d 100644 --- a/src/client/opamSolution.ml +++ b/src/client/opamSolution.ml @@ -634,8 +634,8 @@ let parallel_apply t OpamAction.download_shared_source t url nvs) @@+ function | None -> store_time (); Done (`Successful (installed, removed)) - | Some (_short_error, long_error) -> - Done (`Exception (Fetch_fail long_error))) + | Some { short_reason = _; long_reason } -> + Done (`Exception (Fetch_fail long_reason))) | `Build nv -> if assume_built && OpamPackage.Set.mem nv requested then diff --git a/src/format/opamTypes.mli b/src/format/opamTypes.mli index ba2fa7987a2..7c89431068b 100644 --- a/src/format/opamTypes.mli +++ b/src/format/opamTypes.mli @@ -49,10 +49,12 @@ type std_path = | Toplevel | Stublibs (** Download failure explanation *) -type dl_fail_reason = string option * string -(** Respectively the short and long version of an error message. The - usage is: the first argument is displayed on normal mode (nothing - if [None]), and the second one on verbose mode. *) +type dl_fail_reason = { + short_reason : string option; + long_reason : string; +} +(** The usage is: [short_reason] is displayed on normal mode + (nothing if [None]), and [long_reason] on verbose mode. *) (** Tool download failure infos *) type 'a dl_tool_failure = { diff --git a/src/format/opamTypesBase.ml b/src/format/opamTypesBase.ml index 058a00bb4c0..0449b54ca6c 100644 --- a/src/format/opamTypesBase.ml +++ b/src/format/opamTypesBase.ml @@ -355,7 +355,9 @@ let get_dl_failure_reason = function in match dl_reason with | Curl_empty_response -> - Some "curl failure", head_msg^"Empty response" + { short_reason = Some "curl failure"; + long_reason = head_msg^"Empty response" } | Curl_error_response e -> - Some "curl failure", head_msg^"Returned code "^e - | Curl_generic_error (s, l) -> s, head_msg^l + { short_reason = Some "curl failure"; + long_reason = head_msg^"Returned code "^e } + | Curl_generic_error r -> { r with long_reason = head_msg^r.long_reason } diff --git a/src/repository/opamDownload.ml b/src/repository/opamDownload.ml index ec5d85c9e86..38f4e36373e 100644 --- a/src/repository/opamDownload.ml +++ b/src/repository/opamDownload.ml @@ -17,6 +17,7 @@ let log fmt = OpamConsole.log "CURL" fmt exception Download_fail of dl_failure let fail failure = raise (Download_fail failure) + let user_agent = CString (Printf.sprintf "opam/%s" (OpamVersion.(to_string current))) @@ -93,17 +94,18 @@ let tool_return url ret = match Lazy.force OpamRepositoryConfig.(!r.download_tool) with | _, `Default -> if OpamProcess.is_failure ret then - fail (Generic_failure (Some "Download command failed", - Printf.sprintf "Download command failed: %s" - (OpamProcess.result_summary ret))) + fail (Generic_failure { + short_reason = Some "Download command failed"; + long_reason = Printf.sprintf "Download command failed: %s" + (OpamProcess.result_summary ret); }) else Done () | _, `Curl -> let error = if OpamProcess.is_failure ret then Some (Curl_generic_error - (Some "Curl failed", - Printf.sprintf "Curl failed: %s" - (OpamProcess.result_summary ret))) + { short_reason = Some "Curl failed"; + long_reason = Printf.sprintf "Curl failed: %s" + (OpamProcess.result_summary ret); }) else match ret.OpamProcess.r_stdout with | [] -> Some Curl_empty_response | l -> @@ -163,17 +165,20 @@ let really_download download_command ~compress ?checksum ~url ~dst:tmp_dst () @@+ fun () -> if not (Sys.file_exists tmp_dst) then - fail (Generic_failure (Some "Downloaded file not found", - "Download command succeeded, but resulting file not found")) + fail (Generic_failure { + short_reason = Some "Downloaded file not found"; + long_reason = "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 (Generic_failure (Some "Bad checksum", - Printf.sprintf "Bad checksum, expected %s" - (OpamHash.to_string cksum)))) + fail (Generic_failure { + short_reason = Some "Bad checksum"; + long_reason = Printf.sprintf "Bad checksum, expected %s" + (OpamHash.to_string cksum); })) checksum; OpamSystem.mv tmp_dst dst; Done () @@ -308,9 +313,10 @@ module SWHID = struct let rec aux max_tries = if max_tries <= 0 then Done (Not_available - (Generic_failure - (Some (fallback_err "max_tries"), - fallback_err "%d attempts tried; aborting" attempts))) + (Generic_failure { + short_reason = Some (fallback_err "max_tries"); + long_reason = fallback_err "%d attempts tried; aborting" + attempts; })) else get_dir hash @@+ function | Some (`Done fetch_url) -> Done (Result fetch_url) @@ -319,7 +325,9 @@ module SWHID = struct aux (max_tries - 1) | None | Some (`Failed | `Unknown) -> Done (Not_available - (Generic_failure (None, fallback_err "Unknown swhid"))) + (Generic_failure { + short_reason = None; + long_reason = fallback_err "Unknown swhid"; })) in aux max_tries @@ -351,21 +359,24 @@ module SWHID = struct let sources = OpamFilename.Op.(dir / "src") in OpamFilename.extract_job archive sources @@| function | Some e -> - Not_available (Generic_failure ( - Some (fallback_err "archive extraction failure"), - fallback_err "archive extraction failure %s" - (match e with - | Failure s -> s - | OpamSystem.Process_error pe -> - OpamProcess.string_of_result pe - | e -> Printexc.to_string e))) + Not_available (Generic_failure { + short_reason = + Some (fallback_err "archive extraction failure"); + long_reason = fallback_err "archive extraction failure %s" + (match e with + | Failure s -> s + | OpamSystem.Process_error pe -> + OpamProcess.string_of_result pe + | e -> Printexc.to_string e); }) | None -> (match OpamSWHID.compute sources with | None -> - Not_available (Generic_failure ( - Some (fallback_err "can't check archive validity"), - fallback_err - "error on swhid computation, can't check its validity")) + Not_available (Generic_failure { + short_reason = + Some (fallback_err "can't check archive validity"); + long_reason = fallback_err + "error on swhid computation, can't check its validity"; + }) | Some computed -> if String.equal computed hash then (List.iter (fun (_nv, dst, _sp) -> @@ -374,23 +385,23 @@ module SWHID = struct dirnames; Result (Some "SWH fallback")) else - Not_available (Generic_failure ( - Some (fallback_err "archive not valid"), - fallback_err - "archive corrupted, opam file swhid %S vs computed %S" - hash computed)))) + Not_available (Generic_failure { + short_reason = Some (fallback_err "archive not valid"); + long_reason = fallback_err + "archive corrupted, opam file swhid %S vs \ + computed %S" hash computed; }))) else - Done (Not_available (Generic_failure - (Some (fallback_err "skip retrieval"), - fallback_err "retrieval refused by user"))) + Done (Not_available (Generic_failure { + short_reason = Some (fallback_err "skip retrieval"); + long_reason = fallback_err "retrieval refused by user"; })) else - Done (Not_available (Generic_failure - (Some (fallback_err "unreachable"), - fallback_err "network failure or API down"))) + Done (Not_available (Generic_failure { + short_reason = Some (fallback_err "unreachable"); + long_reason = fallback_err "network failure or API down"; })) else - Done (Not_available (Generic_failure - (Some (fallback_err "no retrieval"), - fallback_err "Download tool permitting post request (%s) not \ - set as download tool" - (OpamStd.Format.pretty_list post_tools)))) + Done (Not_available (Generic_failure { + short_reason = Some (fallback_err "no retrieval"); + long_reason = fallback_err "Download tool permitting \ + post request (%s) not set as download tool" + (OpamStd.Format.pretty_list post_tools); })) end diff --git a/src/repository/opamHTTP.ml b/src/repository/opamHTTP.ml index aa236c9d0fd..a1629ffc0e7 100644 --- a/src/repository/opamHTTP.ml +++ b/src/repository/opamHTTP.ml @@ -78,11 +78,14 @@ module B = struct let failure = let str = Printf.sprintf "%s (%s)" (OpamUrl.to_string remote_url) in match e with - | OpamDownload.Download_fail (Generic_failure (s, l)) -> - Generic_failure (s, str l) + | OpamDownload.Download_fail ( + Generic_failure { short_reason; long_reason = l }) -> + Generic_failure { short_reason; long_reason = str l } | OpamDownload.Download_fail failure -> failure | _ -> - Generic_failure (Some "Download failed", str "download failed") + Generic_failure { + short_reason = Some "Download failed"; + long_reason = str "download failed"; } in Done (Not_available failure)) @@ fun () -> diff --git a/src/repository/opamLocal.ml b/src/repository/opamLocal.ml index 6e67ea53a1c..1265559568f 100644 --- a/src/repository/opamLocal.ml +++ b/src/repository/opamLocal.ml @@ -78,12 +78,14 @@ let rsync ?(args=[]) ?(exclude_vcdirs=true) src dst = ] in if not(remote || Sys.file_exists src) then - Done (Not_available (Generic_failure (None, src))) + Done (Not_available ( + Generic_failure { short_reason = None; long_reason = src })) else if src = dst then Done (Up_to_date []) else if overlap src dst then (OpamConsole.error "Cannot sync %s into %s: they overlap" src dst; - Done (Not_available (Generic_failure (None, src)))) + Done (Not_available ( + Generic_failure { short_reason = None; long_reason = src }))) else ( OpamSystem.mkdir dst; let convert_path = Lazy.force convert_path in @@ -91,7 +93,8 @@ let rsync ?(args=[]) ?(exclude_vcdirs=true) src dst = ( rsync_arg :: args @ exclude_args @ [ "--delete"; "--delete-excluded"; convert_path src; convert_path dst; ]) @@| function - | None -> Not_available (Generic_failure (None, src)) + | None -> Not_available ( + Generic_failure { short_reason = None; long_reason = src }) | Some [] -> Up_to_date [] | Some lines -> Result lines ) @@ -105,14 +108,17 @@ let rsync_dirs ?args ?exclude_vcdirs url dst = not (OpamFilename.exists_dir (OpamFilename.Dir.of_string src_s)) then Done (Not_available - (Generic_failure - (None, Printf.sprintf "Directory %s does not exist" src_s))) + (Generic_failure { + short_reason = None; + long_reason = Printf.sprintf + "Directory %s does not exist" src_s; })) else rsync ?args ?exclude_vcdirs src_s dst_s @@| function | Not_available _ as na -> na | Result _ -> if OpamFilename.exists_dir dst then Result dst - else Not_available (Generic_failure (None, dst_s)) + else Not_available (Generic_failure + { short_reason = None; long_reason = dst_s }) | Up_to_date _ -> Up_to_date dst let rsync_file ?(args=[]) url dst = @@ -120,7 +126,8 @@ let rsync_file ?(args=[]) url dst = let dst_s = OpamFilename.to_string dst in log "rsync_file src=%s dst=%s" src_s dst_s; if not (is_remote url || OpamFilename.(exists (of_string src_s))) then - Done (Not_available (Generic_failure (None, src_s))) + Done (Not_available (Generic_failure + { short_reason = None; long_reason = src_s })) else if src_s = dst_s then Done (Up_to_date dst) else @@ -129,11 +136,13 @@ let rsync_file ?(args=[]) url dst = call_rsync (fun () -> Sys.file_exists dst_s) ( rsync_arg :: args @ [ convert_path src_s; convert_path dst_s ]) @@| function - | None -> Not_available (Generic_failure (None, src_s)) + | None -> Not_available (Generic_failure + { short_reason = None; long_reason = src_s }) | Some [] -> Up_to_date dst | Some [_] -> if OpamFilename.exists dst then Result dst - else Not_available (Generic_failure (None, src_s)) + else Not_available (Generic_failure + { short_reason = None; long_reason = src_s }) | Some l -> OpamSystem.internal_error "unknown rsync output: {%s}" @@ -225,12 +234,14 @@ module B = struct if OpamFilename.exists filename then res (Some filename) else Not_available - (Generic_failure (None, Printf.sprintf - "Could not find target file %s after rsync with %s. \ - Perhaps you meant %s/ ?" - (OpamUrl.basename remote_url) - (OpamUrl.to_string remote_url) - (OpamUrl.to_string remote_url))) + (Generic_failure { + short_reason = None; + long_reason = Printf.sprintf + "Could not find target file %s after rsync with %s. \ + Perhaps you meant %s/ ?" + (OpamUrl.basename remote_url) + (OpamUrl.to_string remote_url) + (OpamUrl.to_string remote_url); }) let revision _ = Done None diff --git a/src/repository/opamRepository.ml b/src/repository/opamRepository.ml index cc009557851..f4cf7909374 100644 --- a/src/repository/opamRepository.ml +++ b/src/repository/opamRepository.ml @@ -15,6 +15,9 @@ open OpamProcess.Job.Op let log fmt = OpamConsole.log "REPOSITORY" fmt let slog = OpamConsole.slog +let generic_failure msg = + Generic_failure { short_reason = Some msg; long_reason = msg } + let find_backend_by_kind = function | `http -> (module OpamHTTP.B: OpamRepositoryBackend.S) @@ -75,7 +78,7 @@ let fetch_from_cache = checksums); OpamFilename.remove file; let m = "cache CONFLICT" in - Done (Not_available (Generic_failure (Some m, m))) + Done (Not_available (generic_failure m)) in let dl_from_cache_job root_cache_url checksum file = let url = cache_url root_cache_url checksum in @@ -120,14 +123,14 @@ let fetch_from_cache = with Not_found -> match checksums with | [] -> let m = "cache miss" in - Done (Not_available (Generic_failure (Some m, m))) + Done (Not_available (generic_failure m)) | checksum::other_checksums -> let local_file = cache_file cache_dir checksum in let tmpfile = OpamFilename.add_extension local_file "tmp" in let rec try_cache_dl = function | [] -> let m = "cache miss" in - Done (Not_available (Generic_failure (Some m, m))) + Done (Not_available (generic_failure m)) | root_cache_url::other_caches -> OpamProcess.Job.catch (function Failure _ @@ -228,7 +231,7 @@ let pull_from_upstream then ret else let m = "Checksum mismatch" in - Not_available (Generic_failure (Some m, m)) + Not_available (generic_failure m) | (Result None | Up_to_date None) as ret -> ret | Not_available _ as na -> na @@ -244,9 +247,9 @@ let pull_from_mirrors label ?full_fetch ?working_dir ?subpath pull_from_upstream label ?full_fetch ?working_dir ?subpath cache_dir destdir checksums url @@+ function - | Not_available (Generic_failure (_,s)) -> + | Not_available (Generic_failure { long_reason; _ }) -> OpamConsole.warning "%s: download of %s failed (%s), trying mirror" - label (OpamUrl.to_string url) s; + label (OpamUrl.to_string url) long_reason; aux mirrors | r -> Done (url, r) in @@ -257,7 +260,7 @@ let pull_from_mirrors label ?full_fetch ?working_dir ?subpath label (OpamUrl.to_string url); OpamFilename.rmdir destdir; let m = "can't check directory checksum" in - url, Not_available (Generic_failure (Some m, m)) + url, Not_available (generic_failure m) | ret -> ret (* handle subpathes *) @@ -269,13 +272,18 @@ let pull_tree_t | None -> success () | Some (Failure s) -> Done (Not_available - (Generic_failure (Some s, "Could not extract archive:\n"^s))) + (Generic_failure { + short_reason = Some s; + long_reason = "Could not extract archive:\n"^s; })) | Some (OpamSystem.Process_error pe) -> - Done (Not_available (Generic_failure - (Some (OpamProcess.result_summary pe), - OpamProcess.string_of_result pe))) + Done (Not_available ( + Generic_failure { + short_reason = Some (OpamProcess.result_summary pe); + long_reason = OpamProcess.string_of_result pe; })) | Some e -> Done (Not_available - (Generic_failure (None, Printexc.to_string e))) + (Generic_failure + { short_reason = None; + long_reason = Printexc.to_string e })) in match dirnames with | [ label, local_dirname, _subpath ] -> @@ -299,8 +307,9 @@ let pull_tree_t Done (Up_to_date label) with OpamSystem.Process_error r -> Done (Not_available - (Generic_failure - (Some label, OpamProcess.result_summary r))))) + (Generic_failure { + short_reason = Some label; + long_reason = OpamProcess.result_summary r; })))) dirnames in let text = @@ -319,7 +328,10 @@ let pull_tree_t let failing = OpamStd.List.filter_map (function | Result _ | Up_to_date _ -> None - | Not_available (Generic_failure (Some s,l)) -> Some (s,l) + | Not_available (Generic_failure + { short_reason = Some s; + long_reason = l }) -> + Some (s,l) | Not_available _ -> assert false ) (copies ()) in @@ -334,7 +346,8 @@ let pull_tree_t Printf.sprintf "%s: %s" nv msg) failing) in - Done (Not_available (Generic_failure (Some simple, long)))) + Done (Not_available (Generic_failure { short_reason = Some simple; + long_reason = long }))) in let label = OpamStd.List.concat_map ", " (fun (x,_,_) -> x) dirnames in (match cache_dir with @@ -345,7 +358,7 @@ let pull_tree_t | None -> assert (cache_urls = []); let m = "no cache" in - Done (Not_available (Generic_failure (Some m, m)))) + Done (Not_available (generic_failure m))) @@+ function | Up_to_date (archive, _) -> extract_archive archive "cached" @@ -359,9 +372,10 @@ let pull_tree_t if checksums = [] && OpamRepositoryConfig.(!r.force_checksums = Some true) then Done ( - Not_available (Generic_failure ( - Some ("missing checksum"), - label ^ ": Missing checksum, and `--require-checksums` was set."))) + Not_available (Generic_failure { + short_reason = Some ("missing checksum"); + long_reason = label ^ ": Missing checksum, and \ + `--require-checksums` was set."; })) else OpamFilename.with_tmp_dir_job @@ fun tmpdir -> let extract url archive = @@ -418,7 +432,7 @@ let pull_file label ?cache_dir ?(cache_urls=[]) ?(silent_hits=false) | None -> assert (cache_urls = []); let m = "no cache" in - Done (Not_available (Generic_failure (Some m, m)))) + Done (Not_available (generic_failure m))) @@+ function | Up_to_date (f, _) -> if not silent_hits then @@ -437,10 +451,10 @@ let pull_file label ?cache_dir ?(cache_urls=[]) ?(silent_hits=false) then Done ( Not_available - (Generic_failure - (Some "missing checksum", - label ^ ": Missing checksum, and `--require-checksums` \ - was set."))) + (Generic_failure { + short_reason = Some "missing checksum"; + long_reason = label ^ ": Missing checksum, and \ + `--require-checksums` was set."; })) else OpamFilename.with_tmp_dir_job (fun tmpdir -> pull_from_mirrors label cache_dir tmpdir checksums remote_urls @@ -449,7 +463,7 @@ let pull_file label ?cache_dir ?(cache_urls=[]) ?(silent_hits=false) | _, Result (Some f) -> OpamFilename.move ~src:f ~dst:file; Result () | _, Result None -> let m = "is a directory" in - Not_available (Generic_failure (Some m, m)) + Not_available (generic_failure m) | _, (Not_available _ as na) -> na) let pull_file_to_cache label ~cache_dir ?(cache_urls=[]) checksums remote_urls = @@ -468,7 +482,7 @@ let pull_file_to_cache label ~cache_dir ?(cache_urls=[]) checksums remote_urls = | url, Result (Some _) -> Result (OpamUrl.to_string url) | _, Result None -> let m = "is a directory" in - Not_available (Generic_failure (Some m, m)) + Not_available (generic_failure m) | _, (Not_available _ as na) -> na) let packages repo_root = @@ -623,8 +637,8 @@ let report_fetch_result pkg = function msg; Up_to_date () | Not_available failure as result -> - let s, l = OpamTypesBase.get_dl_failure_reason failure in - let msg = match s with None -> l | Some s -> s in + let r = OpamTypesBase.get_dl_failure_reason failure in + let msg = match r.short_reason with None -> r.long_reason | Some s -> s in OpamConsole.msg "[%s] fetching sources failed: %s\n" (OpamConsole.colorise `red (OpamPackage.to_string pkg)) msg; result diff --git a/src/repository/opamVCS.ml b/src/repository/opamVCS.ml index 1aeebf88c42..e90be18ccd3 100644 --- a/src/repository/opamVCS.ml +++ b/src/repository/opamVCS.ml @@ -84,7 +84,9 @@ module Make (VCS: VCS) = struct (OpamFilename.Dir.to_string dirname) (OpamUrl.to_string url) (match e with Failure fw -> fw | _ -> Printexc.to_string e); - Done (Not_available (Generic_failure (None, OpamUrl.to_string url)))) + Done (Not_available (Generic_failure { + short_reason = None; + long_reason = OpamUrl.to_string url; }))) @@ fun () -> if VCS.exists dirname then VCS.clean dirname @@+ fun () -> diff --git a/src/state/opamFileTools.ml b/src/state/opamFileTools.ml index aad02051f3f..def9d2be9dc 100644 --- a/src/state/opamFileTools.ml +++ b/src/state/opamFileTools.ml @@ -830,8 +830,9 @@ let t_lint ?check_extra_files ?(check_upstream=false) ?(all=false) t = | `http -> OpamProcess.Job.catch (function | Failure msg -> Done (Some msg) - | OpamDownload.Download_fail (Generic_failure (s,l)) -> - Done (Some (OpamStd.Option.default l s)) + | OpamDownload.Download_fail ( + Generic_failure { short_reason; long_reason }) -> + Done (Some (OpamStd.Option.default long_reason short_reason)) | e -> Done (Some (Printexc.to_string e))) @@ fun () -> OpamDownload.download ~overwrite:false url dir @@ -849,8 +850,8 @@ let t_lint ?check_extra_files ?(check_upstream=false) ?(all=false) t = @@| function | Up_to_date f | Result f -> check_checksum f | Not_available failure -> - let _, src = OpamTypesBase.get_dl_failure_reason failure in - Some ("Source not found: "^src) + let r = OpamTypesBase.get_dl_failure_reason failure in + Some ("Source not found: "^r.long_reason) in cond 60 `Error "Upstream check failed" ~detail:(OpamStd.Option.to_list upstream_error) From 8c791598b431a65cc9bd0486e08f6af2f5d2b5b9 Mon Sep 17 00:00:00 2001 From: Keryan Didier Date: Wed, 24 Jul 2024 16:02:51 +0200 Subject: [PATCH 5/6] pushing structures to end-points --- src/client/opamAction.ml | 50 +++++++++++++++++--------------- src/client/opamAction.mli | 4 +-- src/client/opamAdminCommand.ml | 10 +++++-- src/client/opamSolution.ml | 7 +++-- src/repository/opamHTTP.ml | 3 +- src/repository/opamRepository.ml | 19 +++++++----- 6 files changed, 52 insertions(+), 41 deletions(-) diff --git a/src/client/opamAction.ml b/src/client/opamAction.ml index 70778d72f17..da8846cc815 100644 --- a/src/client/opamAction.ml +++ b/src/client/opamAction.ml @@ -245,7 +245,7 @@ let download_shared_source st url nvs = | None, _ | _, [_] -> "" | Some url, _ -> " " ^ OpamUrl.to_string (OpamFile.URL.url url))) url; if OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.fake) - then Done None else + then Done (Result ()) else let nvs = (* filter out version-pinned packages since we already have their source *) List.filter (fun nv -> @@ -259,7 +259,7 @@ let download_shared_source st url nvs = OpamFile.OPAM.version_opt) = Some nv.version)) nvs in - if nvs = [] then Done None + if nvs = [] then Done (Up_to_date ()) else let print_action = OpamConsole.msg "%s retrieved %s (%s)\n" @@ -290,10 +290,11 @@ let download_shared_source st url nvs = OpamProcess.Job.catch (fun e -> let na = match e with - | OpamDownload.Download_fail (Generic_failure reason) -> reason - | e -> { short_reason = None; long_reason = Printexc.to_string e } + | OpamDownload.Download_fail failure -> failure + | e -> Generic_failure + { short_reason = None; long_reason = Printexc.to_string e } in - Done (Some na)) + Done (Not_available na)) @@ fun () -> OpamUpdate.download_shared_package_source st url nvs @@| function | Some (Not_available failure), _ -> @@ -306,35 +307,36 @@ let download_shared_source st url nvs = | Some url, _ -> Printf.sprintf " (%s)" (OpamUrl.to_string (OpamFile.URL.url url))) msg; - Some r + Not_available failure | _, ((nv, name, Not_available failure) :: _) -> let r = OpamTypesBase.get_dl_failure_reason failure in let msg = OpamStd.Option.default r.long_reason r.short_reason in OpamConsole.error "Failed to get extra source \"%s\" of %s: %s" name (OpamPackage.to_string nv) msg; - Some r + Not_available failure | Some (Result msg), _ -> - print_full_action msg; None + print_full_action msg; Result () | Some (Up_to_date msg), _ -> - print_full_action msg; None - | None, [] -> None + print_full_action msg; Up_to_date () + | None, [] -> Up_to_date () | None, (e :: es as extras) -> if List.for_all (function _, _, Up_to_date _ -> true | _ -> false) extras then - print_full_action "cached" + (print_full_action "cached"; + Up_to_date ()) else - (match e, es with - | (_, _, Result msg), [] -> print_full_action msg - | _, _ -> - print_single_actions - (List.map (fun (nv, _, _) -> - nv, - (Printf.sprintf "%d extra sources" - (List.length - (List.filter (fun (nv',_,_) -> - OpamPackage.compare nv nv' = 0) - extras)))) - extras)); - None + ((match e, es with + | (_, _, Result msg), [] -> print_full_action msg + | _, _ -> + print_single_actions + (List.map (fun (nv, _, _) -> + nv, + (Printf.sprintf "%d extra sources" + (List.length + (List.filter (fun (nv',_,_) -> + OpamPackage.compare nv nv' = 0) + extras)))) + extras)); + Result ()) let download_package st nv = download_shared_source st diff --git a/src/client/opamAction.mli b/src/client/opamAction.mli index da20400d4d9..b1e57bfc3c8 100644 --- a/src/client/opamAction.mli +++ b/src/client/opamAction.mli @@ -21,14 +21,14 @@ open OpamStateTypes This doesn't update dev packages that already have a locally cached source. *) val download_package: - rw switch_state -> package -> dl_fail_reason option OpamProcess.job + rw switch_state -> package -> unit download OpamProcess.job (** [download_same_source_package t url packages] As [download_package], download upstream shared source [url] between [packages]. *) val download_shared_source: rw switch_state -> OpamFile.URL.t option -> package list -> - dl_fail_reason option OpamProcess.job + unit download OpamProcess.job (** [prepare_package_source t pkg dir] updates the given source [dir] with the extra downloads, overlays and patches from the package's metadata diff --git a/src/client/opamAdminCommand.ml b/src/client/opamAdminCommand.ml index 192ba0a60ea..c7d10c5166b 100644 --- a/src/client/opamAdminCommand.ml +++ b/src/client/opamAdminCommand.ml @@ -176,8 +176,7 @@ let package_files_to_cache repo_root cache_dir cache_urls (OpamFile.URL.url urlf :: OpamFile.URL.mirrors urlf) @@| fun r -> match OpamRepository.report_fetch_result nv r with | Not_available failure -> - let r = OpamTypesBase.get_dl_failure_reason failure in - Some r.long_reason + Some failure | Up_to_date () | Result () -> None in error_opt @@| function @@ -287,8 +286,13 @@ let cache_command cli = (OpamPackage.Map.keys errors)); OpamConsole.errmsg "%s" (OpamStd.Format.itemize (fun (nv,el) -> + let reasons = + List.map (fun e -> + (OpamTypesBase.get_dl_failure_reason e).long_reason) + el + in Printf.sprintf "[%s] %s" (OpamPackage.to_string nv) - (String.concat "\n" el)) + (String.concat "\n" reasons)) (OpamPackage.Map.bindings errors)) ); diff --git a/src/client/opamSolution.ml b/src/client/opamSolution.ml index c957fa6cc9d..1f88ca96012 100644 --- a/src/client/opamSolution.ml +++ b/src/client/opamSolution.ml @@ -632,10 +632,11 @@ let parallel_apply t | [] -> None in OpamAction.download_shared_source t url nvs) @@+ function - | None -> + | Result () | Up_to_date () -> store_time (); Done (`Successful (installed, removed)) - | Some { short_reason = _; long_reason } -> - Done (`Exception (Fetch_fail long_reason))) + | Not_available failure -> + let r = get_dl_failure_reason failure in + Done (`Exception (Fetch_fail r.long_reason))) | `Build nv -> if assume_built && OpamPackage.Set.mem nv requested then diff --git a/src/repository/opamHTTP.ml b/src/repository/opamHTTP.ml index a1629ffc0e7..4e6434b21c9 100644 --- a/src/repository/opamHTTP.ml +++ b/src/repository/opamHTTP.ml @@ -85,7 +85,8 @@ module B = struct | _ -> Generic_failure { short_reason = Some "Download failed"; - long_reason = str "download failed"; } + long_reason = str "download failed, "^(Printexc.to_string e); + } in Done (Not_available failure)) @@ fun () -> diff --git a/src/repository/opamRepository.ml b/src/repository/opamRepository.ml index f4cf7909374..81b445aaba3 100644 --- a/src/repository/opamRepository.ml +++ b/src/repository/opamRepository.ml @@ -328,22 +328,25 @@ let pull_tree_t let failing = OpamStd.List.filter_map (function | Result _ | Up_to_date _ -> None - | Not_available (Generic_failure - { short_reason = Some s; - long_reason = l }) -> - Some (s,l) - | Not_available _ -> assert false + | Not_available failure -> Some failure ) (copies ()) in if failing = [] then Done (Up_to_date msg) else let simple = Printf.sprintf "Failed to copy source of %s" - (OpamStd.Format.pretty_list (List.map fst failing)) + (OpamStd.Format.pretty_list (List.map (fun e -> + let r = OpamTypesBase.get_dl_failure_reason e in + OpamStd.Option.default r.long_reason r.short_reason) + failing)) in let long = Printf.sprintf "Failed to copy source of:\n%s" - (OpamStd.Format.itemize (fun (nv, msg) -> - Printf.sprintf "%s: %s" nv msg) + (OpamStd.Format.itemize (fun e -> + let r = OpamTypesBase.get_dl_failure_reason e in + match r.short_reason with + | Some nv -> + Printf.sprintf "%s: %s" nv r.long_reason + | None -> r.long_reason) failing) in Done (Not_available (Generic_failure { short_reason = Some simple; From 3b00f24dc9f7063bca8079465cdeb31433f99219 Mon Sep 17 00:00:00 2001 From: Keryan Didier Date: Wed, 24 Jul 2024 17:04:33 +0200 Subject: [PATCH 6/6] better handling of local exceptions --- src/client/opamPinCommand.ml | 26 +++++++++++++------------- src/client/opamSolution.ml | 11 +++++++---- tests/reftests/archive.test | 26 +++++++++++++------------- tests/reftests/download.test | 16 ++++++++++++---- tests/reftests/extrasource.test | 24 ++++++++++++------------ tests/reftests/shared-fetch.test | 2 +- tests/reftests/swhid.unix.test | 8 ++++---- 7 files changed, 62 insertions(+), 51 deletions(-) diff --git a/src/client/opamPinCommand.ml b/src/client/opamPinCommand.ml index 646d51580c7..2ddad29759f 100644 --- a/src/client/opamPinCommand.ml +++ b/src/client/opamPinCommand.ml @@ -64,8 +64,6 @@ let read_opam_file_for_pinning ?locked ?(quiet=false) name f url = >>| OpamFile.OPAM.with_locked_opt locked -exception Fetch_Fail of string - let get_source_definition ?version ?subpath ?locked st nv url = let root = st.switch_global.root in let srcdir = OpamPath.Switch.pinned_package root st.switch nv.name in @@ -87,13 +85,11 @@ let get_source_definition ?version ?subpath ?locked st nv url = | _, _ -> url in OpamUpdate.fetch_dev_package url srcdir ?subpath nv @@| function - | Not_available failure -> - let r = OpamTypesBase.get_dl_failure_reason failure in - raise (Fetch_Fail r.long_reason) + | Not_available _ as err -> err | Up_to_date _ | Result _ -> let srcdir = OpamFilename.SubPath.(srcdir /? subpath) in match OpamPinned.find_opam_file_in_source ?locked nv.name srcdir with - | None -> None + | None -> Result None | Some (f, locked) -> match read_opam_file_for_pinning nv.name ?locked f (OpamFile.URL.url url) with | None -> @@ -102,8 +98,8 @@ let get_source_definition ?version ?subpath ?locked st nv url = (OpamPath.Switch.Overlay.tmp_opam root st.switch nv.name) in OpamFilename.copy ~src:(OpamFile.filename f) ~dst; - None - | Some opam -> Some (fix opam) + Result None + | Some opam -> Result (Some (fix opam)) let copy_files st opam = let name = OpamFile.OPAM.name opam in @@ -532,16 +528,20 @@ and source_pin OpamFilename.remove (OpamFile.filename temp_file); let opam_opt = - try - opam_opt >>+ fun () -> - urlf >>= fun url -> + opam_opt >>+ fun () -> + urlf >>= fun url -> + match OpamProcess.Job.run @@ get_source_definition ?version ?subpath ?locked st nv url - with Fetch_Fail err -> + with + | Result o | Up_to_date o -> o + | Not_available failure -> if force then None else (OpamConsole.error_and_exit `Sync_error "Error getting source from %s:\n%s" (OpamStd.Option.to_string OpamUrl.to_string target_url) - (OpamStd.Format.itemize (fun x -> x) [err])); + (OpamStd.Format.itemize (fun x -> + (OpamTypesBase.get_dl_failure_reason x).long_reason) + [failure])) in let opam_opt = opam_opt >>| OpamFormatUpgrade.opam_file in diff --git a/src/client/opamSolution.ml b/src/client/opamSolution.ml index 1f88ca96012..15138eb0efa 100644 --- a/src/client/opamSolution.ml +++ b/src/client/opamSolution.ml @@ -20,7 +20,7 @@ module PackageAction = OpamSolver.Action module PackageActionGraph = OpamSolver.ActionGraph -exception Fetch_fail of string +exception Fetch_fail of dl_failure let post_message ?(failed=false) st action = match action, failed with @@ -230,6 +230,8 @@ let display_error (n, error) = | Sys.Break | OpamParallel.Aborted -> () | Failure s -> disp "%s" s | OpamSystem.Process_error e -> disp "%s" (OpamProcess.string_of_result e) + | Fetch_fail failure -> + disp "%s" (get_dl_failure_reason failure).long_reason | e -> disp "%s" (Printexc.to_string e); if OpamConsole.debug () then @@ -635,8 +637,7 @@ let parallel_apply t | Result () | Up_to_date () -> store_time (); Done (`Successful (installed, removed)) | Not_available failure -> - let r = get_dl_failure_reason failure in - Done (`Exception (Fetch_fail r.long_reason))) + Done (`Exception (Fetch_fail failure))) | `Build nv -> if assume_built && OpamPackage.Set.mem nv requested then @@ -763,7 +764,9 @@ let parallel_apply t ) OpamPackage.Map.empty results in if not (OpamPackage.Map.is_empty failed_downloads) then OpamJson.append "download-failures" - (`O (List.map (fun (nv, err) -> OpamPackage.to_string nv, `String err) + (`O (List.map (fun (nv, failure) -> + let err = (get_dl_failure_reason failure).long_reason in + OpamPackage.to_string nv, `String err) (OpamPackage.Map.bindings failed_downloads))); (* Report build/install/remove failures *) let j = diff --git a/tests/reftests/archive.test b/tests/reftests/archive.test index aa6fcc10680..986c2957fb3 100644 --- a/tests/reftests/archive.test +++ b/tests/reftests/archive.test @@ -459,7 +459,7 @@ The following actions will be performed: <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> [ERROR] Failed to get sources of no-checksum.1: missing checksum -OpamSolution.Fetch_fail("no-checksum.1: Missing checksum, and `--require-checksums` was set.") +no-checksum.1: Missing checksum, and `--require-checksums` was set. <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -493,7 +493,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get sources of multiple-md5.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -513,7 +513,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get sources of multiple-md5.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -552,7 +552,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get sources of bad-md5.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -572,7 +572,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get sources of bad-md5.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -628,7 +628,7 @@ The following actions will be performed: got sha256=hash [ERROR] Failed to get sources of good-md5-bad-sha256.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -678,7 +678,7 @@ The following actions will be performed: got sha256=hash [ERROR] Failed to get sources of good-md5-bad-sha256.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -701,7 +701,7 @@ The following actions will be performed: got sha256=hash [ERROR] Failed to get sources of good-md5-bad-sha256.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -740,7 +740,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get sources of good-sha256-bad-md5.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -760,7 +760,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get sources of good-sha256-bad-md5.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -815,7 +815,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get sources of clash-with-all-md5s.666: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -881,7 +881,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get sources of clash-with-all-md5s.666: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -904,7 +904,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get sources of clash-with-all-md5s.666: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> diff --git a/tests/reftests/download.test b/tests/reftests/download.test index 0b56f9908d5..69596a6cec3 100644 --- a/tests/reftests/download.test +++ b/tests/reftests/download.test @@ -66,7 +66,9 @@ Processing 1/1: [foo.1: http] + curl "--another-args" "3" [ERROR] Failed to get sources of foo.1: Curl failed -OpamSolution.Fetch_fail("curl failure while downloading https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz\nExited with code 2\nCurl failed: \"curl --another-args 3\" exited with code 2") +curl failure while downloading https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz +Exited with code 2 +Curl failed: "curl --another-args 3" exited with code 2 <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -90,7 +92,9 @@ Processing 1/1: [foo.1: http] + curl "--another-args" "3" [ERROR] Failed to get sources of foo.1: curl failure -OpamSolution.Fetch_fail("curl failure while downloading https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz\nExited with code 0\nReturned code ***The curl is a lie*** [args: --another-args 3]") +curl failure while downloading https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz +Exited with code 0 +Returned code ***The curl is a lie*** [args: --another-args 3] <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -110,7 +114,9 @@ Processing 1/1: [foo.1: http] + curl "--write-out" "%{http_code}\n" "--retry" "3" "--retry-delay" "2" "--user-agent" "opam/current" "-L" "-o" "${BASEDIR}/OPAM/download/.opam-switch/sources/foo.1/v1.0.0.tar.gz.part" "--" "https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz" [ERROR] Failed to get sources of foo.1: curl failure -OpamSolution.Fetch_fail("curl failure while downloading https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz\nExited with code 0\nReturned code ***The curl is a lie*** [args: --write-out %{http_code}\n --retry 3 --retry-delay 2 --user-agent opam/current -L -o ${BASEDIR}/OPAM/download/.opam-switch/sources/foo.1/v1.0.0.tar.gz.part -- https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz]") +curl failure while downloading https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz +Exited with code 0 +Returned code ***The curl is a lie*** [args: --write-out %{http_code}\n --retry 3 --retry-delay 2 --user-agent opam/current -L -o ${BASEDIR}/OPAM/download/.opam-switch/sources/foo.1/v1.0.0.tar.gz.part -- https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz] <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -130,7 +136,9 @@ Processing 1/1: [foo.1: http] + curl "--another-args" "3" [ERROR] Failed to get sources of foo.1: curl failure -OpamSolution.Fetch_fail("curl failure while downloading https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz\nExited with code 0\nReturned code ***The curl is a lie*** [args: --another-args 3]") +curl failure while downloading https://github.com/UnixJunkie/get_line/archive/v1.0.0.tar.gz +Exited with code 0 +Returned code ***The curl is a lie*** [args: --another-args 3] <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> diff --git a/tests/reftests/extrasource.test b/tests/reftests/extrasource.test index fa65a343d65..8905586218a 100644 --- a/tests/reftests/extrasource.test +++ b/tests/reftests/extrasource.test @@ -563,7 +563,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get extra source "i-am-a-patch" of multiple-md5.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -583,7 +583,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get extra source "i-am-a-patch" of multiple-md5.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -618,7 +618,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get extra source "i-am-a-patch" of bad-md5.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -638,7 +638,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get extra source "i-am-a-patch" of bad-md5.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -690,7 +690,7 @@ The following actions will be performed: got sha256=hash [ERROR] Failed to get extra source "i-am-a-patch" of good-md5-bad-sha256.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -740,7 +740,7 @@ The following actions will be performed: got sha256=hash [ERROR] Failed to get extra source "i-am-a-patch" of good-md5-bad-sha256.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -763,7 +763,7 @@ The following actions will be performed: got sha256=hash [ERROR] Failed to get extra source "i-am-a-patch" of good-md5-bad-sha256.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -798,7 +798,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get extra source "i-am-a-patch" of good-sha256-bad-md5.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -818,7 +818,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get extra source "i-am-a-patch" of good-sha256-bad-md5.1: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -853,7 +853,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get extra source "i-am-a-patch" of clash-with-all-md5s.666: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -919,7 +919,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get extra source "i-am-a-patch" of clash-with-all-md5s.666: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -942,7 +942,7 @@ The following actions will be performed: got md5=hash [ERROR] Failed to get extra source "i-am-a-patch" of clash-with-all-md5s.666: Checksum mismatch -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> diff --git a/tests/reftests/shared-fetch.test b/tests/reftests/shared-fetch.test index 209d951612f..30bfde169c6 100644 --- a/tests/reftests/shared-fetch.test +++ b/tests/reftests/shared-fetch.test @@ -271,7 +271,7 @@ The following actions will be performed: [ERROR] Failed to get sources of extra.3, intra.3, no-extra.3, out.3 (file://${BASEDIR}/shared.tgz): Checksum mismatch -> installed in.3 -OpamSolution.Fetch_fail("Checksum mismatch") +Checksum mismatch <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> diff --git a/tests/reftests/swhid.unix.test b/tests/reftests/swhid.unix.test index 3b0d6ced65b..326e5241016 100644 --- a/tests/reftests/swhid.unix.test +++ b/tests/reftests/swhid.unix.test @@ -39,7 +39,7 @@ The following actions will be performed: <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> [ERROR] Failed to get sources of snappy-ko.2: Download command failed -OpamSolution.Fetch_fail("https://fake.exe/url.tar.gz (Download command failed: \"curl --write-out %{http_code}\\n --retry 3 --retry-delay 2 --user-agent opam/current -L -o ${BASEDIR}/OPAM/fallback/.opam-switch/sources/snappy-ko.2/url.tar.gz.part -- https://fake.exe/url.tar.gz\" exited with code 6)") +https://fake.exe/url.tar.gz (Download command failed: "curl --write-out %{http_code}\n --retry 3 --retry-delay 2 --user-agent opam/current -L -o ${BASEDIR}/OPAM/fallback/.opam-switch/sources/snappy-ko.2/url.tar.gz.part -- https://fake.exe/url.tar.gz" exited with code 6) <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -68,7 +68,7 @@ The following actions will be performed: Processing 1/3: [snappy-swhid-dir.2: http] [ERROR] Failed to get sources of snappy-swhid-dir.2: Download command failed -OpamSolution.Fetch_fail("https://fake.exe/url.tar.gz (Download command failed: \"curl --write-out %{http_code}\\n --retry 3 --retry-delay 2 --user-agent opam/current -L -o ${BASEDIR}/OPAM/fallback/.opam-switch/sources/snappy-swhid-dir.2/url.tar.gz.part -- https://fake.exe/url.tar.gz\" exited with code 6)") +https://fake.exe/url.tar.gz (Download command failed: "curl --write-out %{http_code}\n --retry 3 --retry-delay 2 --user-agent opam/current -L -o ${BASEDIR}/OPAM/fallback/.opam-switch/sources/snappy-swhid-dir.2/url.tar.gz.part -- https://fake.exe/url.tar.gz" exited with code 6) <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -132,7 +132,7 @@ The following actions will be performed: Source https://fake.exe/url.tar.gz is not available. Do you want to try to retrieve it from Software Heritage cache (https://www.softwareheritage.org)? It may take few minutes. [y/n] y [ERROR] Failed to get sources of snappy-swhid-ko.2: SWH fallback: Unknown swhid -OpamSolution.Fetch_fail("SWH fallback: Unknown swhid") +SWH fallback: Unknown swhid <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> @@ -152,7 +152,7 @@ The following actions will be performed: <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> [ERROR] Failed to get sources of snappy-swhid-ko.2: SWH fallback: no retrieval -OpamSolution.Fetch_fail("SWH fallback: Download tool permitting post request (wget and curl) not set as download tool") +SWH fallback: Download tool permitting post request (wget and curl) not set as download tool <><> Error report <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>