Fix patch/diff: add support for empty files, removing empty directories, large patches and move to a new directory

.github/workflows/ci.ml

@@ -517,8 +517,8 @@ let main oc : unit =
     ("OPAM12CACHE", "~/.cache/opam1.2/cache");
     (* These should be identical to the values in appveyor.yml *)
     ("OPAM_REPO", "https://github.com/ocaml/opam-repository.git");
-    ("OPAM_TEST_REPO_SHA", "0c42e982f4cf97fc698132fb2a16b49524a26ab3");
-    ("OPAM_REPO_SHA", "0c42e982f4cf97fc698132fb2a16b49524a26ab3");
+    ("OPAM_TEST_REPO_SHA", "35eb2f107a989a2d623b0bbe170696398fcb9b1e");
+    ("OPAM_REPO_SHA", "35eb2f107a989a2d623b0bbe170696398fcb9b1e");
     ("SOLVER", "");
     (* Cygwin configuration *)
     ("CYGWIN_MIRROR", "http://mirrors.kernel.org/sourceware/cygwin/");

.github/workflows/depexts.yml

@@ -19,7 +19,7 @@ defaults:
 env:
   OPAMVERSION: 2.4.0-alpha1
   OPAM_REPO: https://github.com/ocaml/opam-repository.git
-  OPAM_REPO_SHA: 335860ac6bdab55d9d7376c827d68c361a4a30f9
+  OPAM_REPO_SHA: 35eb2f107a989a2d623b0bbe170696398fcb9b1e
 
 jobs:
   opam-cache:

.github/workflows/main.yml

@@ -26,8 +26,8 @@ env:
   OPAMBSROOT: ~/.cache/.opam.cached
   OPAM12CACHE: ~/.cache/opam1.2/cache
   OPAM_REPO: https://github.com/ocaml/opam-repository.git
-  OPAM_TEST_REPO_SHA: 0c42e982f4cf97fc698132fb2a16b49524a26ab3
-  OPAM_REPO_SHA: 0c42e982f4cf97fc698132fb2a16b49524a26ab3
+  OPAM_TEST_REPO_SHA: 35eb2f107a989a2d623b0bbe170696398fcb9b1e
+  OPAM_REPO_SHA: 35eb2f107a989a2d623b0bbe170696398fcb9b1e
   SOLVER:
   CYGWIN_MIRROR: http://mirrors.kernel.org/sourceware/cygwin/
   CYGWIN_ROOT: D:\cygwin

master_changes.md

@@ -46,6 +46,9 @@ users)
 ## Var/Option
 
 ## Update / Upgrade
