diff options
author | Joey Hess <joey@kitenet.net> | 2013-02-15 17:58:49 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-02-15 17:58:49 -0400 |
commit | 2ff051dd2173e773dfda5d1f0bf6c6b407705580 (patch) | |
tree | 8fec6aac8e2200b003944019c0be637ea877bd56 | |
parent | 7f8b9d55099c15eaf33246c1d9ea2d4aa742abc1 (diff) |
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.
-rw-r--r-- | Annex/Content.hs | 37 | ||||
-rw-r--r-- | Command/Drop.hs | 2 | ||||
-rw-r--r-- | Command/Move.hs | 2 | ||||
-rw-r--r-- | doc/bugs/dropunused_doesn__39__t_work_in_my_case__63__.mdwn | 2 |
4 files changed, 30 insertions, 13 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index 6ec3368c6..4cb6a5ac8 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) @@ -349,7 +350,8 @@ removeAnnex key = withObjectLoc key remove removedirect remove file = do unlessM crippledFileSystem $ liftIO $ allowWrite $ parentDir file - liftIO $ removeFile file + liftIO $ nukeFile file + removeInodeCache key cleanObjectLoc key removedirect fs = do cache <- recordedInodeCache key @@ -389,16 +391,22 @@ moveBad key = do logStatus key InfoMissing 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 = liftIO . traverse (2 :: Int) =<< fromRepo gitAnnexObjectDir +getKeysPresent = do + direct <- isDirect + dir <- fromRepo gitAnnexObjectDir + liftIO $ traverse direct (2 :: Int) dir where - traverse depth dir = do + traverse direct depth dir = do contents <- catchDefaultIO [] (dirContents dir) 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 - let deeper = traverse (depth - 1) + let deeper = traverse direct (depth - 1) continue [] (map deeper contents) continue keys [] = return keys continue keys (a:as) = do @@ -406,6 +414,13 @@ getKeysPresent = liftIO . traverse (2 :: Int) =<< fromRepo gitAnnexObjectDir morekeys <- unsafeInterleaveIO a 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. - - It's acceptable to avoid committing changes to the branch, @@ -436,11 +451,11 @@ preseedTmp key file = go =<< inAnnex key when ok $ thawContent file return ok copy = ifM (liftIO $ doesFileExist file) - ( return True - , do - s <- inRepo $ gitAnnexLocation key - liftIO $ copyFileExternal s file - ) + ( return True + , do + s <- inRepo $ gitAnnexLocation key + liftIO $ copyFileExternal s file + ) {- Blocks writing to an annexed file. The file is made unwritable - to avoid accidental edits. core.sharedRepository may change diff --git a/Command/Drop.hs b/Command/Drop.hs index f7491deae..1683f3b57 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -60,7 +60,7 @@ performLocal key numcopies knownpresentremote = lockContent key $ do untrusteduuids <- trustGet UnTrusted let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids'++untrusteduuids) stopUnless (canDropKey key numcopies trusteduuids' tocheck []) $ do - whenM (inAnnex key) $ removeAnnex key + removeAnnex key next $ cleanupLocal key performRemote :: Key -> Maybe Int -> Remote -> CommandPerform diff --git a/Command/Move.hs b/Command/Move.hs index 316e4192e..20203c205 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -104,7 +104,7 @@ toPerform dest move key file = moveLock move key $ do Remote.logStatus dest key InfoPresent if move then do - whenM (inAnnex key) $ removeAnnex key + removeAnnex key next $ Command.Drop.cleanupLocal key else next $ return True diff --git a/doc/bugs/dropunused_doesn__39__t_work_in_my_case__63__.mdwn b/doc/bugs/dropunused_doesn__39__t_work_in_my_case__63__.mdwn index ec35b0696..7428b091a 100644 --- a/doc/bugs/dropunused_doesn__39__t_work_in_my_case__63__.mdwn +++ b/doc/bugs/dropunused_doesn__39__t_work_in_my_case__63__.mdwn @@ -66,3 +66,5 @@ Debian: sid 2013-02-01 > actual key files are present (it just lists the directories). > But this seems to be needed, since direct mode can leave > cache and mapping files behind. --[[Joey]] + +>> Now fixed properly. [[done]] --[[Joey]] |