e7652b0997
This needs the content to be present in order to hash it. But it's not possible for a module used by Backend.URL to call inAnnex because that would entail a dependency loop. So instead, rely on the fact that Command.Migrate calls inAnnex before performing a migration. But, Command.ExamineKey calls fastMigrate and the key may or may not exist, and it's not wanting to actually perform a migration in any case. To handle that, had to add an additional value to fastMigrate to indicate whether the content is inAnnex. Factored generateEquivilantKey out of Remote.Web. Note that migrateFromURLToVURL hardcodes use of the SHA256E backend. It would have been difficult not to, given all the dependency loop issues. But --backend and annex.backend are used to tell git-annex migrate to use VURL in any case, so there's no config knob that the user could expect to configure that. Sponsored-by: Brock Spratlen on Patreon
101 lines
3.4 KiB
Haskell
101 lines
3.4 KiB
Haskell
{- git-annex VURL backend -- like URL, but with hash-based verification
|
|
- of transfers between git-annex repositories.
|
|
-
|
|
- Copyright 2024 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Backend.VURL (
|
|
backends,
|
|
) where
|
|
|
|
import Annex.Common
|
|
import Types.Key
|
|
import Types.Backend
|
|
import Logs.EquivilantKeys
|
|
import Backend.Variety
|
|
import Backend.Hash (descChecksum)
|
|
import Utility.Hash
|
|
|
|
backends :: [Backend]
|
|
backends = [backendVURL]
|
|
|
|
backendVURL :: Backend
|
|
backendVURL = Backend
|
|
{ backendVariety = VURLKey
|
|
, genKey = Nothing
|
|
, verifyKeyContent = Just $ \k f -> do
|
|
equivkeys k >>= \case
|
|
-- Normally there will always be an key
|
|
-- recorded when a VURL's content is available,
|
|
-- because downloading the content from the web in
|
|
-- the first place records one.
|
|
[] -> return False
|
|
eks -> do
|
|
let check ek = getbackend ek >>= \case
|
|
Nothing -> pure False
|
|
Just b -> case verifyKeyContent b of
|
|
Just verify -> verify ek f
|
|
Nothing -> pure False
|
|
anyM check eks
|
|
, verifyKeyContentIncrementally = Just $ \k -> do
|
|
-- Run incremental verifiers for each equivilant key together,
|
|
-- and see if any of them succeed.
|
|
eks <- equivkeys k
|
|
let get = \ek -> getbackend ek >>= \case
|
|
Nothing -> pure Nothing
|
|
Just b -> case verifyKeyContentIncrementally b of
|
|
Nothing -> pure Nothing
|
|
Just va -> Just <$> va ek
|
|
l <- catMaybes <$> forM eks get
|
|
return $ IncrementalVerifier
|
|
{ updateIncrementalVerifier = \s ->
|
|
forM_ l $ flip updateIncrementalVerifier s
|
|
-- If there are no equivilant keys recorded somehow,
|
|
-- or if none of them support incremental verification,
|
|
-- this will return Nothing, which indicates that
|
|
-- incremental verification was not able to be
|
|
-- performed.
|
|
, finalizeIncrementalVerifier = do
|
|
r <- forM l finalizeIncrementalVerifier
|
|
return $ case catMaybes r of
|
|
[] -> Nothing
|
|
r' -> Just (or r')
|
|
, unableIncrementalVerifier =
|
|
forM_ l unableIncrementalVerifier
|
|
, positionIncrementalVerifier =
|
|
getM positionIncrementalVerifier l
|
|
, descIncrementalVerifier = descChecksum
|
|
}
|
|
, canUpgradeKey = Nothing
|
|
, fastMigrate = Nothing
|
|
-- Even if a hash is recorded on initial download from the web and
|
|
-- is used to verify every subsequent transfer including other
|
|
-- downloads from the web, in a split-brain situation there
|
|
-- can be more than one hash and different versions of the content.
|
|
-- So the content is not stable.
|
|
, isStableKey = const False
|
|
-- Not all keys using this backend are necessarily
|
|
-- cryptographically secure.
|
|
, isCryptographicallySecure = False
|
|
-- A key is secure when all recorded equivilant keys are.
|
|
-- If there are none recorded yet, it's secure because when
|
|
-- downloaded, an equivilant key that is cryptographically secure
|
|
-- will be constructed then.
|
|
, isCryptographicallySecureKey = \k ->
|
|
equivkeys k >>= \case
|
|
[] -> return True
|
|
l -> do
|
|
let check ek = getbackend ek >>= \case
|
|
Nothing -> pure False
|
|
Just b -> isCryptographicallySecureKey b ek
|
|
allM check l
|
|
}
|
|
where
|
|
equivkeys k = filter allowedequiv <$> getEquivilantKeys k
|
|
-- Don't allow using VURL keys as equivilant keys, because that
|
|
-- could let a crafted git-annex branch cause an infinite loop.
|
|
allowedequiv ek = fromKey keyVariety ek /= VURLKey
|
|
varietymap = makeVarietyMap regularBackendList
|
|
getbackend ek = maybeLookupBackendVarietyMap (fromKey keyVariety ek) varietymap
|