From c85abf3027e43406e49fe525fe888e3571e238e6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ren=C3=A9=20Nussbaumer?= <rn@google.com>
Date: Mon, 27 Aug 2012 13:13:55 +0200
Subject: [PATCH] Adding allocList function
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This function iterates over the tryMGAlloc function, updates the node
list and instance list, and refeeds it recursively until no new
instances are left.
This allows us then to allocate multiple instances and see if they would
fit together.
Signed-off-by: RenΓ© Nussbaumer <rn@google.com>
Reviewed-by: Iustin Pop <iustin@google.com>
---
htools/Ganeti/HTools/Cluster.hs | 35 +++++++++++++++++++++++++++++++++
1 file changed, 35 insertions(+)
diff --git a/htools/Ganeti/HTools/Cluster.hs b/htools/Ganeti/HTools/Cluster.hs
index 5d325dc2f..6edf854bf 100644
--- a/htools/Ganeti/HTools/Cluster.hs
+++ b/htools/Ganeti/HTools/Cluster.hs
@@ -35,6 +35,7 @@ module Ganeti.HTools.Cluster
, CStats(..)
, AllocResult
, AllocMethod
+ , AllocSolutionList
-- * Generic functions
, totalResources
, computeAllocationDelta
@@ -64,6 +65,7 @@ module Ganeti.HTools.Cluster
, tryNodeEvac
, tryChangeGroup
, collapseFailures
+ , allocList
-- * Allocation functions
, iterateAlloc
, tieredAlloc
@@ -112,6 +114,9 @@ data EvacSolution = EvacSolution
type AllocResult = (FailStats, Node.List, Instance.List,
[Instance.Instance], [CStats])
+-- | Type alias for easier handling.
+type AllocSolutionList = [(Instance.Instance, AllocSolution)]
+
-- | A type denoting the valid allocation mode/pairs.
--
-- For a one-node allocation, this will be a @Left ['Ndx']@, whereas
@@ -844,6 +849,36 @@ tryMGAlloc mggl mgnl mgil inst cnt = do
selmsg = "Selected group: " ++ group_name
return $ solution { asLog = selmsg:all_msgs }
+-- | Calculate the new instance list after allocation solution.
+updateIl :: Instance.List -- ^ The original instance list
+ -> Maybe Node.AllocElement -- ^ The result of the allocation attempt
+ -> Instance.List -- ^ The updated instance list
+updateIl il Nothing = il
+updateIl il (Just (_, xi, _, _)) = Container.add (Container.size il) xi il
+
+-- | Extract the the new node list from the allocation solution.
+extractNl :: Node.List -- ^ The original node list
+ -> Maybe Node.AllocElement -- ^ The result of the allocation attempt
+ -> Node.List -- ^ The new node list
+extractNl nl Nothing = nl
+extractNl _ (Just (xnl, _, _, _)) = xnl
+
+-- | Try to allocate a list of instances on a multi-group cluster.
+allocList :: Group.List -- ^ The group list
+ -> Node.List -- ^ The node list
+ -> Instance.List -- ^ The instance list
+ -> [(Instance.Instance, Int)] -- ^ The instance to allocate
+ -> AllocSolutionList -- ^ Possible solution list
+ -> Result (Node.List, Instance.List,
+ AllocSolutionList) -- ^ The final solution list
+allocList _ nl il [] result = Ok (nl, il, result)
+allocList gl nl il ((xi, xicnt):xies) result = do
+ ares <- tryMGAlloc gl nl il xi xicnt
+ let sol = asSolution ares
+ nl' = extractNl nl sol
+ il' = updateIl il sol
+ allocList gl nl' il' xies ((xi, ares):result)
+
-- | Function which fails if the requested mode is change secondary.
--
-- This is useful since except DRBD, no other disk template can
--
GitLab