From 5ece562942bed2108811ffb71cc11e1e9f40b0a0 Mon Sep 17 00:00:00 2001 From: Kate Date: Thu, 17 Oct 2024 13:40:41 +0100 Subject: [PATCH 1/5] Ensure each repositories stored in repos-config is associated with an URL --- master_changes.md | 2 ++ src/client/opamClient.ml | 5 +---- src/format/opamFile.ml | 18 ++++++------------ src/format/opamFile.mli | 2 +- src/state/opamFormatUpgrade.ml | 2 +- src/state/opamRepositoryState.ml | 30 +++++------------------------- 6 files changed, 16 insertions(+), 43 deletions(-) diff --git a/master_changes.md b/master_changes.md index cbc6f39abd5..e12a8a07aa0 100644 --- a/master_changes.md +++ b/master_changes.md @@ -95,6 +95,7 @@ users) ## Shell ## Internal + * Ensure each repositories stored in repos-config is associated with an URL [#6249 @kit-ty-kate] ## Internal: Windows @@ -125,5 +126,6 @@ users) ## opam-solver ## opam-format + * `OpamFile.Repos_config.t`: change the type to not allow repositories without an URL [#6249 @kit-ty-kate] ## opam-core diff --git a/src/client/opamClient.ml b/src/client/opamClient.ml index 535135fb191..5320f580206 100644 --- a/src/client/opamClient.ml +++ b/src/client/opamClient.ml @@ -1885,10 +1885,7 @@ let init else config in OpamFile.Config.write config_f config; - let repos_config = - OpamRepositoryName.Map.of_list repos |> - OpamRepositoryName.Map.map OpamStd.Option.some - in + let repos_config = OpamRepositoryName.Map.of_list repos in OpamFile.Repos_config.write (OpamPath.repos_config root) repos_config; diff --git a/src/format/opamFile.ml b/src/format/opamFile.ml index 28707cc9658..1d94fa0a9b9 100644 --- a/src/format/opamFile.ml +++ b/src/format/opamFile.ml @@ -1798,7 +1798,7 @@ module InitConfigSyntax = struct Pp.V.map_options_3 (Pp.V.string -| Pp.of_module "repository" (module OpamRepositoryName)) - (Pp.opt @@ Pp.singleton -| Pp.V.url) + (Pp.singleton -| Pp.V.url) (Pp.map_list Pp.V.string) (Pp.opt @@ Pp.singleton -| Pp.V.int -| @@ -1821,10 +1821,8 @@ module InitConfigSyntax = struct with_repositories repositories (Pp.V.map_list ~depth:1 @@ pp_repository_def -| - Pp.pp (fun ~pos -> function - | (name, Some url, ta) -> (name, (url, ta)) - | (_, None, _) -> Pp.bad_format ~pos "Missing repository URL") - (fun (name, (url, ta)) -> (name, Some url, ta))); + Pp.pp (fun ~pos:_ (name, url, ta) -> (name, (url, ta))) + (fun (name, (url, ta)) -> (name, url, ta))); "default-compiler", Pp.ppacc with_default_compiler default_compiler (Pp.V.package_formula `Disj Pp.V.(constraints Pp.V.version)); @@ -1965,7 +1963,7 @@ module Repos_configSyntax = struct let format_version = OpamVersion.of_string "2.0" let file_format_version = OpamVersion.of_string "2.0" - type t = ((url * trust_anchors option) option) OpamRepositoryName.Map.t + type t = (url * trust_anchors option) OpamRepositoryName.Map.t let empty = OpamRepositoryName.Map.empty @@ -1975,12 +1973,8 @@ module Repos_configSyntax = struct ((Pp.V.map_list ~depth:1 @@ InitConfigSyntax.pp_repository_def -| Pp.pp - (fun ~pos:_ -> function - | (name, Some url, ta) -> name, Some (url, ta) - | (name, None, _) -> name, None) - (fun (name, def) -> match def with - | Some (url, ta) -> name, Some url, ta - | None -> name, None, None)) -| + (fun ~pos:_ (name, url, ta) -> (name, (url, ta))) + (fun (name, (url, ta)) -> (name, url, ta))) -| Pp.of_pair "repository-url-list" OpamRepositoryName.Map.(of_list, bindings)); ] diff --git a/src/format/opamFile.mli b/src/format/opamFile.mli index 00d529c84a8..b2e8da5e000 100644 --- a/src/format/opamFile.mli +++ b/src/format/opamFile.mli @@ -1028,7 +1028,7 @@ module Repo_config_legacy : sig end module Repos_config: sig - type t = (url * trust_anchors option) option OpamRepositoryName.Map.t + type t = (url * trust_anchors option) OpamRepositoryName.Map.t include IO_FILE with type t := t module BestEffort: BestEffortRead with type t := t end diff --git a/src/state/opamFormatUpgrade.ml b/src/state/opamFormatUpgrade.ml index d2304e5c4f6..f488f661fb9 100644 --- a/src/state/opamFormatUpgrade.ml +++ b/src/state/opamFormatUpgrade.ml @@ -770,7 +770,7 @@ let from_1_3_dev7_to_2_0_alpha ~on_the_fly:_ root conf = in OpamFile.Repos_config.write (OpamPath.repos_config root) (OpamRepositoryName.Map.of_list - (List.map (fun (_, r, u) -> r, Some (u,None)) prio_repositories)); + (List.map (fun (_, r, u) -> r, (u,None)) prio_repositories)); let prio_repositories = List.stable_sort (fun (prio1, _, _) (prio2, _, _) -> prio2 - prio1) prio_repositories diff --git a/src/state/opamRepositoryState.ml b/src/state/opamRepositoryState.ml index bebc7d4e905..b7e8ff69a64 100644 --- a/src/state/opamRepositoryState.ml +++ b/src/state/opamRepositoryState.ml @@ -164,16 +164,11 @@ let load lock_kind gt = load with best-effort (read-only)" (OpamVersion.to_string (OpamFile.Config.opam_root_version gt.config)) (OpamVersion.to_string (OpamFile.Config.root_version)); - let mk_repo name url_opt = { + let mk_repo name (url, ta) = { repo_name = name; - repo_url = OpamStd.Option.Op.((url_opt >>| fst) +! OpamUrl.empty); - repo_trust = OpamStd.Option.Op.(url_opt >>= snd); + repo_url = url; + repo_trust = ta; } in - let uncached = - (* Don't cache repositories without remote, as they should be editable - in-place *) - OpamRepositoryName.Map.filter (fun _ url -> url = None) repos_map - in let repositories = OpamRepositoryName.Map.mapi mk_repo repos_map in let repos_tmp_root = lazy (OpamFilename.mk_tmp_dir ()) in let repos_tmp = Hashtbl.create 23 in @@ -211,22 +206,8 @@ let load lock_kind gt = rt in match Cache.load gt.root with - | Some (repofiles, opams) when OpamRepositoryName.Map.is_empty uncached -> - log "Cache found"; - make_rt repofiles opams | Some (repofiles, opams) -> - log "Cache found, loading repositories without remote only"; - OpamFilename.with_flock_upgrade `Lock_read lock @@ fun _ -> - let repofiles, opams = - OpamRepositoryName.Map.fold (fun name url (defs, opams) -> - let repo = mk_repo name url in - let repo_def, repo_opams = - load_repo repo (get_root_raw gt.root repos_tmp name) - in - OpamRepositoryName.Map.add name repo_def defs, - OpamRepositoryName.Map.add name repo_opams opams) - uncached (repofiles, opams) - in + log "Cache found"; make_rt repofiles opams | None -> log "No cache found"; @@ -297,7 +278,7 @@ let with_ lock gt f = let write_config rt = OpamFile.Repos_config.write (OpamPath.repos_config rt.repos_global.root) - (OpamRepositoryName.Map.map (fun r -> + (OpamRepositoryName.Map.filter_map (fun _ r -> if r.repo_url = OpamUrl.empty then None else Some (r.repo_url, r.repo_trust)) rt.repositories) @@ -312,4 +293,3 @@ let check_last_update () = OpamConsole.note "It seems you have not updated your repositories \ for a while. Consider updating them with:\n%s\n" (OpamConsole.colorise `bold "opam update"); - From 2d9732ea1340e4174e35322c0b9bc94e99795560 Mon Sep 17 00:00:00 2001 From: Kate Date: Thu, 17 Oct 2024 17:32:28 +0100 Subject: [PATCH 2/5] Add etag and last-modified to the repos-config file --- src/client/opamAdminCommand.ml | 2 ++ src/client/opamClient.ml | 2 +- src/client/opamCommands.ml | 2 +- src/client/opamInitDefaults.ml | 2 +- src/client/opamRepositoryCommand.ml | 3 ++- src/format/opamFile.ml | 34 ++++++++++++++++------------- src/format/opamFile.mli | 6 ++--- src/format/opamFormat.ml | 14 ++++++++++++ src/format/opamFormat.mli | 7 ++++++ src/format/opamTypes.mli | 8 ++++--- src/state/opamFormatUpgrade.ml | 2 +- src/state/opamRepositoryState.ml | 6 +++-- 12 files changed, 60 insertions(+), 28 deletions(-) diff --git a/src/client/opamAdminCommand.ml b/src/client/opamAdminCommand.ml index 38954d1c6b1..252513f0a2f 100644 --- a/src/client/opamAdminCommand.ml +++ b/src/client/opamAdminCommand.ml @@ -882,6 +882,8 @@ let get_virtual_switch_state repo_root env = repo_name = OpamRepositoryName.of_string "local"; repo_url = OpamUrl.empty; repo_trust = None; + repo_etag = None; + repo_last_modified = None; } in let repo_file = OpamRepositoryPath.repo repo_root in let repo_def = OpamFile.Repo.safe_read repo_file in diff --git a/src/client/opamClient.ml b/src/client/opamClient.ml index 5320f580206..d22b6390de4 100644 --- a/src/client/opamClient.ml +++ b/src/client/opamClient.ml @@ -1836,7 +1836,7 @@ let init try (* Create the content of ~/.opam/config *) let repos = match repo with - | Some r -> [r.repo_name, (r.repo_url, r.repo_trust)] + | Some r -> [r.repo_name, (r.repo_url, r.repo_trust, r.repo_etag, r.repo_last_modified)] | None -> OpamFile.InitConfig.repositories init_config in let config = diff --git a/src/client/opamCommands.ml b/src/client/opamCommands.ml index 2e59b57f021..99425dcfba6 100644 --- a/src/client/opamCommands.ml +++ b/src/client/opamCommands.ml @@ -478,7 +478,7 @@ let init cli = let repo = OpamStd.Option.map (fun url -> let repo_url = OpamUrl.parse ?backend:repo_kind ~from_file:false url in - { repo_name; repo_url; repo_trust = None }) + { repo_name; repo_url; repo_trust = None; repo_etag = None; repo_last_modified = None }) repo_url in let gt, rt, default_compiler = diff --git a/src/client/opamInitDefaults.ml b/src/client/opamInitDefaults.ml index 6b5a7017fbf..43b6052c207 100644 --- a/src/client/opamInitDefaults.ml +++ b/src/client/opamInitDefaults.ml @@ -168,7 +168,7 @@ let (@|) g f = OpamStd.Op.(g @* f) () let init_config ?(sandboxing=true) () = I.empty |> I.with_repositories - [OpamRepositoryName.of_string "default", (repository_url, None)] |> + [OpamRepositoryName.of_string "default", (repository_url, None, None, None)] |> I.with_default_compiler default_compiler |> I.with_default_invariant default_invariant |> I.with_eval_variables eval_variables |> diff --git a/src/client/opamRepositoryCommand.ml b/src/client/opamRepositoryCommand.ml index 583b23e42eb..4536de56e57 100644 --- a/src/client/opamRepositoryCommand.ml +++ b/src/client/opamRepositoryCommand.ml @@ -80,7 +80,8 @@ let add rt name url trust_anchors = (OpamUrl.to_string url) | None -> let repo = { repo_name = name; repo_url = url; - repo_trust = trust_anchors; } + repo_trust = trust_anchors; + repo_etag = None; repo_last_modified = None; } in if OpamFilename.exists_dir (OpamRepositoryPath.root root name) || OpamFilename.exists (OpamRepositoryPath.tar root name) diff --git a/src/format/opamFile.ml b/src/format/opamFile.ml index 1d94fa0a9b9..83530cb2ee7 100644 --- a/src/format/opamFile.ml +++ b/src/format/opamFile.ml @@ -1706,7 +1706,7 @@ module InitConfigSyntax = struct type t = { opam_version : opam_version; - repositories : (repository_name * (url * trust_anchors option)) list; + repositories : (repository_name * (url * trust_anchors option * string option * string option)) list; default_compiler : formula; default_invariant : formula; jobs : int option; @@ -1795,22 +1795,26 @@ module InitConfigSyntax = struct } let pp_repository_def = - Pp.V.map_options_3 + Pp.V.map_options_5 (Pp.V.string -| Pp.of_module "repository" (module OpamRepositoryName)) (Pp.singleton -| Pp.V.url) (Pp.map_list Pp.V.string) (Pp.opt @@ Pp.singleton -| Pp.V.int -| - OpamPp.check ~name:"quorum" ~errmsg:"quorum must be >= 0" ((<=) 0)) -| + OpamPp.check ~name:"quorum" ~errmsg:"quorum must be >= 0" ((<=) 0)) + (Pp.opt (Pp.singleton -| Pp.V.string)) + (Pp.opt (Pp.singleton -| Pp.V.string)) -| Pp.pp - (fun ~pos:_ (name, url, fingerprints, quorum) -> - name, url, - match fingerprints with [] -> None | fingerprints -> - Some {fingerprints; quorum = OpamStd.Option.default 1 quorum}) - (fun (name, url, ta) -> match ta with - | Some ta -> name, url, ta.fingerprints, Some ta.quorum - | None -> name, url, [], None) + (fun ~pos:_ (name, url, fingerprints, quorum, etag, last_modified) -> + let ta = + match fingerprints with [] -> None | fingerprints -> + Some {fingerprints; quorum = OpamStd.Option.default 1 quorum} + in + (name, url, ta, etag, last_modified)) + (fun (name, url, ta, etag, last_modified) -> match ta with + | Some ta -> (name, url, ta.fingerprints, Some ta.quorum, etag, last_modified) + | None -> (name, url, [], None, etag, last_modified)) let fields = [ @@ -1821,8 +1825,8 @@ module InitConfigSyntax = struct with_repositories repositories (Pp.V.map_list ~depth:1 @@ pp_repository_def -| - Pp.pp (fun ~pos:_ (name, url, ta) -> (name, (url, ta))) - (fun (name, (url, ta)) -> (name, url, ta))); + Pp.pp (fun ~pos:_ (name, url, ta, etag, last_modified) -> (name, (url, ta, etag, last_modified))) + (fun (name, (url, ta, etag, last_modified)) -> (name, url, ta, etag, last_modified))); "default-compiler", Pp.ppacc with_default_compiler default_compiler (Pp.V.package_formula `Disj Pp.V.(constraints Pp.V.version)); @@ -1963,7 +1967,7 @@ module Repos_configSyntax = struct let format_version = OpamVersion.of_string "2.0" let file_format_version = OpamVersion.of_string "2.0" - type t = (url * trust_anchors option) OpamRepositoryName.Map.t + type t = (url * trust_anchors option * string option * string option) OpamRepositoryName.Map.t let empty = OpamRepositoryName.Map.empty @@ -1973,8 +1977,8 @@ module Repos_configSyntax = struct ((Pp.V.map_list ~depth:1 @@ InitConfigSyntax.pp_repository_def -| Pp.pp - (fun ~pos:_ (name, url, ta) -> (name, (url, ta))) - (fun (name, (url, ta)) -> (name, url, ta))) -| + (fun ~pos:_ (name, url, ta, etag, last_modified) -> (name, (url, ta, etag, last_modified))) + (fun (name, (url, ta, etag, last_modified)) -> (name, url, ta, etag, last_modified))) -| Pp.of_pair "repository-url-list" OpamRepositoryName.Map.(of_list, bindings)); ] diff --git a/src/format/opamFile.mli b/src/format/opamFile.mli index b2e8da5e000..2c1c44eb2e9 100644 --- a/src/format/opamFile.mli +++ b/src/format/opamFile.mli @@ -254,7 +254,7 @@ module InitConfig: sig include IO_FILE val opam_version: t -> opam_version - val repositories: t -> (repository_name * (url * trust_anchors option)) list + val repositories: t -> (repository_name * (url * trust_anchors option * string option * string option)) list val default_compiler: t -> formula val default_invariant: t -> formula val jobs: t -> int option @@ -274,7 +274,7 @@ module InitConfig: sig val with_opam_version: opam_version -> t -> t val with_repositories: - (repository_name * (url * trust_anchors option)) list -> t -> t + (repository_name * (url * trust_anchors option * string option * string option)) list -> t -> t val with_default_compiler: formula -> t -> t val with_default_invariant: formula -> t -> t val with_jobs: int option -> t -> t @@ -1028,7 +1028,7 @@ module Repo_config_legacy : sig end module Repos_config: sig - type t = (url * trust_anchors option) OpamRepositoryName.Map.t + type t = (url * trust_anchors option * string option * string option) OpamRepositoryName.Map.t include IO_FILE with type t := t module BestEffort: BestEffortRead with type t := t end diff --git a/src/format/opamFormat.ml b/src/format/opamFormat.ml index 08d2b618f8b..cf0e5181421 100644 --- a/src/format/opamFormat.ml +++ b/src/format/opamFormat.ml @@ -244,6 +244,20 @@ module V = struct pp4 -| pp (fun ~pos:_ (((a,b),c),d) -> a,b,c,d) (fun (a,b,c,d) -> ((a,b),c),d) + let map_options_5 pp1 pp2 pp3 pp4 pp5 pp6 = + option_depth 5 -| + option_strict -| map_option_contents + (option_strict -| map_option_contents + (option_strict -| map_option_contents + (option_strict -| map_option_contents + (option_strict -| map_option_contents + pp1 pp2) + pp3) + pp4) + pp5) + pp6 -| + pp (fun ~pos:_ (((((a,b),c),d),e),f) -> a,b,c,d,e,f) (fun (a,b,c,d,e,f) -> ((((a,b),c),d),e),f) + let map_pair pp1 pp2 = pp ~name:(Printf.sprintf "[%s %s]" pp1.ppname pp2.ppname) (fun ~pos:_ v -> match v.pelem with diff --git a/src/format/opamFormat.mli b/src/format/opamFormat.mli index f8a1776641e..fe77f28a30b 100644 --- a/src/format/opamFormat.mli +++ b/src/format/opamFormat.mli @@ -101,6 +101,13 @@ module V : sig (value list, 'b) t -> (value list, 'c) t -> (value list, 'd) t -> (value, 'a * 'b * 'c * 'd) t + (** Maps over five options (e.g. [v {op1} {op2} {op3} {op4} {op5}]) *) + val map_options_5 : + (value, 'a) t -> + (value list, 'b) t -> (value list, 'c) t -> (value list, 'd) t -> + (value list, 'e) t -> (value list, 'f) t -> + (value, 'a * 'b * 'c * 'd * 'e * 'f) t + (** A pair is simply a list with two elements in the [value] type *) val map_pair : (value, 'a) t -> diff --git a/src/format/opamTypes.mli b/src/format/opamTypes.mli index ca3fb2ec855..211ebe13f81 100644 --- a/src/format/opamTypes.mli +++ b/src/format/opamTypes.mli @@ -176,9 +176,11 @@ type trust_anchors = { (** Repositories *) type repository = { - repo_name : repository_name; - repo_url : url; - repo_trust : trust_anchors option; + repo_name : repository_name; + repo_url : url; + repo_trust : trust_anchors option; + repo_etag : string option; + repo_last_modified : string option; } (** {2 Variable-based filters} *) diff --git a/src/state/opamFormatUpgrade.ml b/src/state/opamFormatUpgrade.ml index f488f661fb9..4a31e64423f 100644 --- a/src/state/opamFormatUpgrade.ml +++ b/src/state/opamFormatUpgrade.ml @@ -770,7 +770,7 @@ let from_1_3_dev7_to_2_0_alpha ~on_the_fly:_ root conf = in OpamFile.Repos_config.write (OpamPath.repos_config root) (OpamRepositoryName.Map.of_list - (List.map (fun (_, r, u) -> r, (u,None)) prio_repositories)); + (List.map (fun (_, r, u) -> r, (u,None,None,None)) prio_repositories)); let prio_repositories = List.stable_sort (fun (prio1, _, _) (prio2, _, _) -> prio2 - prio1) prio_repositories diff --git a/src/state/opamRepositoryState.ml b/src/state/opamRepositoryState.ml index b7e8ff69a64..916837f4fbf 100644 --- a/src/state/opamRepositoryState.ml +++ b/src/state/opamRepositoryState.ml @@ -164,10 +164,12 @@ let load lock_kind gt = load with best-effort (read-only)" (OpamVersion.to_string (OpamFile.Config.opam_root_version gt.config)) (OpamVersion.to_string (OpamFile.Config.root_version)); - let mk_repo name (url, ta) = { + let mk_repo name (url, ta, etag, last_modified) = { repo_name = name; repo_url = url; repo_trust = ta; + repo_etag = etag; + repo_last_modified = last_modified; } in let repositories = OpamRepositoryName.Map.mapi mk_repo repos_map in let repos_tmp_root = lazy (OpamFilename.mk_tmp_dir ()) in @@ -280,7 +282,7 @@ let write_config rt = OpamFile.Repos_config.write (OpamPath.repos_config rt.repos_global.root) (OpamRepositoryName.Map.filter_map (fun _ r -> if r.repo_url = OpamUrl.empty then None - else Some (r.repo_url, r.repo_trust)) + else Some (r.repo_url, r.repo_trust, r.repo_etag, r.repo_last_modified)) rt.repositories) let check_last_update () = From 272ede37a4140677c6ec05e2e7d2187702a1ba14 Mon Sep 17 00:00:00 2001 From: Kate Date: Mon, 28 Oct 2024 13:00:11 +0000 Subject: [PATCH 3/5] tmp --- src/client/opamAdminRepoUpgrade.ml | 2 +- src/client/opamCommands.ml | 2 +- src/repository/opamDownload.ml | 104 +++++++++++++---------- src/repository/opamDownload.mli | 3 +- src/repository/opamHTTP.ml | 54 ++++++------ src/repository/opamLocal.ml | 2 +- src/repository/opamRepository.ml | 6 +- src/repository/opamRepositoryBackend.ml | 1 + src/repository/opamRepositoryBackend.mli | 1 + src/repository/opamVCS.ml | 2 +- src/state/opamSysInteract.ml | 4 +- 11 files changed, 104 insertions(+), 77 deletions(-) diff --git a/src/client/opamAdminRepoUpgrade.ml b/src/client/opamAdminRepoUpgrade.ml index 84a12fae7f2..acb6d14517e 100644 --- a/src/client/opamAdminRepoUpgrade.ml +++ b/src/client/opamAdminRepoUpgrade.ml @@ -196,7 +196,7 @@ let do_upgrade repo_root = let base = OpamFilename.Base.of_string "package.patch" in OpamFilename.create dir base in - OpamDownload.download_as ~overwrite:false url f @@| fun () -> + OpamDownload.download_as ~etag:None ~last_modified:None ~overwrite:false url f @@| fun _was_downloaded -> let hash = OpamHash.compute (OpamFilename.to_string f) in Hashtbl.add url_md5 url hash; Some hash)), diff --git a/src/client/opamCommands.ml b/src/client/opamCommands.ml index 99425dcfba6..c45eb04a8d8 100644 --- a/src/client/opamCommands.ml +++ b/src/client/opamCommands.ml @@ -135,7 +135,7 @@ let get_init_config ~no_sandboxing ~no_default_config_file ~add_config_file = | Some f -> OpamFile.make f | None -> let f = OpamFilename.of_string (OpamSystem.temp_file "conf") in - OpamProcess.Job.run (OpamDownload.download_as ~overwrite:false url f); + let _was_downloaded = OpamProcess.Job.run (OpamDownload.download_as ~etag:None ~last_modified:None ~overwrite:false url f) in let hash = OpamHash.compute ~kind:`SHA256 (OpamFilename.to_string f) in if OpamConsole.confirm "Using configuration file from %s. \ diff --git a/src/repository/opamDownload.ml b/src/repository/opamDownload.ml index 9e792eebe54..95aeaa183ff 100644 --- a/src/repository/opamDownload.ml +++ b/src/repository/opamDownload.ml @@ -32,16 +32,27 @@ let curl_args = CString "--", None; (* End list of options; 5.0 1-Dec-1998 *) CIdent "url", None; ] in - fun ~with_mitigation -> - if with_mitigation then - (* --fail is as old as curl; though the assumption that it leads to exit - code 22 when there's an error is probably 5.3 21-Dec-1998 (prior to - that it led to exit code 21) *) - (CString "--fail", None) :: main_args - else - (CString "--write-out", None) :: - (CString "%%{http_code}\\n", None) :: (* 6.5 13-Mar-2000 *) - main_args + fun ~with_mitigation ~etag ~last_modified -> + let args = + if with_mitigation then + (* --fail is as old as curl; though the assumption that it leads to exit + code 22 when there's an error is probably 5.3 21-Dec-1998 (prior to + that it led to exit code 21) *) + (CString "--fail", None) :: main_args + else + (CString "--write-out", None) :: + (CString "%%{http_code}\\n", None) :: (* 6.5 13-Mar-2000 *) + main_args + in + let args = match etag with + | None -> args + | Some etag -> (CString "-H", None) :: (CString ("If-None-Match: "^etag), None) :: args + in + let args = match last_modified with + | None -> args + | Some last_modified -> (CString "-H", None) :: (CString ("If-Modified-Since: "^last_modified), None) :: args + in + args let wget_args = [ CString "-t", None; CIdent "retry", None; @@ -66,7 +77,7 @@ let ftp_args = [ ] let download_args ~url ~out ~retry ?(with_curl_mitigation=false) - ?checksum ~compress () = + ?checksum ~compress ~etag ~last_modified () = let cmd, _ = Lazy.force OpamRepositoryConfig.(!r.download_tool) in let cmd = match cmd with @@ -74,7 +85,7 @@ let download_args ~url ~out ~retry ?(with_curl_mitigation=false) | [(CIdent "fetch"), _] -> cmd @ fetch_args | [(CIdent "ftp"), _] -> cmd @ ftp_args (* Assume curl if the command is a single arg *) - | [_] -> cmd @ curl_args ~with_mitigation:with_curl_mitigation + | [_] -> cmd @ curl_args ~with_mitigation:with_curl_mitigation ~etag ~last_modified | _ -> cmd in OpamFilter.single_command (fun v -> @@ -100,7 +111,7 @@ let download_args ~url ~out ~retry ?(with_curl_mitigation=false) | _ -> None) cmd -let download_command_t ~with_curl_mitigation ~compress ?checksum ~url ~dst c = +let download_command_t ~with_curl_mitigation ~compress ~etag ~last_modified ?checksum ~url ~dst c = let cmd, args = match download_args @@ -110,6 +121,7 @@ let download_command_t ~with_curl_mitigation ~compress ?checksum ~url ~dst c = ~with_curl_mitigation ?checksum ~compress + ~etag ~last_modified () with | cmd::args -> cmd, args @@ -128,7 +140,7 @@ let tool_return redownload_command url ret = fail (Some "Download command failed", Printf.sprintf "Download command failed: %s" (OpamProcess.result_summary ret)) - else Done () + else Done true | _, `Curl -> if OpamProcess.is_failure ret then if ret.r_code = 43 then begin @@ -149,7 +161,7 @@ let tool_return redownload_command url ret = fail (Some "curl failed", Printf.sprintf "curl failed: %s" (OpamProcess.result_summary ret)) - else Done () + else Done true end else fail (Some "curl failed", Printf.sprintf "curl failed: %s" (OpamProcess.result_summary ret)) @@ -166,15 +178,16 @@ let tool_return redownload_command url ret = fail (Some ("curl error code " ^ code), Printf.sprintf "curl: code %s while downloading %s" code (OpamUrl.to_string url)) - else Done () + else if num = 304 then Done false + else Done true -let download_command ~compress ?checksum ~url ~dst () = - let download_command = download_command_t ~compress ?checksum ~url ~dst in +let download_command ~compress ~etag ~last_modified ?checksum ~url ~dst () = + let download_command = download_command_t ~compress ~etag ~last_modified ?checksum ~url ~dst in download_command ~with_curl_mitigation:false @@ tool_return download_command url let really_download - ?(quiet=false) ~overwrite ?(compress=false) ?checksum ?(validate=true) + ?(quiet=false) ~overwrite ?(compress=false) ~etag ~last_modified ?checksum ?(validate=true) ~url ~dst () = assert (url.OpamUrl.backend = `http); let tmp_dst = dst ^ ".part" in @@ -191,37 +204,40 @@ let really_download log "Could not download file at %s." (OpamUrl.to_string url); raise e) @@ fun () -> - 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") - 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", - Printf.sprintf "Bad checksum, expected %s" - (OpamHash.to_string cksum))) - checksum; - OpamSystem.mv tmp_dst dst; - Done () + download_command ~compress ~etag ~last_modified ?checksum ~url ~dst:tmp_dst () + @@+ fun was_downloaded -> + if was_downloaded then begin + if not (Sys.file_exists tmp_dst) then + fail (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", + Printf.sprintf "Bad checksum, expected %s" + (OpamHash.to_string cksum))) + checksum; + OpamSystem.mv tmp_dst dst; + Done true + end else + Done false -let download_as ?quiet ?validate ~overwrite ?compress ?checksum url dst = +let download_as ?quiet ?validate ~overwrite ?compress ~etag ~last_modified ?checksum url dst = match OpamUrl.local_file url with | Some src -> - if src = dst then Done () else + if src = dst then Done true else (if OpamFilename.exists dst then if overwrite then OpamFilename.remove dst else OpamSystem.internal_error "The downloaded file will overwrite %s." (OpamFilename.to_string dst); OpamFilename.copy ~src ~dst; - Done ()) + Done true) | None -> OpamFilename.(mkdir (dirname dst)); - really_download ?quiet ~overwrite ?compress ?checksum ?validate + really_download ?quiet ~overwrite ?compress ~etag ~last_modified ?checksum ?validate ~url ~dst:(OpamFilename.to_string dst) () @@ -240,8 +256,8 @@ let download ?quiet ?validate ~overwrite ?compress ?checksum url dstdir = let dst = OpamFilename.(create dstdir (Base.of_string base)) in - download_as ?quiet ?validate ~overwrite ?compress ?checksum url dst @@| - fun () -> dst + download_as ?quiet ?validate ~overwrite ?compress ~etag:None ~last_modified:None ?checksum url dst @@| + fun _was_downloaded -> dst (** Stdout output retrieval and post requests management *) @@ -255,7 +271,7 @@ let check_post_tool () = let get_output ~post ?(args=[]) url = let cmd_args = download_args ~url ~out:"-" ~retry:OpamRepositoryConfig.(!r.retries) - ~compress:false () + ~compress:false ~etag:None ~last_modified:None () @ args in let cmd_args = @@ -376,7 +392,7 @@ module SWHID = struct let hash = OpamSWHID.hash swhid in OpamFilename.with_tmp_dir_job @@ fun dir -> let archive = OpamFilename.Op.(dir // hash) in - download_as ~overwrite:true url archive @@+ fun () -> + download_as ~etag:None ~last_modified:None ~overwrite:true url archive @@+ fun _was_downloaded -> let sources = OpamFilename.Op.(dir / "src") in OpamFilename.extract_job archive sources @@| function | Some e -> diff --git a/src/repository/opamDownload.mli b/src/repository/opamDownload.mli index 5d936039c90..d354262773e 100644 --- a/src/repository/opamDownload.mli +++ b/src/repository/opamDownload.mli @@ -28,9 +28,10 @@ val download: (** As [download], but with a specified output filename. *) val download_as: ?quiet:bool -> ?validate:bool -> overwrite:bool -> ?compress:bool -> + etag:string option -> last_modified:string option -> ?checksum:OpamHash.t -> OpamUrl.t -> OpamFilename.t -> - unit OpamProcess.job + bool OpamProcess.job (** Software Heritage fallback *) diff --git a/src/repository/opamHTTP.ml b/src/repository/opamHTTP.ml index 9c62d0ea231..c58d0846bd0 100644 --- a/src/repository/opamHTTP.ml +++ b/src/repository/opamHTTP.ml @@ -20,26 +20,29 @@ let index_archive_name = "index.tar.gz" let remote_index_archive url = OpamUrl.Op.(url / index_archive_name) -let sync_state name destdir url = +let sync_state ~etag ~last_modified name destdir url = OpamFilename.with_tmp_dir_job @@ fun dir -> let local_index_archive = OpamFilename.Op.(dir // index_archive_name) in - OpamDownload.download_as ~quiet:true ~overwrite:true + OpamDownload.download_as ~quiet:true ~overwrite:true ~etag ~last_modified (remote_index_archive url) local_index_archive - @@+ fun () -> - List.iter OpamFilename.rmdir (OpamFilename.dirs destdir); - OpamProcess.Job.with_text - (Printf.sprintf "[%s: unpacking]" - (OpamConsole.colorise `green (OpamRepositoryName.to_string name))) @@ - OpamFilename.extract_in_job local_index_archive destdir @@+ function - | None -> Done () + @@+ fun was_downloaded -> + if was_downloaded then begin + List.iter OpamFilename.rmdir (OpamFilename.dirs destdir); + OpamProcess.Job.with_text + (Printf.sprintf "[%s: unpacking]" + (OpamConsole.colorise `green (OpamRepositoryName.to_string name))) @@ + OpamFilename.extract_in_job local_index_archive destdir @@+ function + | None -> Done true | Some err -> raise err + end else + Done false module B = struct let name = `http - let fetch_repo_update repo_name ?cache_dir:_ repo_root url = + let fetch_repo_update ~etag ~last_modified repo_name ?cache_dir:_ repo_root url = log "pull-repo-update"; let quarantine = OpamFilename.Dir.(of_string (to_string repo_root ^ ".new")) @@ -51,20 +54,23 @@ module B = struct Done (OpamRepositoryBackend.Update_err e)) @@ fun () -> OpamRepositoryBackend.job_text repo_name "sync" - (sync_state repo_name quarantine url) @@+ fun () -> - if not (OpamFilename.exists_dir repo_root) || - OpamFilename.dir_is_empty repo_root then - Done (OpamRepositoryBackend.Update_full quarantine) - else - OpamProcess.Job.finally finalise @@ fun () -> - OpamRepositoryBackend.job_text repo_name "diff" - (OpamRepositoryBackend.get_diff - (OpamFilename.dirname_dir repo_root) - (OpamFilename.basename_dir repo_root) - (OpamFilename.basename_dir quarantine)) - @@| function - | None -> OpamRepositoryBackend.Update_empty - | Some patch -> OpamRepositoryBackend.Update_patch patch + (sync_state ~etag ~last_modified repo_name quarantine url) @@+ fun was_downloaded -> + if was_downloaded then begin + if not (OpamFilename.exists_dir repo_root) || + OpamFilename.dir_is_empty repo_root then + Done (OpamRepositoryBackend.Update_full quarantine) + else + OpamProcess.Job.finally finalise @@ fun () -> + OpamRepositoryBackend.job_text repo_name "diff" + (OpamRepositoryBackend.get_diff + (OpamFilename.dirname_dir repo_root) + (OpamFilename.basename_dir repo_root) + (OpamFilename.basename_dir quarantine)) + @@| function + | None -> OpamRepositoryBackend.Update_empty + | Some patch -> OpamRepositoryBackend.Update_patch patch + end else + Done OpamRepositoryBackend.Update_empty let repo_update_complete _ _ = Done () diff --git a/src/repository/opamLocal.ml b/src/repository/opamLocal.ml index 4b1f77d97da..8ca190267ae 100644 --- a/src/repository/opamLocal.ml +++ b/src/repository/opamLocal.ml @@ -144,7 +144,7 @@ module B = struct let pull_dir_quiet local_dirname url = rsync_dirs url local_dirname - let fetch_repo_update repo_name ?cache_dir:_ repo_root url = + let fetch_repo_update ~etag:_ ~last_modified:_ repo_name ?cache_dir:_ repo_root url = log "pull-repo-update"; let quarantine = OpamFilename.Dir.(of_string (to_string repo_root ^ ".new")) diff --git a/src/repository/opamRepository.ml b/src/repository/opamRepository.ml index 1ff3eddcca4..6c0ed76cb6c 100644 --- a/src/repository/opamRepository.ml +++ b/src/repository/opamRepository.ml @@ -82,8 +82,10 @@ let fetch_from_cache = match url.OpamUrl.backend with | `http -> OpamDownload.download_as + ~etag:None ~last_modified:None ~quiet:true ~validate:false ~overwrite:true ~checksum - url file + url file @@+ fun _was_downloaded -> + Done () | `rsync -> begin match OpamUrl.local_file url with | Some src -> @@ -563,7 +565,7 @@ let cleanup_repo_update upd = let update repo repo_root = log "update %a" (slog OpamRepositoryBackend.to_string) repo; let module B = (val find_backend repo: OpamRepositoryBackend.S) in - B.fetch_repo_update repo.repo_name repo_root repo.repo_url @@+ function + B.fetch_repo_update ~etag:repo.repo_etag ~last_modified:repo.repo_last_modified repo.repo_name repo_root repo.repo_url @@+ function | Update_err e -> raise e | Update_empty -> log "update empty, no validation performed"; diff --git a/src/repository/opamRepositoryBackend.ml b/src/repository/opamRepositoryBackend.ml index 202c702c083..ff23b4c51c5 100644 --- a/src/repository/opamRepositoryBackend.ml +++ b/src/repository/opamRepositoryBackend.ml @@ -26,6 +26,7 @@ module type S = sig ?cache_dir:dirname -> ?subpath:subpath -> dirname -> OpamHash.t option -> url -> filename option download OpamProcess.job val fetch_repo_update: + etag:string option -> last_modified:string option -> repository_name -> ?cache_dir:dirname -> dirname -> url -> update OpamProcess.job val repo_update_complete: dirname -> url -> unit OpamProcess.job diff --git a/src/repository/opamRepositoryBackend.mli b/src/repository/opamRepositoryBackend.mli index 7d51025a6f7..c1f17f56223 100644 --- a/src/repository/opamRepositoryBackend.mli +++ b/src/repository/opamRepositoryBackend.mli @@ -60,6 +60,7 @@ module type S = sig verifications. The file or directory returned is always temporary and should be cleaned up by the caller. *) val fetch_repo_update: + etag:string option -> last_modified:string option -> repository_name -> ?cache_dir:dirname -> dirname -> url -> update OpamProcess.job diff --git a/src/repository/opamVCS.ml b/src/repository/opamVCS.ml index b7ef4f8b754..419cdb3333f 100644 --- a/src/repository/opamVCS.ml +++ b/src/repository/opamVCS.ml @@ -41,7 +41,7 @@ module Make (VCS: VCS) = struct let name = VCS.name - let fetch_repo_update repo_name ?cache_dir repo_root repo_url = + let fetch_repo_update ~etag:_ ~last_modified:_ repo_name ?cache_dir repo_root repo_url = let full_fetch = false in if VCS.exists repo_root then OpamProcess.Job.catch (fun e -> Done (OpamRepositoryBackend.Update_err e)) diff --git a/src/state/opamSysInteract.ml b/src/state/opamSysInteract.ml index dfbcdb2cb79..e123f97aa76 100644 --- a/src/state/opamSysInteract.ml +++ b/src/state/opamSysInteract.ml @@ -299,8 +299,8 @@ module Cygwin = struct log "Downloading setup-x86_64.exe"; if OpamConsole.disp_status_line () then OpamConsole.status_line "Downloading Cygwin setup from cygwin.com"; - OpamDownload.download_as ~overwrite ?checksum url_setupexe dst @@+ - fun () -> + OpamDownload.download_as ~etag:None ~last_modified:None ~overwrite ?checksum url_setupexe dst @@+ + fun _was_downloaded -> OpamConsole.clear_status (); Done () end From d239c8694358879923b7d98929c99bbcdbb85c71 Mon Sep 17 00:00:00 2001 From: Kate Date: Wed, 30 Oct 2024 13:59:36 +0000 Subject: [PATCH 4/5] tmp --- src/repository/opamDownload.ml | 35 ++++++++++++--------- src/repository/opamDownload.mli | 2 +- src/repository/opamHTTP.ml | 54 ++++++++++++++++----------------- 3 files changed, 48 insertions(+), 43 deletions(-) diff --git a/src/repository/opamDownload.ml b/src/repository/opamDownload.ml index 95aeaa183ff..651259793cc 100644 --- a/src/repository/opamDownload.ml +++ b/src/repository/opamDownload.ml @@ -41,7 +41,7 @@ let curl_args = (CString "--fail", None) :: main_args else (CString "--write-out", None) :: - (CString "%%{http_code}\\n", None) :: (* 6.5 13-Mar-2000 *) + (CString "%%header{last-modified}\\n%%header{etag}\\n%%{http_code}\\n", None) :: (* 6.5 13-Mar-2000 *) main_args in let args = match etag with @@ -140,7 +140,7 @@ let tool_return redownload_command url ret = fail (Some "Download command failed", Printf.sprintf "Download command failed: %s" (OpamProcess.result_summary ret)) - else Done true + else Done (`Was_downloaded (None, None)) | _, `Curl -> if OpamProcess.is_failure ret then if ret.r_code = 43 then begin @@ -161,25 +161,30 @@ let tool_return redownload_command url ret = fail (Some "curl failed", Printf.sprintf "curl failed: %s" (OpamProcess.result_summary ret)) - else Done true + else Done (`Was_downloaded (None, None)) end else fail (Some "curl failed", Printf.sprintf "curl failed: %s" (OpamProcess.result_summary ret)) else - match ret.OpamProcess.r_stdout with + match List.rev 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 + | code::etag::last_modified::_ -> + let etag = if etag = "" then None else Some etag in + let last_modified = if last_modified = "" then None else Some last_modified 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 if num = 304 then Done false - else Done true + else if num = 304 then Done `Not_downloaded + else Done (`Was_downloaded (etag, last_modified)) + | _ -> + fail (Some "unexpected curl response", + Printf.sprintf "curl: unexpected response while downloading %s" + (OpamUrl.to_string url)) let download_command ~compress ~etag ~last_modified ?checksum ~url ~dst () = let download_command = download_command_t ~compress ~etag ~last_modified ?checksum ~url ~dst in @@ -205,8 +210,8 @@ let really_download raise e) @@ fun () -> download_command ~compress ~etag ~last_modified ?checksum ~url ~dst:tmp_dst () - @@+ fun was_downloaded -> - if was_downloaded then begin + @@+ function + | `Was_downloaded _ as was_downloaded -> if not (Sys.file_exists tmp_dst) then fail (Some "Downloaded file not found", "Download command succeeded, but resulting file not found") @@ -221,20 +226,20 @@ let really_download (OpamHash.to_string cksum))) checksum; OpamSystem.mv tmp_dst dst; - Done true - end else - Done false + Done was_downloaded + | `Not_downloaded -> + Done `Not_downloaded let download_as ?quiet ?validate ~overwrite ?compress ~etag ~last_modified ?checksum url dst = match OpamUrl.local_file url with | Some src -> - if src = dst then Done true else + if src = dst then Done (`Was_downloaded (None, None)) else (if OpamFilename.exists dst then if overwrite then OpamFilename.remove dst else OpamSystem.internal_error "The downloaded file will overwrite %s." (OpamFilename.to_string dst); OpamFilename.copy ~src ~dst; - Done true) + Done (`Was_downloaded (None, None))) | None -> OpamFilename.(mkdir (dirname dst)); really_download ?quiet ~overwrite ?compress ~etag ~last_modified ?checksum ?validate diff --git a/src/repository/opamDownload.mli b/src/repository/opamDownload.mli index d354262773e..da605e2ba6d 100644 --- a/src/repository/opamDownload.mli +++ b/src/repository/opamDownload.mli @@ -31,7 +31,7 @@ val download_as: etag:string option -> last_modified:string option -> ?checksum:OpamHash.t -> OpamUrl.t -> OpamFilename.t -> - bool OpamProcess.job + [`Was_downloaded of (string option * string option) | `Not_downloaded] OpamProcess.job (** Software Heritage fallback *) diff --git a/src/repository/opamHTTP.ml b/src/repository/opamHTTP.ml index c58d0846bd0..c223b1bfb2a 100644 --- a/src/repository/opamHTTP.ml +++ b/src/repository/opamHTTP.ml @@ -26,17 +26,17 @@ let sync_state ~etag ~last_modified name destdir url = OpamDownload.download_as ~quiet:true ~overwrite:true ~etag ~last_modified (remote_index_archive url) local_index_archive - @@+ fun was_downloaded -> - if was_downloaded then begin - List.iter OpamFilename.rmdir (OpamFilename.dirs destdir); - OpamProcess.Job.with_text - (Printf.sprintf "[%s: unpacking]" - (OpamConsole.colorise `green (OpamRepositoryName.to_string name))) @@ - OpamFilename.extract_in_job local_index_archive destdir @@+ function - | None -> Done true - | Some err -> raise err - end else - Done false + @@+ function + | `Was_downloaded _ as was_downloaded -> + (List.iter OpamFilename.rmdir (OpamFilename.dirs destdir); + OpamProcess.Job.with_text + (Printf.sprintf "[%s: unpacking]" + (OpamConsole.colorise `green (OpamRepositoryName.to_string name))) @@ + OpamFilename.extract_in_job local_index_archive destdir @@+ function + | None -> Done was_downloaded + | Some err -> raise err) + | `Not_downloaded -> + Done `Not_downloaded module B = struct @@ -54,22 +54,22 @@ module B = struct Done (OpamRepositoryBackend.Update_err e)) @@ fun () -> OpamRepositoryBackend.job_text repo_name "sync" - (sync_state ~etag ~last_modified repo_name quarantine url) @@+ fun was_downloaded -> - if was_downloaded then begin - if not (OpamFilename.exists_dir repo_root) || - OpamFilename.dir_is_empty repo_root then - Done (OpamRepositoryBackend.Update_full quarantine) - else - OpamProcess.Job.finally finalise @@ fun () -> - OpamRepositoryBackend.job_text repo_name "diff" - (OpamRepositoryBackend.get_diff - (OpamFilename.dirname_dir repo_root) - (OpamFilename.basename_dir repo_root) - (OpamFilename.basename_dir quarantine)) - @@| function - | None -> OpamRepositoryBackend.Update_empty - | Some patch -> OpamRepositoryBackend.Update_patch patch - end else + (sync_state ~etag ~last_modified repo_name quarantine url) @@+ function + | `Was_downloaded -> + (if not (OpamFilename.exists_dir repo_root) || + OpamFilename.dir_is_empty repo_root then + Done (OpamRepositoryBackend.Update_full quarantine) + else + OpamProcess.Job.finally finalise @@ fun () -> + OpamRepositoryBackend.job_text repo_name "diff" + (OpamRepositoryBackend.get_diff + (OpamFilename.dirname_dir repo_root) + (OpamFilename.basename_dir repo_root) + (OpamFilename.basename_dir quarantine)) + @@| function + | None -> OpamRepositoryBackend.Update_empty + | Some patch -> OpamRepositoryBackend.Update_patch patch) + | `Not_downloaded -> Done OpamRepositoryBackend.Update_empty let repo_update_complete _ _ = Done () From e4f187b44c715f6ab7daacf2a371a65270b9c83b Mon Sep 17 00:00:00 2001 From: Kate Date: Thu, 31 Oct 2024 13:38:10 +0000 Subject: [PATCH 5/5] finish? --- src/repository/opamHTTP.ml | 6 +++--- src/repository/opamLocal.ml | 4 ++-- src/repository/opamRepository.ml | 24 ++++++++++++------------ src/repository/opamRepository.mli | 2 +- src/repository/opamRepositoryBackend.ml | 4 ++-- src/repository/opamRepositoryBackend.mli | 4 ++-- src/repository/opamVCS.ml | 4 ++-- src/state/opamUpdate.ml | 5 +++-- 8 files changed, 27 insertions(+), 26 deletions(-) diff --git a/src/repository/opamHTTP.ml b/src/repository/opamHTTP.ml index c223b1bfb2a..fac21dd76e5 100644 --- a/src/repository/opamHTTP.ml +++ b/src/repository/opamHTTP.ml @@ -55,10 +55,10 @@ module B = struct @@ fun () -> OpamRepositoryBackend.job_text repo_name "sync" (sync_state ~etag ~last_modified repo_name quarantine url) @@+ function - | `Was_downloaded -> + | `Was_downloaded was_downloaded -> (if not (OpamFilename.exists_dir repo_root) || OpamFilename.dir_is_empty repo_root then - Done (OpamRepositoryBackend.Update_full quarantine) + Done (OpamRepositoryBackend.Update_full (quarantine, was_downloaded)) else OpamProcess.Job.finally finalise @@ fun () -> OpamRepositoryBackend.job_text repo_name "diff" @@ -68,7 +68,7 @@ module B = struct (OpamFilename.basename_dir quarantine)) @@| function | None -> OpamRepositoryBackend.Update_empty - | Some patch -> OpamRepositoryBackend.Update_patch patch) + | Some patch -> OpamRepositoryBackend.Update_patch (patch, was_downloaded)) | `Not_downloaded -> Done OpamRepositoryBackend.Update_empty diff --git a/src/repository/opamLocal.ml b/src/repository/opamLocal.ml index 8ca190267ae..fbb4ee9b634 100644 --- a/src/repository/opamLocal.ml +++ b/src/repository/opamLocal.ml @@ -176,7 +176,7 @@ module B = struct | Result _ -> if not (OpamFilename.exists_dir repo_root) || OpamFilename.dir_is_empty repo_root then - Done (OpamRepositoryBackend.Update_full quarantine) + Done (OpamRepositoryBackend.Update_full (quarantine, (None, None))) else OpamProcess.Job.finally finalise @@ fun () -> OpamRepositoryBackend.job_text repo_name "diff" @@ @@ -186,7 +186,7 @@ module B = struct (OpamFilename.basename_dir quarantine) @@| function | None -> OpamRepositoryBackend.Update_empty - | Some p -> OpamRepositoryBackend.Update_patch p + | Some p -> OpamRepositoryBackend.Update_patch (p, (None, None)) let repo_update_complete _ _ = Done () diff --git a/src/repository/opamRepository.ml b/src/repository/opamRepository.ml index 6c0ed76cb6c..d1236dbaacb 100644 --- a/src/repository/opamRepository.ml +++ b/src/repository/opamRepository.ml @@ -492,10 +492,10 @@ let validate_repo_update repo repo_root update = | "anchors", _ -> Some (S (String.concat "," ta.fingerprints)) | "quorum", _ -> Some (S (string_of_int ta.quorum)) | "repo", _ -> Some (S (OpamFilename.Dir.to_string repo_root)) - | "patch", Update_patch f -> Some (S (OpamFilename.to_string f)) + | "patch", Update_patch (f, _) -> Some (S (OpamFilename.to_string f)) | "incremental", Update_patch _ -> Some (B true) | "incremental", _ -> Some (B false) - | "dir", Update_full d -> Some (S (OpamFilename.Dir.to_string d)) + | "dir", Update_full (d, _) -> Some (S (OpamFilename.Dir.to_string d)) | _ -> None in match OpamFilter.single_command env hook with @@ -513,7 +513,7 @@ let validate_repo_update repo repo_root update = open OpamRepositoryBackend let apply_repo_update repo repo_root = function - | Update_full d -> + | Update_full (d, was_downloaded) -> log "%a: applying update from scratch at %a" (slog OpamRepositoryName.to_string) repo.repo_name (slog OpamFilename.Dir.to_string) d; @@ -526,8 +526,8 @@ let apply_repo_update repo repo_root = function OpamConsole.msg "[%s] Initialised\n" (OpamConsole.colorise `green (OpamRepositoryName.to_string repo.repo_name)); - Done () - | Update_patch f -> + Done was_downloaded + | Update_patch (f, was_downloaded) -> OpamConsole.msg "[%s] synchronised from %s\n" (OpamConsole.colorise `green (OpamRepositoryName.to_string repo.repo_name)) @@ -544,7 +544,7 @@ let apply_repo_update repo repo_root = function | Some e -> if not (OpamConsole.debug ()) then OpamFilename.remove f; raise e - | None -> OpamFilename.remove f; Done ()) + | None -> OpamFilename.remove f; Done was_downloaded) | Update_empty -> OpamConsole.msg "[%s] no changes from %s\n" (OpamConsole.colorise `green @@ -552,14 +552,14 @@ let apply_repo_update repo repo_root = function (OpamUrl.to_string repo.repo_url); log "%a: applying empty update" (slog OpamRepositoryName.to_string) repo.repo_name; - Done () + Done (None, None) | Update_err _ -> assert false let cleanup_repo_update upd = if not (OpamConsole.debug ()) then match upd with - | Update_full d -> OpamFilename.rmdir d - | Update_patch f -> OpamFilename.remove f + | Update_full (d, _) -> OpamFilename.rmdir d + | Update_patch (f, _) -> OpamFilename.remove f | _ -> () let update repo repo_root = @@ -569,7 +569,7 @@ let update repo repo_root = | Update_err e -> raise e | Update_empty -> log "update empty, no validation performed"; - apply_repo_update repo repo_root Update_empty @@+ fun () -> + apply_repo_update repo repo_root Update_empty @@+ fun _was_downloaded -> B.repo_update_complete repo_root repo.repo_url @@+ fun () -> Done `No_changes | (Update_full _ | Update_patch _) as upd -> @@ -582,9 +582,9 @@ let update repo repo_root = cleanup_repo_update upd; failwith "Invalid repository signatures, update aborted" | true -> - apply_repo_update repo repo_root upd @@+ fun () -> + apply_repo_update repo repo_root upd @@+ fun was_downloaded -> B.repo_update_complete repo_root repo.repo_url @@+ fun () -> - Done `Changes + Done (`Changes was_downloaded) let on_local_version_control url ~default f = match url.OpamUrl.backend with diff --git a/src/repository/opamRepository.mli b/src/repository/opamRepository.mli index babd92c3127..e6cbdf3a06c 100644 --- a/src/repository/opamRepository.mli +++ b/src/repository/opamRepository.mli @@ -25,7 +25,7 @@ val packages_with_prefixes: dirname -> string option package_map (** Update {i $opam/repo/$repo}. Raises [Failure] in case the update couldn't be achieved. Returns [`No_changes] if the update did not bring any changes, and [`Changes] otherwise. *) -val update: repository -> dirname -> [`Changes | `No_changes] OpamProcess.job +val update: repository -> dirname -> [`Changes of string option * string option | `No_changes] OpamProcess.job (** [pull_shared_tree ?cache_dir ?cache_url labels_dirnames checksums urls] Fetch an URL and put the resulting tree into the supplied directories diff --git a/src/repository/opamRepositoryBackend.ml b/src/repository/opamRepositoryBackend.ml index ff23b4c51c5..5eb49c2635f 100644 --- a/src/repository/opamRepositoryBackend.ml +++ b/src/repository/opamRepositoryBackend.ml @@ -14,8 +14,8 @@ let log = OpamConsole.log "REPO_BACKEND" let slog = OpamConsole.slog type update = - | Update_full of dirname - | Update_patch of filename + | Update_full of dirname * (string option * string option) + | Update_patch of filename * (string option * string option) | Update_empty | Update_err of exn diff --git a/src/repository/opamRepositoryBackend.mli b/src/repository/opamRepositoryBackend.mli index c1f17f56223..d5c648bd52b 100644 --- a/src/repository/opamRepositoryBackend.mli +++ b/src/repository/opamRepositoryBackend.mli @@ -15,10 +15,10 @@ open OpamTypes (** Type returned by repository updates. *) type update = - | Update_full of dirname + | Update_full of dirname * (string option * string option) (** No previous known state, the full contents have been put in the given temporary directory *) - | Update_patch of filename + | Update_patch of filename * (string option * string option) (** The given patch file corresponds to the update, i.e. applying it to the local repository with 'patch -p1' would get it to the upstream state *) | Update_empty diff --git a/src/repository/opamVCS.ml b/src/repository/opamVCS.ml index 419cdb3333f..ce6025d6a2c 100644 --- a/src/repository/opamVCS.ml +++ b/src/repository/opamVCS.ml @@ -53,7 +53,7 @@ module Make (VCS: VCS) = struct (VCS.diff repo_root repo_url) @@| function | None -> OpamRepositoryBackend.Update_empty - | Some patch -> OpamRepositoryBackend.Update_patch patch + | Some patch -> OpamRepositoryBackend.Update_patch (patch, (None, None)) else OpamProcess.Job.catch (fun e -> OpamFilename.rmdir repo_root; @@ -70,7 +70,7 @@ module Make (VCS: VCS) = struct OpamProcess.Job.catch (fun e -> OpamFilename.rmdir tmpdir; raise e) @@ fun () -> VCS.reset_tree tmpdir repo_url @@| fun () -> - OpamRepositoryBackend.Update_full tmpdir + OpamRepositoryBackend.Update_full (tmpdir, (None, None)) let repo_update_complete dirname url = VCS.patch_applied dirname url @@+ fun () -> diff --git a/src/state/opamUpdate.ml b/src/state/opamUpdate.ml index c62a54eb23b..968ebff857e 100644 --- a/src/state/opamUpdate.ml +++ b/src/state/opamUpdate.ml @@ -67,7 +67,7 @@ let repository rt repo = in OpamProcess.Job.with_text text @@ OpamRepository.update r repo_root @@+ fun has_changes -> - let has_changes = if redirect then `Changes else has_changes in + let has_changes = if redirect then `Changes (None, None) else has_changes in if n <> max_loop && r = repo then (OpamConsole.warning "%s: Cyclic redirections, stopping." (OpamRepositoryName.to_string repo.repo_name); @@ -99,7 +99,7 @@ let repository rt repo = | `No_changes -> log "Repository did not change: nothing to do."; Done None - | `Changes -> + | `Changes was_downloaded -> log "Repository has new changes"; let repo_file = OpamFile.Repo.safe_read repo_file_path in let repo_file = OpamFile.Repo.with_root_url repo.repo_url repo_file in @@ -145,6 +145,7 @@ let repository rt repo = else if OpamFilename.exists tarred_repo then (OpamFilename.move_dir ~src:repo_root ~dst:local_dir; OpamFilename.remove tarred_repo); + let repo = {repo with repo_etag = fst was_downloaded; repo_last_modified = snd was_downloaded} in Done (Some ( (* Return an update function to make parallel execution possible *) fun rt ->