diff --git a/Command/UpdateCluster.hs b/Command/UpdateCluster.hs index 3a98ef43f4..72b59233a6 100644 --- a/Command/UpdateCluster.hs +++ b/Command/UpdateCluster.hs @@ -50,7 +50,7 @@ start = startingCustomOutput (ActionItemOther Nothing) $ do let mynodes = S.map (ClusterNodeUUID . R.uuid) mynodesremotes let recordednodes = fromMaybe mempty $ M.lookup cu $ clusterUUIDs recordedclusters - proxiednodes <- findProxiedNodes recordednodes + proxiednodes <- findProxiedClusterNodes recordednodes let allnodes = S.union mynodes proxiednodes if recordednodes == allnodes then liftIO $ putStrLn $ safeOutput $ @@ -74,8 +74,8 @@ start = startingCustomOutput (ActionItemOther Nothing) $ do "Removed node " ++ desc ++ " from cluster: " ++ clustername -- Finds nodes that are proxied by other cluster gateways. -findProxiedNodes :: S.Set ClusterNodeUUID -> Annex (S.Set ClusterNodeUUID) -findProxiedNodes recordednodes = +findProxiedClusterNodes :: S.Set ClusterNodeUUID -> Annex (S.Set ClusterNodeUUID) +findProxiedClusterNodes recordednodes = (S.fromList . map asclusternode . filter isproxynode) <$> R.remoteList where isproxynode r = diff --git a/Command/UpdateProxy.hs b/Command/UpdateProxy.hs index b30b20f8be..cbe7ae9a81 100644 --- a/Command/UpdateProxy.hs +++ b/Command/UpdateProxy.hs @@ -10,11 +10,11 @@ module Command.UpdateProxy where import Command import qualified Annex import Logs.Proxy +import Logs.Cluster import Annex.UUID import qualified Remote as R import qualified Types.Remote as R import Utility.SafeOutput -import Types.Cluster import qualified Data.Map as M import qualified Data.Set as S @@ -32,10 +32,8 @@ start = startingCustomOutput (ActionItemOther Nothing) $ do rs <- R.remoteList let remoteproxies = S.fromList $ map mkproxy $ filter (isproxy . R.gitconfig) rs - clusterproxies <- - (S.fromList . map mkclusterproxy . M.toList . annexClusters) - <$> Annex.getGitConfig - let proxies = remoteproxies <> clusterproxies + clusterproxies <- getClusterProxies + let proxies = S.union remoteproxies clusterproxies u <- getUUID oldproxies <- fromMaybe mempty . M.lookup u <$> getProxies if oldproxies == proxies @@ -60,5 +58,38 @@ start = startingCustomOutput (ActionItemOther Nothing) $ do mkproxy r = Proxy (R.uuid r) (R.name r) +-- Automatically proxy nodes of any cluster this repository is configured +-- to serve as a gateway for. Also proxy other cluster nodes that are +-- themselves proxied via other remotes. +getClusterProxies :: Annex (S.Set Proxy) +getClusterProxies = do + mynodes <- (map mkclusterproxy . M.toList . annexClusters) + <$> Annex.getGitConfig + remoteproxiednodes <- findRemoteProxiedClusterNodes + let mynodesuuids = S.fromList $ map proxyRemoteUUID mynodes + -- filter out nodes we proxy for from the remote proxied nodes + -- to avoid cycles + let remoteproxiednodes' = filter + (\n -> proxyRemoteUUID n `S.notMember` mynodesuuids) + remoteproxiednodes + return (S.fromList (mynodes ++ remoteproxiednodes')) + where mkclusterproxy (remotename, cu) = Proxy (fromClusterUUID cu) remotename + +findRemoteProxiedClusterNodes :: Annex [Proxy] +findRemoteProxiedClusterNodes = do + myclusters <- (S.fromList . M.elems . annexClusters) + <$> Annex.getGitConfig + clusternodes <- clusterNodeUUIDs <$> getClusters + let isproxiedclusternode r + | remoteAnnexProxied (R.gitconfig r) = + case M.lookup (ClusterNodeUUID (R.uuid r)) clusternodes of + Nothing -> False + Just s -> not $ S.null $ + S.intersection s myclusters + | otherwise = False + (map asproxy . filter isproxiedclusternode) + <$> R.remoteList + where + asproxy r = Proxy (R.uuid r) (R.name r) diff --git a/doc/git-annex-extendcluster.mdwn b/doc/git-annex-extendcluster.mdwn index 53b6839652..79796fe6e8 100644 --- a/doc/git-annex-extendcluster.mdwn +++ b/doc/git-annex-extendcluster.mdwn @@ -17,8 +17,8 @@ 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 serves to the cluster, -then run [[git-annex-updatecluster]]. See the documentation of -that command for details about configuring nodes. +then run [[git-annex-updatecluster]] on each gateway. +See the documentation of that command for details about configuring nodes. # OPTIONS diff --git a/doc/git-annex-updatecluster.mdwn b/doc/git-annex-updatecluster.mdwn index f7adebb8cb..b40b417f73 100644 --- a/doc/git-annex-updatecluster.mdwn +++ b/doc/git-annex-updatecluster.mdwn @@ -9,8 +9,8 @@ git-annex updatecluster # DESCRIPTION This command is used to record the nodes of a cluster in the git-annex -branch. It should be run in the repository that will serve as a gateway -to the cluster. +branch, and set up proxying to the nodes. It should be run in the +repository that will serve as a gateway to the cluster. 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