ensure that content directory is thawed when writing direct mode mapping and cache files

Annex/Content.hs

@@ -27,8 +27,6 @@ module Annex.Content (
 	preseedTmp,
 	freezeContent,
 	thawContent,
-	freezeContentDir,
-	createContentDir,
 	replaceFile,
 ) where
 
@@ -457,27 +455,3 @@ thawContent file = liftIO . go =<< fromRepo getSharedRepository
 	go GroupShared = groupWriteRead file
 	go AllShared = groupWriteRead file
 	go _ = allowWrite file
-
-{- Blocks writing to the directory an annexed file is in, to prevent the
- - file accidentially being deleted. However, if core.sharedRepository
- - is set, this is not done, since the group must be allowed to delete the
- - file.
- -}
-freezeContentDir :: FilePath -> Annex ()
-freezeContentDir file = liftIO . go =<< fromRepo getSharedRepository
-  where
-	dir = parentDir file
-	go GroupShared = groupWriteRead dir
-	go AllShared = groupWriteRead dir
-	go _ = preventWrite dir
-
-{- Makes the directory tree to store an annexed file's content,
- - with appropriate permissions on each level. -}
-createContentDir :: FilePath -> Annex ()
-createContentDir dest = do
-	unlessM (liftIO $ doesDirectoryExist dir) $
-		createAnnexDirectory dir 
-	-- might have already existed with restricted perms
-	liftIO $ allowWrite dir
-  where
-	dir = parentDir dest

Annex/Content/Direct.hs

@@ -23,6 +23,7 @@ module Annex.Content.Direct (
 ) where
 
 import Common.Annex
+import Annex.Perms
 import qualified Git
 import Utility.TempFile
 import Logs.Location
@@ -53,7 +54,8 @@ changeAssociatedFiles key transform = do
 	mapping <- inRepo $ gitAnnexMapping key
 	files <- associatedFilesRelative key
 	let files' = transform files
-	when (files /= files') $
+	when (files /= files') $ do
+		createContentDir mapping
 		liftIO $ viaTmp write mapping $ unlines files'
 	top <- fromRepo Git.repoPath
 	return $ map (top </>) files'
@@ -109,7 +111,7 @@ changedFileStatus key status = do
 {- Gets the recorded cache for a key. -}
 recordedCache :: Key -> Annex (Maybe Cache)
 recordedCache key = withCacheFile key $ \cachefile ->
-	catchDefaultIO Nothing $ readCache <$> readFile cachefile
+	liftIO $ catchDefaultIO Nothing $ readCache <$> readFile cachefile
 
 {- Compares a cache with the current cache for a file. -}
 compareCache :: FilePath -> Maybe Cache -> Annex Bool
@@ -124,12 +126,14 @@ updateCache key file = maybe noop (writeCache key) =<< liftIO (genCache file)
 {- Writes a cache for a key. -}
 writeCache :: Key -> Cache -> Annex ()
 writeCache key cache = withCacheFile key $ \cachefile -> do
-	createDirectoryIfMissing True (parentDir cachefile)
+	createContentDir cachefile
-	writeFile cachefile $ showCache cache
+	liftIO $ writeFile cachefile $ showCache cache
 
 {- Removes a cache. -}
 removeCache :: Key -> Annex ()
-removeCache key = withCacheFile key nukeFile
+removeCache key = withCacheFile key $ \f -> do
+	createContentDir f -- also thaws directory
+	liftIO $ nukeFile f
 
 {- Cache a file's inode, size, and modification time to determine if it's
  - been changed. -}
@@ -166,5 +170,5 @@ toCache s
 		(modificationTime s)
 	| otherwise = Nothing
 
-withCacheFile :: Key -> (FilePath -> IO a) -> Annex a
+withCacheFile :: Key -> (FilePath -> Annex a) -> Annex a
-withCacheFile key a = liftIO . a =<< inRepo (gitAnnexCache key)
+withCacheFile key a = a =<< inRepo (gitAnnexCache key)

Annex/Direct.hs

@@ -171,7 +171,6 @@ toDirect k f = maybe noop id =<< toDirectGen k f
 toDirectGen :: Key -> FilePath -> Annex (Maybe (Annex ()))
 toDirectGen k f = do
 	loc <- inRepo $ gitAnnexLocation k
-	createContentDir loc -- thaws directory too
 	absf <- liftIO $ absPath f
 	locs <- filter (/= absf) <$> addAssociatedFile k f
 	case locs of

Annex/Perms.hs

@@ -10,6 +10,8 @@ module Annex.Perms (
 	annexFileMode,
 	createAnnexDirectory,
 	noUmask,
+	createContentDir,
+	freezeContentDir,
 ) where
 
 import Common.Annex
@@ -68,3 +70,27 @@ createAnnexDirectory dir = traverse dir [] =<< top
 		done = forM_ below $ \p -> do
 			liftIO $ createDirectory p
 			setAnnexPerm p
+
+{- Blocks writing to the directory an annexed file is in, to prevent the
+ - file accidentially being deleted. However, if core.sharedRepository
+ - is set, this is not done, since the group must be allowed to delete the
+ - file.
+ -}
+freezeContentDir :: FilePath -> Annex ()
+freezeContentDir file = liftIO . go =<< fromRepo getSharedRepository
+  where
+	dir = parentDir file
+	go GroupShared = groupWriteRead dir
+	go AllShared = groupWriteRead dir
+	go _ = preventWrite dir
+
+{- Makes the directory tree to store an annexed file's content,
+ - with appropriate permissions on each level. -}
+createContentDir :: FilePath -> Annex ()
+createContentDir dest = do
+	unlessM (liftIO $ doesDirectoryExist dir) $
+		createAnnexDirectory dir 
+	-- might have already existed with restricted perms
+	liftIO $ allowWrite dir
+  where
+	dir = parentDir dest