summaryrefslogtreecommitdiff
path: root/Annex
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-01-26 20:09:15 +1100
committerGravatar Joey Hess <joey@kitenet.net>2013-01-26 20:09:15 +1100
commit8126c41bc247cfb31a3d2a9c57cb3e4783e8e37b (patch)
tree42ba9965d90455a7c9bf331803300e4bc5aab7c4 /Annex
parent2b604c3556ad538ff573ec073fa1a298daf03151 (diff)
ensure that content directory is thawed when writing direct mode mapping and cache files
Diffstat (limited to 'Annex')
-rw-r--r--Annex/Content.hs26
-rw-r--r--Annex/Content/Direct.hs18
-rw-r--r--Annex/Direct.hs1
-rw-r--r--Annex/Perms.hs26
4 files changed, 37 insertions, 34 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index f58628097..ed234511e 100644
--- a/Annex/Content.hs
+++ b/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
diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs
index 9862b5dfe..ec99c1ef4 100644
--- a/Annex/Content/Direct.hs
+++ b/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)
- writeFile cachefile $ showCache cache
+ createContentDir cachefile
+ 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 a = liftIO . a =<< inRepo (gitAnnexCache key)
+withCacheFile :: Key -> (FilePath -> Annex a) -> Annex a
+withCacheFile key a = a =<< inRepo (gitAnnexCache key)
diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index f43c94fcb..648bb7518 100644
--- a/Annex/Direct.hs
+++ b/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
diff --git a/Annex/Perms.hs b/Annex/Perms.hs
index 13deb20bd..27804ad3d 100644
--- a/Annex/Perms.hs
+++ b/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