summaryrefslogtreecommitdiff
path: root/Annex/Content.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-02-07 08:28:40 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-02-07 08:28:40 -0400
commitf797939d15a2b414e62b28ccb0bd9e5b77978d76 (patch)
tree4095dd3f6e97bc1d7638cfbecbd1e75ce002af95 /Annex/Content.hs
parenta7b151f28926f3a6455f4456c496aeaf31df091a (diff)
Clean up direct mode cache and mapping info when dropping keys.
These files were left behind, and made getKeysPresent find keys that were not present. It would be expensive to make getKeysPresent check that the actual key files are present (it just lists the directories). But that's not needed if we just clean up the stale cache and mapping files. To handle systems that were in direct mode and got switched back with stale direct mode files, made cleanObjectLoc remove all files in the key's directory. git annex unused will still list keys that are gone but for which the stale direct mode files exists. To deal with that, made dropunused remove the key's directory even if the key does not seem to be present.
Diffstat (limited to 'Annex/Content.hs')
-rw-r--r--Annex/Content.hs10
1 files changed, 8 insertions, 2 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 87ff3f692..8be2cf008 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -28,6 +28,7 @@ module Annex.Content (
freezeContent,
thawContent,
replaceFile,
+ cleanObjectLoc,
) where
import System.IO.Unsafe (unsafeInterleaveIO)
@@ -334,7 +335,12 @@ withObjectLoc key indirect direct = ifM isDirect
cleanObjectLoc :: Key -> Annex ()
cleanObjectLoc key = do
file <- inRepo $ gitAnnexLocation key
- liftIO $ removeparents file (3 :: Int)
+ liftIO $ do
+ let dir = parentDir file
+ void $ catchMaybeIO $ do
+ allowWrite dir
+ removeDirectoryRecursive dir
+ removeparents dir (2 :: Int)
where
removeparents _ 0 = noop
removeparents file n = do
@@ -356,8 +362,8 @@ removeAnnex key = withObjectLoc key remove removedirect
cleanObjectLoc key
removedirect fs = do
cache <- recordedCache key
- removeCache key
mapM_ (resetfile cache) fs
+ cleanObjectLoc key
resetfile cache f = whenM (compareCache f cache) $ do
l <- calcGitLink f key
top <- fromRepo Git.repoPath