fsck --from

Fscking a remote is now supported. It's done by retrieving
the contents of the specified files from the remote, and checking them,
so can be an expensive operation.

(Several optimisations are possible, to speed it up, of course.. This is
the slow and stupid remote fsck to start with.)

Still, if the remote is a special remote, or a git repository that you
cannot run fsck in locally, it's nice to have the ability to fsck it.

If you have any directory special remotes, now would be a good time to
fsck them, in case you were hit by the data loss bug fixed in the
previous release!

8 files changed, 131 insertions, 44 deletions

diff --git a/Backend/SHA.hs b/Backend/SHA.hs
index 29f4e2e94..3adac65d8 100644
--- a/Backend/SHA.hs
+++ b/Backend/SHA.hs
@@ -9,7 +9,6 @@ module Backend.SHA (backends) where
 
 import Common.Annex
 import qualified Annex
-import Annex.Content
 import Types.Backend
 import Types.Key
 import qualified Build.SysConfig as SysConfig
@@ -97,18 +96,14 @@ keyValueE size file = keyValue size file >>= maybe (return Nothing) addE
 			| otherwise = naiveextension
 
 {- A key's checksum is checked during fsck. -}
-checkKeyChecksum :: SHASize -> Key -> Annex Bool
-checkKeyChecksum size key = do
+checkKeyChecksum :: SHASize -> Key -> FilePath -> Annex Bool
+checkKeyChecksum size key file = do
 	fast <- Annex.getState Annex.fast
-	file <- inRepo $ gitAnnexLocation key
 	present <- liftIO $ doesFileExist file
 	if not present || fast
 		then return True
-		else check =<< shaN size file
+		else check <$> shaN size file
 	where
 		check s
-			| s == dropExtension (keyName key) = return True
-			| otherwise = do
-				dest <- moveBad key
-				warning $ "Bad file content; moved to " ++ dest
-				return False
+			| s == dropExtension (keyName key) = True
+			| otherwise = False
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 578ab62b9..b40de00cb 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -87,7 +87,7 @@ cleanupRemote key remote ok = do
 	-- better safe than sorry: assume the remote dropped the key
 	-- even if it seemed to fail; the failure could have occurred
 	-- after it really dropped it
-	Remote.logStatus remote key False
+	Remote.logStatus remote key InfoMissing
 	return ok
 
 {- Checks specified remotes to verify that enough copies of a key exist to
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 051a58fb4..aec29a39b 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -20,20 +20,31 @@ import Annex.UUID
 import Utility.DataUnits
 import Utility.FileMode
 import Config
+import qualified Option
 
 def :: [Command]
-def = [command "fsck" paramPaths seek "check for problems"]
+def = [withOptions options $ command "fsck" paramPaths seek
+	"check for problems"]
+
+fromOption :: Option
+fromOption = Option.field ['f'] "from" paramRemote "check remote"
+
+options :: [Option]
+options = [fromOption]
 
 seek :: [CommandSeek]
 seek =
-	[ withNumCopies $ \n -> whenAnnexed $ start n
+	[ withField fromOption Remote.byName $ \from ->
+		withNumCopies $ \n -> whenAnnexed $ start from n
 	, withBarePresentKeys startBare
 	]
 
-start :: Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
-start numcopies file (key, backend) = do
+start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
+start from numcopies file (key, backend) = do
 	showStart "fsck" file
-	next $ perform key file backend numcopies
+	case from of
+		Nothing -> next $ perform key file backend numcopies
+		Just r -> next $ performRemote key file backend numcopies r
 
 perform :: Key -> FilePath -> Backend -> Maybe Int -> CommandPerform
 perform key file backend numcopies = check
@@ -44,6 +55,27 @@ perform key file backend numcopies = check
 	, checkKeyNumCopies key file numcopies
 	]
 
+{- To fsck a remote, the content is retrieved to a tmp file,
+ - and checked locally. -}
+performRemote :: Key -> FilePath -> Backend -> Maybe Int -> Remote -> CommandPerform
+performRemote key file backend numcopies remote = withTmp key $ \tmpfile -> do
+	v <- Remote.hasKey remote key
+	case v of
+		Left err -> do
+			showNote err
+			stop
+		Right True -> do
+			copied <- Remote.retrieveKeyFile remote key tmpfile
+			if copied then go True (Just tmpfile) else go False Nothing
+		Right False -> go False Nothing
+	where
+		go present localcopy = check
+			[ verifyLocationLogRemote key file remote present
+			, checkKeySizeRemote key remote localcopy
+			, checkBackendRemote backend key remote localcopy
+			, checkKeyNumCopies key file numcopies
+			]
+
 {- To fsck a bare repository, fsck each key in the location log. -}
 withBarePresentKeys :: (Key -> CommandStart) -> CommandSeek
 withBarePresentKeys a params = isBareRepo >>= go
@@ -93,26 +125,33 @@ verifyLocationLog key desc = do
 			preventWrite (parentDir f)
 
 	u <- getUUID
-	uuids <- Remote.keyLocations key
+	verifyLocationLog' key desc present u (logChange key u)
+
+verifyLocationLogRemote :: Key -> String -> Remote -> Bool -> Annex Bool
+verifyLocationLogRemote key desc remote present =
+	verifyLocationLog' key desc present (Remote.uuid remote)
+		(Remote.logStatus remote key)
 
+verifyLocationLog' :: Key -> String -> Bool -> UUID -> (LogStatus -> Annex ()) -> Annex Bool
+verifyLocationLog' key desc present u bad = do
+	uuids <- Remote.keyLocations key
 	case (present, u `elem` uuids) of
 		(True, False) -> do
-				fix u InfoPresent
+				fix InfoPresent
 				-- There is no data loss, so do not fail.
 				return True
 		(False, True) -> do
-				fix u InfoMissing
+				fix InfoMissing
 				warning $
 					"** Based on the location log, " ++ desc
 					++ "\n** was expected to be present, " ++
 					"but its content is missing."
 				return False
 		_ -> return True
-	
 	where
-		fix u s = do
+		fix s = do
 			showNote "fixing location log"
-			logChange key u s
+			bad s
 
 {- The size of the data for a key is checked against the size encoded in
  - the key's metadata, if available. -}
@@ -120,26 +159,49 @@ checkKeySize :: Key -> Annex Bool
 checkKeySize key = do
 	file <- inRepo $ gitAnnexLocation key
 	present <- liftIO $ doesFileExist file
-	case (present, Types.Key.keySize key) of
-		(_, Nothing) -> return True
-		(False, _) -> return True
-		(True, Just size) -> do
-			stat <- liftIO $ getFileStatus file
-			let size' = fromIntegral (fileSize stat)
-			if size == size'
-				then return True
-				else do
-					dest <- moveBad key
-					warning $ "Bad file size (" ++
-						compareSizes storageUnits True size size' ++ 
-						"); moved to " ++ dest
-					return False
+	if present
+		then checkKeySize' key file badContent
+		else return True
+
+checkKeySizeRemote :: Key -> Remote -> Maybe FilePath -> Annex Bool
+checkKeySizeRemote _ _ Nothing = return True
+checkKeySizeRemote key remote (Just file) = checkKeySize' key file
+	(badContentRemote remote)
 
+checkKeySize' :: Key -> FilePath -> (Key -> Annex String) -> Annex Bool
+checkKeySize' key file bad = case Types.Key.keySize key of
+	Nothing -> return True
+	Just size -> do
+		stat <- liftIO $ getFileStatus file
+		let size' = fromIntegral (fileSize stat)
+		if size == size'
+			then return True
+			else do
+				msg <- bad key
+				warning $ "Bad file size (" ++
+					compareSizes storageUnits True size size' ++
+					"); " ++ msg
+				return False
 
 checkBackend :: Backend -> Key -> Annex Bool
-checkBackend backend key = case Types.Backend.fsckKey backend of
+checkBackend backend key = do
+	file <- inRepo (gitAnnexLocation key)
+	checkBackend' backend key (Just file) badContent
+
+checkBackendRemote :: Backend -> Key -> Remote -> Maybe FilePath -> Annex Bool
+checkBackendRemote backend key remote localcopy =
+	checkBackend' backend key localcopy (badContentRemote remote)
+
+checkBackend' :: Backend -> Key -> Maybe FilePath -> (Key -> Annex String) -> Annex Bool
+checkBackend' _ _ Nothing _ = return True
+checkBackend' backend key (Just file) bad = case Types.Backend.fsckKey backend of
 	Nothing -> return True
-	Just a -> a key
+	Just a -> do
+		ok <- a key file
+		unless ok $ do
+			msg <- bad key
+			warning $ "Bad file content; " ++ msg
+		return ok
 
 checkKeyNumCopies :: Key -> FilePath -> Maybe Int -> Annex Bool
 checkKeyNumCopies key file numcopies = do
@@ -168,3 +230,19 @@ missingNote file present needed untrusted =
 		missingNote file present needed [] ++
 		"\nThe following untrusted locations may also have copies: " ++
 		"\n" ++ untrusted
+
+{- Bad content is moved aside. -}
+badContent :: Key -> Annex String
+badContent key = do
+	dest <- moveBad key
+	return $ "moved to " ++ dest
+
+badContentRemote :: Remote -> Key -> Annex String
+badContentRemote remote key = do
+	ok <- Remote.removeKey remote key
+	-- better safe than sorry: assume the remote dropped the key
+	-- even if it seemed to fail; the failure could have occurred
+	-- after it really dropped it
+	Remote.logStatus remote key InfoMissing
+	return $ (if ok then "dropped from " else "failed to drop from ")
+		++ Remote.name remote
diff --git a/Command/Move.hs b/Command/Move.hs
index 2efaebbcb..2f2cd1b5d 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -15,6 +15,7 @@ import Annex.Content
 import qualified Remote
 import Annex.UUID
 import qualified Option
+import Logs.Presence
 
 def :: [Command]
 def = [withOptions options $ command "move" paramPaths seek
@@ -97,7 +98,7 @@ toPerform dest move key = moveLock move key $ do
 		Right True -> finish
 	where
 		finish = do
-			Remote.logStatus dest key True
+			Remote.logStatus dest key InfoPresent
 			if move
 				then do
 					whenM (inAnnex key) $ removeAnnex key
diff --git a/Remote.hs b/Remote.hs
index 7feb84d61..133d3e274 100644
--- a/Remote.hs
+++ b/Remote.hs
@@ -212,7 +212,5 @@ forceTrust level remotename = do
  - in the local repo, not on the remote. The process of transferring the
  - key to the remote, or removing the key from it *may* log the change
  - on the remote, but this cannot always be relied on. -}
-logStatus :: Remote -> Key -> Bool -> Annex ()
-logStatus remote key present = logChange key (uuid remote) status
-	where
-		status = if present then InfoPresent else InfoMissing
+logStatus :: Remote -> Key -> LogStatus -> Annex ()
+logStatus remote key present = logChange key (uuid remote) present
diff --git a/Types/Backend.hs b/Types/Backend.hs
index 1966d667f..d52cec547 100644
--- a/Types/Backend.hs
+++ b/Types/Backend.hs
@@ -17,7 +17,7 @@ data BackendA a = Backend {
 	-- converts a filename to a key
 	getKey :: FilePath -> a (Maybe Key),
 	-- called during fsck to check a key, if the backend has its own checks
-	fsckKey :: Maybe (Key -> a Bool)
+	fsckKey :: Maybe (Key -> FilePath -> a Bool)
 }
 
 instance Show (BackendA a) where
diff --git a/debian/changelog b/debian/changelog
index d6c4419bb..684993148 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,16 @@
+git-annex (3.20120117) UNRELEASED; urgency=low
+
+  * fsck --from: Fscking a remote is now supported. It's done by retrieving
+    the contents of the specified files from the remote, and checking them,
+    so can be an expensive operation. Still, if the remote is a special
+    remote, or a git repository that you cannot run fsck in locally, it's
+    nice to have the ability to fsck it.
+  * If you have any directory special remotes, now would be a good time to
+    fsck them, in case you were hit by the data loss bug fixed in the
+    previous release!
+
+ -- Joey Hess <joeyh@debian.org>  Thu, 19 Jan 2012 15:12:03 -0400
+
 git-annex (3.20120116) unstable; urgency=medium
 
   * Fix data loss bug in directory special remote, when moving a file
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 59b756de8..edf300d8d 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -212,6 +212,8 @@ subdirectories).
 
   To avoid expensive checksum calculations, specify --fast
 
+  To check a remote to fsck, specify --from.
+
 * unused
 
   Checks the annex for data that does not correspond to any files present