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.

1 files changed, 26 insertions, 11 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