+  * Fix a crash when updating a repository that is deleting or adding empty files [#6490 @kit-ty-kate]
+  * Fix an extreme performance issue (takes several hours) when applying a large repository update [#6490 @kit-ty-kate]
+  * Fix a crash when updating a git repository that moved a file to a new directory [#6490 @kit-ty-kate]
 
 ## Tree
 
@@ -75,6 +78,8 @@ users)
 ## VCS
 
 ## Build
+  * Update the requirement for the `patch` library to `3.0.0~alpha2` [#6490 @kit-ty-kate]
+  * Upgrade the downloaded-if-missing `patch` to `3.0.0~alpha2` [#6490 @kit-ty-kate]
 
 ## Infrastructure
 
@@ -105,12 +110,15 @@ users)
 ## Internal: Windows
 
 ## Test
+  * patchDiff: add some tests showing the handling of empty files and new directories [#6490 @rjbou]
+  * patchDiff: test the diff parser when generated using `git diff` [#6490 @rjbou]
 
 ## Benchmarks
 
 ## Reftests
 ### Tests
   * Show the behaviour of `opam switch create` in presence of `avoid-version`/`deprecated` packages [#6494 @kit-ty-kate]
+  * Add some tests showing the behaviour of the internal patch implementation [#6490 @rjbou]
 
 ### Engine
 
@@ -138,3 +146,7 @@ users)
 
 ## opam-core
   * `OpamSystem`: remove `print_stats` function [#6485 @hannesm]
+  * `OpamSystem`: add the `rmdir_cleanup` function [#6490 @kit-ty-kate]
+  * `OpamSystem.dir_is_empty`: Speedup and change its type to handle unreachable directories better [#6490 @kit-ty-kate]
+  * `OpamSystem.internal_patch`: remove parent directories when all of their content has been moved somewhere else [#6490 @kit-ty-kate]
+  * `OpamSystem.internal_patch`: fix moving files to new directories when receiving a git diff [#6490 @kit-ty-kate]

opam-core.opam

@@ -30,7 +30,7 @@ depends: [
   "sha" {>= "1.13"}
   "jsonm"
   "swhid_core"
-  "patch" {>= "3.0.0~alpha1"}
+  "patch" {>= "3.0.0~alpha2"}
   "uutf"
   (("host-system-mingw" {os = "win32" & os-distribution != "cygwinports"} &
     "conf-mingw-w64-gcc-i686" {os = "win32" & os-distribution != "cygwinports"} &

src/client/opamAuxCommands.ml

@@ -64,14 +64,18 @@ let remove_files_from_destdir st pfx packages =
            (OpamConsole.colorise `bold (OpamFilename.to_string f));
        if not OpamStateConfig.(!r.dryrun) then OpamFilename.remove f)
     else if OpamFilename.exists_dir d then
-      if OpamFilename.dir_is_empty d then
-        (if OpamConsole.verbose () then
-           OpamConsole.msg "Removing %s\n"
-             (OpamConsole.colorise `bold (OpamFilename.Dir.to_string d));
-         if not OpamStateConfig.(!r.dryrun) then OpamFilename.rmdir d)
-      else
+      begin match OpamFilename.dir_is_empty d with
+      | Some true ->
+        if OpamConsole.verbose () then
+          OpamConsole.msg "Removing %s\n"
+            (OpamConsole.colorise `bold (OpamFilename.Dir.to_string d));
+        if not OpamStateConfig.(!r.dryrun) then
+          OpamFilename.rmdir d
+      | Some false ->
         OpamConsole.note "Not removing non-empty directory %s"
           (OpamConsole.colorise `bold (OpamFilename.Dir.to_string d))
+      | None -> ()
+      end
   | _ -> ()
 
 let name_from_project_dirname d =

src/client/opamClient.ml

@@ -1805,9 +1805,7 @@ let init
   log "INIT %a"
     (slog @@ OpamStd.Option.to_string OpamRepositoryBackend.to_string) repo;
   let original_root = OpamStateConfig.(!r.original_root_dir) in
-  let root_empty =
-    not (OpamFilename.exists_dir original_root)
-    || OpamFilename.dir_is_empty original_root in
+  let root_empty = OpamFilename.dir_is_empty original_root <> Some false in
   let root = OpamStateConfig.(!r.root_dir) in
   let root, remove_root =
     let ignore_non_fatal f x =

src/core/opamDirTrack.ml

@@ -257,7 +257,7 @@ let revert ?title ?(verbose=OpamConsole.verbose()) ?(force=false)
             (already, fname::modified, nonempty, cannot)
           else if cur_item_ct = Some Dir then
             let d = OpamFilename.Dir.of_string f in
-            if OpamFilename.dir_is_empty d then
+            if OpamFilename.dir_is_empty d = Some true then
               (rmdir d; acc)
             else
               let nonempty =

src/core/opamFilename.ml

@@ -72,13 +72,8 @@ let with_tmp_dir_job fjob =
 let rmdir dirname =
   OpamSystem.remove_dir (Dir.to_string dirname)
 
-let rec rmdir_cleanup dirname =
-  let sd = Dir.to_string dirname in
-  if OpamSystem.dir_is_empty sd then (
-    rmdir dirname;
-    let parent = Filename.dirname sd in
-    if parent <> sd then rmdir_cleanup parent
-  )
+let rmdir_cleanup dirname =
+  OpamSystem.rmdir_cleanup (Dir.to_string dirname)
 
 let cwd () =
   Dir.of_string (Unix.getcwd ())

src/core/opamFilename.mli

@@ -50,7 +50,9 @@ val mkdir: Dir.t -> unit
 (** List the sub-directory recursively *)
 val rec_dirs: Dir.t -> Dir.t list
 
-val dir_is_empty: Dir.t -> bool
+(** Returns whether a directory is empty.
+    Returns [None] if the directory could not be found. *)
+val dir_is_empty: Dir.t -> bool option
 
 (** List the sub-directory (do not recurse) *)
 val dirs: Dir.t -> Dir.t list

src/core/opamSystem.ml

@@ -389,8 +389,25 @@ let dirs dir =
   directories_with_links dir
 
 let dir_is_empty dir =
-  try in_dir dir (fun () -> Sys.readdir (Sys.getcwd ()) = [||])
-  with File_not_found _ -> false
+  try
+    let dir = Unix.opendir dir in
+    Fun.protect ~finally:(fun () -> Unix.closedir dir) @@ fun () ->
+    let rec loop () =
+      match Unix.readdir dir with
+      | "." | ".." -> loop ()
+      | _ -> false
+      | exception End_of_file -> true
+    in
+    Some (loop ())
+  with Unix.Unix_error(Unix.ENOENT, _, _) -> None
+
+let rec rmdir_cleanup dirname =
+  if dir_is_empty dirname = Some true then (
+    remove_dir dirname;
+    let parent = Filename.dirname dirname in
+    if parent <> (dirname : string) then
+      rmdir_cleanup parent
+  )
 
 let with_tmp_dir fn =
   let dir = mk_temp_dir () in
@@ -1619,29 +1636,31 @@ let internal_patch ~allow_unclean ~patch_filename ~dir diffs =
   in
   let apply diff = match diff.Patch.operation with
     | Patch.Edit (file1, file2) ->
+      let file1 = get_path file1 in
+      let file2 = get_path file2 in
+      let file1_exists = Sys.file_exists file1 in
       (* That seems to be the GNU patch behaviour *)
-      let file =
-        let file1 = get_path file1 in
-        if Sys.file_exists file1 then
-          file1
-        else
-          get_path file2
-      in
+      let file = if file1_exists then file1 else file2 in
       let content = read file in
       let content = patch ~file:file (Some content) diff in
       write file content;
-    | Patch.Delete file ->
+      if file1_exists && file1 <> (file2 : string) then
+        rmdir_cleanup (Filename.dirname file1)
+    | Patch.Delete file | Patch.Git_ext (file, _, Patch.Delete_only) ->
       let file = get_path file in
-      remove_file_t ~with_log:false file
-    | Patch.Create file ->
+      remove_file_t ~with_log:false file;
+      rmdir_cleanup (Filename.dirname file)
+    | Patch.Create file | Patch.Git_ext (_, file, Patch.Create_only) ->
       let file = get_path file in
       let content = patch ~file None diff in
       write file content
-    | Patch.Rename_only (src, dst) ->
+    | Patch.Git_ext (_, _, Patch.Rename_only (src, dst)) ->
       let src = get_path src in
       let dst = get_path dst in
-      (* we use rename as we have all guarantee *)
-      Unix.rename src dst
+      mv src dst;
+      let dirname_src = Filename.dirname src in
+      if dirname_src <> (Filename.dirname dst : string) then
+        rmdir_cleanup dirname_src
   in
   List.iter apply diffs
 

src/core/opamSystem.mli

@@ -141,6 +141,11 @@ val remove_file: string -> unit
     directory (not for symlinks or other files). *)
 val remove_dir: string -> unit
 
+(** Removes an empty directory, as well as any empty leading path components.
+    Must be called only on a directory that is known to not have empty parents,
+    only internal opam directory (and not tmp dir). *)
+val rmdir_cleanup : string -> unit
+
 (** Change the current working directory *)
 val chdir: string -> unit
 
@@ -174,7 +179,9 @@ val rec_dirs: string -> string list
 (** Return the list of directories in the current directory. *)
 val dirs: string -> string list
 
-val dir_is_empty: string -> bool
+(** Returns whether a directory is empty.
+    Returns [None] if the directory could not be found. *)
+val dir_is_empty: string -> bool option
 
 (** [directories_with_links dir] returns the directories in the directory [dir].
     Links pointing to directory are also returned. *)

src/repository/opamHTTP.ml

@@ -52,8 +52,7 @@ module B = struct
     @@ 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
+    if OpamFilename.dir_is_empty repo_root <> Some false then
       Done (OpamRepositoryBackend.Update_full quarantine)
     else
       OpamStd.Exn.finally finalise @@ fun () ->

src/repository/opamLocal.ml

@@ -87,7 +87,7 @@ let rsync ?(args=[]) ?(exclude_vcdirs=true) src dst =
   else (
     OpamSystem.mkdir dst;
     let convert_path = Lazy.force convert_path in
-    call_rsync (fun () -> not (OpamSystem.dir_is_empty dst))
+    call_rsync (fun () -> OpamSystem.dir_is_empty dst = Some false)
       ( rsync_arg :: args @ exclude_args @
         [ "--delete"; "--delete-excluded"; convert_path src; convert_path dst; ])
     @@| function
@@ -174,8 +174,7 @@ module B = struct
     | Up_to_date _ ->
       finalise (); Done OpamRepositoryBackend.Update_empty
     | Result _ ->
-      if not (OpamFilename.exists_dir repo_root) ||
-         OpamFilename.dir_is_empty repo_root then
+      if OpamFilename.dir_is_empty repo_root <> Some false then
         Done (OpamRepositoryBackend.Update_full quarantine)
       else
         OpamStd.Exn.finally finalise @@ fun () ->

src/repository/opamRepositoryBackend.ml

@@ -79,10 +79,10 @@ let get_files_for_diff parent_dir dir1 dir2 =
   match dir1, dir2 with
   | None, None -> assert false
   | Some dir, None ->
-    List.map (fun file -> Patch.Delete (dir^"/"^file))
+    List.map (fun file -> (Some (dir^"/"^file), None))
       (getfiles parent_dir dir)
   | None, Some dir ->
-    List.map (fun file -> Patch.Create (dir^"/"^file))
+    List.map (fun file -> (None, Some (dir^"/"^file)))
       (getfiles parent_dir dir)
   | Some dir1, Some dir2 ->
     let files1 = List.fast_sort String.compare (getfiles parent_dir dir1) in
@@ -91,18 +91,16 @@ let get_files_for_diff parent_dir dir1 dir2 =
       | (file1::files1 as orig1), (file2::files2 as orig2) ->
         let cmp = String.compare file1 file2 in
         if cmp = 0 then
-          aux (Patch.Edit
-                 (dir1^"/"^file1, dir2^"/"^file2)
-               :: acc)
+          aux ((Some (dir1^"/"^file1), Some (dir2^"/"^file2)) :: acc)
             files1 files2
         else if cmp < 0 then
-          aux (Patch.Delete (dir1^"/"^file1) :: acc) files1 orig2
+          aux ((Some (dir1^"/"^file1), None) :: acc) files1 orig2
         else
-          aux (Patch.Create (dir2^"/"^file2) :: acc) orig1 files2
+          aux ((None, Some (dir2^"/"^file2)) :: acc) orig1 files2
       | file1::files1, [] ->
-        aux (Patch.Delete (dir1^"/"^file1) :: acc) files1 []
+        aux ((Some (dir1^"/"^file1), None) :: acc) files1 []
       | [], file2::files2 ->
-        aux (Patch.Create (dir2^"/"^file2) :: acc) [] files2
+        aux ((None, Some (dir2^"/"^file2)) :: acc) [] files2
       | [], [] ->
         acc
     in
@@ -115,8 +113,10 @@ let get_diff parent_dir dir1 dir2 =
     (slog OpamFilename.Base.to_string) dir1
     (slog OpamFilename.Base.to_string) dir2;
   let readfile parent_dir file =
-    let file = Filename.concat (OpamFilename.Dir.to_string parent_dir) file in
-    OpamSystem.read file
+    let real_file =
+      Filename.concat (OpamFilename.Dir.to_string parent_dir) file
+    in
+    (file, OpamSystem.read real_file)
   in
   let lstat_opt parent_dir = function
     | None -> None
@@ -127,15 +127,9 @@ let get_diff parent_dir dir1 dir2 =
   let rec aux diffs dir1 dir2 =
     let files = get_files_for_diff parent_dir dir1 dir2 in
     let diffs =
-      List.fold_left (fun diffs operation ->
-          let file1, file2 = match operation with
-            | Patch.Delete filename -> (Some filename, None)
-            | Patch.Create filename -> (None, Some filename)
-            | Patch.Edit (file1, file2)
-            | Patch.Rename_only (file1, file2) -> (Some file1, Some file2)
-          in
+      List.fold_left (fun diffs (file1, file2) ->
           let add_to_diffs content1 content2 diffs =
-            match Patch.diff operation content1 content2 with
+            match Patch.diff content1 content2 with
             | None -> diffs
             | Some diff -> diff :: diffs
           in

src/state/opamRepositoryState.ml

@@ -130,7 +130,7 @@ let clean_repo_tmp tmp_dir =
     (let dir = Lazy.force tmp_dir in
      OpamFilename.rmdir dir;
      let parent = OpamFilename.dirname_dir dir in
-     if OpamFilename.dir_is_empty parent then
+     if OpamFilename.dir_is_empty parent = Some true then
        OpamFilename.rmdir parent)
 
 let remove_from_repos_tmp rt name =

src_ext/Makefile.sources

@@ -60,5 +60,5 @@ MD5_swhid_core = 77d88d4b1d96261c866f140c64d89af8
 URL_menhir = https://gitlab.inria.fr/fpottier/menhir/-/archive/20240715/archive.tar.gz
 MD5_menhir = d39a8943fe1be28199e5ec1f4133504c
 
-URL_patch = https://github.com/hannesm/patch/releases/download/v3.0.0-alpha1/patch-3.0.0-alpha1.tar.gz
-MD5_patch = 03aa87f8500c9caf4a73b2299c19b514
+URL_patch = https://github.com/hannesm/patch/releases/download/v3.0.0-alpha2/patch-3.0.0-alpha2.tar.gz
+MD5_patch = 7f11023c7231b916cfe3dd28ff6ce948

tests/lib/dune

@@ -12,4 +12,4 @@
 (test
   (name patchDiff)
   (modules patchDiff)
-  (libraries opam-repository))
+  (libraries str opam-repository))