implement isCryptographicallySecureKey for VURL

Considerable difficulty to work around an import cycle. Had to move the
list of backends (except for VURL) to Backend.Variety to VURL could use
it.

Sponsored-by: Kevin Mueller on Patreon
This commit is contained in:
Joey Hess 2024-02-29 17:21:29 -04:00
parent e7b7ea78af
commit cc17ac423b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
16 changed files with 143 additions and 64 deletions

View file

@ -439,7 +439,7 @@ moveAnnex key af src = ifM (checkSecureHashes' key)
alreadyhave = liftIO $ R.removeLink src alreadyhave = liftIO $ R.removeLink src
checkSecureHashes :: Key -> Annex (Maybe String) checkSecureHashes :: Key -> Annex (Maybe String)
checkSecureHashes key = ifM (Backend.isCryptographicallySecure key) checkSecureHashes key = ifM (Backend.isCryptographicallySecureKey key)
( return Nothing ( return Nothing
, ifM (annexSecureHashesOnly <$> Annex.getGitConfig) , ifM (annexSecureHashesOnly <$> Annex.getGitConfig)
( return $ Just $ "annex.securehashesonly blocked adding " ++ decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " key" ( return $ Just $ "annex.securehashesonly blocked adding " ++ decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " key"

View file

@ -42,7 +42,7 @@ import Types.WorkerPool
import Annex.WorkerPool import Annex.WorkerPool
import Annex.TransferrerPool import Annex.TransferrerPool
import Annex.StallDetection import Annex.StallDetection
import Backend (isCryptographicallySecure) import Backend (isCryptographicallySecureKey)
import Types.StallDetection import Types.StallDetection
import qualified Utility.RawFilePath as R import qualified Utility.RawFilePath as R
@ -276,10 +276,10 @@ runTransferrer sd r k afile retrydecider direction _witness =
preCheckSecureHashes :: Observable v => Key -> Maybe Backend -> Annex v -> Annex v preCheckSecureHashes :: Observable v => Key -> Maybe Backend -> Annex v -> Annex v
preCheckSecureHashes k meventualbackend a = case meventualbackend of preCheckSecureHashes k meventualbackend a = case meventualbackend of
Just eventualbackend -> go Just eventualbackend -> go
(Types.Backend.isCryptographicallySecure eventualbackend) (pure (Types.Backend.isCryptographicallySecure eventualbackend))
(Types.Backend.backendVariety eventualbackend) (Types.Backend.backendVariety eventualbackend)
Nothing -> go Nothing -> go
(isCryptographicallySecure k) (isCryptographicallySecureKey k)
(fromKey keyVariety k) (fromKey keyVariety k)
where where
go checksecure variety = ifM checksecure go checksecure variety = ifM checksecure

View file

@ -18,10 +18,12 @@ module Backend (
lookupBuiltinBackendVariety, lookupBuiltinBackendVariety,
maybeLookupBackendVariety, maybeLookupBackendVariety,
isStableKey, isStableKey,
isCryptographicallySecureKey,
isCryptographicallySecure, isCryptographicallySecure,
isCryptographicallySecure',
) where ) where
import qualified Data.Map as M
import Annex.Common import Annex.Common
import qualified Annex import qualified Annex
import Annex.CheckAttr import Annex.CheckAttr
@ -29,18 +31,12 @@ import Types.Key
import Types.KeySource import Types.KeySource
import qualified Types.Backend as B import qualified Types.Backend as B
import Utility.Metered import Utility.Metered
import Backend.Variety
-- When adding a new backend, import it here and add it to the builtinList. import qualified Backend.VURL
import qualified Backend.Hash
import qualified Backend.WORM
import qualified Backend.URL
import qualified Backend.External
import qualified Data.Map as M
{- Built-in backends. Does not include externals. -} {- Built-in backends. Does not include externals. -}
builtinList :: [Backend] builtinList :: [Backend]
builtinList = Backend.Hash.backends ++ Backend.WORM.backends ++ Backend.URL.backends builtinList = regularBackendList ++ Backend.VURL.backends
{- The default hashing backend. This must use a cryptographically secure {- The default hashing backend. This must use a cryptographically secure
- hash. -} - hash. -}
@ -107,25 +103,24 @@ lookupBuiltinBackendVariety :: KeyVariety -> Backend
lookupBuiltinBackendVariety v = fromMaybe (giveup (unknownBackendVarietyMessage v)) $ lookupBuiltinBackendVariety v = fromMaybe (giveup (unknownBackendVarietyMessage v)) $
maybeLookupBuiltinBackendVariety v maybeLookupBuiltinBackendVariety v
maybeLookupBackendVariety :: KeyVariety -> Annex (Maybe Backend)
maybeLookupBackendVariety (ExternalKey s hasext) =
Just <$> Backend.External.makeBackend s hasext
maybeLookupBackendVariety v =
pure $ M.lookup v varietyMap
maybeLookupBuiltinBackendVariety :: KeyVariety -> Maybe Backend maybeLookupBuiltinBackendVariety :: KeyVariety -> Maybe Backend
maybeLookupBuiltinBackendVariety v = M.lookup v varietyMap maybeLookupBuiltinBackendVariety v = M.lookup v varietyMap
maybeLookupBackendVariety :: KeyVariety -> Annex (Maybe Backend)
maybeLookupBackendVariety v = maybeLookupBackendVarietyMap v varietyMap
varietyMap :: M.Map KeyVariety Backend varietyMap :: M.Map KeyVariety Backend
varietyMap = M.fromList $ zip (map B.backendVariety builtinList) builtinList varietyMap = makeVarietyMap builtinList
isStableKey :: Key -> Annex Bool isStableKey :: Key -> Annex Bool
isStableKey k = maybe False (`B.isStableKey` k) isStableKey k = maybe False (`B.isStableKey` k)
<$> maybeLookupBackendVariety (fromKey keyVariety k) <$> maybeLookupBackendVariety (fromKey keyVariety k)
isCryptographicallySecure :: Key -> Annex Bool isCryptographicallySecureKey :: Key -> Annex Bool
isCryptographicallySecure k = maybe (pure False) isCryptographicallySecure' isCryptographicallySecureKey k = maybe
(pure False)
(\b -> B.isCryptographicallySecureKey b k)
=<< maybeLookupBackendVariety (fromKey keyVariety k) =<< maybeLookupBackendVariety (fromKey keyVariety k)
isCryptographicallySecure' :: Backend -> Annex Bool isCryptographicallySecure :: Backend -> Bool
isCryptographicallySecure' = B.isCryptographicallySecure isCryptographicallySecure = B.isCryptographicallySecure

View file

@ -72,7 +72,8 @@ makeBackend' ebname@(ExternalBackendName bname) hasext (Right p) = do
, canUpgradeKey = Nothing , canUpgradeKey = Nothing
, fastMigrate = Nothing , fastMigrate = Nothing
, isStableKey = const isstable , isStableKey = const isstable
, isCryptographicallySecure = pure iscryptographicallysecure , isCryptographicallySecure = iscryptographicallysecure
, isCryptographicallySecureKey = const (pure iscryptographicallysecure)
} }
makeBackend' ebname hasext (Left _) = return $ unavailBackend ebname hasext makeBackend' ebname hasext (Left _) = return $ unavailBackend ebname hasext
@ -86,7 +87,8 @@ unavailBackend (ExternalBackendName bname) hasext =
, canUpgradeKey = Nothing , canUpgradeKey = Nothing
, fastMigrate = Nothing , fastMigrate = Nothing
, isStableKey = const False , isStableKey = const False
, isCryptographicallySecure = pure False , isCryptographicallySecure = False
, isCryptographicallySecureKey = const (pure False)
} }
genKeyExternal :: ExternalBackendName -> HasExt -> KeySource -> MeterUpdate -> Annex Key genKeyExternal :: ExternalBackendName -> HasExt -> KeySource -> MeterUpdate -> Annex Key

