Fix bug in automatic merge conflict resolution

When one side is an annexed symlink, and the other side is a non-annexed symlink.

In this case, git-merge does not replace the annexed symlink in the work
tree with the non-annexed symlink, which is different from it's handling of
conflicts between annexed symlinks and regular files or directories.
So, while git-annex generated the correct merge commit, the work tree
didn't get updated to reflect it.
See comments on bug for additional analysis.

Did not add this to the test suite yet; just unloaded a truckload of firewood
and am feeling lazy.

This commit was sponsored by Adam Spiers.

3 files changed, 50 insertions, 18 deletions

diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs
index b5c4b911d..1c463003e 100644
--- a/Annex/AutoMerge.hs
+++ b/Annex/AutoMerge.hs
@@ -110,11 +110,11 @@ resolveMerge' (Just us) them u = do
 				makelink keyUs
 		-- Our side is annexed file, other side is not.
 		(Just keyUs, Nothing) -> resolveby $ do
-			graftin them file
+			graftin them file LsFiles.valThem LsFiles.valThem
 			makelink keyUs
 		-- Our side is not annexed file, other side is.
 		(Nothing, Just keyThem) -> resolveby $ do
-			graftin us file
+			graftin us file LsFiles.valUs LsFiles.valUs
 			makelink keyThem
 		-- Neither side is annexed file; cannot resolve.
 		(Nothing, Nothing) -> return Nothing
@@ -131,17 +131,41 @@ resolveMerge' (Just us) them u = do
 	makelink key = do
 		let dest = variantFile file key
 		l <- inRepo $ gitAnnexLink dest key
-		ifM isDirect
-			( do
-				d <- fromRepo gitAnnexMergeDir
-				replaceFile (d </> dest) $ makeAnnexLink l
-			, replaceFile dest $ makeAnnexLink l
-			)
+		replacewithlink dest l
 		stageSymlink dest =<< hashSymlink l
 
-	{- stage a graft of a directory or file from a branch -}
-	graftin b item = Annex.Queue.addUpdateIndex
-		=<< fromRepo (UpdateIndex.lsSubTree b item)
+	replacewithlink file link = ifM isDirect
+		( do
+			d <- fromRepo gitAnnexMergeDir
+			replaceFile (d </> file) $ makeGitLink link
+		, replaceFile file $ makeGitLink link
+		)
+
+	{- Stage a graft of a directory or file from a branch.
+	 -
+	 - When there is a conflicted merge where one side is a directory
+	 - or file, and the other side is a symlink, git merge always
+	 - updates the work tree to contain the non-symlink. So, the
+	 - directory or file will already be in the work tree correctly,
+	 - and they just need to be staged into place. Do so by copying the
+	 - index. (Note that this is also better than calling git-add
+	 - because on a crippled filesystem, it preserves any symlink
+	 - bits.)
+	 -
+	 - It's also possible for the branch to have a symlink in it,
+	 - which is not a git-annex symlink. In this special case,
+	 - git merge does not update the work tree to contain the symlink
+	 - from the branch, so we have to do so manually.
+	 -}
+	graftin b item select select' = do
+		Annex.Queue.addUpdateIndex
+			=<< fromRepo (UpdateIndex.lsSubTree b item)
+		when (select (LsFiles.unmergedBlobType u) == Just SymlinkBlob) $
+			case select' (LsFiles.unmergedSha u) of
+				Nothing -> noop
+				Just sha -> do
+					link <- catLink True sha
+					replacewithlink item link
 		
 	resolveby a = do
 		{- Remove conflicted file from index so merge can be resolved. -}
diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs
index 6a778db03..2f8c43079 100644
--- a/Annex/CatFile.hs
+++ b/Annex/CatFile.hs
@@ -15,6 +15,7 @@ module Annex.CatFile (
 	catKey,
 	catKeyFile,
 	catKeyFileHEAD,
+	catLink,
 ) where
 
 import qualified Data.ByteString.Lazy as L
@@ -77,21 +78,25 @@ catFileHandle = do
 catKey :: Ref -> FileMode -> Annex (Maybe Key)
 catKey = catKey' True
 
-catKey' :: Bool -> Ref -> FileMode -> Annex (Maybe Key)
-catKey' modeguaranteed ref mode
+catKey' :: Bool -> Sha -> FileMode -> Annex (Maybe Key)
+catKey' modeguaranteed sha mode
 	| isSymLink mode = do
-		l <- fromInternalGitPath . decodeBS <$> get
+		l <- catLink modeguaranteed sha
 		return $ if isLinkToAnnex l
 			then fileKey $ takeFileName l
 			else Nothing
 	| otherwise = return Nothing
+
+{- Gets a symlink target. -}
+catLink :: Bool -> Sha -> Annex String
+catLink modeguaranteed sha = fromInternalGitPath . decodeBS <$> get
   where
   	-- If the mode is not guaranteed to be correct, avoid
 	-- buffering the whole file content, which might be large.
 	-- 8192 is enough if it really is a symlink.
   	get
-		| modeguaranteed = catObject ref
-		| otherwise = L.take 8192 <$> catObject ref
+		| modeguaranteed = catObject sha
+		| otherwise = L.take 8192 <$> catObject sha
 
 {- Looks up the key corresponding to the Ref using the running cat-file.
  -
diff --git a/Annex/Link.hs b/Annex/Link.hs
index 26991e911..25166bff5 100644
--- a/Annex/Link.hs
+++ b/Annex/Link.hs
@@ -68,6 +68,9 @@ getAnnexLinkTarget file = ifM (coreSymlinks <$> Annex.getGitConfig)
 					then ""
 					else s
 
+makeAnnexLink :: LinkTarget -> FilePath -> Annex ()
+makeAnnexLink = makeGitLink
+
 {- Creates a link on disk.
  -
  - On a filesystem that does not support symlinks, writes the link target
@@ -75,8 +78,8 @@ getAnnexLinkTarget file = ifM (coreSymlinks <$> Annex.getGitConfig)
  - it's staged as such, so use addAnnexLink when adding a new file or
  - modified link to git.
  -}
-makeAnnexLink :: LinkTarget -> FilePath -> Annex ()
-makeAnnexLink linktarget file = ifM (coreSymlinks <$> Annex.getGitConfig)
+makeGitLink :: LinkTarget -> FilePath -> Annex ()
+makeGitLink linktarget file = ifM (coreSymlinks <$> Annex.getGitConfig)
 	( liftIO $ do
 		void $ tryIO $ removeFile file
 		createSymbolicLink linktarget file