use hmac in balanced preferred content

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.

Annex/Balanced.hs

@@ -0,0 +1,42 @@
+{- 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"

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

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 ()

Logs/Group.hs

@@ -1,6 +1,6 @@
 {- git-annex group log
  -
- - Copyright 2012, 2019 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>
  -
  - 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

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

Types/Group.hs

@@ -1,6 +1,6 @@
 {- git-annex repo groups
  -
- - Copyright 2012, 2019 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>
  -
  - 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

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")

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 = 

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
 

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