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

This commit is contained in:
Joey Hess 2013-01-18 12:20:08 -04:00
parent 299aeca177
commit bbf0e74f72
3 changed files with 26 additions and 11 deletions

View file

@ -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.
-

View file

@ -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

3
debian/changelog vendored
View file

@ -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