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.

5 files changed, 43 insertions, 27 deletions

diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index bedb9fb99..20ef2c808 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -64,11 +64,11 @@ verifyLocationLog key file = do
 
 	case (present, u `elem` uuids) of
 		(True, False) -> do
-				fix g u ValuePresent
+				fix u ValuePresent
 				-- There is no data loss, so do not fail.
 				return True
 		(False, True) -> do
-				fix g u ValueMissing
+				fix u ValueMissing
 				warning $
 					"** Based on the location log, " ++ file
 					++ "\n** was expected to be present, " ++
@@ -77,7 +77,6 @@ verifyLocationLog key file = do
 		_ -> return True
 	
 	where
-		fix g u s = do
+		fix u s = do
 			showNote "fixing location log"
-			_ <- liftIO $ logChange g key u s
-			return ()
+			logStatusFor u key s
diff --git a/Command/Move.hs b/Command/Move.hs
index e5e78d249..476bf866a 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -7,19 +7,15 @@
 
 module Command.Move where
 
-import Control.Monad.State (liftIO)
-
 import Command
 import qualified Command.Drop
 import qualified Annex
-import qualified AnnexQueue
 import LocationLog
 import Types
 import Content
 import qualified Remote
 import UUID
 import Messages
-import Utility
 
 command :: [Command]
 command = [repoCommand "move" paramPath seek
@@ -57,10 +53,8 @@ showAction False file = showStart "copy" file
  - for bare repos. -}
 remoteHasKey :: Remote.Remote Annex -> Key -> Bool -> Annex ()
 remoteHasKey remote key present	= do
-	g <- Annex.gitRepo
 	let remoteuuid = Remote.uuid remote
-	logfile <- liftIO $ logChange g key remoteuuid status
-	AnnexQueue.add "add" [Param "--"] logfile
+	logStatusFor remoteuuid key status
 	where
 		status = if present then ValuePresent else ValueMissing
 
diff --git a/Content.hs b/Content.hs
index 576eecb31..bf9456221 100644
--- a/Content.hs
+++ b/Content.hs
@@ -9,6 +9,7 @@ module Content (
 	inAnnex,
 	calcGitLink,
 	logStatus,
+	logStatusFor,
 	getViaTmp,
 	getViaTmpUnchecked,
 	checkDiskSpace,
@@ -61,7 +62,8 @@ calcGitLink file key = do
 	return $ relPathDirToFile (parentDir absfile) 
 			(Git.workTree g) </> ".git" </> annexLocation key
 
-{- Updates the LocationLog when a key's presence changes.
+{- Updates the LocationLog when a key's presence changes in the current
+ - repository.
  -
  - Note that the LocationLog is not updated in bare repositories.
  - Operations that change a bare repository should be done from
@@ -70,10 +72,18 @@ calcGitLink file key = do
 logStatus :: Key -> LogStatus -> Annex ()
 logStatus key status = do
 	g <- Annex.gitRepo
+	u <- getUUID g
+	logStatusFor u key status
+
+{- Updates the LocationLog when a key's presence changes in a repository
+ - identified by UUID. -}
+logStatusFor :: UUID -> Key -> LogStatus -> Annex ()
+logStatusFor u key status = do
+	g <- Annex.gitRepo
 	unless (Git.repoIsLocalBare g) $ do
-		u <- getUUID g
 		logfile <- liftIO $ logChange g key u status
-		AnnexQueue.add "add" [Param "--"] logfile
+		rellogfile <- liftIO $ Git.workTreeFile g logfile
+		AnnexQueue.add "add" [Param "--"] rellogfile
 
 {- Runs an action, passing it a temporary filename to download,
  - and if the action succeeds, moves the temp file into 
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
diff --git a/debian/changelog b/debian/changelog
index 872277d0f..c6dfb1ff3 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -4,6 +4,8 @@ git-annex (0.20110421) UNRELEASED; urgency=low
   * Remove testpack from build depends, as it is not available
     on all architectures. The test suite will not be run if it
     cannot be compiled.
+  * Avoid using absolute paths when staging location log, as that can
+    confuse git when a remote's path contains a symlink. Closes: #621386
 
  -- Joey Hess <joeyh@debian.org>  Thu, 21 Apr 2011 16:35:27 -0400