diff --git a/master_changes.md b/master_changes.md index 428df6ddceb..2efe7e53f99 100644 --- a/master_changes.md +++ b/master_changes.md @@ -119,6 +119,7 @@ users) * download tool: Use fetch on DragonFlyBSD and ftp on NetBSD [#6305 @kit-ty-kate] * Prefer curl over any other download tools on every systems, if available [#6305 @kit-ty-kate] * Avoid issues when using wget2 where the requested url might return an html page instead of the expected content [#6303 @kit-ty-kate] + * Ensure each repositories stored in repos-config is associated with an URL [#6249 @kit-ty-kate] ## Internal: Windows @@ -164,6 +165,7 @@ users) ## opam-format * `OpamFormula.string_of_relop`: export function [#6197 @mbarbin] * `OpamFormula.all_relop`: a list of all operators [#6197 @mbarbin] + * `OpamFile.Repos_config.t`: change the type to not allow repositories without an URL [#6249 @kit-ty-kate] ## opam-core * `OpamStd.Sys.{get_terminal_columns,uname,getconf,guess_shell_compat}`: Harden the process calls to account for failures [#6230 @kit-ty-kate - fix #6215] diff --git a/src/client/opamClient.ml b/src/client/opamClient.ml index 14db917ed22..2b37a6f6fcc 100644 --- a/src/client/opamClient.ml +++ b/src/client/opamClient.ml @@ -1890,10 +1890,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 9ac19f15b87..45c51ef8320 100644 --- a/src/format/opamFile.mli +++ b/src/format/opamFile.mli @@ -1029,7 +1029,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"); - diff --git a/tests/reftests/repository.test b/tests/reftests/repository.test index 755d99f385c..d84dbba52ff 100644 --- a/tests/reftests/repository.test +++ b/tests/reftests/repository.test @@ -816,3 +816,55 @@ GARBAGE ### opam show two-three --raw [ERROR] No package matching two-three found # Return code 5 # +### : Repo config with no url repo +### opam switch create nourl --empty +### opam repo remove --all repo versions +### +opam-version: "2.0" +### +opam-version: "2.0" +### cat OPAM/repo/repos-config +opam-version: "2.0" +### opam repo --all +# Repository # Url # Switches(rank) +### opam repo add nourl ./nourl --this-switch +[nourl] Initialised +### opam repo --all | grep -v '^#' +nourl file://${BASEDIR}/nourl nourl +### opam list -A +# Packages matching: any +# Name # Installed # Synopsis +no -- +### +opam-version: "2.0" +repositories: [ "nourl" ] +### opam repo --all +[WARNING] Errors in ${BASEDIR}/OPAM/repo/repos-config, some fields have been ignored: + - At ${BASEDIR}/OPAM/repo/repos-config:2:16-2:23:: + expected url + +# Repository # Url # Switches(rank) +### +opam-version: "2.0" +### opam update nourl +[WARNING] Errors in ${BASEDIR}/OPAM/repo/repos-config, some fields have been ignored: + - At ${BASEDIR}/OPAM/repo/repos-config:2:16-2:23:: + expected url + +[ERROR] Unknown repositories or installed packages: nourl +# Return code 40 # +### opam list -A +[WARNING] Errors in ${BASEDIR}/OPAM/repo/repos-config, some fields have been ignored: + - At ${BASEDIR}/OPAM/repo/repos-config:2:16-2:23:: + expected url + +# Packages matching: any +# No matches found +### sh -c "rm OPAM/repo/state-*.cache" +### opam list -A +[WARNING] Errors in ${BASEDIR}/OPAM/repo/repos-config, some fields have been ignored: + - At ${BASEDIR}/OPAM/repo/repos-config:2:16-2:23:: + expected url + +# Packages matching: any +# No matches found