diff --git a/Annex/Balanced.hs b/Annex/Balanced.hs new file mode 100644 index 0000000000..46089ea0be --- /dev/null +++ b/Annex/Balanced.hs @@ -0,0 +1,42 @@ +{- Balancing between UUIDs + - + - Copyright 2024 Joey Hess + - + - 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" diff --git a/Crypto.hs b/Crypto.hs index 3fa6d781d1..192c19bc78 100644 --- a/Crypto.hs +++ b/Crypto.hs @@ -245,7 +245,7 @@ decrypt cmd c cipher feeder reader = case cipher of macWithCipher :: Mac -> Cipher -> S.ByteString -> String macWithCipher mac c = macWithCipher' mac (cipherMac c) macWithCipher' :: Mac -> S.ByteString -> S.ByteString -> String -macWithCipher' mac c s = calcMac mac c s +macWithCipher' mac c s = calcMac show mac c s {- Ensure that macWithCipher' returns the same thing forevermore. -} prop_HmacSha1WithCipher_sane :: Bool diff --git a/Limit.hs b/Limit.hs index edbb5999c6..850abfaaef 100644 --- a/Limit.hs +++ b/Limit.hs @@ -37,7 +37,6 @@ import Git.Types (RefDate(..)) import Utility.Glob import Utility.HumanTime import Utility.DataUnits -import Utility.Hash import qualified Database.Keys import qualified Utility.RawFilePath as R import Backend @@ -48,8 +47,6 @@ import qualified Data.Set as S import qualified Data.Map as M import qualified System.FilePath.ByteString as P import System.PosixCompat.Files (accessTime, isSymbolicLink) -import qualified Data.ByteArray as BA -import Data.Bits (shiftL) {- Some limits can look at the current status of files on - disk, or in the annex. This allows controlling which happens. -} @@ -594,14 +591,13 @@ limitBalanced mu getgroupmap groupname = do limitFullyBalanced :: Maybe UUID -> Annex GroupMap -> MkLimit Annex limitFullyBalanced mu getgroupmap groupname = Right $ MatchFiles { matchAction = const $ checkKey $ \key -> do - groupmembers <- fromMaybe S.empty - . M.lookup (toGroup groupname) - . uuidsByGroup - <$> getgroupmap + gm <- getgroupmap + let groupmembers = fromMaybe S.empty $ + M.lookup g (uuidsByGroup gm) -- TODO free space checking - return $ case mu of - Just u -> u == pickBalanced key groupmembers - Nothing -> False + return $ case (mu, M.lookup g (balancedPickerByGroup gm)) of + (Just u, Just picker) -> u == picker groupmembers key + _ -> False , matchNeedsFileName = False , matchNeedsFileContent = False , matchNeedsKey = True @@ -609,22 +605,7 @@ limitFullyBalanced mu getgroupmap groupname = Right $ MatchFiles , matchDesc = "fullybalanced" =? groupname } where - -pickBalanced :: Key -> S.Set UUID -> UUID -pickBalanced key s = - let m = fromIntegral (S.size s) - n = keyToInteger key - in S.elemAt (fromIntegral (n `mod` m)) s - -{- Converts a Key into a stable Integer. - - - - The SHA2 hash of the key is used to constrain the size of the Integer - - and to get an even distribution. - -} -keyToInteger :: Key -> Integer -keyToInteger key = - foldl' (\i b -> (i `shiftL` 8) + fromIntegral b) 0 $ - BA.unpack (sha2_256s (serializeKey' key)) + g = toGroup groupname {- Adds a limit to skip files not using a specified key-value backend. -} addInBackend :: String -> Annex () diff --git a/Logs/Group.hs b/Logs/Group.hs index bb5d17a033..549519004e 100644 --- a/Logs/Group.hs +++ b/Logs/Group.hs @@ -1,6 +1,6 @@ {- git-annex group log - - - Copyright 2012, 2019 Joey Hess + - Copyright 2012-2024 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -29,6 +29,7 @@ import qualified Annex import Logs.UUIDBased import Types.Group import Types.StandardGroups +import Annex.Balanced {- Returns the groups of a given repo UUID. -} lookupGroups :: UUID -> Annex (S.Set Group) @@ -82,7 +83,7 @@ groupMapLoad = do return m makeGroupMap :: M.Map UUID (S.Set Group) -> GroupMap -makeGroupMap byuuid = GroupMap byuuid bygroup +makeGroupMap byuuid = GroupMap byuuid bygroup (M.map balancedPicker bygroup) where bygroup = M.fromListWith S.union $ concatMap explode $ M.toList byuuid diff --git a/Test.hs b/Test.hs index b752d4dc22..d454a3a1b1 100644 --- a/Test.hs +++ b/Test.hs @@ -63,6 +63,7 @@ import qualified Annex.VectorClock import qualified Annex.VariantFile import qualified Annex.View import qualified Annex.View.ViewedFile +import qualified Annex.Balanced import qualified Logs.View import qualified Command.TestRemote import qualified Utility.Path.Tests @@ -186,6 +187,7 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" $ , testProperty "prop_view_roundtrips" Annex.View.prop_view_roundtrips , testProperty "prop_viewedFile_rountrips" Annex.View.ViewedFile.prop_viewedFile_roundtrips , testProperty "prop_standardGroups_parse" Logs.PreferredContent.prop_standardGroups_parse + , testProperty "prop_balanced_stable" Annex.Balanced.prop_balanced_stable ] ++ map (uncurry testProperty) combos where combos = concat diff --git a/Types/Group.hs b/Types/Group.hs index cd9975a967..03c14099c2 100644 --- a/Types/Group.hs +++ b/Types/Group.hs @@ -1,6 +1,6 @@ {- git-annex repo groups - - - Copyright 2012, 2019 Joey Hess + - Copyright 2012-2024 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -15,6 +15,7 @@ module Types.Group ( import Types.UUID import Utility.FileSystemEncoding +import Annex.Balanced import qualified Data.Map as M import qualified Data.Set as S @@ -32,7 +33,8 @@ toGroup = Group . encodeBS data GroupMap = GroupMap { groupsByUUID :: M.Map UUID (S.Set Group) , uuidsByGroup :: M.Map Group (S.Set UUID) + , balancedPickerByGroup :: M.Map Group BalancedPicker } emptyGroupMap :: GroupMap -emptyGroupMap = GroupMap M.empty M.empty +emptyGroupMap = GroupMap M.empty M.empty M.empty diff --git a/Utility/Hash.hs b/Utility/Hash.hs index 84b4718aba..a80ed1c2b3 100644 --- a/Utility/Hash.hs +++ b/Utility/Hash.hs @@ -6,6 +6,7 @@ -} {-# LANGUAGE BangPatterns, PackageImports #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-} module Utility.Hash ( @@ -16,7 +17,6 @@ module Utility.Hash ( sha2_224_context, sha2_256, sha2_256_context, - sha2_256s, sha2_384, sha2_384_context, sha2_512, @@ -107,9 +107,6 @@ sha2_256 = hashlazy sha2_256_context :: Context SHA256 sha2_256_context = hashInit -sha2_256s :: S.ByteString -> Digest SHA256 -sha2_256s = hash - sha2_384 :: L.ByteString -> Digest SHA384 sha2_384 = hashlazy @@ -267,25 +264,26 @@ data Mac = HmacSha1 | HmacSha224 | HmacSha256 | HmacSha384 | HmacSha512 deriving (Eq) calcMac - :: Mac -- ^ MAC + :: (forall a. Digest a -> t) -- ^ applied to MAC'ed message + -> Mac -- ^ MAC -> S.ByteString -- ^ secret key -> S.ByteString -- ^ message - -> String -- ^ MAC'ed message, in hexadecimal -calcMac mac = case mac of + -> t +calcMac f mac = case mac of HmacSha1 -> use SHA1 HmacSha224 -> use SHA224 HmacSha256 -> use SHA256 HmacSha384 -> use SHA384 HmacSha512 -> use SHA512 where - use alg k m = show (hmacGetDigest (hmacWitnessAlg alg k m)) + use alg k m = f (hmacGetDigest (hmacWitnessAlg alg k m)) hmacWitnessAlg :: HashAlgorithm a => a -> S.ByteString -> S.ByteString -> HMAC a hmacWitnessAlg _ = hmac -- Check that all the MACs continue to produce the same. props_macs_stable :: [(String, Bool)] -props_macs_stable = map (\(desc, mac, result) -> (desc ++ " stable", calcMac mac key msg == result)) +props_macs_stable = map (\(desc, mac, result) -> (desc ++ " stable", calcMac show mac key msg == result)) [ ("HmacSha1", HmacSha1, "46b4ec586117154dacd49d664e5d63fdc88efb51") , ("HmacSha224", HmacSha224, "4c1f774863acb63b7f6e9daa9b5c543fa0d5eccf61e3ffc3698eacdd") , ("HmacSha256", HmacSha256, "f9320baf0249169e73850cd6156ded0106e2bb6ad8cab01b7bbbebe6d1065317") diff --git a/Utility/Verifiable.hs b/Utility/Verifiable.hs index a437d947f6..f24231d658 100644 --- a/Utility/Verifiable.hs +++ b/Utility/Verifiable.hs @@ -37,7 +37,7 @@ verify :: (Eq a, Show a) => Verifiable a -> Secret -> Bool verify v secret = v == mkVerifiable (verifiableVal v) secret calcDigest :: String -> Secret -> HMACDigest -calcDigest v secret = calcMac HmacSha1 secret (fromString v) +calcDigest v secret = calcMac show HmacSha1 secret (fromString v) prop_verifiable_sane :: TestableString -> TestableString -> Bool prop_verifiable_sane v ts = diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn index 2fc350c2b8..ca173df671 100644 --- a/doc/todo/git-annex_proxies.mdwn +++ b/doc/todo/git-annex_proxies.mdwn @@ -42,12 +42,6 @@ Planned schedule of work: not occur. Users wanting 2 copies can have 2 groups which are each balanced, although that would mean more repositories on more drives. -* picking a low UUID and picking keys that mod N == 0 would let an attacker - generate keys that balancing always puts on that UUID. To avoid this - use HMAC with the set of UUIDs and the key. Then any such attack can be - prevented by adding another UUID to the set, it could even be a dummy - UUID that is marked as having 0 size, so it will never be used. - * document balancing algo well enough that someone else could implement it from the design doc diff --git a/git-annex.cabal b/git-annex.cabal index a5de0d92b6..b7b147c0e9 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -519,6 +519,7 @@ Executable git-annex Annex.AdjustedBranch.Merge Annex.AdjustedBranch.Name Annex.AutoMerge + Annex.Balanced Annex.BloomFilter Annex.Branch Annex.Branch.Transitions