Repository loading: update load from diff mechanism

master_changes.md

@@ -53,6 +53,7 @@ users)
   * Compute the list of available depexts on `opam update` [#6489 @arozovyk - fix #6461]
   * Update depexts availability repository state cache when running `opam update --depexts` [#6489 @arozovyk - fix #6461]
   * Display status message while loading system package availability during `opam update` [#6489 @arozovyk - fix #6461]
+  * When loading a repository from a diff, no longer apply updates of unrelated files [#6871 @rjbou - fix 6872]
 
 ## Tree
 
@@ -196,6 +197,7 @@ users)
   * `OpamSolution.get_depexts` remove no longer needed `recover` option that was used with `--depext-only` option  [#6489 @arozovyk]
 
 ## opam-repository
+  * `OpamRepositoryPath`: add `extrafile_nv_dir` to retrieve information from a path if it is an extra files path [#6871 @rjbou]
 
 ## opam-state
   * `OpamStateConfig.t`: replace `no_depexts` fields that contains disabling informations by `depexts` field that returns if the depexts mechanism is enabled. This field is automatically update by global config value in `OpamStateConfig.load_defaults` [#6489 @rjbou]
@@ -247,3 +249,6 @@ users)
   * `OpamFilename`: add `is_dir_read_only` [#6489 @rjbou]
   * `OpamFilename.might_escape`: ensure / is detected as a file separator when called with `~sep:Unspecified` on Windows [#6897 @kit-ty-kate]
   * `OpamFilename.Unix` was added abstracting over `/` separated paths regardless of the current system [#6914 @rjbou @kit-ty-kate]
+  * `OpamFilename`: add `to_list` that deconstructs a `filename` path [#6871 @rjbou]
+  * `OpamFilename.Dir`: add `of_list` that constructs a `dirname` from a string path elements [#6871 @rjbou]
+  * `OpamFilename.Unix`: add `starts_with`, `basename`, `dirname` [#6871 @rjbou]

src/core/opamFilename.ml

@@ -59,6 +59,8 @@ module Dir = struct
     OpamSystem.real_path (OpamSystem.forward_to_back dirname)
 
   let to_string dirname = dirname
+  let of_list dirs =
+    String.concat Filename.dir_sep dirs
 
 end
 
@@ -813,4 +815,16 @@ module Unix = struct
 
   let of_filename x = OpamSystem.back_to_forward (concat x.dirname x.basename)
   let to_filename x = {dirname = dirname x; basename = basename x}
+
+  let to_list (t:t) =
+    let base d = Base.to_string (basename_dir d) in
+    let rec aux acc dir =
+      let d = dirname_dir dir in
+      if d <> dir then aux (base dir :: acc) d
+      else base dir :: acc in
+    aux [] t
+
+ let starts_with prefix filename =
+    OpamCompat.String.starts_with ~prefix filename
+
 end

src/core/opamFilename.mli

@@ -27,7 +27,11 @@ module Base: sig
 end
 
 (** Directory names *)
-module Dir: OpamStd.ABSTRACT
+module Dir: sig
+  include OpamStd.ABSTRACT
+
+  val of_list: string list -> t
+end
 
 (** Return the current working directory *)
 val cwd: unit -> Dir.t
@@ -426,4 +430,17 @@ module Unix : sig
   val of_filename : filename -> t
 
   val to_filename : t -> filename
+
+  (** Check whether a filename starts by a given Dir.t *)
+  val starts_with: Dir.t -> t -> bool
+
+  (** Return the base name *)
+  val basename: t -> Base.t
+
+  (** Return the directory name *)
+  val dirname: t -> Dir.t
+
+  (** Deconstruct a filename into a list of path elements *)
+  val to_list: t -> string list
+
 end

src/repository/opamRepositoryPath.ml

@@ -53,6 +53,35 @@ let url repo_root prefix nv =
 let files repo_root prefix nv =
   packages repo_root prefix nv / "files"
 
+let extrafile_nv_dir filename =
+  let rec find_files prefix_files tail =
+    match tail with
+    | "files"::_ -> Some prefix_files
+    | h::t -> find_files (h::prefix_files) t
+    | [] -> None
+  in
+  let rec aux (pre, rest) =
+    match rest with
+    | "packages"::packages ->
+      (* We don't check packages/name/name.version layer because repo loading
+         is more permissive *)
+      (match find_files [] packages with
+       | Some (nv::prefix_files) ->
+         (match OpamPackage.of_string_opt nv with
+          | Some pkg ->
+            let dir =
+              List.rev (nv :: prefix_files @ ["packages"])
+              |> OpamFilename.Dir.of_list
+              |> OpamFilename.Unix.Dir.of_dir
+            in
+            Some (pkg, dir)
+          | None -> None)
+       | None | Some [] -> None)
+    | p::r -> aux (p::pre, r)
+    | [] -> None
+  in
+  aux ([], OpamFilename.Unix.to_list filename)
+
 module Remote = struct
   (** URL, not FS paths *)
   open OpamUrl.Op

src/repository/opamRepositoryPath.mli

@@ -51,6 +51,11 @@ val url: dirname -> string option -> package -> OpamFile.URL_legacy.t OpamFile.t
 (** files {i $repo/packages/XXX/$NAME.$VERSION/files} *)
 val files: dirname -> string option -> package -> dirname
 
+(** Returns package and main directory if the path is an extrafile one from
+    a repository root: {i packages/[/...]/$NAME.$VERSION/files/...}
+*)
+val extrafile_nv_dir: unix_filename -> (package * unix_dirname) option
+
 (** Url constructor for parts of remote repositories, when applicable (http and
     rsync). Function take the repo's root url. *)
 module Remote: sig

src/state/opamRepositoryState.ml

@@ -141,76 +141,108 @@ let load_opams_from_dir repo_name repo_root =
 let load_opams_from_diff repo diffs rt =
   if OpamConsole.disp_status_line () || OpamConsole.verbose () then
     OpamConsole.status_line "Processing: [%s: loading data]"
-      (OpamConsole.colorise `blue (OpamRepositoryName.to_string repo.repo_name));
-  let existing_opams =
-    OpamRepositoryName.Map.find repo.repo_name rt.repo_opams
-  in
+      (OpamConsole.colorise `blue
+         (OpamRepositoryName.to_string repo.repo_name));
   let repo_root = get_repo_root rt repo in
-  (*  processed_dirs: used to avoid re-read in case of diff generated by extra files.
-      added_pkgs: used to skip removing version-equivalent packages *)
-  let process_file (opams, processed_dirs, added_pkgs) file ~is_removal =
-    let pkg_dir =
-      let file = OpamFilename.raw file in
-      let dirname = OpamFilename.dirname file in
-      let basename = OpamFilename.basename_dir dirname in
-      let full_path =
-        Filename.concat
-          (OpamFilename.Dir.to_string repo_root)
-          (OpamFilename.Dir.to_string dirname)
+  let open OpamFilename.Op in
+  let additions, removals, xfiles =
+    let add, remove =
+      let packages_dir =
+        "packages"
+        |> OpamFilename.Unix.Dir.of_string
       in
-      if OpamFilename.Base.to_string basename = "files" then
-        OpamFilename.Dir.of_string (Filename.dirname full_path)
-      else
-        OpamFilename.Dir.of_string full_path
+      let is_opam_file filename =
+        if OpamFilename.Unix.starts_with packages_dir filename then
+          if OpamFilename.Unix.Base.equal (OpamFilename.Unix.basename filename)
+              (OpamFilename.Unix.Base.of_string "opam") then
+            match OpamPackage.of_filename (OpamFilename.Unix.to_filename filename) with
+            | Some nv -> Some nv
+            | None ->
+              log "ERR: directory name not a valid package: ignored %s"
+                (OpamFilename.to_string
+                   (repo_root // (OpamFilename.Unix.to_string filename)));
+              None
+          else None
+        else None
+      in
+      let xfile_info = OpamRepositoryPath.extrafile_nv_dir in
+      let aux file ~rm (adds, rms, xfs) =
+        let file = OpamFilename.Unix.of_string file in
+        match is_opam_file file with
+        | Some nv ->
+          if rm then
+            adds, OpamPackage.Set.add nv rms, xfs
+          else
+            OpamPackage.Map.add nv file adds, rms, xfs
+        | None ->
+          match xfile_info file with
+          | Some (nv, dir) ->
+            (* TAR TODO : opam repo path install nv dir should return tarfile *)
+            adds, rms, OpamPackage.Map.add nv dir xfs
+          | None -> adds, rms, xfs
+      in
+      aux ~rm:false, aux ~rm:true
     in
-    if OpamFilename.Dir.Set.mem pkg_dir processed_dirs then
-      opams, processed_dirs, added_pkgs
-    else
-      let processed_dirs = OpamFilename.Dir.Set.add pkg_dir processed_dirs in
-      match read_package_opam ~repo_name:repo.repo_name ~repo_root pkg_dir with
-      | Some (nv, opam) ->
-        let added_pkgs = OpamPackage.Set.add nv added_pkgs in
-        OpamPackage.Map.add nv opam opams, processed_dirs, added_pkgs
-      | None ->
-        if is_removal then
-          match OpamPackage.of_dirname pkg_dir with
-          | None ->
-            log "ERR: directory name not a valid package: ignored %s"
-              (OpamFilename.Dir.to_string pkg_dir);
-            opams, processed_dirs, added_pkgs
-          | Some nv ->
-            if OpamPackage.Set.mem nv added_pkgs then
-              opams, processed_dirs, added_pkgs
-            else
-              OpamPackage.Map.remove nv opams, processed_dirs, added_pkgs
+    let operations acc  = function
+      | Patch.Edit (old_file, new_file) ->
+        if String.equal old_file new_file then
+          add new_file acc
         else
-          opams, processed_dirs, added_pkgs
+          add new_file acc |> remove old_file
+      | Patch.Delete file -> remove file acc
+      | Patch.Create file -> add file acc
+      | Patch.Git_ext (file1, file2, git_ext) ->
+        match git_ext with
+        | Patch.Rename_only (_, _) ->
+          add file2 acc |> remove file1
+        | Patch.Delete_only -> remove file1 acc
+        | Patch.Create_only -> add file2 acc
+    in
+    List.fold_left operations OpamPackage.(Map.empty, Set.empty, Map.empty) diffs
   in
-  let remove_file file acc = process_file acc file ~is_removal:true in
-  let add_file file acc = process_file acc file ~is_removal:false in
-  let process_operation acc = function
-    | Patch.Edit (old_file, new_file) ->
-      if String.equal old_file new_file
-      then
-        add_file new_file acc
-      else
-        remove_file old_file acc |> add_file new_file
-    | Patch.Delete file -> remove_file file acc
-    | Patch.Create file -> add_file file acc
-    | Patch.Git_ext (file1, file2, git_ext) ->
-      match git_ext with
-      | Patch.Rename_only (_, _) -> remove_file file1 acc |> add_file file2
-      | Patch.Delete_only -> remove_file file1 acc
-      | Patch.Create_only -> add_file file2 acc
+  let xfiles =
+    OpamPackage.Map.fold (fun nv dir lst ->
+        if OpamPackage.Map.mem nv additions
+        || OpamPackage.Set.mem nv removals then lst
+        else dir::lst)
+      xfiles []
   in
-  Fun.protect
-    (fun () ->
-       let opams, _, _ =
-         List.fold_left process_operation
-           (existing_opams, OpamFilename.Dir.Set.empty, OpamPackage.Set.empty)
-           diffs
-       in
-       opams)
+  let read_and_add =
+    let read_package_opam dir =
+      let dir = OpamFilename.Unix.Dir.to_dir dir in
+      let dir = repo_root / OpamFilename.Dir.to_string dir in
+      read_package_opam ~repo_name:repo.repo_name ~repo_root dir
+    in
+    fun dir opams ->
+      match read_package_opam dir with
+      | Some (nv, opam) -> OpamPackage.Map.add nv opam opams
+      | None ->
+        log "ERR: Could not load %s, ignored"
+          (OpamFilename.Unix.to_string OpamFilename.Unix.Op.(dir//"opam"));
+        opams
+  in
+  let process_operations opams =
+    (* remove obsolete packages *)
+    let opams =
+      OpamPackage.Set.fold OpamPackage.Map.remove removals opams
+    in
+    (* add new packages *)
+    let opams =
+      OpamPackage.Map.fold (fun _nv file ->
+          read_and_add (OpamFilename.Unix.dirname file))
+        additions opams
+    in
+    (* update extra files *)
+    let opams =
+      List.fold_left (fun opams dir -> read_and_add dir opams)
+        opams xfiles
+    in
+    opams
+  in
+  let existing_opams =
+    OpamRepositoryName.Map.find repo.repo_name rt.repo_opams
+  in
+  Fun.protect (fun () -> process_operations existing_opams)
     ~finally:OpamConsole.clear_status
 
 let load_repo repo repo_root =

tests/reftests/dune.inc

@@ -1868,6 +1868,27 @@
    %{targets}
    (run ./run.exe %{exe:../../src/client/opamMain.exe.exe} %{dep:remove.test} %{read-lines:testing-env}))))
 
+(rule
+ (alias reftest-repository-formats)
+ (enabled_if (and  (or (<> %{env:TESTALL=1} 0) (= %{env:TESTN0REP0=0} 1))))
+ (action
+  (diff repository-formats.test repository-formats.out)))
+
+(alias
+ (name reftest)
+ (enabled_if (and  (or (<> %{env:TESTALL=1} 0) (= %{env:TESTN0REP0=0} 1))))
+ (deps (alias reftest-repository-formats)))
+
+(rule
+ (targets repository-formats.out)
+ (deps root-N0REP0)
+ (enabled_if (and  (or (<> %{env:TESTALL=1} 0) (= %{env:TESTN0REP0=0} 1))))
+ (package opam)
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./run.exe %{exe:../../src/client/opamMain.exe.exe} %{dep:repository-formats.test} %{read-lines:testing-env}))))
+
 (rule
  (alias reftest-repository-patchdiff)
  (enabled_if (and  (or (<> %{env:TESTALL=1} 0) (= %{env:TESTN0REP0=0} 1))))

tests/reftests/extrafile.test

@@ -695,7 +695,6 @@ cp p.patch $pkgpath/files/dir/
 
 <><> Updating package repositories ><><><><><><><><><><><><><><><><><><><><><><>
 [default] synchronised from file://${BASEDIR}/REPO
-opam-file                       Mismatching extra-files at ${BASEDIR}/OPAM/repo/default/packages/good-md5-good-sha256/good-md5-good-sha256.1: missing from 'files' directory (1)
 Now run 'opam upgrade' to apply any package updates.
 ### opam install good-nested-md5.1
 The following actions will be performed: