diff options
Diffstat (limited to 'Annex')
| -rw-r--r-- | Annex/Content.hs | 28 | ||||
| -rw-r--r-- | Annex/Content/Direct.hs | 26 | ||||
| -rw-r--r-- | Annex/Direct.hs | 6 | ||||
| -rw-r--r-- | Annex/Perms.hs | 12 |
4 files changed, 41 insertions, 31 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index 66ca7be18..5ce0f2689 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -29,7 +29,6 @@ module Annex.Content ( preseedTmp, freezeContent, thawContent, - cleanObjectLoc, dirKeys, ) where @@ -255,11 +254,9 @@ moveAnnex key src = withObjectLoc key storeobject storedirect where storeobject dest = ifM (liftIO $ doesFileExist dest) ( alreadyhave - , do - createContentDir dest + , modifyContent dest $ do liftIO $ moveFile src dest freezeContent dest - freezeContentDir dest ) storeindirect = storeobject =<< calcRepo (gitAnnexLocation key) @@ -273,7 +270,6 @@ moveAnnex key src = withObjectLoc key storeobject storedirect storedirect = storedirect' storeindirect storedirect' fallback [] = fallback storedirect' fallback (f:fs) = do - thawContentDir =<< calcRepo (gitAnnexLocation key) thawContent src v <- isAnnexLink f if Just key == v @@ -349,11 +345,11 @@ withObjectLoc key indirect direct = ifM isDirect where goindirect = indirect =<< calcRepo (gitAnnexLocation key) -cleanObjectLoc :: Key -> Annex () -cleanObjectLoc key = do +cleanObjectLoc :: Key -> Annex () -> Annex () +cleanObjectLoc key cleaner = do file <- calcRepo $ gitAnnexLocation key - unlessM crippledFileSystem $ - void $ liftIO $ catchMaybeIO $ allowWrite $ parentDir file + void $ tryAnnexIO $ thawContentDir file + cleaner liftIO $ removeparents file (3 :: Int) where removeparents _ 0 = noop @@ -369,13 +365,10 @@ cleanObjectLoc key = do removeAnnex :: Key -> Annex () removeAnnex key = withObjectLoc key remove removedirect where - remove file = do - thawContentDir file + remove file = cleanObjectLoc key $ do liftIO $ nukeFile file removeInodeCache key - cleanObjectLoc key removedirect fs = do - thawContentDir =<< calcRepo (gitAnnexLocation key) cache <- recordedInodeCache key removeInodeCache key mapM_ (resetfile cache) fs @@ -389,12 +382,10 @@ removeAnnex key = withObjectLoc key remove removedirect {- Moves a key's file out of .git/annex/objects/ -} fromAnnex :: Key -> FilePath -> Annex () -fromAnnex key dest = do +fromAnnex key dest = cleanObjectLoc key $ do file <- calcRepo $ gitAnnexLocation key - thawContentDir file thawContent file liftIO $ moveFile file dest - cleanObjectLoc key {- Moves a key out of .git/annex/objects/ into .git/annex/bad, and - returns the file it was moved to. -} @@ -404,9 +395,8 @@ moveBad key = do bad <- fromRepo gitAnnexBadDir let dest = bad </> takeFileName src createAnnexDirectory (parentDir dest) - thawContentDir src - liftIO $ moveFile src dest - cleanObjectLoc key + cleanObjectLoc key $ + liftIO $ moveFile src dest logStatus key InfoMissing return dest diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs index b0b8621e9..a5d71288b 100644 --- a/Annex/Content/Direct.hs +++ b/Annex/Content/Direct.hs @@ -10,6 +10,7 @@ module Annex.Content.Direct ( associatedFilesRelative, removeAssociatedFile, removeAssociatedFileUnchecked, + removeAssociatedFiles, addAssociatedFile, goodContent, recordedInodeCache, @@ -64,8 +65,8 @@ changeAssociatedFiles key transform = do files <- associatedFilesRelative key let files' = transform files when (files /= files') $ do - createContentDir mapping - liftIO $ viaTmp write mapping $ unlines files' + modifyContent mapping $ + liftIO $ viaTmp write mapping $ unlines files' top <- fromRepo Git.repoPath return $ map (top </>) files' where @@ -75,6 +76,13 @@ changeAssociatedFiles key transform = do hPutStr h content hClose h +{- Removes the list of associated files. -} +removeAssociatedFiles :: Key -> Annex () +removeAssociatedFiles key = do + mapping <- calcRepo $ gitAnnexMapping key + modifyContent mapping $ + liftIO $ nukeFile mapping + {- Removes an associated file. Returns new associatedFiles value. - Checks if this was the last copy of the object, and updates location - log. -} @@ -142,16 +150,16 @@ addInodeCache key cache = do {- Writes inode cache for a key. -} writeInodeCache :: Key -> [InodeCache] -> Annex () -writeInodeCache key caches = withInodeCacheFile key $ \f -> do - createContentDir f - liftIO $ writeFile f $ - unlines $ map showInodeCache caches +writeInodeCache key caches = withInodeCacheFile key $ \f -> + modifyContent f $ + liftIO $ writeFile f $ + unlines $ map showInodeCache caches {- Removes an inode cache. -} removeInodeCache :: Key -> Annex () -removeInodeCache key = withInodeCacheFile key $ \f -> do - createContentDir f -- also thaws directory - liftIO $ nukeFile f +removeInodeCache key = withInodeCacheFile key $ \f -> + modifyContent f $ + liftIO $ nukeFile f withInodeCacheFile :: Key -> (FilePath -> Annex a) -> Annex a withInodeCacheFile key a = a =<< calcRepo (gitAnnexInodeCache key) diff --git a/Annex/Direct.hs b/Annex/Direct.hs index 366966fc2..3fa5f9362 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -210,11 +210,11 @@ toDirectGen k f = do where fromindirect loc = do {- Move content from annex to direct file. -} - thawContentDir loc updateInodeCache k loc void $ addAssociatedFile k f - thawContent loc - replaceFile f $ liftIO . moveFile loc + modifyContent loc $ do + thawContent loc + replaceFile f $ liftIO . moveFile loc fromdirect loc = do replaceFile f $ liftIO . void . copyFileExternal loc diff --git a/Annex/Perms.hs b/Annex/Perms.hs index f5925b741..9ce0fe2a6 100644 --- a/Annex/Perms.hs +++ b/Annex/Perms.hs @@ -13,12 +13,14 @@ module Annex.Perms ( createContentDir, freezeContentDir, thawContentDir, + modifyContent, ) where import Common.Annex import Utility.FileMode import Git.SharedRepository import qualified Annex +import Annex.Exception import Config import System.Posix.Types @@ -103,3 +105,13 @@ createContentDir dest = do liftIO $ allowWrite dir where dir = parentDir dest + +{- Creates the content directory for a file if it doesn't already exist, + - or thaws it if it does, then runs an action to modify the file, and + - finally, freezes the content directory. -} +modifyContent :: FilePath -> Annex a -> Annex a +modifyContent f a = do + createContentDir f -- also thaws it + v <- tryAnnex a + freezeContentDir f + either throwAnnex return v |