From 2566eb85fe2bbd0f9d1798d50ca0d88970a4490c Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 29 Oct 2011 17:49:37 -0400
Subject: fsck: Now works in bare repositories.

Checks location log information, and file contents.

Does not check that numcopies is satisfied, as .gitattributes information
about numcopies is not available in a bare repository. In practice, that
should not be a problem, since fsck is also run in a checkout and will
check numcopies there.
---
 Command/Fsck.hs   | 49 +++++++++++++++++++++++++++++++++++++++++--------
 Command/Unused.hs | 10 +---------
 2 files changed, 42 insertions(+), 17 deletions(-)

(limited to 'Command')

diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 9f3ae0263..6f184a760 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2010,2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -12,6 +12,8 @@ import Command
 import qualified Remote
 import qualified Types.Backend
 import qualified Types.Key
+import qualified Backend
+import qualified Git
 import Annex.Content
 import Logs.Location
 import Logs.Trust
@@ -24,30 +26,61 @@ def :: [Command]
 def = [command "fsck" paramPaths seek "check for problems"]
 
 seek :: [CommandSeek]
-seek = [withNumCopies start]
+seek = [withNumCopies start, withBarePresentKeys startBare]
 
 start :: FilePath -> Maybe Int -> CommandStart
-start file numcopies = notBareRepo $ isAnnexed file $ \(key, backend) -> do
+start file numcopies = isAnnexed file $ \(key, backend) -> do
 	showStart "fsck" file
 	next $ perform key file backend numcopies
 
 perform :: Key -> FilePath -> Backend Annex -> Maybe Int -> CommandPerform
-perform key file backend numcopies = check =<< sequence
+perform key file backend numcopies = check
 	-- order matters
 	[ verifyLocationLog key file
 	, checkKeySize key
 	, checkKeyNumCopies key file numcopies
 	, (Types.Backend.fsckKey backend) key
 	]
+
+{- To fsck a bare repository, fsck each key in the location log. -}
+withBarePresentKeys :: (Key -> CommandStart) -> CommandSeek
+withBarePresentKeys a params = do
+	bare <- Git.repoIsLocalBare <$> gitRepo
+	if bare
+		then do
+			unless (null params) $ do
+				error "fsck should be run without parameters in a bare repository"
+			liftM (map a) loggedKeys
+		else return []
+
+startBare :: Key -> CommandStart
+startBare key = case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of
+	Nothing -> stop
+	Just backend -> do
+		showStart "fsck" (show key)
+		next $ performBare key backend
+
+{- Note that numcopies cannot be checked in a bare repository, because
+ - getting the numcopies value requires a working copy with .gitattributes
+ - files. -}
+performBare :: Key -> Backend Annex -> CommandPerform
+performBare key backend = check
+	[ verifyLocationLog key (show key)
+	, checkKeySize key
+	, (Types.Backend.fsckKey backend) key
+	]
+
+check :: [Annex Bool] -> CommandPerform	
+check s = sequence s >>= dispatch
 	where
-		check vs
+		dispatch vs
 			| all (== True) vs = next $ return True
 			| otherwise = stop
 
 {- Checks that the location log reflects the current status of the key,
    in this repository only. -}
-verifyLocationLog :: Key -> FilePath -> Annex Bool
-verifyLocationLog key file = do
+verifyLocationLog :: Key -> String -> Annex Bool
+verifyLocationLog key desc = do
 	g <- gitRepo
 	present <- inAnnex key
 	
@@ -69,7 +102,7 @@ verifyLocationLog key file = do
 		(False, True) -> do
 				fix g u InfoMissing
 				warning $
-					"** Based on the location log, " ++ file
+					"** Based on the location log, " ++ desc
 					++ "\n** was expected to be present, " ++
 					"but its content is missing."
 				return False
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 11c3f429e..a6cced27f 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -67,19 +67,11 @@ checkRemoteUnused name = do
 checkRemoteUnused' :: Remote.Remote Annex -> Annex ()
 checkRemoteUnused' r = do
 	showAction "checking for unused data"
-	remotehas <- filterM isthere =<< loggedKeys
+	remotehas <- loggedKeysFor (Remote.uuid r)
 	remoteunused <- excludeReferenced remotehas
 	let list = number 0 remoteunused
 	writeUnusedFile "" list
 	unless (null remoteunused) $ showLongNote $ remoteUnusedMsg r list
-	where
-		{- This should run strictly to avoid the filterM
-		 - building many thunks containing keyLocations data. -}
-		isthere k = do
-			us <- keyLocations k
-			let !there = uuid `elem` us
-			return there
-		uuid = Remote.uuid r
 
 writeUnusedFile :: FilePath -> [(Int, Key)] -> Annex ()
 writeUnusedFile prefix l = do
-- 
cgit v1.2.3