bd5affa362
This deals with the possible security problem that someone could make an unusually low UUID and generate keys that are all constructed to hash to a number that, mod the number of repositories in the group, == 0. So balanced preferred content would always put those keys in the repository with the low UUID as long as the group contains the number of repositories that the attacker anticipated. Presumably the attacker than holds the data for ransom? Dunno. Anyway, the partial solution is to use HMAC (sha256) with all the UUIDs combined together as the "secret", and the key as the "message". Now any change in the set of UUIDs in a group will invalidate the attacker's constructed keys from hashing to anything in particular. Given that there are plenty of other things someone can do if they can write to the repository -- including modifying preferred content so only their repository wants files, and numcopies so other repositories drom them -- this seems like safeguard enough. Note that, in balancedPicker, combineduuids is memoized.
42 lines
1.2 KiB
Haskell
42 lines
1.2 KiB
Haskell
{- Balancing between UUIDs
|
|
-
|
|
- Copyright 2024 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.Balanced where
|
|
|
|
import Key
|
|
import Types.UUID
|
|
import Utility.Hash
|
|
|
|
import Data.List
|
|
import Data.Maybe
|
|
import Data.Bits (shiftL)
|
|
import qualified Data.Set as S
|
|
import qualified Data.ByteArray as BA
|
|
|
|
type BalancedPicker = S.Set UUID -> Key -> UUID
|
|
|
|
-- The set of UUIDs provided here are all the UUIDs that are ever
|
|
-- expected to be picked amoung. A subset of that can be provided
|
|
-- when later using the BalancedPicker.
|
|
balancedPicker :: S.Set UUID -> BalancedPicker
|
|
balancedPicker s = \s' key ->
|
|
let n = calcMac tointeger HmacSha256 combineduuids (serializeKey' key)
|
|
in S.elemAt (fromIntegral (n `mod` m)) s'
|
|
where
|
|
combineduuids = mconcat (map fromUUID (S.toAscList s))
|
|
m = fromIntegral (S.size s)
|
|
|
|
tointeger :: Digest a -> Integer
|
|
tointeger = foldl' (\i b -> (i `shiftL` 8) + fromIntegral b) 0
|
|
. BA.unpack
|
|
|
|
{- The selection for a given key never changes. -}
|
|
prop_balanced_stable :: Bool
|
|
prop_balanced_stable = balancedPicker us us k == toUUID "332"
|
|
where
|
|
us = S.fromList $ map (toUUID . show) [1..500 :: Int]
|
|
k = fromJust $ deserializeKey "WORM--test"
|