sim: add commands for cluster management

Clusters are not actually simulated yet.

diff --git a/Annex/Sim.hs b/Annex/Sim.hs
index dfae56949b1fbed1c7690d30fe44ccf6c1aee8dd..0cae7929cff47295d2c6ddac0704a541f5e53c2f 100644 (file)
--- a/Annex/Sim.hs
+++ b/Annex/Sim.hs
@@ -71,6 +71,7 @@ data SimState t = SimState
        , simGroupWanted :: M.Map Group PreferredContentExpression
        , simMaxSize :: M.Map UUID MaxSize
        , simRebalance :: Bool
+       , simClusters :: M.Map RepoName (S.Set RemoteName)
        , simHistory :: [SimCommand]
        , simVectorClock :: VectorClock
        , simRootDirectory :: FilePath
@@ -94,6 +95,7 @@ emptySimState rngseed rootdir = SimState
        , simGroupWanted = mempty
        , simMaxSize = mempty
        , simRebalance = False
+       , simClusters = mempty
        , simHistory = []
        , simVectorClock = VectorClock 0
        , simRootDirectory = rootdir
@@ -230,6 +232,9 @@ data SimCommand
        | CommandRandomGroupWanted Group [PreferredContentExpression]
        | CommandMaxSize RepoName MaxSize
        | CommandRebalance Bool
+       | CommandInitCluster RepoName
+       | CommandAddCluster RepoName [RemoteName]
+       | CommandRemoveCluster RepoName RemoteName
        | CommandVisit RepoName [String]
        | CommandComment String
        | CommandBlank
@@ -524,6 +529,34 @@ applySimCommand' (CommandRebalance b) st _ =
        Right $ Right $ st
                { simRebalance = b
                }
+applySimCommand' (CommandInitCluster clustername) st _ =
+       checkNonexistantRepo clustername st $
+               let (u, st') = genSimUUID st clustername
+                   st'' = st'
+                       { simClusters = M.insert clustername mempty
+                               (simClusters st')
+                       }
+               in Right $ Right $
+                       addRepo clustername (newSimRepoConfig u False) st''
+applySimCommand' (CommandAddCluster clustername nodes) st _ =
+       checkKnownRepo clustername st $ \u ->
+               case M.lookup clustername (simClusters st) of
+                       Nothing -> Left $ fromRepoName clustername ++ " is not a cluster (use initcluster before addcluster)"
+                       Just nodeset -> 
+                               let nodeset' = S.union nodeset (S.fromList nodes)
+                               in Right $ Right $ st
+                                       { simClusters = M.insert clustername nodeset'
+                                               (simClusters st)
+                                       }
+applySimCommand' (CommandRemoveCluster clustername node) st _ =
+       case M.lookup clustername (simClusters st) of
+               Nothing -> Left $ fromRepoName clustername ++ " is not a cluster"
+               Just nodeset -> 
+                       let nodeset' = S.delete node nodeset
+                       in Right $ Right $ st
+                               { simClusters = M.insert clustername nodeset'
+                                       (simClusters st)
+                               }
 applySimCommand' (CommandComment _) st _ = Right $ Right st
 applySimCommand' CommandBlank st _ = Right $ Right st
 applySimCommand' (CommandVisit _ _) _ _ = error "applySimCommand' CommandVisit"

diff --git a/Annex/Sim/File.hs b/Annex/Sim/File.hs
index d4bc59c75c178d80a6bb517df8856f467150d58a..c3b104507abdb8bc63408f2e240805f3c2222a2d 100644 (file)
--- a/Annex/Sim/File.hs
+++ b/Annex/Sim/File.hs
@@ -88,6 +88,12 @@ generateSimFile = unlines . map unwords . go
                ["maxsize", repo, showsize (fromMaxSize maxsize)] : go rest
        go (CommandRebalance b : rest) =
                ["rebalance", if b then "on" else "off"] : go rest
+       go (CommandInitCluster (RepoName repo) : rest) =
+               ["initcluster", repo] : go rest
+       go (CommandAddCluster (RepoName repo) nodes : rest) =
+               ("addcluster" : repo : map fromRemoteName nodes) : go rest
+       go (CommandRemoveCluster (RepoName repo) (RemoteName node) : rest) =
+               ["removecluster", repo, node] : go rest
        go (CommandVisit (RepoName repo) cmdparams : rest) =
                (["visit", repo] ++ cmdparams) : go rest
        go (CommandComment s : rest) = 
@@ -204,6 +210,12 @@ parseSimCommand ("maxsize":repo:size:[]) =
 parseSimCommand ("rebalance":onoff:[]) = case isTrueFalse onoff of
        Just b -> Right $ CommandRebalance b
        Nothing -> Left $ "Unable to parse rebalance value \"" ++ onoff ++ "\""
+parseSimCommand ("initcluster":name:[]) =
+       Right $ CommandInitCluster (RepoName name)
+parseSimCommand ("addcluster":name:nodes) =
+       Right $ CommandAddCluster (RepoName name) (map RemoteName nodes)
+parseSimCommand ("removecluster":name:node:[]) =
+       Right $ CommandRemoveCluster (RepoName name) (RemoteName node)
 parseSimCommand ("visit":repo:cmdparams) =
        Right $ CommandVisit (RepoName repo) cmdparams
 parseSimCommand ws = parseError ws

diff --git a/doc/git-annex-sim.mdwn b/doc/git-annex-sim.mdwn
index 09505ee9d4a35abda6f81adb760f526cb1c94c5c..5d96c08f78b3592a3b0a3dd5e1d671809ad41141 100644 (file)
--- a/doc/git-annex-sim.mdwn
+++ b/doc/git-annex-sim.mdwn
@@ -368,6 +368,31 @@ as passed to "git annex sim" while a simulation is running.
     step 100
     rebalance off
 
+* `initcluster name`
+
+  Initializes a simulated cluster with the given name.
+
+* `addcluster name [node ...]`
+
+  Adds each of the listed nodes to the cluster. The cluster is connected to
+  each node, and will accept files sent to it and store them on the nodes.
+  Repositories that are connected to the cluster will also be able to
+  receive files from it.
+
+  Note that adding a connection to a cluster does not automatically
+  set up connections to its nodes. To replicate git-annex's behavior with
+  a real cluster remote, those connections can be manually configured. For
+  example:
+
+    addcluster mycluster node1 node2
+    connect foo -> mycluster
+    connect foo -> node1
+    connect foo -> node2
+
+* `removecluster name node`
+
+  Removes a node from the cluster.
+
 # OPTIONS
 
 * The [[git-annex-common-options]](1) can be used.