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)