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.

1 files changed, 12 insertions, 0 deletions

diff --git a/Annex.hs b/Annex.hs
index 202c25e4f..e4c05c627 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -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' }