diff --git a/Annex/Perms.hs b/Annex/Perms.hs index d255ce97ee..fe01d13a2b 100644 --- a/Annex/Perms.hs +++ b/Annex/Perms.hs @@ -11,6 +11,7 @@ module Annex.Perms ( setAnnexDirPerm, annexFileMode, createAnnexDirectory, + createWorkTreeDirectory, noUmask, freezeContent, isContentWritePermOk, @@ -25,6 +26,7 @@ module Annex.Perms ( import Annex.Common import Utility.FileMode +import Git import Git.ConfigTypes import qualified Annex import Config @@ -77,6 +79,20 @@ createAnnexDirectory dir = do liftIO $ createDirectory p setAnnexDirPerm p +{- Create a directory in the git work tree, creating any parent + - directories up to the top of the work tree. + - + - Uses default permissions. + -} +createWorkTreeDirectory :: FilePath -> Annex () +createWorkTreeDirectory dir = do + fromRepo repoWorkTree >>= liftIO . \case + Just wt -> createDirectoryUnder (fromRawFilePath wt) dir + -- Should never happen, but let whatever tries to write + -- to the directory be what throws an exception, as that + -- will be clearer than an exception from here. + Nothing -> noop + {- Normally, blocks writing to an annexed file, and modifies file - permissions to allow reading it. - diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs index 7fc513b59d..ddbbedf96a 100644 --- a/Annex/ReplaceFile.hs +++ b/Annex/ReplaceFile.hs @@ -35,13 +35,7 @@ replaceGitDirFile = replaceFile $ \dir -> do {- replaceFile on a worktree file. -} replaceWorkTreeFile :: FilePath -> (FilePath -> Annex a) -> Annex a -replaceWorkTreeFile = replaceFile $ \dir -> - fromRepo repoWorkTree >>= liftIO . \case - Just wt -> createDirectoryUnder (fromRawFilePath wt) dir - -- Should never happen, but let the file move be what - -- throws an exception as that would more clearly indicate - -- the problem. - Nothing -> noop +replaceWorkTreeFile = replaceFile createWorkTreeDirectory {- Replaces a possibly already existing file with a new version, - atomically, by running an action.