View file

@ -81,7 +81,9 @@ genBackend hash = Backend
, canUpgradeKey = Just needsUpgrade , canUpgradeKey = Just needsUpgrade
, fastMigrate = Just trivialMigrate , fastMigrate = Just trivialMigrate
, isStableKey = const True , isStableKey = const True
, isCryptographicallySecure = pure $ cryptographicallySecure hash , isCryptographicallySecure = cryptographicallySecure hash
, isCryptographicallySecureKey = const $ pure $
cryptographicallySecure hash
} }
genBackendE :: Hash -> Backend genBackendE :: Hash -> Backend

View file

@ -1,5 +1,4 @@
{- git-annex "URL" and "VURL" backends -- keys whose content is {- git-annex URL backend -- keys whose content is available from urls.
- available from urls.
- -
- Copyright 2011-2024 Joey Hess <id@joeyh.name> - Copyright 2011-2024 Joey Hess <id@joeyh.name>
- -
@ -15,10 +14,9 @@ import Annex.Common
import Types.Key import Types.Key
import Types.Backend import Types.Backend
import Backend.Utilities import Backend.Utilities
import Logs.EquivilantKeys
backends :: [Backend] backends :: [Backend]
backends = [backendURL, backendVURL] backends = [backendURL]
backendURL :: Backend backendURL :: Backend
backendURL = Backend backendURL = Backend
@ -31,25 +29,8 @@ backendURL = Backend
-- The content of an url can change at any time, so URL keys are -- The content of an url can change at any time, so URL keys are
-- not stable. -- not stable.
, isStableKey = const False , isStableKey = const False
, isCryptographicallySecure = pure False , isCryptographicallySecure = False
} , isCryptographicallySecureKey = const (pure False)
backendVURL :: Backend
backendVURL = Backend
{ backendVariety = VURLKey
, genKey = Nothing
, verifyKeyContent = Nothing -- TODO
, verifyKeyContentIncrementally = Nothing -- TODO
, 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
, isCryptographicallySecure = pure False
-- TODO it is when all recorded hashes are
} }
{- Every unique url has a corresponding key. -} {- Every unique url has a corresponding key. -}

