Fix direct mode mapping code to always store direct mode filenames relative to the top of the repository, even when operating inside a subdirectory.

3 files changed, 26 insertions, 11 deletions

diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs
index 778a86f0a..822ae0608 100644
--- a/Annex/Content/Direct.hs
+++ b/Annex/Content/Direct.hs
@@ -29,7 +29,7 @@ import Logs.Location
 
 import System.Posix.Types
 
-{- Files in the tree that are associated with a key. -}
+{- Absolute FilePaths of Files in the tree that are associated with a key. -}
 associatedFiles :: Key -> Annex [FilePath]
 associatedFiles key = do
 	files <- associatedFilesRelative key
@@ -44,7 +44,7 @@ associatedFilesRelative key = do
 	liftIO $ catchDefaultIO [] $ lines <$> readFile mapping
 
 {- Changes the associated files information for a key, applying a
- - transformation to the list. Returns a copy of the new info. -}
+ - transformation to the list. Returns new associatedFiles value. -}
 changeAssociatedFiles :: Key -> ([FilePath] -> [FilePath]) -> Annex [FilePath]
 changeAssociatedFiles key transform = do
 	mapping <- inRepo $ gitAnnexMapping key
@@ -52,22 +52,33 @@ changeAssociatedFiles key transform = do
 	let files' = transform files
 	when (files /= files') $
 		liftIO $ viaTmp writeFile mapping $ unlines files'
-	return files'
+	top <- fromRepo Git.repoPath
+	return $ map (top </>) files'
 
+{- Removes an associated file. Returns new associatedFiles value. -}
 removeAssociatedFile :: Key -> FilePath -> Annex [FilePath]
 removeAssociatedFile key file = do
-	fs <- changeAssociatedFiles key $ filter (/= normalise file)
+	file' <- normaliseAssociatedFile file
+	fs <- changeAssociatedFiles key $ filter (/= file')
 	when (null fs) $
 		logStatus key InfoMissing
 	return fs
 
+{- Adds an associated file. Returns new associatedFiles value. -}
 addAssociatedFile :: Key -> FilePath -> Annex [FilePath]
-addAssociatedFile key file = changeAssociatedFiles key $ \files ->
-	if file' `elem` files
-		then files
-		else file':files
-  where
-	file' = normalise file
+addAssociatedFile key file = do
+	file' <- normaliseAssociatedFile file
+	changeAssociatedFiles key $ \files -> do
+		if file' `elem` files
+			then files
+			else file':files
+
+{- Associated files are always stored relative to the top of the repository.
+ - The input FilePath is relative to the CWD. -}
+normaliseAssociatedFile :: FilePath -> Annex FilePath
+normaliseAssociatedFile file = do
+	top <- fromRepo Git.repoPath
+	liftIO $ relPathDirToFile top <$> absPath file
 
 {- Checks if a file in the tree, associated with a key, has not been modified.
  -
diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index e0d3f9d79..71ba4b41e 100644
--- a/Annex/Direct.hs
+++ b/Annex/Direct.hs
@@ -172,7 +172,8 @@ toDirectGen :: Key -> FilePath -> Annex (Maybe (Annex ()))
 toDirectGen k f = do
 	loc <- inRepo $ gitAnnexLocation k
 	createContentDir loc -- thaws directory too
-	locs <- filter (/= normalise f) <$> addAssociatedFile k f
+	top <- fromRepo Git.repoPath
+	locs <- filter (/= normalise (top </> f)) <$> addAssociatedFile k f
 	case locs of
 		[] -> ifM (liftIO $ doesFileExist loc)
 			( return $ Just $ do
diff --git a/debian/changelog b/debian/changelog
index f71a5ab63..182439acd 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -15,6 +15,9 @@ git-annex (3.20130115) UNRELEASED; urgency=low
     in the location log data becoming wrong, and fsck being needed to fix it.
   * sync: Automatic merge conflict resolution now stages deleted files.
   * Depend on git 1.7.7.6 for --no-edit. Closes: #698399
+  * Fix direct mode mapping code to always store direct mode filenames
+    relative to the top of the repository, even when operating inside a
+    subdirectory.
 
  -- Joey Hess <joeyh@debian.org>  Mon, 14 Jan 2013 18:35:01 -0400