implement cluster.log

Not used yet. (Or tested.)

I did consider making the log start with the uuid of the node, followed
by the cluster uuid (or uuids). That would perhaps mean a smaller write
to the git-annex branch when adding a node, but overall the log file
would be larger, and it will be read and cached near to startup on most
git-annex runs.

diff --git a/Logs.hs b/Logs.hs
index f86b27cd610c00d2c2cd8017831ed7cffb87db3b..2260c3899a91106ba5a437b89449f577637bf1ba 100644 (file)
--- a/Logs.hs
+++ b/Logs.hs
@@ -99,6 +99,7 @@ topLevelNewUUIDBasedLogs :: [RawFilePath]
 topLevelNewUUIDBasedLogs =
        [ exportLog
        , proxyLog
+       , clusterLog
        ]
 
 {- Other top-level logs. -}
@@ -158,6 +159,9 @@ exportLog = "export.log"
 proxyLog :: RawFilePath
 proxyLog = "proxy.log"
 
+clusterLog :: RawFilePath
+clusterLog = "cluster.log"
+
 {- This is not a log file, it's where exported treeishes get grafted into
  - the git-annex branch. -}
 exportTreeGraftPoint :: RawFilePath

diff --git a/Logs/Cluster.hs b/Logs/Cluster.hs
new file mode 100644 (file)
index 0000000..76c520a
--- /dev/null
+++ b/Logs/Cluster.hs
@@ -0,0 +1,82 @@
+{- git-annex cluster log
+ -
+ - Copyright 2024 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE OverloadedStrings, TupleSections #-}
+
+module Logs.Cluster (
+       ClusterUUID(..),
+       ClusterNodeUUID(..),
+       getClusters,
+       recordCluster,
+) where
+
+import qualified Annex
+import Annex.Common
+import qualified Annex.Branch
+import Types.Cluster
+import Logs
+import Logs.UUIDBased
+import Logs.MapLog
+import Annex.UUID
+
+import qualified Data.Set as S
+import qualified Data.Map as M
+import Data.ByteString.Builder
+import qualified Data.Attoparsec.ByteString as A
+import qualified Data.Attoparsec.ByteString.Char8 as A8
+import qualified Data.ByteString.Lazy as L
+
+-- TODO caching
+getClusters :: Annex Clusters
+getClusters = do
+       m <- M.mapKeys ClusterUUID . M.map value 
+               . fromMapLog . parseClusterLog
+               <$> Annex.Branch.get clusterLog
+       return $ Clusters
+               { clusterUUIDs = m
+               , clusterNodeUUIDs = M.foldlWithKey inverter mempty m
+               }
+  where
+       inverter m k v = M.unionWith (<>) m 
+               (M.fromList (map (, S.singleton k) (S.toList v)))
+
+recordCluster :: ClusterUUID -> S.Set ClusterNodeUUID -> Annex ()
+recordCluster clusteruuid nodeuuids = do
+       -- If a private UUID has been configured as a cluster node, 
+       -- avoid leaking it into the git-annex log.
+       privateuuids <- annexPrivateRepos <$> Annex.getGitConfig
+       let nodeuuids' = S.filter
+               (\(ClusterNodeUUID n) -> S.notMember n privateuuids)
+               nodeuuids
+       
+       c <- currentVectorClock
+       u <- getUUID
+       Annex.Branch.change (Annex.Branch.RegardingUUID [fromClusterUUID clusteruuid]) clusterLog $
+               (buildLogNew buildClusterNodeList)
+                       . changeLog c u nodeuuids'
+                       . parseClusterLog
+
+buildClusterNodeList :: S.Set ClusterNodeUUID -> Builder
+buildClusterNodeList = assemble 
+       . map (buildUUID . fromClusterNodeUUID) 
+       . S.toList
+  where
+       assemble [] = mempty
+       assemble (x:[]) = x
+       assemble (x:y:l) = x <> " " <> assemble (y:l)
+
+parseClusterLog :: L.ByteString -> Log (S.Set ClusterNodeUUID)
+parseClusterLog = parseLogNew parseClusterNodeList
+
+parseClusterNodeList :: A.Parser (S.Set ClusterNodeUUID)
+parseClusterNodeList = S.fromList <$> many parseword
+  where
+       parseword = parsenode
+               <* ((const () <$> A8.char ' ') <|> A.endOfInput)
+       parsenode = ClusterNodeUUID
+               <$> (toUUID <$> A8.takeWhile1 (/= ' '))
+

diff --git a/Logs/Proxy.hs b/Logs/Proxy.hs
index 15bc4e524ff91ddf640fb4b9c7abe3732921defe..4772ce02587c872b45fc308f312788372c8eb0a0 100644 (file)
--- a/Logs/Proxy.hs
+++ b/Logs/Proxy.hs
@@ -13,8 +13,6 @@ module Logs.Proxy (
        recordProxies,
 ) where
 
-import qualified Data.Map as M
-
 import qualified Annex
 import Annex.Common
 import qualified Annex.Branch
@@ -26,6 +24,7 @@ import Logs.MapLog
 import Annex.UUID
 
 import qualified Data.Set as S
+import qualified Data.Map as M
 import Data.ByteString.Builder
 import qualified Data.Attoparsec.ByteString as A
 import qualified Data.Attoparsec.ByteString.Char8 as A8

diff --git a/Types/Cluster.hs b/Types/Cluster.hs
new file mode 100644 (file)
index 0000000..1bf96c9
--- /dev/null
+++ b/Types/Cluster.hs
@@ -0,0 +1,29 @@
+{- git-annex cluster types
+ -
+ - Copyright 2024 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Types.Cluster where
+
+import Types.UUID
+
+import qualified Data.Set as S
+import qualified Data.Map as M
+
+-- The UUID of a cluster as a whole.
+newtype ClusterUUID = ClusterUUID { fromClusterUUID :: UUID }
+       deriving (Show, Eq, Ord)
+
+-- 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 }
+       deriving (Show, Eq, Ord)
+
+-- The same information is indexed two ways to allow fast lookups in either
+-- direction.
+data Clusters = Clusters
+       { clusterUUIDs :: M.Map ClusterUUID (S.Set ClusterNodeUUID)
+       , clusterNodeUUIDs :: M.Map ClusterNodeUUID (S.Set ClusterUUID)
+       }

diff --git a/doc/internals.mdwn b/doc/internals.mdwn
index 37e652d9ce29bbd4966c0f576fe634be7bf7051b..c2a0c7874bf2c46ae17cf8684451d7a11f65a99f 100644 (file)
--- a/doc/internals.mdwn
+++ b/doc/internals.mdwn
@@ -288,7 +288,7 @@ For example:
 These log files store per-remote content identifiers for keys.
 A given key may have any number of content identifiers.
 
-The format is a timestamp, followed by the uuid of the remote,
+The format is a timestamp, followed by the UUID of the remote,
 followed by the content identifiers which are separated by colons.
 If a content identifier contains a colon or \r or \n, it will be base64
 encoded. Base64 encoded values are indicated by prefixing them with "!".
@@ -312,17 +312,29 @@ For example, this logs that a remote has an object stored using both
 
 Used to record what repositories are accessible via a proxy.
 
-Each line starts with a timestamp, then the uuid of the repository
+Each line starts with a timestamp, then the UUID of the repository
 that can serve as a proxy, and then a list of the remotes that it can
 proxy to, separated by spaces.
 
-Each remote in the list consists of a uuid, followed by a colon (`:`)
-and then a remote name.
-       
+Each remote in the list consists of a repository's UUID, 
+followed by a colon (`:`) and then a remote name.
+
 For example:
 
     1317929100.012345s e605dca6-446a-11e0-8b2a-002170d25c55 26339d22-446b-11e0-9101-002170d25c55:foo c076460c-2290-11ef-be53-b7f0d194c863:bar
 
+## `cluster.log`
+
+Used to record the UUIDs of clusters, and the UUIDs of the nodes
+comprising each cluster. 
+
+Each line starts with a timestamp, then the UUID the cluster,
+followed by a list of the UUIDs of its nodes, separated by spaces.
+
+For example:
+
+    1317929100.012345s 5b070cc8-29b8-11ef-80e1-0fd524be241b 5c0c97d2-29b8-11ef-b1d2-5f3d1c80940d 5c40375e-29b8-11ef-814d-872959d2c013
+
 ## `schedule.log`
 
 Used to record scheduled events, such as periodic fscks.

diff --git a/git-annex.cabal b/git-annex.cabal
index c5e6c19d7c5d86f2b3bd4df9030f770244162f9d..24ff6bba034b23dd8cd9a305cb4f26f0f59b50ee 100644 (file)
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -815,6 +815,7 @@ Executable git-annex
     Logs.AdjustedBranchUpdate
     Logs.Chunk
     Logs.Chunk.Pure
+    Logs.Cluster
     Logs.Config
     Logs.ContentIdentifier
     Logs.ContentIdentifier.Pure
@@ -933,6 +934,7 @@ Executable git-annex
     Types.BranchState
     Types.CatFileHandles
     Types.CleanupActions
+    Types.Cluster
     Types.Command
     Types.Concurrency
     Types.Creds