View file

@ -1,6 +1,6 @@
{- git-annex backend utilities {- git-annex backend utilities
- -
- Copyright 2012-2020 Joey Hess <id@joeyh.name> - Copyright 2012-2024 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}

59
Backend/VURL.hs Normal file
View file

@ -0,0 +1,59 @@
{- 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
backends :: [Backend]
backends = [backendVURL]
backendVURL :: Backend
backendVURL = Backend
{ backendVariety = VURLKey
, genKey = Nothing
, verifyKeyContent = Nothing -- TODO
, verifyKeyContentIncrementally = Nothing -- TODO
, 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

35
Backend/Variety.hs Normal file
View file

@ -0,0 +1,35 @@
{- git-annex backend varieties
-
- Copyright 2012-2024 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Backend.Variety where
import qualified Data.Map as M
import Annex.Common
import Types.Key
import Types.Backend
import qualified Backend.External
-- When adding a new backend, import it here and add it to the builtinList.
import qualified Backend.Hash
import qualified Backend.WORM
import qualified Backend.URL
{- Regular backends. Does not include externals or VURL. -}
regularBackendList :: [Backend]
regularBackendList = Backend.Hash.backends
++ Backend.WORM.backends
++ Backend.URL.backends
makeVarietyMap :: [Backend] -> M.Map KeyVariety Backend
makeVarietyMap l = M.fromList $ zip (map backendVariety l) l
maybeLookupBackendVarietyMap :: KeyVariety -> M.Map KeyVariety Backend -> Annex (Maybe Backend)
maybeLookupBackendVarietyMap (ExternalKey s hasext) _varitymap =
Just <$> Backend.External.makeBackend s hasext
maybeLookupBackendVarietyMap v varietymap =
pure $ M.lookup v varietymap

View file

@ -32,7 +32,8 @@ backend = Backend
, canUpgradeKey = Just needsUpgrade , canUpgradeKey = Just needsUpgrade
, fastMigrate = Just removeProblemChars , fastMigrate = Just removeProblemChars
, isStableKey = const True , isStableKey = const True
, isCryptographicallySecure = pure False , isCryptographicallySecure = False
, isCryptographicallySecureKey = const (pure False)
} }
{- The key includes the file size, modification time, and the {- The key includes the file size, modification time, and the

View file

@ -328,8 +328,8 @@ verifyLocationLog key keystatus ai = do
{- Warn when annex.securehashesonly is set and content using an {- Warn when annex.securehashesonly is set and content using an
- insecure hash is present. This should only be able to happen - insecure hash is present. This should only be able to happen
- if the repository already contained the content before the - if the repository already contained the content before the
- config was set. -} - config was set, or of course if a hash was broken. -}
whenM (pure present <&&> (not <$> Backend.isCryptographicallySecure key)) $ whenM (pure present <&&> (not <$> Backend.isCryptographicallySecureKey key)) $
whenM (annexSecureHashesOnly <$> Annex.getGitConfig) $ whenM (annexSecureHashesOnly <$> Annex.getGitConfig) $
warning $ "** Despite annex.securehashesonly being set, " <> QuotedPath obj <> " has content present in the annex using an insecure " <> UnquotedString (decodeBS (formatKeyVariety (fromKey keyVariety key))) <> " key" warning $ "** Despite annex.securehashesonly being set, " <> QuotedPath obj <> " has content present in the annex using an insecure " <> UnquotedString (decodeBS (formatKeyVariety (fromKey keyVariety key))) <> " key"

View file

@ -575,7 +575,7 @@ addSecureHash = addLimit $ Right limitSecureHash
limitSecureHash :: MatchFiles Annex limitSecureHash :: MatchFiles Annex
limitSecureHash = MatchFiles limitSecureHash = MatchFiles
{ matchAction = const $ checkKey isCryptographicallySecure { matchAction = const $ checkKey isCryptographicallySecureKey
, matchNeedsFileName = False , matchNeedsFileName = False
, matchNeedsFileContent = False , matchNeedsFileContent = False
, matchNeedsKey = True , matchNeedsKey = True

View file

@ -171,10 +171,9 @@ downloadKey urlincludeexclude key _af dest p vc =
-- Make sure to pick a backend that is cryptographically -- Make sure to pick a backend that is cryptographically
-- secure. -- secure.
db <- defaultBackend db <- defaultBackend
b <- ifM (isCryptographicallySecure' db) let b = if isCryptographicallySecure db
( pure db then db
, pure defaultHashBackend else defaultHashBackend
)
showSideAction (UnquotedString descChecksum) showSideAction (UnquotedString descChecksum)
(hashk, _) <- genKey ks nullMeterUpdate b (hashk, _) <- genKey ks nullMeterUpdate b
unless (hashk `elem` eks) $ unless (hashk `elem` eks) $

View file

@ -2,7 +2,7 @@
- -
- Most things should not need this, using Types instead - Most things should not need this, using Types instead
- -
- Copyright 2010-2021 Joey Hess <id@joeyh.name> - Copyright 2010-2024 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
@ -33,8 +33,11 @@ data BackendA a = Backend
-- Checks if a key is known (or assumed) to always refer to the -- Checks if a key is known (or assumed) to always refer to the
-- same data. -- same data.
, isStableKey :: Key -> Bool , isStableKey :: Key -> Bool
-- Are all keys using this backend verified using a cryptographically
-- secure hash?
, isCryptographicallySecure :: Bool
-- Checks if a key is verified using a cryptographically secure hash. -- Checks if a key is verified using a cryptographically secure hash.
, isCryptographicallySecure :: a Bool , isCryptographicallySecureKey :: Key -> a Bool
} }
instance Show (BackendA a) where instance Show (BackendA a) where

View file

@ -85,8 +85,8 @@ cryptographically secure hashes were recorded for a VURL. But of course,
which hashes are considered secure can change. Still, let's start by which hashes are considered secure can change. Still, let's start by
only allowing currently secure hashes to be used for VURLs. This way, only allowing currently secure hashes to be used for VURLs. This way,
when there are multiple hashes recorded for a VURL, they will all be when there are multiple hashes recorded for a VURL, they will all be
cryptographically secure, and so the VURL can have cryptographically secure normally, and so the VURL can be considered
`isCryptographicallySecure = True`. If any of the hashes later becomes cryptographically secure itself. If any of the hashes later becomes
broken, the VURL will no longer be treated as cryptographically secure, broken, the VURL will no longer be treated as cryptographically secure,
because the broken hash can be used to verify its content. because the broken hash can be used to verify its content.
In that case, the user would probably just migrate to a hash-based key, In that case, the user would probably just migrate to a hash-based key,

View file

@ -583,6 +583,8 @@ Executable git-annex
Backend.Hash Backend.Hash
Backend.URL Backend.URL
Backend.Utilities Backend.Utilities
Backend.Variety
Backend.VURL
Backend.WORM Backend.WORM
Benchmark Benchmark
Build.BundledPrograms Build.BundledPrograms