[PATCH master 06/12] Enable evacuation/relocation for shared storage

[Iustin Pop]

This patch toggles the final bit and enables nodeEvacInstance to work
on shared storage instances. Diskless instances are handled the same
(as in, None is the same everywhere :).
---
 htools/Ganeti/HTools/Cluster.hs |   36 ++++++++++++++++++++----------------
 1 files changed, 20 insertions(+), 16 deletions(-)

diff --git a/htools/Ganeti/HTools/Cluster.hs b/htools/Ganeti/HTools/Cluster.hs
index a8acd2c..6879bf1 100644
--- a/htools/Ganeti/HTools/Cluster.hs
+++ b/htools/Ganeti/HTools/Cluster.hs
@@ -870,10 +870,11 @@ nodeEvacInstance :: Node.List         -- ^ The node list 
(cluster-wide)
                  -> [Ndx]             -- ^ The list of available nodes
                                       -- for allocation
                  -> Result (Node.List, Instance.List, [OpCodes.OpCode])
-nodeEvacInstance _ _ mode (Instance.Instance
-                           {Instance.diskTemplate = dt@DTDiskless}) _ _ =
-                  failOnSecondaryChange mode dt >>
-                  fail "Diskless relocations not implemented yet"
+nodeEvacInstance nl il mode inst@(Instance.Instance
+                                  {Instance.diskTemplate = dt@DTDiskless})
+                 gdx avail_nodes =
+                   failOnSecondaryChange mode dt >>
+                   evacOneNodeOnly nl il inst gdx avail_nodes
 
 nodeEvacInstance _ _ _ (Instance.Instance
                         {Instance.diskTemplate = DTPlain}) _ _ =
@@ -883,20 +884,23 @@ nodeEvacInstance _ _ _ (Instance.Instance
                         {Instance.diskTemplate = DTFile}) _ _ =
                   fail "Instances of type file cannot be relocated"
 
-nodeEvacInstance _ _ mode  (Instance.Instance
-                            {Instance.diskTemplate = dt@DTSharedFile}) _ _ =
-                  failOnSecondaryChange mode dt >>
-                  fail "Shared file relocations not implemented yet"
+nodeEvacInstance nl il mode inst@(Instance.Instance
+                                  {Instance.diskTemplate = dt@DTSharedFile})
+                 gdx avail_nodes =
+                   failOnSecondaryChange mode dt >>
+                   evacOneNodeOnly nl il inst gdx avail_nodes
 
-nodeEvacInstance _ _ mode (Instance.Instance
-                           {Instance.diskTemplate = dt@DTBlock}) _ _ =
-                  failOnSecondaryChange mode dt >>
-                  fail "Block device relocations not implemented yet"
+nodeEvacInstance nl il mode inst@(Instance.Instance
+                                  {Instance.diskTemplate = dt@DTBlock})
+                 gdx avail_nodes =
+                   failOnSecondaryChange mode dt >>
+                   evacOneNodeOnly nl il inst gdx avail_nodes
 
-nodeEvacInstance _ _ mode  (Instance.Instance
-                            {Instance.diskTemplate = dt@DTRbd}) _ _ =
-                  failOnSecondaryChange mode dt >>
-                  fail "Rbd relocations not implemented yet"
+nodeEvacInstance nl il mode inst@(Instance.Instance
+                                  {Instance.diskTemplate = dt@DTRbd})
+                 gdx avail_nodes =
+                   failOnSecondaryChange mode dt >>
+                   evacOneNodeOnly nl il inst gdx avail_nodes
 
 nodeEvacInstance nl il ChangePrimary
                  inst@(Instance.Instance {Instance.diskTemplate = DTDrbd8})
-- 
1.7.9.1