From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 26 Mar 2021 20:01:55 +0000 (-0400)
Subject: Fix bug importing from a special remote into a subdirectory more than one level deep
X-Git-Tag: archive/raspbian/10.20250416-2+rpi1~1^2~94
X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=03c7dd4373e8ad7e51cbf42e9b1f96ad5ded18f5;p=git-annex.git

Fix bug importing from a special remote into a subdirectory more than one level deep

Which generated unusual git trees that could confuse git merge,
since they incorrectly had 2 subtrees with the same name.

Root of the bug was a) not testing that at all! but also
b) confusing graftdirs, which contains eg "foo/bar" with
non-recursively read trees, which would contain eg "bar"
when reading a subtree of "foo".

It's worth noting that Annex.Import uses graftTree, but it really
shouldn't have needed to. Eg, when importing into foo/bar from a remote,
it's enough to generate a tree of foo/bar/x, foo/bar/y, and does not
include other files that are at the top of the master branch. It uses
graftTree, so it does include the other files, as well as the foo/bar
tree. git merge will do the same thing for both trees. With that said,
switching it away from graftTree would result in another import
generating a new commit that seems to delete files that were there in a
previous commit, so it probably has to keep using graftTree since it
used it before.
---

diff --git a/Git/Tree.hs b/Git/Tree.hs
index ba62499ba5..c9534cd9a3 100644
--- a/Git/Tree.hs
+++ b/Git/Tree.hs
@@ -300,43 +300,43 @@ graftTree'
 	-> Repo
 	-> MkTreeHandle
 	-> IO Sha
-graftTree' subtree graftloc basetree repo hdl = go basetree graftdirs
+graftTree' subtree graftloc basetree repo hdl = go basetree subdirs graftdirs
   where
-	go tsha (topmostgraphdir:restgraphdirs) = do
+	go tsha (subdir:restsubdirs) (topmostgraphdir:restgraphdirs) = do
 		Tree t <- getTree LsTree.LsTreeNonRecursive tsha repo
-		t' <- case partition isabovegraft t of
+		let abovegraftpoint i = gitPath i == gitPath subdir
+		t' <- case partition abovegraftpoint t of
+			-- the graft point is not already in the tree,
+			-- so graft it in, keeping the existing tree
+			-- content
 			([], _) -> do
 				graft <- graftin (topmostgraphdir:restgraphdirs)
 				return (graft:t)
-			-- normally there can only be one matching item
-			-- in the tree, but it's theoretically possible
-			-- for a git tree to have multiple items with the
-			-- same name, so process them all
 			(matching, rest) -> do
 				newshas <- forM matching $ \case
 					RecordedSubTree tloc tsha' _
 						| null restgraphdirs -> return $
 							RecordedSubTree tloc subtree []
 						| otherwise -> do
-							tsha'' <- go tsha' restgraphdirs
+							tsha'' <- go tsha' restsubdirs restgraphdirs
 							return $ RecordedSubTree tloc tsha'' []
 					_ -> graftin (topmostgraphdir:restgraphdirs)
 				return (newshas ++ rest)
 		mkTree hdl t'
-	go _ [] = return subtree
-
-	isabovegraft i = beneathSubTree i graftloc || gitPath i == gitPath graftloc
+	go _ _ [] = return subtree
 	
 	graftin t = recordSubTree hdl $ graftin' t
 	graftin' [] = RecordedSubTree graftloc subtree []
 	graftin' (d:rest) 
 		| d == graftloc = graftin' []
 		| otherwise = NewSubTree d [graftin' rest]
-	
+
+	subdirs = splitDirectories $ gitPath graftloc
+
 	-- For a graftloc of "foo/bar/baz", this generates
 	-- ["foo", "foo/bar", "foo/bar/baz"]
 	graftdirs = map (asTopFilePath . toInternalGitPath . encodeBS) $
-		mkpaths [] $ splitDirectories $ gitPath graftloc
+		mkpaths [] subdirs
 	mkpaths _ [] = []
 	mkpaths base (d:rest) = (joinPath base </> d) : mkpaths (base ++ [d]) rest