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.

diff --git a/Logs/Cluster.hs b/Logs/Cluster.hs
index 76c520afcc1fc62bfda28ae920a7ee96d85286b2..0bf3d5358d17126ff64df6f333f39730f66485eb 100644 (file)
--- a/Logs/Cluster.hs
+++ b/Logs/Cluster.hs
@@ -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)))
 

diff --git a/Types/Cluster.hs b/Types/Cluster.hs
index 1bf96c9c9f29cc128ebcaeca1321d0d8716bff1c..0ce3e0db0b65490b57f4250b64762156e2e6f392 100644 (file)
--- a/Types/Cluster.hs
+++ b/Types/Cluster.hs
@@ -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 }