From 73206d0a80aec3624f7a632d16877d9b7e3a461d Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Thu, 16 Dec 2010 15:15:44 +0100
Subject: [PATCH] IAllocator: respect the alloc_policy for groups
This patch changes the allocate mode to respect the alloc_policy for
groups. It does this by changing the sort key from simply the solution
score, to a tuple with two elements: the alloc policy (which is now an
Ord instance) and the solution score. Also, the unallocable groups are
filtered out in the filterMGResults phase.
The patch also slightly enhances the informational message by
including the policy in the group information, to help debugging.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Balazs Lecz <leczb@google.com>
---
Ganeti/HTools/Cluster.hs | 31 ++++++++++++++++++++++---------
Ganeti/HTools/Types.hs | 17 +++++++++++++----
2 files changed, 35 insertions(+), 13 deletions(-)
diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
index 6ec2f9f4a..13a74870c 100644
--- a/Ganeti/HTools/Cluster.hs
+++ b/Ganeti/HTools/Cluster.hs
@@ -629,19 +629,34 @@ tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \
solutionDescription :: Group.List -> (Gdx, Result AllocSolution) -> [String]
solutionDescription gl (groupId, result) =
case result of
- Ok solution -> map (printf "Group %s: %s" gname) (asLog solution)
+ Ok solution -> map (printf "Group %s (%s): %s" gname pol) (asLog solution)
Bad message -> [printf "Group %s: error %s" gname message]
- where gname = Group.name $ Container.find groupId gl
+ where grp = Container.find groupId gl
+ gname = Group.name grp
+ pol = apolToString (Group.allocPolicy grp)
-- | From a list of possibly bad and possibly empty solutions, filter
-- only the groups with a valid result
-filterMGResults :: [(Gdx, Result AllocSolution)] ->
- [(Gdx, AllocSolution)]
-filterMGResults =
+filterMGResults :: Group.List
+ -> [(Gdx, Result AllocSolution)]
+ -> [(Gdx, AllocSolution)]
+filterMGResults gl=
+ filter ((/= AllocUnallocable) . Group.allocPolicy .
+ flip Container.find gl . fst) .
filter (not . null . asSolutions . snd) .
map (\(y, Ok x) -> (y, x)) .
filter (isOk . snd)
+-- | Sort multigroup results based on policy and score
+sortMGResults :: Group.List
+ -> [(Gdx, AllocSolution)]
+ -> [(Gdx, AllocSolution)]
+sortMGResults gl sols =
+ let extractScore = \(_, _, _, x) -> x
+ solScore (gdx, sol) = (Group.allocPolicy (Container.find gdx gl),
+ (extractScore . head . asSolutions) sol)
+ in sortBy (comparing solScore) sols
+
-- | Try to allocate an instance on a multi-group cluster.
tryMGAlloc :: Group.List -- ^ The group list
-> Node.List -- ^ The node list
@@ -656,10 +671,8 @@ tryMGAlloc mggl mgnl mgil inst cnt =
(gid, tryAlloc nl il inst cnt)) groups::
[(Gdx, Result AllocSolution)]
all_msgs = concatMap (solutionDescription mggl) sols
- goodSols = filterMGResults sols
- extractScore = \(_, _, _, x) -> x
- solScore = extractScore . head . asSolutions . snd
- sortedSols = sortBy (comparing solScore) goodSols
+ goodSols = filterMGResults mggl sols
+ sortedSols = sortMGResults mggl goodSols
in if null sortedSols
then Bad $ intercalate ", " all_msgs
else let (final_group, final_sol) = head sortedSols
diff --git a/Ganeti/HTools/Types.hs b/Ganeti/HTools/Types.hs
index c86ce1eb0..64a39c8b2 100644
--- a/Ganeti/HTools/Types.hs
+++ b/Ganeti/HTools/Types.hs
@@ -86,10 +86,19 @@ type Weight = Double
type GroupID = String
-- | The Group allocation policy type.
-data AllocPolicy = AllocPreferred
- | AllocLastResort
- | AllocUnallocable
- deriving (Show, Eq)
+--
+-- Note that the order of constructors is important as the automatic
+-- Ord instance will order them in the order they are defined, so when
+-- changing this data type be careful about the interaction with the
+-- desired sorting order.
+data AllocPolicy
+ = AllocPreferred -- ^ This is the normal status, the group
+ -- should be used normally during allocations
+ | AllocLastResort -- ^ This group should be used only as
+ -- last-resort, after the preferred groups
+ | AllocUnallocable -- ^ This group must not be used for new
+ -- allocations
+ deriving (Show, Eq, Ord)
-- | Convert a string to an alloc policy
apolFromString :: (Monad m) => String -> m AllocPolicy
--
GitLab