proper fix for dropunused
Now getKeysPresent checks that the key's content, not only its directory, exists. In direct mode, the inode cache file is used as a standin for the content. removeAnnex always removes the inode cache file, and drop and move --from always call removeAnnex, even if the object does not seem to be inAnnex, to ensure it's always deleted.
This commit is contained in:
parent
55069f0fab
commit
397082013a
4 changed files with 30 additions and 13 deletions
|
@ -28,6 +28,7 @@ module Annex.Content (
|
||||||
freezeContent,
|
freezeContent,
|
||||||
thawContent,
|
thawContent,
|
||||||
replaceFile,
|
replaceFile,
|
||||||
|
cleanObjectLoc,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import System.IO.Unsafe (unsafeInterleaveIO)
|
import System.IO.Unsafe (unsafeInterleaveIO)
|
||||||
|
@ -349,7 +350,8 @@ removeAnnex key = withObjectLoc key remove removedirect
|
||||||
remove file = do
|
remove file = do
|
||||||
unlessM crippledFileSystem $
|
unlessM crippledFileSystem $
|
||||||
liftIO $ allowWrite $ parentDir file
|
liftIO $ allowWrite $ parentDir file
|
||||||
liftIO $ removeFile file
|
liftIO $ nukeFile file
|
||||||
|
removeInodeCache key
|
||||||
cleanObjectLoc key
|
cleanObjectLoc key
|
||||||
removedirect fs = do
|
removedirect fs = do
|
||||||
cache <- recordedInodeCache key
|
cache <- recordedInodeCache key
|
||||||
|
@ -389,16 +391,22 @@ moveBad key = do
|
||||||
logStatus key InfoMissing
|
logStatus key InfoMissing
|
||||||
return dest
|
return dest
|
||||||
|
|
||||||
{- List of keys whose content exists in .git/annex/objects/ -}
|
{- List of keys whose content exists in the annex. -}
|
||||||
getKeysPresent :: Annex [Key]
|
getKeysPresent :: Annex [Key]
|
||||||
getKeysPresent = liftIO . traverse (2 :: Int) =<< fromRepo gitAnnexObjectDir
|
getKeysPresent = do
|
||||||
|
direct <- isDirect
|
||||||
|
dir <- fromRepo gitAnnexObjectDir
|
||||||
|
liftIO $ traverse direct (2 :: Int) dir
|
||||||
where
|
where
|
||||||
traverse depth dir = do
|
traverse direct depth dir = do
|
||||||
contents <- catchDefaultIO [] (dirContents dir)
|
contents <- catchDefaultIO [] (dirContents dir)
|
||||||
if depth == 0
|
if depth == 0
|
||||||
then continue (mapMaybe (fileKey . takeFileName) contents) []
|
then do
|
||||||
|
contents' <- filterM (present direct) contents
|
||||||
|
let keys = mapMaybe (fileKey . takeFileName) contents'
|
||||||
|
continue keys []
|
||||||
else do
|
else do
|
||||||
let deeper = traverse (depth - 1)
|
let deeper = traverse direct (depth - 1)
|
||||||
continue [] (map deeper contents)
|
continue [] (map deeper contents)
|
||||||
continue keys [] = return keys
|
continue keys [] = return keys
|
||||||
continue keys (a:as) = do
|
continue keys (a:as) = do
|
||||||
|
@ -406,6 +414,13 @@ getKeysPresent = liftIO . traverse (2 :: Int) =<< fromRepo gitAnnexObjectDir
|
||||||
morekeys <- unsafeInterleaveIO a
|
morekeys <- unsafeInterleaveIO a
|
||||||
continue (morekeys++keys) as
|
continue (morekeys++keys) as
|
||||||
|
|
||||||
|
{- In indirect mode, look for the key. In direct mode,
|
||||||
|
- the inode cache file is only present when a key's content
|
||||||
|
- is present. -}
|
||||||
|
present False d = doesFileExist $ contentfile d
|
||||||
|
present True d = doesFileExist $ contentfile d ++ ".cache"
|
||||||
|
contentfile d = d </> takeFileName d
|
||||||
|
|
||||||
{- Things to do to record changes to content when shutting down.
|
{- Things to do to record changes to content when shutting down.
|
||||||
-
|
-
|
||||||
- It's acceptable to avoid committing changes to the branch,
|
- It's acceptable to avoid committing changes to the branch,
|
||||||
|
|
|
@ -60,7 +60,7 @@ performLocal key numcopies knownpresentremote = lockContent key $ do
|
||||||
untrusteduuids <- trustGet UnTrusted
|
untrusteduuids <- trustGet UnTrusted
|
||||||
let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids'++untrusteduuids)
|
let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids'++untrusteduuids)
|
||||||
stopUnless (canDropKey key numcopies trusteduuids' tocheck []) $ do
|
stopUnless (canDropKey key numcopies trusteduuids' tocheck []) $ do
|
||||||
whenM (inAnnex key) $ removeAnnex key
|
removeAnnex key
|
||||||
next $ cleanupLocal key
|
next $ cleanupLocal key
|
||||||
|
|
||||||
performRemote :: Key -> Maybe Int -> Remote -> CommandPerform
|
performRemote :: Key -> Maybe Int -> Remote -> CommandPerform
|
||||||
|
|
|
@ -104,7 +104,7 @@ toPerform dest move key file = moveLock move key $ do
|
||||||
Remote.logStatus dest key InfoPresent
|
Remote.logStatus dest key InfoPresent
|
||||||
if move
|
if move
|
||||||
then do
|
then do
|
||||||
whenM (inAnnex key) $ removeAnnex key
|
removeAnnex key
|
||||||
next $ Command.Drop.cleanupLocal key
|
next $ Command.Drop.cleanupLocal key
|
||||||
else next $ return True
|
else next $ return True
|
||||||
|
|
||||||
|
|
|
@ -66,3 +66,5 @@ Debian: sid 2013-02-01
|
||||||
> actual key files are present (it just lists the directories).
|
> actual key files are present (it just lists the directories).
|
||||||
> But this seems to be needed, since direct mode can leave
|
> But this seems to be needed, since direct mode can leave
|
||||||
> cache and mapping files behind. --[[Joey]]
|
> cache and mapping files behind. --[[Joey]]
|
||||||
|
|
||||||
|
>> Now fixed properly. [[done]] --[[Joey]]
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue