split verifyKeyContent
This avoids it calling enteringStage VerifyStage when it's used in places that only fall back to verification rarely, and which might be called while in TransferStage and be going to perform a transfer after the verification.
This commit is contained in:
parent
d4fc506f27
commit
817ccbbc47
5 changed files with 13 additions and 8 deletions
|
@ -51,6 +51,7 @@ module Annex.Content (
|
|||
pruneTmpWorkDirBefore,
|
||||
isUnmodified,
|
||||
isUnmodifiedCheap,
|
||||
verifyKeyContentPostRetrieval,
|
||||
verifyKeyContent,
|
||||
VerifyConfig(..),
|
||||
Verification(..),
|
||||
|
@ -230,7 +231,7 @@ getViaTmpFromDisk rsp v key af action = checkallowed $ do
|
|||
_ -> MustVerify
|
||||
else verification
|
||||
if ok
|
||||
then ifM (verifyKeyContent rsp v verification' key tmpfile)
|
||||
then ifM (verifyKeyContentPostRetrieval rsp v verification' key tmpfile)
|
||||
( pruneTmpWorkDirBefore tmpfile (moveAnnex key af)
|
||||
, do
|
||||
warning "verification of content failed"
|
||||
|
|
|
@ -9,7 +9,6 @@ module Annex.Content.Presence.LowLevel where
|
|||
|
||||
import Annex.Common
|
||||
import Annex.Verify
|
||||
import Types.Remote
|
||||
import Annex.InodeSentinal
|
||||
import Utility.InodeCache
|
||||
|
||||
|
@ -17,7 +16,7 @@ isUnmodifiedLowLevel :: (Key -> [InodeCache] -> Annex ()) -> Key -> RawFilePath
|
|||
isUnmodifiedLowLevel addinodecaches key f fc ic =
|
||||
isUnmodifiedCheapLowLevel fc ic <||> expensivecheck
|
||||
where
|
||||
expensivecheck = ifM (verifyKeyContent RetrievalAllKeysSecure AlwaysVerify UnVerified key f)
|
||||
expensivecheck = ifM (verifyKeyContent key f)
|
||||
( do
|
||||
-- The file could have been modified while it was
|
||||
-- being verified. Detect that.
|
||||
|
|
|
@ -8,6 +8,7 @@
|
|||
module Annex.Verify (
|
||||
VerifyConfig(..),
|
||||
shouldVerify,
|
||||
verifyKeyContentPostRetrieval,
|
||||
verifyKeyContent,
|
||||
Verification(..),
|
||||
unVerified,
|
||||
|
@ -55,8 +56,8 @@ shouldVerify (RemoteVerify r) =
|
|||
- If the RetrievalSecurityPolicy requires verification and the key's
|
||||
- backend doesn't support it, the verification will fail.
|
||||
-}
|
||||
verifyKeyContent :: RetrievalSecurityPolicy -> VerifyConfig -> Verification -> Key -> RawFilePath -> Annex Bool
|
||||
verifyKeyContent rsp v verification k f = case (rsp, verification) of
|
||||
verifyKeyContentPostRetrieval :: RetrievalSecurityPolicy -> VerifyConfig -> Verification -> Key -> RawFilePath -> Annex Bool
|
||||
verifyKeyContentPostRetrieval rsp v verification k f = case (rsp, verification) of
|
||||
(_, Verified) -> return True
|
||||
(RetrievalVerifiableKeysSecure, _) -> ifM (isVerifiable k)
|
||||
( verify
|
||||
|
@ -71,7 +72,11 @@ verifyKeyContent rsp v verification k f = case (rsp, verification) of
|
|||
)
|
||||
(_, MustVerify) -> verify
|
||||
where
|
||||
verify = enteringStage VerifyStage $ verifysize <&&> verifycontent
|
||||
verify = enteringStage VerifyStage $ verifyKeyContent k f
|
||||
|
||||
verifyKeyContent :: Key -> RawFilePath -> Annex Bool
|
||||
verifyKeyContent k f = verifysize <&&> verifycontent
|
||||
where
|
||||
verifysize = case fromKey keySize k of
|
||||
Nothing -> return True
|
||||
Just size -> do
|
||||
|
|
|
@ -50,7 +50,7 @@ startSrcDest ps@(src:dest:[])
|
|||
where
|
||||
src' = toRawFilePath src
|
||||
go key = starting "reinject" ai si $
|
||||
ifM (verifyKeyContent RetrievalAllKeysSecure DefaultVerify UnVerified key src')
|
||||
ifM (verifyKeyContent key src')
|
||||
( perform src' key
|
||||
, giveup $ src ++ " does not have expected content of " ++ dest
|
||||
)
|
||||
|
|
|
@ -354,7 +354,7 @@ testExportTree runannex mkr mkk1 mkk2 =
|
|||
liftIO $ hClose h
|
||||
tryNonAsync (Remote.retrieveExport ea k testexportlocation tmp nullMeterUpdate) >>= \case
|
||||
Left _ -> return False
|
||||
Right () -> verifyKeyContent RetrievalAllKeysSecure AlwaysVerify UnVerified k (toRawFilePath tmp)
|
||||
Right () -> verifyKeyContentPostRetrieval RetrievalAllKeysSecure AlwaysVerify UnVerified k (toRawFilePath tmp)
|
||||
checkpresentexport ea k = Remote.checkPresentExport ea k testexportlocation
|
||||
removeexport ea k = Remote.removeExport ea k testexportlocation
|
||||
removeexportdirectory ea = case Remote.removeExportDirectory ea of
|
||||
|
|
Loading…
Reference in a new issue