move verifyKeyContent to Annex.Verify
The goal is that Database.Keys be able to use it; it can't use Annex.Content.Presence due to an import loop. Several other things also needed to be moved to Annex.Verify as a conseqence.
This commit is contained in:
parent
0ec5919bbe
commit
de482c7eeb
8 changed files with 91 additions and 88 deletions
|
@ -66,6 +66,7 @@ import Annex.Common
|
|||
import Annex.Content.Presence
|
||||
import Annex.Content.LowLevel
|
||||
import Annex.Content.PointerFile
|
||||
import Annex.Verify
|
||||
import qualified Git
|
||||
import qualified Annex
|
||||
import qualified Annex.Queue
|
||||
|
@ -253,7 +254,7 @@ getViaTmpFromDisk rsp v key af action = checkallowed $ do
|
|||
-- RetrievalSecurityPolicy would cause verification to always fail.
|
||||
checkallowed a = case rsp of
|
||||
RetrievalAllKeysSecure -> a
|
||||
RetrievalVerifiableKeysSecure -> ifM (Backend.isVerifiable key)
|
||||
RetrievalVerifiableKeysSecure -> ifM (isVerifiable key)
|
||||
( a
|
||||
, ifM (annexAllowUnverifiedDownloads <$> Annex.getGitConfig)
|
||||
( a
|
||||
|
|
|
@ -17,11 +17,6 @@ module Annex.Content.Presence (
|
|||
isUnmodified,
|
||||
isUnmodified',
|
||||
isUnmodifiedCheap,
|
||||
verifyKeyContent,
|
||||
VerifyConfig(..),
|
||||
Verification(..),
|
||||
unVerified,
|
||||
warnUnverifiableInsecure,
|
||||
contentLockFile,
|
||||
) where
|
||||
|
||||
|
@ -29,15 +24,10 @@ import Annex.Common
|
|||
import qualified Annex
|
||||
import Annex.Verify
|
||||
import Annex.LockPool
|
||||
import Annex.WorkerPool
|
||||
import Types.Remote (unVerified, Verification(..), RetrievalSecurityPolicy(..))
|
||||
import qualified Types.Backend
|
||||
import qualified Backend
|
||||
import qualified Database.Keys
|
||||
import Types.Key
|
||||
import Types.Remote
|
||||
import Annex.InodeSentinal
|
||||
import Utility.InodeCache
|
||||
import Types.WorkerPool
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
#ifdef mingw32_HOST_OS
|
||||
|
@ -189,55 +179,3 @@ isUnmodifiedCheap' key fc = isUnmodifiedCheap'' fc
|
|||
|
||||
isUnmodifiedCheap'' :: InodeCache -> [InodeCache] -> Annex Bool
|
||||
isUnmodifiedCheap'' fc ic = anyM (compareInodeCaches fc) ic
|
||||
|
||||
{- Verifies that a file is the expected content of a key.
|
||||
-
|
||||
- Configuration can prevent verification, for either a
|
||||
- particular remote or always, unless the RetrievalSecurityPolicy
|
||||
- requires verification.
|
||||
-
|
||||
- Most keys have a known size, and if so, the file size is checked.
|
||||
-
|
||||
- When the key's backend allows verifying the content (via checksum),
|
||||
- it is checked.
|
||||
-
|
||||
- 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
|
||||
(_, Verified) -> return True
|
||||
(RetrievalVerifiableKeysSecure, _) -> ifM (Backend.isVerifiable k)
|
||||
( verify
|
||||
, ifM (annexAllowUnverifiedDownloads <$> Annex.getGitConfig)
|
||||
( verify
|
||||
, warnUnverifiableInsecure k >> return False
|
||||
)
|
||||
)
|
||||
(_, UnVerified) -> ifM (shouldVerify v)
|
||||
( verify
|
||||
, return True
|
||||
)
|
||||
(_, MustVerify) -> verify
|
||||
where
|
||||
verify = enteringStage VerifyStage $ verifysize <&&> verifycontent
|
||||
verifysize = case fromKey keySize k of
|
||||
Nothing -> return True
|
||||
Just size -> do
|
||||
size' <- liftIO $ catchDefaultIO 0 $ getFileSize f
|
||||
return (size' == size)
|
||||
verifycontent = Backend.maybeLookupBackendVariety (fromKey keyVariety k) >>= \case
|
||||
Nothing -> return True
|
||||
Just b -> case Types.Backend.verifyKeyContent b of
|
||||
Nothing -> return True
|
||||
Just verifier -> verifier k f
|
||||
|
||||
warnUnverifiableInsecure :: Key -> Annex ()
|
||||
warnUnverifiableInsecure k = warning $ unwords
|
||||
[ "Getting " ++ kv ++ " keys with this remote is not secure;"
|
||||
, "the content cannot be verified to be correct."
|
||||
, "(Use annex.security.allow-unverified-downloads to bypass"
|
||||
, "this safety check.)"
|
||||
]
|
||||
where
|
||||
kv = decodeBS (formatKeyVariety (fromKey keyVariety k))
|
||||
|
|
|
@ -16,7 +16,6 @@ import Utility.CopyFile
|
|||
import Utility.FileMode
|
||||
import Utility.Touch
|
||||
import Types.Backend
|
||||
import Backend
|
||||
import Annex.Verify
|
||||
|
||||
import Control.Concurrent
|
||||
|
|
|
@ -5,11 +5,28 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Annex.Verify where
|
||||
module Annex.Verify (
|
||||
VerifyConfig(..),
|
||||
shouldVerify,
|
||||
verifyKeyContent,
|
||||
Verification(..),
|
||||
unVerified,
|
||||
warnUnverifiableInsecure,
|
||||
isVerifiable,
|
||||
startVerifyKeyContentIncrementally,
|
||||
IncrementalVerifier(..),
|
||||
) where
|
||||
|
||||
import Annex.Common
|
||||
import qualified Annex
|
||||
import qualified Types.Remote
|
||||
import qualified Types.Backend
|
||||
import Types.Backend (IncrementalVerifier(..))
|
||||
import qualified Backend
|
||||
import Types.Remote (unVerified, Verification(..), RetrievalSecurityPolicy(..))
|
||||
import Annex.WorkerPool
|
||||
import Types.WorkerPool
|
||||
import Types.Key
|
||||
|
||||
data VerifyConfig = AlwaysVerify | NoVerify | RemoteVerify Remote | DefaultVerify
|
||||
|
||||
|
@ -23,3 +40,70 @@ shouldVerify (RemoteVerify r) =
|
|||
-- Export remotes are not key/value stores, so always verify
|
||||
-- content from them even when verification is disabled.
|
||||
<||> Types.Remote.isExportSupported r
|
||||
|
||||
{- Verifies that a file is the expected content of a key.
|
||||
-
|
||||
- Configuration can prevent verification, for either a
|
||||
- particular remote or always, unless the RetrievalSecurityPolicy
|
||||
- requires verification.
|
||||
-
|
||||
- Most keys have a known size, and if so, the file size is checked.
|
||||
-
|
||||
- When the key's backend allows verifying the content (via checksum),
|
||||
- it is checked.
|
||||
-
|
||||
- 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
|
||||
(_, Verified) -> return True
|
||||
(RetrievalVerifiableKeysSecure, _) -> ifM (isVerifiable k)
|
||||
( verify
|
||||
, ifM (annexAllowUnverifiedDownloads <$> Annex.getGitConfig)
|
||||
( verify
|
||||
, warnUnverifiableInsecure k >> return False
|
||||
)
|
||||
)
|
||||
(_, UnVerified) -> ifM (shouldVerify v)
|
||||
( verify
|
||||
, return True
|
||||
)
|
||||
(_, MustVerify) -> verify
|
||||
where
|
||||
verify = enteringStage VerifyStage $ verifysize <&&> verifycontent
|
||||
verifysize = case fromKey keySize k of
|
||||
Nothing -> return True
|
||||
Just size -> do
|
||||
size' <- liftIO $ catchDefaultIO 0 $ getFileSize f
|
||||
return (size' == size)
|
||||
verifycontent = Backend.maybeLookupBackendVariety (fromKey keyVariety k) >>= \case
|
||||
Nothing -> return True
|
||||
Just b -> case Types.Backend.verifyKeyContent b of
|
||||
Nothing -> return True
|
||||
Just verifier -> verifier k f
|
||||
|
||||
warnUnverifiableInsecure :: Key -> Annex ()
|
||||
warnUnverifiableInsecure k = warning $ unwords
|
||||
[ "Getting " ++ kv ++ " keys with this remote is not secure;"
|
||||
, "the content cannot be verified to be correct."
|
||||
, "(Use annex.security.allow-unverified-downloads to bypass"
|
||||
, "this safety check.)"
|
||||
]
|
||||
where
|
||||
kv = decodeBS (formatKeyVariety (fromKey keyVariety k))
|
||||
|
||||
isVerifiable :: Key -> Annex Bool
|
||||
isVerifiable k = maybe False (isJust . Types.Backend.verifyKeyContent)
|
||||
<$> Backend.maybeLookupBackendVariety (fromKey keyVariety k)
|
||||
|
||||
startVerifyKeyContentIncrementally :: VerifyConfig -> Key -> Annex (Maybe IncrementalVerifier)
|
||||
startVerifyKeyContentIncrementally verifyconfig k =
|
||||
ifM (shouldVerify verifyconfig)
|
||||
( Backend.maybeLookupBackendVariety (fromKey keyVariety k) >>= \case
|
||||
Just b -> case Types.Backend.verifyKeyContentIncrementally b of
|
||||
Just v -> Just <$> v k
|
||||
Nothing -> return Nothing
|
||||
Nothing -> return Nothing
|
||||
, return Nothing
|
||||
)
|
||||
|
|
18
Backend.hs
18
Backend.hs
|
@ -16,14 +16,11 @@ module Backend (
|
|||
maybeLookupBackendVariety,
|
||||
isStableKey,
|
||||
isCryptographicallySecure,
|
||||
isVerifiable,
|
||||
startVerifyKeyContentIncrementally,
|
||||
) where
|
||||
|
||||
import Annex.Common
|
||||
import qualified Annex
|
||||
import Annex.CheckAttr
|
||||
import Annex.Verify
|
||||
import Types.Key
|
||||
import Types.KeySource
|
||||
import qualified Types.Backend as B
|
||||
|
@ -125,18 +122,3 @@ isStableKey k = maybe False (`B.isStableKey` k)
|
|||
isCryptographicallySecure :: Key -> Annex Bool
|
||||
isCryptographicallySecure k = maybe False (`B.isCryptographicallySecure` k)
|
||||
<$> maybeLookupBackendVariety (fromKey keyVariety k)
|
||||
|
||||
isVerifiable :: Key -> Annex Bool
|
||||
isVerifiable k = maybe False (isJust . B.verifyKeyContent)
|
||||
<$> maybeLookupBackendVariety (fromKey keyVariety k)
|
||||
|
||||
startVerifyKeyContentIncrementally :: VerifyConfig -> Key -> Annex (Maybe B.IncrementalVerifier)
|
||||
startVerifyKeyContentIncrementally verifyconfig k =
|
||||
ifM (shouldVerify verifyconfig)
|
||||
( maybeLookupBackendVariety (fromKey keyVariety k) >>= \case
|
||||
Just b -> case B.verifyKeyContentIncrementally b of
|
||||
Just v -> Just <$> v k
|
||||
Nothing -> return Nothing
|
||||
Nothing -> return Nothing
|
||||
, return Nothing
|
||||
)
|
||||
|
|
|
@ -23,8 +23,7 @@ import P2P.IO
|
|||
import Logs.Location
|
||||
import Types.NumCopies
|
||||
import Utility.Metered
|
||||
import Types.Backend (IncrementalVerifier(..))
|
||||
import Backend
|
||||
import Annex.Verify
|
||||
|
||||
import Control.Monad.Free
|
||||
import Control.Concurrent.STM
|
||||
|
|
|
@ -13,7 +13,7 @@ import Annex.Common
|
|||
import Types.Remote
|
||||
import Types.Key
|
||||
import Types.ProposedAccepted
|
||||
import Backend
|
||||
import Annex.Verify
|
||||
import Remote.Helper.Encryptable (encryptionIsEnabled)
|
||||
import qualified Database.Export as Export
|
||||
import qualified Database.ContentIdentifier as ContentIdentifier
|
||||
|
|
|
@ -17,7 +17,7 @@ import Annex.Content
|
|||
import Messages.Progress
|
||||
import Utility.Metered
|
||||
import Types.NumCopies
|
||||
import Backend
|
||||
import Annex.Verify
|
||||
|
||||
import Control.Concurrent
|
||||
|
||||
|
|
Loading…
Reference in a new issue