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.

7 files changed, 77 insertions, 31 deletions

diff --git a/Command.hs b/Command.hs
index b039403ca..4e312e66d 100644
--- a/Command.hs
+++ b/Command.hs
@@ -81,18 +81,6 @@ doCommand = start
 		success = return True
 		failure = showEndFail >> return False
 
-notAnnexed :: FilePath -> Annex (Maybe a) -> Annex (Maybe a)
-notAnnexed file a = maybe a (const $ return Nothing) =<< Backend.lookupFile file
-
-isAnnexed :: FilePath -> ((Key, Backend Annex) -> Annex (Maybe a)) -> Annex (Maybe a)
-isAnnexed file a = maybe (return Nothing) a =<< Backend.lookupFile file
-
-notBareRepo :: Annex a -> Annex a
-notBareRepo a = do
-	whenM (Git.repoIsLocalBare <$> gitRepo) $
-		error "You cannot run this subcommand in a bare repository."
-	a
-
 {- These functions find appropriate files or other things based on a
    user's parameters, and prepare actions operating on them. -}
 withFilesInGit :: (FilePath -> CommandStart) -> CommandSeek
@@ -168,7 +156,18 @@ runFilteredGen a d fs = do
 			ok <- matcher f
 			if ok then a v else stop
 
-{- filter out symlinks -}	
+notAnnexed :: FilePath -> Annex (Maybe a) -> Annex (Maybe a)
+notAnnexed file a = maybe a (const $ return Nothing) =<< Backend.lookupFile file
+
+isAnnexed :: FilePath -> ((Key, Backend Annex) -> Annex (Maybe a)) -> Annex (Maybe a)
+isAnnexed file a = maybe (return Nothing) a =<< Backend.lookupFile file
+
+notBareRepo :: Annex a -> Annex a
+notBareRepo a = do
+	whenM (Git.repoIsLocalBare <$> gitRepo) $
+		error "You cannot run this subcommand in a bare repository."
+	a
+
 notSymlink :: FilePath -> IO Bool
 notSymlink f = liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f
 
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
diff --git a/Logs/Location.hs b/Logs/Location.hs
index 8868912db..8855cf63b 100644
--- a/Logs/Location.hs
+++ b/Logs/Location.hs
@@ -17,6 +17,7 @@ module Logs.Location (
 	readLog,
 	keyLocations,
 	loggedKeys,
+	loggedKeysFor,
 	logFile,
 	logFileKey
 ) where
@@ -44,6 +45,18 @@ keyLocations = currentLog . logFile
 loggedKeys :: Annex [Key]
 loggedKeys = mapMaybe (logFileKey . takeFileName) <$> Annex.Branch.files
 
+{- Finds all keys that have location log information indicating
+ - they are present for the specified repository. -}
+loggedKeysFor :: UUID -> Annex [Key]
+loggedKeysFor u = filterM isthere =<< loggedKeys
+	where
+		{- This should run strictly to avoid the filterM
+		 - building many thunks containing keyLocations data. -}
+		isthere k = do
+			us <- keyLocations k
+			let !there = u `elem` us
+			return there
+
 {- The filename of the log file for a given key. -}
 logFile :: Key -> String
 logFile key = hashDirLower key ++ keyFile key ++ ".log"
diff --git a/debian/changelog b/debian/changelog
index 4a873af94..42454fe8f 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -8,6 +8,10 @@ git-annex (3.20111026) UNRELEASED; urgency=low
   * drop --from is now supported to remove file content from a remote.
   * status: Now always shows the current repository, even when it does not
     appear in uuid.log.
+  * 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.
 
  -- Joey Hess <joeyh@debian.org>  Thu, 27 Oct 2011 13:58:53 -0400
 
diff --git a/doc/bugs/git_annex_fsck_is_a_no-op_in_bare_repos.mdwn b/doc/bugs/git_annex_fsck_is_a_no-op_in_bare_repos.mdwn
index 3fd1a8082..9a044860a 100644
--- a/doc/bugs/git_annex_fsck_is_a_no-op_in_bare_repos.mdwn
+++ b/doc/bugs/git_annex_fsck_is_a_no-op_in_bare_repos.mdwn
@@ -17,3 +17,5 @@ See http://lists.madduck.net/pipermail/vcs-home/2011-June/000433.html
 >>> While storing the data is no longer an issue in bare repos, fsck would
 >>> need a special mode that examines all the location logs, since it
 >>> cannot run thru the checked out files. --[[Joey]] 
+
+>>>> [[done]]! --[[Joey]] 
diff --git a/doc/todo/support_fsck_in_bare_repos.mdwn b/doc/todo/support_fsck_in_bare_repos.mdwn
index e6980fa28..53331a4f5 100644
--- a/doc/todo/support_fsck_in_bare_repos.mdwn
+++ b/doc/todo/support_fsck_in_bare_repos.mdwn
@@ -1,6 +1,5 @@
 What is says on the tin:
 
-
     22:56:54 < RichiH> joeyh_: by the way, i have been thinking about fsck on bare repos
     22:57:37 < RichiH> joeyh_: the best i could come with is to have a bare and a non-bare access the same repo store
     22:58:00 < RichiH> joeyh_: alternatively, with the SHA* backend, you have all the information to verify that the local data is correct
@@ -10,3 +9,7 @@ What is says on the tin:
     23:14:51 < joeyh_> unused/dropunused could work in bare repos too btw
 
 > Also `status`'s total annex keys/size could be handled for bare repos. --[[Joey]] 
+
+>> Fsck is done. Rest not done yet. --[[Joey]]
+
+[[!meta title="support status, unused, dropunused in bare repos"]]