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.

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

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 }