Homogenize the behaviour of initial repository loads and subsequent loads from diff

src/core/opamFilename.ml

@@ -813,4 +813,19 @@ 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_relative_canonical_list x =
+    if Filename.is_relative x then
+      match String.split_on_char '/' x with
+      | [] | ""::_::_ -> assert false
+      | [""] -> [current_dir_name]
+      | x ->
+        List.filter (fun seg ->
+            if seg = ".." then
+              invalid_arg "'..' is forbidden"
+            else
+              seg <> "" && not (String.equal current_dir_name seg))
+          x
+    else
+      invalid_arg "not relative"
 end

src/core/opamFilename.mli

@@ -426,4 +426,6 @@ module Unix : sig
   val of_filename : filename -> t
 
   val to_filename : t -> filename
+
+  val to_relative_canonical_list : t -> string list
 end

src/repository/opamRepositoryPath.ml

@@ -53,6 +53,29 @@ let url repo_root prefix nv =
 let files repo_root prefix nv =
   packages repo_root prefix nv / "files"
 
+let get_pkg_dir file =
+  let rec find_pkg_rev prefix_files = function
+    | x::xs ->
+      begin match OpamPackage.of_string_opt x with
+      | Some nv -> Some (nv, x::prefix_files)
+      | None -> find_pkg_rev (x::prefix_files) xs
+      end
+    | [] -> None
+  in
+  match OpamFilename.Unix.to_relative_canonical_list file with
+  | "packages"::xs ->
+    begin match find_pkg_rev [] xs with
+    | Some (nv, full_rev_prefix) ->
+      let dir =
+        List.rev full_rev_prefix
+        |> List.fold_left OpamFilename.Unix.Op.(/)
+          (OpamFilename.Unix.Dir.of_string "packages")
+      in
+      Some (nv, dir)
+    | None -> None
+    end
+  | _ -> None
+
 module Remote = struct
   (** URL, not FS paths *)
   open OpamUrl.Op

src/repository/opamRepositoryPath.mli

@@ -51,6 +51,17 @@ 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
 
+(** [get_pkg_dir f] returns the pair of package and directory [(p, d)],
+    where [d] is a prefix of [f], that matches a repository package folder.
+    [p] is the pair [nv] associated with that folder.
+    It returns [None] if no folder was detected.
+
+    Note: [f] must always be a relative filename starting at a repository root.
+
+    For example, [get_pkg_dir packages/a/a.1/files/extrafile] will return
+    [(a.1, packages/a/a.1)]. *)
+val get_pkg_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

@@ -101,17 +101,7 @@ let get_repo_files rt name dir =
 
 let read_package_opam ~repo_name ~repo_root package_dir =
   match OpamFileTools.read_repo_opam ~repo_name ~repo_root package_dir with
-  | Some opam ->
-    (try
-       let nv =
-         OpamPackage.of_string
-           (OpamFilename.Base.to_string (OpamFilename.basename_dir package_dir))
-       in
-       Some (nv, opam)
-     with Failure _ ->
-       log "ERR: directory name not a valid package: ignored %s"
-         (OpamFilename.to_string OpamFilename.Op.(package_dir // "opam"));
-       None)
+  | Some opam -> Some opam
   | None ->
     log "ERR: Could not load %s, ignored"
       (OpamFilename.to_string OpamFilename.Op.(package_dir // "opam"));
@@ -123,71 +113,72 @@ let load_opams_from_dir repo_name repo_root =
       (OpamConsole.colorise `blue (OpamRepositoryName.to_string repo_name));
   (* FIXME: why is this different from OpamPackage.list ? *)
   let rec aux r dir =
-    if OpamFilename.exists_dir dir then
-      let fnames = Sys.readdir (OpamFilename.Dir.to_string dir) in
-      if Array.exists (fun f -> f = "opam") fnames then
-        match read_package_opam ~repo_name ~repo_root dir with
-        | Some (nv, opam) -> OpamPackage.Map.add nv opam r
+    let full_path =
+      OpamFilename.Op.(repo_root / OpamFilename.Unix.Dir.to_string dir)
+    in
+    if OpamFilename.exists_dir full_path then
+      match OpamRepositoryPath.get_pkg_dir OpamFilename.Unix.Op.(dir // "") with
+      | Some (nv, _pkg_dir) ->
+        (* NOTE: we ignore [pkg_dir] because load_opams_from_dir
+           will always scan parent directories before going deeper *)
+        begin match read_package_opam ~repo_name ~repo_root full_path with
+        | Some opam -> OpamPackage.Map.add nv opam r
         | None -> r
-      else
-        Array.fold_left (fun r name -> aux r OpamFilename.Op.(dir / name))
-          r fnames
+        end
+      | None ->
+        Array.fold_left (fun r name -> aux r OpamFilename.Unix.Op.(dir / name))
+          r (Sys.readdir (OpamFilename.Dir.to_string full_path))
     else r
   in
   Fun.protect
-    (fun () -> aux OpamPackage.Map.empty (OpamRepositoryPath.packages_dir repo_root))
+    (fun () ->
+       aux OpamPackage.Map.empty (OpamFilename.Unix.Dir.of_string "packages"))
     ~finally:OpamConsole.clear_status
 
 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));
+      (OpamConsole.colorise `blue
+         (OpamRepositoryName.to_string repo.repo_name));
   let existing_opams =
     OpamRepositoryName.Map.find repo.repo_name rt.repo_opams
   in
   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)
-      in
-      if OpamFilename.Base.to_string basename = "files" then
-        OpamFilename.Dir.of_string (Filename.dirname full_path)
-      else
-        OpamFilename.Dir.of_string full_path
-    in
-    if OpamFilename.Dir.Set.mem pkg_dir processed_dirs then
+    match OpamRepositoryPath.get_pkg_dir file with
+    | None ->
+      log "ERR: file name not a valid package: ignored %s"
+        (OpamFilename.Unix.to_string file);
       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 ->
+    | Some (nv, pkg_dir) ->
+      if OpamFilename.Unix.Dir.Set.mem pkg_dir processed_dirs then
+        opams, processed_dirs, added_pkgs
+      else
+        let processed_dirs = OpamFilename.Unix.Dir.Set.add pkg_dir processed_dirs in
+        let full_path =
+          OpamFilename.Op.(repo_root / OpamFilename.Unix.Dir.to_string pkg_dir)
+        in
+        match read_package_opam ~repo_name:repo.repo_name ~repo_root full_path with
+        | Some 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
             if OpamPackage.Set.mem nv added_pkgs then
               opams, processed_dirs, added_pkgs
             else
               OpamPackage.Map.remove nv opams, processed_dirs, added_pkgs
-        else
-          opams, processed_dirs, added_pkgs
+          else
+            opams, processed_dirs, added_pkgs
+  in
+  let remove_file file acc =
+    process_file acc (OpamFilename.Unix.of_string file) ~is_removal:true
+  in
+  let add_file file acc =
+    process_file acc (OpamFilename.Unix.of_string file) ~is_removal:false
   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
@@ -207,7 +198,9 @@ let load_opams_from_diff repo diffs rt =
     (fun () ->
        let opams, _, _ =
          List.fold_left process_operation
-           (existing_opams, OpamFilename.Dir.Set.empty, OpamPackage.Set.empty)
+           (existing_opams,
+            OpamFilename.Unix.Dir.Set.empty,
+            OpamPackage.Set.empty)
            diffs
        in
        opams)

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))))