set up proxies for cluster nodes that are themselves proxied via a remote
When there are multiple gateways to a cluster, this sets up proxying for nodes that are accessed via a remote gateway. Eg, when running in nyc and amsterdam is the remote gateway, and it has node1 and node2, this sets up proxying for amsterdam-node1 and amsterdam-node2. A client that has nyc as a remote will see proxied remotes nyc-amsterdam-node1 and nyc-amsterdam-node2.
This commit is contained in:
parent
02bf3ddc3f
commit
1ec2fecf3f
4 changed files with 43 additions and 12 deletions
|
@ -50,7 +50,7 @@ start = startingCustomOutput (ActionItemOther Nothing) $ do
|
||||||
let mynodes = S.map (ClusterNodeUUID . R.uuid) mynodesremotes
|
let mynodes = S.map (ClusterNodeUUID . R.uuid) mynodesremotes
|
||||||
let recordednodes = fromMaybe mempty $ M.lookup cu $
|
let recordednodes = fromMaybe mempty $ M.lookup cu $
|
||||||
clusterUUIDs recordedclusters
|
clusterUUIDs recordedclusters
|
||||||
proxiednodes <- findProxiedNodes recordednodes
|
proxiednodes <- findProxiedClusterNodes recordednodes
|
||||||
let allnodes = S.union mynodes proxiednodes
|
let allnodes = S.union mynodes proxiednodes
|
||||||
if recordednodes == allnodes
|
if recordednodes == allnodes
|
||||||
then liftIO $ putStrLn $ safeOutput $
|
then liftIO $ putStrLn $ safeOutput $
|
||||||
|
@ -74,8 +74,8 @@ start = startingCustomOutput (ActionItemOther Nothing) $ do
|
||||||
"Removed node " ++ desc ++ " from cluster: " ++ clustername
|
"Removed node " ++ desc ++ " from cluster: " ++ clustername
|
||||||
|
|
||||||
-- Finds nodes that are proxied by other cluster gateways.
|
-- Finds nodes that are proxied by other cluster gateways.
|
||||||
findProxiedNodes :: S.Set ClusterNodeUUID -> Annex (S.Set ClusterNodeUUID)
|
findProxiedClusterNodes :: S.Set ClusterNodeUUID -> Annex (S.Set ClusterNodeUUID)
|
||||||
findProxiedNodes recordednodes =
|
findProxiedClusterNodes recordednodes =
|
||||||
(S.fromList . map asclusternode . filter isproxynode) <$> R.remoteList
|
(S.fromList . map asclusternode . filter isproxynode) <$> R.remoteList
|
||||||
where
|
where
|
||||||
isproxynode r =
|
isproxynode r =
|
||||||
|
|
|
@ -10,11 +10,11 @@ module Command.UpdateProxy where
|
||||||
import Command
|
import Command
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Logs.Proxy
|
import Logs.Proxy
|
||||||
|
import Logs.Cluster
|
||||||
import Annex.UUID
|
import Annex.UUID
|
||||||
import qualified Remote as R
|
import qualified Remote as R
|
||||||
import qualified Types.Remote as R
|
import qualified Types.Remote as R
|
||||||
import Utility.SafeOutput
|
import Utility.SafeOutput
|
||||||
import Types.Cluster
|
|
||||||
|
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
@ -32,10 +32,8 @@ start = startingCustomOutput (ActionItemOther Nothing) $ do
|
||||||
rs <- R.remoteList
|
rs <- R.remoteList
|
||||||
let remoteproxies = S.fromList $ map mkproxy $
|
let remoteproxies = S.fromList $ map mkproxy $
|
||||||
filter (isproxy . R.gitconfig) rs
|
filter (isproxy . R.gitconfig) rs
|
||||||
clusterproxies <-
|
clusterproxies <- getClusterProxies
|
||||||
(S.fromList . map mkclusterproxy . M.toList . annexClusters)
|
let proxies = S.union remoteproxies clusterproxies
|
||||||
<$> Annex.getGitConfig
|
|
||||||
let proxies = remoteproxies <> clusterproxies
|
|
||||||
u <- getUUID
|
u <- getUUID
|
||||||
oldproxies <- fromMaybe mempty . M.lookup u <$> getProxies
|
oldproxies <- fromMaybe mempty . M.lookup u <$> getProxies
|
||||||
if oldproxies == proxies
|
if oldproxies == proxies
|
||||||
|
@ -60,5 +58,38 @@ start = startingCustomOutput (ActionItemOther Nothing) $ do
|
||||||
|
|
||||||
mkproxy r = Proxy (R.uuid r) (R.name r)
|
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) =
|
mkclusterproxy (remotename, cu) =
|
||||||
Proxy (fromClusterUUID cu) remotename
|
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)
|
||||||
|
|
|
@ -17,8 +17,8 @@ The `clustername` parameter is the name of the cluster.
|
||||||
|
|
||||||
The next step after running this command is to configure
|
The next step after running this command is to configure
|
||||||
any additional cluster nodes that this gateway serves to the cluster,
|
any additional cluster nodes that this gateway serves to the cluster,
|
||||||
then run [[git-annex-updatecluster]]. See the documentation of
|
then run [[git-annex-updatecluster]] on each gateway.
|
||||||
that command for details about configuring nodes.
|
See the documentation of that command for details about configuring nodes.
|
||||||
|
|
||||||
# OPTIONS
|
# OPTIONS
|
||||||
|
|
||||||
|
|
|
@ -9,8 +9,8 @@ git-annex updatecluster
|
||||||
# DESCRIPTION
|
# DESCRIPTION
|
||||||
|
|
||||||
This command is used to record the nodes of a cluster in the git-annex
|
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
|
branch, and set up proxying to the nodes. It should be run in the
|
||||||
to the cluster.
|
repository that will serve as a gateway to the cluster.
|
||||||
|
|
||||||
It looks at the 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
|
each remote. When that is set to the name of a cluster that has been
|
||||||
|
|
Loading…
Reference in a new issue