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:
parent
676ef32547
commit
44c9714fdf
2 changed files with 14 additions and 1 deletions
12
Annex.hs
12
Annex.hs
|
@ -31,6 +31,7 @@ module Annex (
|
||||||
changeGitRepo,
|
changeGitRepo,
|
||||||
getRemoteGitConfig,
|
getRemoteGitConfig,
|
||||||
withCurrentState,
|
withCurrentState,
|
||||||
|
changeDirectory,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Common
|
import Common
|
||||||
|
@ -300,3 +301,14 @@ withCurrentState :: Annex a -> Annex (IO a)
|
||||||
withCurrentState a = do
|
withCurrentState a = do
|
||||||
s <- getState id
|
s <- getState id
|
||||||
return $ eval s a
|
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' }
|
||||||
|
|
|
@ -29,6 +29,7 @@ import Annex.Hook
|
||||||
import qualified Git.Command
|
import qualified Git.Command
|
||||||
import qualified Git.LsFiles as LsFiles
|
import qualified Git.LsFiles as LsFiles
|
||||||
import qualified Git.Branch
|
import qualified Git.Branch
|
||||||
|
import qualified Git.Types as Git
|
||||||
import qualified Git.Ref
|
import qualified Git.Ref
|
||||||
import qualified Git
|
import qualified Git
|
||||||
import qualified Remote.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
|
- of the repo. This also means that sync always acts on all files in the
|
||||||
- repository, not just on a subdirectory. -}
|
- repository, not just on a subdirectory. -}
|
||||||
prepMerge :: Annex ()
|
prepMerge :: Annex ()
|
||||||
prepMerge = liftIO . setCurrentDirectory =<< fromRepo Git.repoPath
|
prepMerge = Annex.changeDirectory =<< fromRepo Git.repoPath
|
||||||
|
|
||||||
syncBranch :: Git.Ref -> Git.Ref
|
syncBranch :: Git.Ref -> Git.Ref
|
||||||
syncBranch = Git.Ref.under "refs/heads/synced" . fromDirectBranch
|
syncBranch = Git.Ref.under "refs/heads/synced" . fromDirectBranch
|
||||||
|
|
Loading…
Reference in a new issue