From ad48b0cbb812300f65c140e0d1fe5389bc36602d Mon Sep 17 00:00:00 2001 From: Stephen Sherratt Date: Tue, 21 Feb 2023 13:50:38 +1100 Subject: [PATCH 1/2] Error when multiple dev-repos collide on dir The duniverse directory of a package is implied by its dev-repo. It's possible for different dev-repos to map to the same directory. Prior to this change, one lucky package would be downloaded to the expected place and the others would be silently ignored. More precisely, each package would be downloaded and placed in the duniverse dir implied by their dev-repo, but first any existing duniverse dir of the same name would be removed. After this change, the same situation results in an error when running `opam monorepo lock`. Signed-off-by: Stephen Sherratt --- CHANGES.md | 3 + lib/dev_repo.ml | 1 + lib/dev_repo.mli | 1 + lib/duniverse.ml | 57 +++++++++++++++++-- .../repo/packages/bar/bar.0.1.0/opam | 12 ++++ .../packages/foo-branch/foo-branch.0.1.0/opam | 12 ++++ .../repo/packages/foo/foo.0.1.0/opam | 12 ++++ test/bin/error-on-directory-conflict.t/run.t | 16 ++++++ test/bin/error-on-directory-conflict.t/x.opam | 10 ++++ 9 files changed, 120 insertions(+), 4 deletions(-) create mode 100644 test/bin/error-on-directory-conflict.t/repo/packages/bar/bar.0.1.0/opam create mode 100644 test/bin/error-on-directory-conflict.t/repo/packages/foo-branch/foo-branch.0.1.0/opam create mode 100644 test/bin/error-on-directory-conflict.t/repo/packages/foo/foo.0.1.0/opam create mode 100644 test/bin/error-on-directory-conflict.t/run.t create mode 100644 test/bin/error-on-directory-conflict.t/x.opam diff --git a/CHANGES.md b/CHANGES.md index 8bfca878e..5768750b3 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -18,6 +18,9 @@ ### Fixed +- Error in case where multiple packages with different dev-repo fields would be + placed in the same duniverse directory (#377, @gridbugs) + ### Removed ### Security diff --git a/lib/dev_repo.ml b/lib/dev_repo.ml index 2781ce180..651ff9eca 100644 --- a/lib/dev_repo.ml +++ b/lib/dev_repo.ml @@ -5,6 +5,7 @@ type t = string let compare = String.compare let from_string s = s let to_string t = t +let pp fmt t = Format.fprintf fmt "%s" t let rec repeat_while_some x ~f = match f x with None -> x | Some x -> repeat_while_some x ~f diff --git a/lib/dev_repo.mli b/lib/dev_repo.mli index cc1a59f3f..e74bb1cc4 100644 --- a/lib/dev_repo.mli +++ b/lib/dev_repo.mli @@ -4,6 +4,7 @@ type t val from_string : string -> t val to_string : t -> string +val pp : t Fmt.t val repo_name : t -> (string, Rresult.R.msg) result (** Computes a name for the repo by applying the following method: diff --git a/lib/duniverse.ml b/lib/duniverse.ml index 5986a12dc..035edad3f 100644 --- a/lib/duniverse.ml +++ b/lib/duniverse.ml @@ -231,6 +231,58 @@ let dev_repo_map_from_packages packages = | Some pkgs -> Some (pkg :: pkgs) | None -> Some [ pkg ])) +(* converts a map from dev-repos to lists of packages to a list of repos after + checking for errors *) +let dev_repo_package_map_to_repos dev_repo_package_map = + let open Result.O in + let dev_repo_to_repo_result_map = + Dev_repo.Map.mapi dev_repo_package_map ~f:(fun dev_repo pkgs -> + Repo.from_packages ~dev_repo pkgs) + in + (* Handle any errors relating to individual repos but maintain the + association between dev-repo and repo for further error checking. *) + let* repo_by_dev_repo = + Dev_repo.Map.bindings dev_repo_to_repo_result_map + |> List.map ~f:(fun (dev_repo, repo_result) -> + Result.map (fun repo -> (dev_repo, repo)) repo_result) + |> Base.Result.all + in + (* Detect the case where multiple different dev-repos are associated with the + same duniverse directory. *) + let* () = + let dev_repos_by_dir = + List.fold_left repo_by_dev_repo ~init:String.Map.empty + ~f:(fun acc (dev_repo, (repo : _ Repo.t)) -> + String.Map.update acc repo.dir ~f:(function + | None -> Some [ dev_repo ] + | Some dev_repos -> Some (dev_repo :: dev_repos))) + |> String.Map.bindings + in + match + List.find_opt dev_repos_by_dir ~f:(fun (_, dev_repos) -> + List.length dev_repos > 1) + with + | None -> Ok () + | Some (dir, dev_repos) -> + let dir_path = Fpath.(Config.vendor_dir / dir) in + let message_first_line = + Format.asprintf + "Multiple dev-repos would be vendored into the directory: %a" + Fpath.pp dir_path + in + let message_dev_repos = + Format.sprintf "Dev-repos:\n%s" + (List.map dev_repos ~f:(fun dev_repo -> + Format.asprintf "- %a" Dev_repo.pp dev_repo) + |> String.concat ~sep:"\n") + in + let message = + [ message_first_line; message_dev_repos ] |> String.concat ~sep:"\n" + in + Error (`Msg message) + in + Ok (List.map ~f:snd repo_by_dev_repo) + let from_dependency_entries ~get_default_branch dependencies = let open Result.O in let summaries = @@ -247,10 +299,7 @@ let from_dependency_entries ~get_default_branch dependencies = let* pkg_opts = Base.Result.all results in let pkgs = Base.List.filter_opt pkg_opts in let dev_repo_map = dev_repo_map_from_packages pkgs in - Dev_repo.Map.fold dev_repo_map ~init:[] - ~f:(fun ~key:dev_repo ~data:pkgs acc -> - Repo.from_packages ~dev_repo pkgs :: acc) - |> Base.Result.all + dev_repo_package_map_to_repos dev_repo_map let resolve ~resolve_ref t = Parallel.map ~f:(Repo.resolve ~resolve_ref) t |> Base.Result.all diff --git a/test/bin/error-on-directory-conflict.t/repo/packages/bar/bar.0.1.0/opam b/test/bin/error-on-directory-conflict.t/repo/packages/bar/bar.0.1.0/opam new file mode 100644 index 000000000..9ebd9593a --- /dev/null +++ b/test/bin/error-on-directory-conflict.t/repo/packages/bar/bar.0.1.0/opam @@ -0,0 +1,12 @@ +opam-version: "2.0" +dev-repo: "git+https://github.com/bar/project" +depends: [ + "dune" +] +build: [ "dune" "build" ] +url { + src: "https://test.com/bar.tbz" + checksum: [ + "sha256=0000000000000000000000000000000000000000000000000000000000000000" + ] +} diff --git a/test/bin/error-on-directory-conflict.t/repo/packages/foo-branch/foo-branch.0.1.0/opam b/test/bin/error-on-directory-conflict.t/repo/packages/foo-branch/foo-branch.0.1.0/opam new file mode 100644 index 000000000..c410ea5ff --- /dev/null +++ b/test/bin/error-on-directory-conflict.t/repo/packages/foo-branch/foo-branch.0.1.0/opam @@ -0,0 +1,12 @@ +opam-version: "2.0" +dev-repo: "git+https://github.com/foo/project.git#branch" +depends: [ + "dune" +] +build: [ "dune" "build" ] +url { + src: "https://test.com/foo-branch.tbz" + checksum: [ + "sha256=0000000000000000000000000000000000000000000000000000000000000000" + ] +} diff --git a/test/bin/error-on-directory-conflict.t/repo/packages/foo/foo.0.1.0/opam b/test/bin/error-on-directory-conflict.t/repo/packages/foo/foo.0.1.0/opam new file mode 100644 index 000000000..fba9fcf69 --- /dev/null +++ b/test/bin/error-on-directory-conflict.t/repo/packages/foo/foo.0.1.0/opam @@ -0,0 +1,12 @@ +opam-version: "2.0" +dev-repo: "git+https://github.com/foo/project" +depends: [ + "dune" +] +build: [ "dune" "build" ] +url { + src: "https://test.com/foo.tbz" + checksum: [ + "sha256=0000000000000000000000000000000000000000000000000000000000000000" + ] +} diff --git a/test/bin/error-on-directory-conflict.t/run.t b/test/bin/error-on-directory-conflict.t/run.t new file mode 100644 index 000000000..bcaeef795 --- /dev/null +++ b/test/bin/error-on-directory-conflict.t/run.t @@ -0,0 +1,16 @@ +We have a project which depends on multiple packages with different dev-repos +but which happen to resolve to the same directory under duniverse. This tests +that such a situation results in an explicit error. + + $ gen-minimal-repo + $ opam-monorepo lock + ==> Using 1 locally scanned package as the target. + ==> Found 11 opam dependencies for the target package. + ==> Querying opam database for their metadata and Dune compatibility. + ==> Calculating exact pins for each of them. + opam-monorepo: [ERROR] Multiple dev-repos would be vendored into the directory: duniverse/project + Dev-repos: + - git+https://github.com/foo/project.git#branch + - git+https://github.com/foo/project + - git+https://github.com/bar/project + [1] diff --git a/test/bin/error-on-directory-conflict.t/x.opam b/test/bin/error-on-directory-conflict.t/x.opam new file mode 100644 index 000000000..d9a0fa45b --- /dev/null +++ b/test/bin/error-on-directory-conflict.t/x.opam @@ -0,0 +1,10 @@ +opam-version: "2.0" +depends: [ + "foo" + "foo-branch" + "bar" +] +x-opam-monorepo-opam-repositories: [ + "file://$OPAM_MONOREPO_CWD/minimal-repo" + "file://$OPAM_MONOREPO_CWD/repo" +] From c6584489146b6c4619cfdebf95baf9040d629e9e Mon Sep 17 00:00:00 2001 From: Stephen Sherratt Date: Wed, 22 Feb 2023 15:45:41 +1100 Subject: [PATCH 2/2] More consise error message printing --- lib/dev_repo.ml | 2 +- lib/duniverse.ml | 18 +++++++----------- 2 files changed, 8 insertions(+), 12 deletions(-) diff --git a/lib/dev_repo.ml b/lib/dev_repo.ml index 651ff9eca..30fbea196 100644 --- a/lib/dev_repo.ml +++ b/lib/dev_repo.ml @@ -5,7 +5,7 @@ type t = string let compare = String.compare let from_string s = s let to_string t = t -let pp fmt t = Format.fprintf fmt "%s" t +let pp = Fmt.string let rec repeat_while_some x ~f = match f x with None -> x | Some x -> repeat_while_some x ~f diff --git a/lib/duniverse.ml b/lib/duniverse.ml index 035edad3f..5abac2f9a 100644 --- a/lib/duniverse.ml +++ b/lib/duniverse.ml @@ -266,20 +266,16 @@ let dev_repo_package_map_to_repos dev_repo_package_map = | Some (dir, dev_repos) -> let dir_path = Fpath.(Config.vendor_dir / dir) in let message_first_line = - Format.asprintf - "Multiple dev-repos would be vendored into the directory: %a" + Fmt.str "Multiple dev-repos would be vendored into the directory: %a" Fpath.pp dir_path in - let message_dev_repos = - Format.sprintf "Dev-repos:\n%s" - (List.map dev_repos ~f:(fun dev_repo -> - Format.asprintf "- %a" Dev_repo.pp dev_repo) - |> String.concat ~sep:"\n") + let dev_repos_pp = + Fmt.list + ~sep:Fmt.(const char '\n') + (fun ppf dev_repo -> Fmt.pf ppf "- %a" Dev_repo.pp dev_repo) in - let message = - [ message_first_line; message_dev_repos ] |> String.concat ~sep:"\n" - in - Error (`Msg message) + Rresult.R.error_msgf "%s\nDev-repos:\n%a" message_first_line + dev_repos_pp dev_repos in Ok (List.map ~f:snd repo_by_dev_repo)