mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

use ActionItem rather than String

Browse source 
This changes fsck -A warnings to include the name of the key,
which is a bit redundant in one case, but was missing in another case.
This commit is contained in:
Joey Hess 2017-03-10 14:12:39 -04:00
parent c8e1e3dada
commit 71a05b0d25
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
1 changed files with 49 additions and 47 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

96
Command/Fsck.hs
View file

@ -36,6 +36,7 @@ import qualified Database.Keys
import qualified Database.Fsck as FsckDb import qualified Database.Fsck as FsckDb
import Types.CleanupActions import Types.CleanupActions
import Types.Key import Types.Key
import Types.ActionItem
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
import System.Posix.Types (EpochTime) import System.Posix.Types (EpochTime)
@ -121,15 +122,16 @@ perform key file backend numcopies = do
check check
-- order matters -- order matters
[ fixLink key file [ fixLink key file
, verifyLocationLog key keystatus file , verifyLocationLog key keystatus ai
, verifyAssociatedFiles key keystatus file , verifyAssociatedFiles key keystatus file
, verifyWorkTree key file , verifyWorkTree key file
, checkKeySize key keystatus afile , checkKeySize key keystatus ai
, checkBackend backend key keystatus afile , checkBackend backend key keystatus afile
, checkKeyNumCopies key afile numcopies , checkKeyNumCopies key afile numcopies
] ]
where where
afile = AssociatedFile (Just file) afile = AssociatedFile (Just file)
ai = ActionItemAssociatedFile afile
{- To fsck a remote, the content is retrieved to a tmp file, {- To fsck a remote, the content is retrieved to a tmp file,
- and checked locally. -} - and checked locally. -}
@ -151,11 +153,12 @@ performRemote key afile backend numcopies remote =
return False return False
dispatch (Right False) = go False Nothing dispatch (Right False) = go False Nothing
go present localcopy = check go present localcopy = check
[ verifyLocationLogRemote key afile remote present [ verifyLocationLogRemote key ai remote present
, withLocalCopy localcopy $ checkKeySizeRemote key remote afile , withLocalCopy localcopy $ checkKeySizeRemote key remote ai
, withLocalCopy localcopy $ checkBackendRemote backend key remote afile , withLocalCopy localcopy $ checkBackendRemote backend key remote ai
, checkKeyNumCopies key afile numcopies , checkKeyNumCopies key afile numcopies
] ]
ai = ActionItemAssociatedFile afile
withtmp a = do withtmp a = do
pid <- liftIO getPID pid <- liftIO getPID
t <- fromRepo gitAnnexTmpObjectDir t <- fromRepo gitAnnexTmpObjectDir
@ -190,8 +193,8 @@ performKey :: Key -> Backend -> NumCopies -> Annex Bool
performKey key backend numcopies = do performKey key backend numcopies = do
keystatus <- getKeyStatus key keystatus <- getKeyStatus key
check check
[ verifyLocationLog key keystatus (key2file key) [ verifyLocationLog key keystatus ActionItemKey
, checkKeySize key keystatus (AssociatedFile Nothing) , checkKeySize key keystatus ActionItemKey
, checkBackend backend key keystatus (AssociatedFile Nothing) , checkBackend backend key keystatus (AssociatedFile Nothing)
, checkKeyNumCopies key (AssociatedFile Nothing) numcopies , checkKeyNumCopies key (AssociatedFile Nothing) numcopies
] ]
@ -218,8 +221,8 @@ fixLink key file = do
{- Checks that the location log reflects the current status of the key, {- Checks that the location log reflects the current status of the key,
- in this repository only. -} - in this repository only. -}
verifyLocationLog :: Key -> KeyStatus -> String -> Annex Bool verifyLocationLog :: Key -> KeyStatus -> ActionItem -> Annex Bool
verifyLocationLog key keystatus desc = do verifyLocationLog key keystatus ai = do
direct <- isDirect direct <- isDirect
obj <- calcRepo $ gitAnnexLocation key obj <- calcRepo $ gitAnnexLocation key
present <- if not direct && isKeyUnlocked keystatus present <- if not direct && isKeyUnlocked keystatus
@ -250,17 +253,15 @@ verifyLocationLog key keystatus desc = do
- but that is expected and not something to do anything about. -} - but that is expected and not something to do anything about. -}
if direct && not present if direct && not present
then return True then return True
else verifyLocationLog' key desc present u (logChange key u) else verifyLocationLog' key ai present u (logChange key u)
verifyLocationLogRemote :: Key -> AssociatedFile -> Remote -> Bool -> Annex Bool verifyLocationLogRemote :: Key -> ActionItem -> Remote -> Bool -> Annex Bool
verifyLocationLogRemote key (AssociatedFile afile) remote present = verifyLocationLogRemote key ai remote present =
verifyLocationLog' key desc present (Remote.uuid remote) verifyLocationLog' key ai present (Remote.uuid remote)
(Remote.logStatus remote key) (Remote.logStatus remote key)
where
desc = fromMaybe (key2file key) afile
verifyLocationLog' :: Key -> String -> Bool -> UUID -> (LogStatus -> Annex ()) -> Annex Bool verifyLocationLog' :: Key -> ActionItem -> Bool -> UUID -> (LogStatus -> Annex ()) -> Annex Bool
verifyLocationLog' key desc present u updatestatus = do verifyLocationLog' key ai present u updatestatus = do
uuids <- loggedLocations key uuids <- loggedLocations key
case (present, u `elem` uuids) of case (present, u `elem` uuids) of
(True, False) -> do (True, False) -> do
@ -270,8 +271,9 @@ verifyLocationLog' key desc present u updatestatus = do
(False, True) -> do (False, True) -> do
fix InfoMissing fix InfoMissing
warning $ warning $
"** Based on the location log, " ++ desc "** Based on the location log, " ++
++ "\n** was expected to be present, " ++ actionItemDesc ai key ++
"\n** was expected to be present, " ++
"but its content is missing." "but its content is missing."
return False return False
(False, False) -> do (False, False) -> do
@ -343,12 +345,12 @@ verifyWorkTree key file = do
- -
- Not checked when a file is unlocked, or in direct mode. - Not checked when a file is unlocked, or in direct mode.
-} -}
checkKeySize :: Key -> KeyStatus -> AssociatedFile -> Annex Bool checkKeySize :: Key -> KeyStatus -> ActionItem -> Annex Bool
checkKeySize _ KeyUnlocked _ = return True checkKeySize _ KeyUnlocked _ = return True
checkKeySize key _ afile = do checkKeySize key _ ai = do
file <- calcRepo $ gitAnnexLocation key file <- calcRepo $ gitAnnexLocation key
ifM (liftIO $ doesFileExist file) ifM (liftIO $ doesFileExist file)
( checkKeySizeOr badContent key file afile ( checkKeySizeOr badContent key file ai
, return True , return True
) )
@ -356,12 +358,12 @@ withLocalCopy :: Maybe FilePath -> (FilePath -> Annex Bool) -> Annex Bool
withLocalCopy Nothing _ = return True withLocalCopy Nothing _ = return True
withLocalCopy (Just localcopy) f = f localcopy withLocalCopy (Just localcopy) f = f localcopy
checkKeySizeRemote :: Key -> Remote -> AssociatedFile -> FilePath -> Annex Bool checkKeySizeRemote :: Key -> Remote -> ActionItem -> FilePath -> Annex Bool
checkKeySizeRemote key remote afile localcopy = checkKeySizeRemote key remote ai localcopy =
checkKeySizeOr (badContentRemote remote localcopy) key localcopy afile checkKeySizeOr (badContentRemote remote localcopy) key localcopy ai
checkKeySizeOr :: (Key -> Annex String) -> Key -> FilePath -> AssociatedFile -> Annex Bool checkKeySizeOr :: (Key -> Annex String) -> Key -> FilePath -> ActionItem -> Annex Bool
checkKeySizeOr bad key file (AssociatedFile afile) = case keySize key of checkKeySizeOr bad key file ai = case keySize key of
Nothing -> return True Nothing -> return True
Just size -> do Just size -> do
size' <- liftIO $ getFileSize file size' <- liftIO $ getFileSize file
@ -373,12 +375,12 @@ checkKeySizeOr bad key file (AssociatedFile afile) = case keySize key of
return same return same
badsize a b = do badsize a b = do
msg <- bad key msg <- bad key
warning $ concat $ catMaybes warning $ concat
[ afile <> Just ": " [ actionItemDesc ai key
, Just "Bad file size (" , ": Bad file size ("
, Just $ compareSizes storageUnits True a b , compareSizes storageUnits True a b
, Just "); " , "); "
, Just msg , msg
] ]
{- Runs the backend specific check on a key's content object. {- Runs the backend specific check on a key's content object.
@ -399,31 +401,31 @@ checkBackend backend key keystatus afile = go =<< isDirect
content <- calcRepo $ gitAnnexLocation key content <- calcRepo $ gitAnnexLocation key
ifM (pure (isKeyUnlocked keystatus) <&&> (not <$> isUnmodified key content)) ifM (pure (isKeyUnlocked keystatus) <&&> (not <$> isUnmodified key content))
( nocheck ( nocheck
, checkBackendOr badContent backend key content afile , checkBackendOr badContent backend key content (mkActionItem afile)
) )
go True = case afile of go True = case afile of
AssociatedFile Nothing -> nocheck AssociatedFile Nothing -> nocheck
AssociatedFile (Just f) -> checkdirect f AssociatedFile (Just f) -> checkdirect f
checkdirect file = ifM (Direct.goodContent key file) checkdirect file = ifM (Direct.goodContent key file)
( checkBackendOr' (badContentDirect file) backend key file afile ( checkBackendOr' (badContentDirect file) backend key file (mkActionItem afile)
(Direct.goodContent key file) (Direct.goodContent key file)
, nocheck , nocheck
) )
nocheck = return True nocheck = return True
checkBackendRemote :: Backend -> Key -> Remote -> AssociatedFile -> FilePath -> Annex Bool checkBackendRemote :: Backend -> Key -> Remote -> ActionItem -> FilePath -> Annex Bool
checkBackendRemote backend key remote afile localcopy = checkBackendRemote backend key remote ai localcopy =
checkBackendOr (badContentRemote remote localcopy) backend key localcopy afile checkBackendOr (badContentRemote remote localcopy) backend key localcopy ai
checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> AssociatedFile -> Annex Bool checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> ActionItem -> Annex Bool
checkBackendOr bad backend key file afile = checkBackendOr bad backend key file ai =
checkBackendOr' bad backend key file afile (return True) checkBackendOr' bad backend key file ai (return True)
-- The postcheck action is run after the content is verified, -- The postcheck action is run after the content is verified,
-- in order to detect situations where the file is changed while being -- in order to detect situations where the file is changed while being
-- verified (particularly in direct mode). -- verified (particularly in direct mode).
checkBackendOr' :: (Key -> Annex String) -> Backend -> Key -> FilePath -> AssociatedFile -> Annex Bool -> Annex Bool checkBackendOr' :: (Key -> Annex String) -> Backend -> Key -> FilePath -> ActionItem -> Annex Bool -> Annex Bool
checkBackendOr' bad backend key file (AssociatedFile afile) postcheck = checkBackendOr' bad backend key file ai postcheck =
case Types.Backend.verifyKeyContent backend of case Types.Backend.verifyKeyContent backend of
Nothing -> return True Nothing -> return True
Just verifier -> do Just verifier -> do
@ -432,10 +434,10 @@ checkBackendOr' bad backend key file (AssociatedFile afile) postcheck =
( do ( do
unless ok $ do unless ok $ do
msg <- bad key msg <- bad key
warning $ concat $ catMaybes warning $ concat
[ afile <> Just ": " [ actionItemDesc ai key
, Just "Bad file content; " , ": Bad file content; "
, Just msg , msg
] ]
return ok return ok
, return True , return True