handle sync's use of setCurrentDirectory to work with relative paths

I think this is the last problimatic setCurrentDirectory. I also audited
for extrnal commands that git-annex might run with cwd = foo, and did not
find any that were passed any FilePath that might be absolute.
This commit is contained in:
Joey Hess 2015-01-06 22:23:04 -04:00
parent 676ef32547
commit 44c9714fdf
2 changed files with 14 additions and 1 deletions

View file

@ -31,6 +31,7 @@ module Annex (
changeGitRepo,
getRemoteGitConfig,
withCurrentState,
changeDirectory,
) where
import Common
@ -300,3 +301,14 @@ withCurrentState :: Annex a -> Annex (IO a)
withCurrentState a = do
s <- getState id
return $ eval s a
{- It's not safe to use setCurrentDirectory in the Annex monad,
- because the git repo paths are stored relative.
- Instead, use this.
-}
changeDirectory :: FilePath -> Annex ()
changeDirectory d = do
r <- liftIO . Git.adjustPath absPath =<< gitRepo
liftIO $ setCurrentDirectory d
r' <- liftIO $ Git.relPath r
changeState $ \s -> s { repo = r' }

View file

@ -29,6 +29,7 @@ import Annex.Hook
import qualified Git.Command
import qualified Git.LsFiles as LsFiles
import qualified Git.Branch
import qualified Git.Types as Git
import qualified Git.Ref
import qualified Git
import qualified Remote.Git
@ -107,7 +108,7 @@ seek rs = do
- of the repo. This also means that sync always acts on all files in the
- repository, not just on a subdirectory. -}
prepMerge :: Annex ()
prepMerge = liftIO . setCurrentDirectory =<< fromRepo Git.repoPath
prepMerge = Annex.changeDirectory =<< fromRepo Git.repoPath
syncBranch :: Git.Ref -> Git.Ref
syncBranch = Git.Ref.under "refs/heads/synced" . fromDirectBranch