improve direct mode fsck

An earlier commit (mislabeled) made direct mode fsck check file checksums.
While it's expected for files to change at any time in direct mode, and so
fsck cannot complain every time there's a checksum mismatch, it is possible
for it to detect when a file does not *seem* to have changed, then check
its checksum, and so detect disk corruption or other problems.

This commit improves that, by checking a second time, if the checksum
fails, that the file is still not modified, before taking action. This way,
a direct mode file can be modified while being fscked.

1 files changed, 23 insertions, 6 deletions

diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 870dac07d..2e26b0af6 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -311,7 +311,8 @@ checkBackend backend key = do
 	file <- inRepo $ gitAnnexLocation key
 	ifM isDirect
 		( ifM (goodContent key file)
-			( checkBackendOr badContent backend key file
+			( checkBackendOr' (badContentDirect file) backend key file
+				(goodContent key file)
 			, return True
 			)
 		, checkBackendOr badContent backend key file
@@ -320,18 +321,26 @@ checkBackend backend key = do
 checkBackendRemote :: Backend -> Key -> Remote -> Maybe FilePath -> Annex Bool
 checkBackendRemote backend key remote = maybe (return True) go
   where
-	go = checkBackendOr (badContentRemote remote) backend key
+	go file = checkBackendOr (badContentRemote remote) backend key file
 
 checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> Annex Bool
 checkBackendOr bad backend key file =
+	checkBackendOr' bad backend key file (return True)
+
+checkBackendOr' :: (Key -> Annex String) -> Backend -> Key -> FilePath -> Annex Bool -> Annex Bool
+checkBackendOr' bad backend key file postcheck =
 	case Types.Backend.fsckKey backend of
 		Nothing -> return True
 		Just a -> do
 			ok <- a key file
-			unless ok $ do
-				msg <- bad key
-				warning $ "Bad file content; " ++ msg
-			return ok
+			ifM postcheck
+				( do
+					unless ok $ do
+						msg <- bad key
+						warning $ "Bad file content; " ++ msg
+					return ok
+				, return True
+				)
 
 checkKeyNumCopies :: Key -> FilePath -> Maybe Int -> Annex Bool
 checkKeyNumCopies key file numcopies = do
@@ -367,6 +376,14 @@ badContent key = do
 	dest <- moveBad key
 	return $ "moved to " ++ dest
 
+{- Bad content is left where it is, but we touch the file, so it'll be
+ - committed to a new key. -}
+badContentDirect :: FilePath -> Key -> Annex String
+badContentDirect file key = do
+	void $ liftIO $ catchMaybeIO $ touchFile file
+	logStatus key InfoMissing
+	return $ "left in place for you to examine"
+
 badContentRemote :: Remote -> Key -> Annex String
 badContentRemote remote key = do
 	ok <- Remote.removeKey remote key