diff options
Diffstat (limited to 'Command')
| -rw-r--r-- | Command/Fsck.hs | 49 | ||||
| -rw-r--r-- | Command/Unused.hs | 10 |
2 files changed, 42 insertions, 17 deletions
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 |