added git-annex extendcluster

This works, but updatecluster does not work yet in multi-gateway
clusters, nor do gateways relay to other gateways.

CmdLine/GitAnnex.hs

@@ -126,6 +126,7 @@ import qualified Command.Restage
 import qualified Command.Undo
 import qualified Command.InitCluster
 import qualified Command.UpdateCluster
+import qualified Command.ExtendCluster
 import qualified Command.UpdateProxy
 import qualified Command.Version
 import qualified Command.RemoteDaemon
@@ -252,6 +253,7 @@ cmds testoptparser testrunner mkbenchmarkgenerator = map addGitAnnexCommonOption
 	, Command.Undo.cmd
 	, Command.InitCluster.cmd
 	, Command.UpdateCluster.cmd
+	, Command.ExtendCluster.cmd
 	, Command.UpdateProxy.cmd
 	, Command.Version.cmd
 	, Command.RemoteDaemon.cmd

Command/ExtendCluster.hs

@@ -0,0 +1,50 @@
+{- git-annex command
+ -
+ - Copyright 2024 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Command.ExtendCluster where
+
+import Command
+import qualified Annex
+import Types.Cluster
+import Config
+import qualified Remote
+
+import qualified Data.Map as M
+
+cmd :: Command
+cmd = command "extendcluster" SectionSetup "add an gateway to a cluster"
+	(paramPair paramRemote paramName) (withParams seek)
+
+seek :: CmdParams -> CommandSeek
+seek (remotename:clustername:[]) = Remote.byName (Just clusterremotename) >>= \case
+	Just clusterremote -> 
+		case mkClusterUUID (Remote.uuid clusterremote) of
+			Just cu -> commandAction $ start cu clustername
+			Nothing -> giveup $ clusterremotename 
+				++ " is not a cluster remote."
+	Nothing -> giveup $ "Expected to find a cluster remote named " 
+		++ clusterremotename
+		++ " that is accessed via " ++ remotename
+		++ ", but there is no such remote. Perhaps you need to"
+		++ "git fetch from " ++ remotename 
+		++ ", or git-annex updatecluster needs to be run there?"
+  where
+	clusterremotename = remotename ++ "-" ++ clustername
+seek _ = giveup "Expected two parameters, gateway and clustername."
+
+start :: ClusterUUID -> String -> CommandStart
+start cu clustername = starting "extendcluster" ai si $ do
+	myclusters <- annexClusters <$> Annex.getGitConfig
+	unless (M.member clustername myclusters) $ do
+		setConfig (annexConfig ("cluster." <> encodeBS clustername))
+			(fromUUID (fromClusterUUID cu))
+	next $ return True
+  where
+	ai = ActionItemOther (Just (UnquotedString clustername))
+	si = SeekInput [clustername]

doc/git-annex-extendcluster.mdwn

@@ -0,0 +1,40 @@
+# NAME
+
+git-annex extendcluster - add an additional gateway to a cluster
+
+# SYNOPSIS
+
+git-annex extendcluster gateway clustername
+
+# DESCRIPTION
+
+This command is used to configure a repository to serve as an additional
+gateway to a cluster. It is run in that repository.
+
+The repository this command is run in should have a remote that is a
+gateway to the cluster. The `gateway` parameter is the name of that remote.
+The `clustername` parameter is the name of the cluster.
+
+The next step after running this command is to configure
+any additional cluster nodes that this gateway provide to the cluster,
+then run [[git-annex-updatecluster]]. See the documentation of
+that command for details about configuring nodes.
+
+# OPTIONS
+
+* The [[git-annex-common-options]](1) can be used.
+
+# SEE ALSO
+
+[[git-annex]](1)
+[[git-annex-initcluster]](1)
+[[git-annex-updatecluster]](1)
+[[git-annex-updateproxy]](1)
+
+<https://git-annex.branchable.com/clusters/>
+
+# AUTHOR
+
+Joey Hess <id@joeyh.name>
+
+Warning: Automatically converted into a man page by mdwn2man. Edit with care.

doc/git-annex-initcluster.mdwn

@@ -11,8 +11,12 @@ git-annex initcluster name [description]
 This command initializes a new cluster with the specified name. If no
 description is provided, one will be set automatically.
 
+This command should be run in the repository that will serve as the gateway
+to the cluster.
+
 The next step after running this command is to configure
-the cluster, then run [[git-annex-updatecluster]].
+the cluster nodes, then run [[git-annex-updatecluster]]. See the
+documentation of that command for details about configuring nodes.
 
 # OPTIONS
 
@@ -22,6 +26,7 @@ the cluster, then run [[git-annex-updatecluster]].
 
 [[git-annex]](1)
 [[git-annex-updatecluster]](1)
+[[git-annex-extendcluster]](1)
 [[git-annex-preferred-content]](1)
 [[git-annex-updateproxy]](1)
 

doc/git-annex-updatecluster.mdwn

@@ -9,9 +9,10 @@ git-annex updatecluster
 # DESCRIPTION
 
 This command is used to record the nodes of a cluster in the git-annex
-branch.
+branch. It should be run in each repository that will serve as a gateway
+to the cluster.
 
-It looks at the git configs `git config remote.name.annex-cluster-node` of
+It looks at the git config `remote.name.annex-cluster-node` of
 each remote. When that is set to the name of a cluster that has been
 initialized with `git-annex initcluster`, the node will be recorded in the
 git-annex branch.
@@ -19,6 +20,9 @@ git-annex branch.
 To remove a node from a cluster, unset `remote.name.annex-cluster-node`
 and run this command.
 
+To add additional gateways to a cluster, after running this command,
+use [[git-annex-extendcluster]].
+
 # OPTIONS
 
 * The [[git-annex-common-options]](1) can be used.
@@ -27,6 +31,7 @@ and run this command.
 
 [[git-annex]](1)
 [[git-annex-initcluster]](1)
+[[git-annex-extendcluster]](1)
 [[git-annex-updateproxy]](1)
 
 <https://git-annex.branchable.com/clusters/>

doc/git-annex.mdwn

@@ -338,6 +338,13 @@ content from the key-value store.
   
   See [[git-annex-updatecluster](1) for details.
 
+* `extendcluster`
+
+  Adds an additional gateway to a cluster.
+  
+  See [[git-annex-extendcluster](1) for details.
+
+
 * `updateproxy`
 
   Update records with proxy configuration.

git-annex.cabal

@@ -638,6 +638,7 @@ Executable git-annex
     Command.EnableRemote
     Command.EnableTor
     Command.ExamineKey
+    Command.ExtendCluster
     Command.Expire
     Command.Export
     Command.FilterBranch