82 lines
2.1 KiB
Haskell
82 lines
2.1 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.Fsck where
|
|
|
|
import Control.Monad (when)
|
|
import Control.Monad.State (liftIO)
|
|
|
|
import Command
|
|
import qualified Backend
|
|
import qualified Annex
|
|
import UUID
|
|
import Types
|
|
import Messages
|
|
import Utility
|
|
import Content
|
|
import LocationLog
|
|
import Locations
|
|
|
|
command :: [Command]
|
|
command = [repoCommand "fsck" (paramOptional $ paramRepeating paramPath) seek
|
|
"check for problems"]
|
|
|
|
seek :: [CommandSeek]
|
|
seek = [withAttrFilesInGit "annex.numcopies" start]
|
|
|
|
start :: CommandStartAttrFile
|
|
start (file, attr) = notBareRepo $ isAnnexed file $ \(key, backend) -> do
|
|
showStart "fsck" file
|
|
next $ perform key file backend numcopies
|
|
where
|
|
numcopies = readMaybe attr :: Maybe Int
|
|
|
|
perform :: Key -> FilePath -> Backend Annex -> Maybe Int -> CommandPerform
|
|
perform key file backend numcopies = do
|
|
-- the location log is checked first, so that if it has bad data
|
|
-- that gets corrected
|
|
locationlogok <- verifyLocationLog key file
|
|
backendok <- Backend.fsckKey backend key (Just file) numcopies
|
|
if locationlogok && backendok
|
|
then next $ return True
|
|
else 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
|
|
g <- Annex.gitRepo
|
|
present <- inAnnex key
|
|
|
|
-- Since we're checking that a key's file is present, throw
|
|
-- in a permission fixup here too.
|
|
when present $ liftIO $ do
|
|
let f = gitAnnexLocation g key
|
|
preventWrite f
|
|
preventWrite (parentDir f)
|
|
|
|
u <- getUUID g
|
|
uuids <- liftIO $ keyLocations g key
|
|
|
|
case (present, u `elem` uuids) of
|
|
(True, False) -> do
|
|
fix u ValuePresent
|
|
-- There is no data loss, so do not fail.
|
|
return True
|
|
(False, True) -> do
|
|
fix u ValueMissing
|
|
warning $
|
|
"** Based on the location log, " ++ file
|
|
++ "\n** was expected to be present, " ++
|
|
"but its content is missing."
|
|
return False
|
|
_ -> return True
|
|
|
|
where
|
|
fix u s = do
|
|
showNote "fixing location log"
|
|
logStatusFor u key s
|