1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
{- git-annex command
-
- Copyright 2024 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Command.UpdateCluster where
import Command
import qualified Annex
import Types.Cluster
import Logs.Cluster
import qualified Remote as R
import qualified Types.Remote as R
import qualified Command.UpdateProxy
import Utility.SafeOutput
import qualified Data.Map as M
import qualified Data.Set as S
cmd :: Command
cmd = noMessages $ command "updatecluster" SectionSetup
"update records of cluster nodes"
paramNothing (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withNothing $ do
commandAction start
commandAction Command.UpdateProxy.start
start :: CommandStart
start = startingCustomOutput (ActionItemOther Nothing) $ do
rs <- R.remoteList
let getnode r = case remoteAnnexClusterNode (R.gitconfig r) of
Nothing -> return Nothing
Just [] -> return Nothing
Just clusternames ->
ifM (Command.UpdateProxy.checkCanProxy r "Cannot use this remote as a cluster node.")
( return $ Just $ M.fromList $
zip clusternames (repeat (S.singleton r))
, return Nothing
)
myclusternodes <- M.unionsWith S.union . catMaybes
<$> mapM getnode rs
myclusters <- annexClusters <$> Annex.getGitConfig
recordedclusters <- getClusters
descs <- R.uuidDescriptions
-- Update the cluster log to list the currently configured nodes
-- of each configured cluster.
forM_ (M.toList myclusters) $ \(clustername, cu) -> do
let mynodesremotes = fromMaybe mempty $
M.lookup clustername myclusternodes
let mynodes = S.map (ClusterNodeUUID . R.uuid) mynodesremotes
let recordednodes = fromMaybe mempty $ M.lookup cu $
clusterUUIDs recordedclusters
proxiednodes <- findProxiedClusterNodes recordednodes
let allnodes = S.union mynodes proxiednodes
if recordednodes == allnodes
then liftIO $ putStrLn $ safeOutput $
"No cluster node changes for cluster: " ++ clustername
else do
describechanges descs clustername recordednodes allnodes mynodesremotes
recordCluster cu allnodes
next $ return True
where
describechanges descs clustername oldnodes allnodes mynodesremotes = do
forM_ (S.toList mynodesremotes) $ \r ->
unless (S.member (ClusterNodeUUID (R.uuid r)) oldnodes) $
liftIO $ putStrLn $ safeOutput $
"Added node " ++ R.name r ++ " to cluster: " ++ clustername
forM_ (S.toList oldnodes) $ \n ->
unless (S.member n allnodes) $ do
let desc = maybe (fromUUID (fromClusterNodeUUID n)) fromUUIDDesc $
M.lookup (fromClusterNodeUUID n) descs
liftIO $ putStrLn $ safeOutput $
"Removed node " ++ desc ++ " from cluster: " ++ clustername
-- Finds nodes that are proxied by other cluster gateways.
findProxiedClusterNodes :: S.Set ClusterNodeUUID -> Annex (S.Set ClusterNodeUUID)
findProxiedClusterNodes recordednodes =
(S.fromList . map asclusternode . filter isproxynode) <$> R.remoteList
where
isproxynode r =
asclusternode r `S.member` recordednodes
&& isJust (remoteAnnexProxiedBy (R.gitconfig r))
asclusternode = ClusterNodeUUID . R.uuid
|
