Avoid using absolute paths when staging location log, as that can confuse git when a remote's path contains a symlink. Closes: #621386

This was a real PITA to fix, since location logs can be staged in
both the current repo, as well as in local remote's repos, in
which case the cwd will not be in the repo. And git add needs different
params in both cases, when absolute paths are not used.

In passing, git annex fsck now stages location log fixes.

1 files changed, 23 insertions, 12 deletions

diff --git a/GitRepo.hs b/GitRepo.hs
index 3e177cf1b..2bf320eda 100644
--- a/GitRepo.hs
+++ b/GitRepo.hs
@@ -21,8 +21,8 @@ module GitRepo (
 	repoDescribe,
 	repoLocation,
 	workTree,
+	workTreeFile,
 	gitDir,
-	relative,
 	urlPath,
 	urlHost,
 	urlPort,
@@ -59,7 +59,7 @@ module GitRepo (
 	prop_idempotent_deencode
 ) where
 
-import Control.Monad (unless, when)
+import Control.Monad (unless)
 import System.Directory
 import System.FilePath
 import System.Posix.Directory
@@ -236,27 +236,38 @@ workTree r@(Repo { location = Url _ }) = urlPath r
 workTree (Repo { location = Dir d }) = d
 workTree Repo { location = Unknown } = undefined
 
-{- Given a relative or absolute filename in a repository, calculates the
- - name to use to refer to the file relative to a git repository's top.
- - This is the same form displayed and used by git. -}
-relative :: Repo -> FilePath -> IO FilePath
-relative repo@(Repo { location = Dir d }) file = do
+{- Given a relative or absolute filename inside a git repository's
+ - workTree, calculates the name to use to refer to that file to git.
+ -
+ - This is complicated because the best choice can vary depending on
+ - whether the cwd is in a subdirectory of the git repository, or not.
+ -
+ - For example, when adding a file "/tmp/repo/foo", it's best to refer
+ - to it as "foo" if the cwd is outside the repository entirely
+ - (this avoids a gotcha with using the full path name when /tmp/repo
+ - is itself a symlink). But, if the cwd is "/tmp/repo/subdir",
+ - it's best to refer to "../foo".
+ -}
+workTreeFile :: Repo -> FilePath -> IO FilePath
+workTreeFile repo@(Repo { location = Dir d }) file = do
 	cwd <- getCurrentDirectory
 	let file' = absfile cwd
-	let len = length absrepo
-	when (take len file' /= absrepo) $
+	unless (inrepo file') $
 		error $ file ++ " is not located inside git repository " ++ absrepo
-	return $ drop (length absrepo) file'
+	if (inrepo $ addTrailingPathSeparator cwd)
+		then return $ relPathDirToFile cwd file'
+		else return $ drop (length absrepo) file'
 	where
 		-- normalize both repo and file, so that repo
 		-- will be substring of file
 		absrepo = case (absNormPath "/" d) of
-			Just f -> f ++ "/"
+			Just f -> addTrailingPathSeparator f
 			Nothing -> error $ "bad repo" ++ repoDescribe repo
 		absfile c = case (secureAbsNormPath c file) of
 			Just f -> f
 			Nothing -> file
-relative repo _ = assertLocal repo $ error "internal"
+		inrepo f = absrepo `isPrefixOf` f
+workTreeFile repo _ = assertLocal repo $ error "internal"
 
 {- Path of an URL repo. -}
 urlPath :: Repo -> String