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.

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]]