diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
index c3a1a26400b6f03ef6df886f2e2d06b74625dd4b..a1aae239461d34ea4c2a36ca461180111b4d5268 100644
--- a/Ganeti/HTools/Cluster.hs
+++ b/Ganeti/HTools/Cluster.hs
@@ -7,7 +7,7 @@ goes into the "Main" module for the individual binaries.
{-
-Copyright (C) 2009, 2010 Google Inc.
+Copyright (C) 2009, 2010, 2011 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@@ -58,6 +58,7 @@ module Ganeti.HTools.Cluster
, tryAlloc
, tryMGAlloc
, tryReloc
+ , tryMGReloc
, tryEvac
, collapseFailures
-- * Allocation functions
@@ -718,6 +719,24 @@ tryReloc _ _ _ reqn _ = fail $ "Unsupported number of relocation \
\destinations required (" ++ show reqn ++
"), only one supported"
+tryMGReloc :: (Monad m) =>
+ Group.List -- ^ The group list
+ -> Node.List -- ^ The node list
+ -> Instance.List -- ^ The instance list
+ -> Idx -- ^ The index of the instance to move
+ -> Int -- ^ The number of nodes required
+ -> [Ndx] -- ^ Nodes which should not be used
+ -> m AllocSolution -- ^ Solution list
+tryMGReloc _ mgnl mgil xid ncount ex_ndx = do
+ let groups = splitCluster mgnl mgil
+ -- TODO: we only relocate inside the group for now
+ inst = Container.find xid mgil
+ (nl, il) <- case lookup (instancePriGroup mgnl inst) groups of
+ Nothing -> fail $ "Cannot find group for instance " ++
+ Instance.name inst
+ Just v -> return v
+ tryReloc nl il xid ncount ex_ndx
+
-- | Try to evacuate a list of nodes.
tryEvac :: (Monad m) =>
Node.List -- ^ The node list
@@ -984,6 +1003,12 @@ instanceGroup nl i =
show pgroup ++ ", secondary " ++ show sgroup)
else return pgroup
+-- | Computes the group of an instance per the primary node
+instancePriGroup :: Node.List -> Instance.Instance -> Gdx
+instancePriGroup nl i =
+ let pnode = Container.find (Instance.pNode i) nl
+ in Node.group pnode
+
-- | Compute the list of badly allocated instances (split across node
-- groups)
findSplitInstances :: Node.List -> Instance.List -> [Instance.Instance]
diff --git a/hail.hs b/hail.hs
index 78eb8e11a281593b7ba650c0fcbe16b022c9c85f..734cd928a6632bc3a310eea4a0ce8a4ef6a064c6 100644
--- a/hail.hs
+++ b/hail.hs
@@ -4,7 +4,7 @@
{-
-Copyright (C) 2009, 2010 Google Inc.
+Copyright (C) 2009, 2010, 2011 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@@ -71,7 +71,8 @@ processRequest request =
let Request rqtype (ClusterData gl nl il _) = request
in case rqtype of
Allocate xi reqn -> Cluster.tryMGAlloc gl nl il xi reqn
- Relocate idx reqn exnodes -> Cluster.tryReloc nl il idx reqn exnodes
+ Relocate idx reqn exnodes -> Cluster.tryMGReloc gl nl il
+ idx reqn exnodes
Evacuate exnodes -> Cluster.tryEvac nl il exnodes
-- | Reads the request from the data file(s)