make cluster UUIDs distinguishable from any other repository UUID

A cluster UUID is a version 8 UUID, with first octets 'a' and 'c'.
The rest of the content will be random.

This avoids a class of attack where the UUID of a repository is used as
the UUID of a cluster, which will prevent git-annex from updating
location logs for that repository. I don't know why someone would want
to do that, but let's prevent it.

Also, isClusterUUID make it easy to filter out cluster UUIDs when
writing the location logs.
This commit is contained in:
Joey Hess 2024-06-14 11:07:31 -04:00
parent 6d59118b29
commit da3c0115cb
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 50 additions and 5 deletions

View file

@ -8,7 +8,7 @@
{-# LANGUAGE OverloadedStrings, TupleSections #-}
module Logs.Cluster (
ClusterUUID(..),
ClusterUUID,
ClusterNodeUUID(..),
getClusters,
recordCluster,
@ -33,14 +33,17 @@ import qualified Data.ByteString.Lazy as L
-- TODO caching
getClusters :: Annex Clusters
getClusters = do
m <- M.mapKeys ClusterUUID . M.map value
. fromMapLog . parseClusterLog
m <- convclusteruuids . M.map value . fromMapLog . parseClusterLog
<$> Annex.Branch.get clusterLog
return $ Clusters
{ clusterUUIDs = m
, clusterNodeUUIDs = M.foldlWithKey inverter mempty m
}
where
convclusteruuids :: M.Map UUID (S.Set ClusterNodeUUID) -> M.Map ClusterUUID (S.Set ClusterNodeUUID)
convclusteruuids = M.fromList
. mapMaybe (\(mk, v) -> (, v) <$> mk)
. M.toList . M.mapKeys mkClusterUUID
inverter m k v = M.unionWith (<>) m
(M.fromList (map (, S.singleton k) (S.toList v)))

View file

@ -5,17 +5,59 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
module Types.Cluster where
{-# LANGUAGE CPP, OverloadedStrings #-}
module Types.Cluster (
ClusterUUID,
mkClusterUUID,
isClusterUUID,
fromClusterUUID,
ClusterNodeUUID(..),
Clusters(..),
) where
import Types.UUID
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.ByteString as B
import Data.Char
-- The UUID of a cluster as a whole.
newtype ClusterUUID = ClusterUUID { fromClusterUUID :: UUID }
--
-- Cluster UUIDs are specially constructed so that regular repository UUIDs
-- can never be used as a cluster UUID. This is ncessary for security.
-- They are a version 8 UUID with the first octet set to 'a' and the second
-- to 'c'.
newtype ClusterUUID = ClusterUUID UUID
deriving (Show, Eq, Ord)
-- Smart constructor for a ClusterUUID.
--
-- The input UUID can be a regular UUID (eg V4). It is converted to a valid
-- cluster uuid.
mkClusterUUID :: UUID -> Maybe ClusterUUID
mkClusterUUID (UUID b)
| B.length b > 14 = Just $ ClusterUUID $ UUID $
"ac" <> B.drop 2 (B.take 14 b) <> "8" <> B.drop 15 b
| otherwise = Nothing
mkClusterUUID NoUUID = Nothing
isClusterUUID :: UUID -> Bool
isClusterUUID (UUID b)
| B.take 2 b == "ac" =
#if MIN_VERSION_bytestring(0,11,0)
B.indexMaybe b 14 == Just eight
#else
B.length b > 14 && B.head (B.drop 14 b) == eight
#endif
where
eight = fromIntegral (ord '8')
isClusterUUID _ = False
fromClusterUUID :: ClusterUUID -> UUID
fromClusterUUID (ClusterUUID u) = u
-- The UUID of a node in a cluster. The UUID can be either the UUID of a
-- repository, or of another cluster.
newtype ClusterNodeUUID = ClusterNodeUUID { fromClusterNodeUUID :: UUID }