From 9dcec0011685db5521ecdeb6ed8af93b4a93a3dd Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Mon, 1 Jun 2009 15:48:44 +0200
Subject: [PATCH] Rework the tryAlloc/tryReloc functions
Currently tryAlloc/tryReloc do not return the new instance, as this is
not needed for IAllocator alloc/reloc requests. However, for computing
the space, the new instance is useful, so we modify these functions to
return this information too.
The patch also improves hspace to have (with default parameters) a
parseable output.
---
Ganeti/HTools/Cluster.hs | 19 +++++++-----
hail.hs | 7 +++--
hspace.hs | 67 +++++++++++++++++++++++++++-------------
3 files changed, 60 insertions(+), 33 deletions(-)
diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
index e7910e9c8..60d4ddd3c 100644
--- a/Ganeti/HTools/Cluster.hs
+++ b/Ganeti/HTools/Cluster.hs
@@ -624,19 +624,21 @@ tryAlloc :: (Monad m) =>
-> Instance.List -- ^ The instance list
-> Instance.Instance -- ^ The instance to allocate
-> Int -- ^ Required number of nodes
- -> m [(Maybe Node.List, [Node.Node])] -- ^ Possible solution list
+ -> m [(Maybe Node.List, Instance.Instance, [Node.Node])]
+ -- ^ Possible solution list
tryAlloc nl _ inst 2 =
let all_nodes = getOnline nl
all_pairs = liftM2 (,) all_nodes all_nodes
ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs
- sols = map (\(p, s) ->
- (fst $ allocateOnPair nl inst p s, [p, s]))
+ sols = map (\(p, s) -> let (mnl, i) = allocateOnPair nl inst p s
+ in (mnl, i, [p, s]))
ok_pairs
in return sols
tryAlloc nl _ inst 1 =
let all_nodes = getOnline nl
- sols = map (\p -> (fst $ allocateOnSingle nl inst p, [p]))
+ sols = map (\p -> let (mnl, i) = allocateOnSingle nl inst p
+ in (mnl, i, [p]))
all_nodes
in return sols
@@ -651,16 +653,17 @@ tryReloc :: (Monad m) =>
-> Idx -- ^ The index of the instance to move
-> Int -- ^ The numver of nodes required
-> [Ndx] -- ^ Nodes which should not be used
- -> m [(Maybe Node.List, [Node.Node])] -- ^ Solution list
+ -> m [(Maybe Node.List, Instance.Instance, [Node.Node])]
+ -- ^ Solution list
tryReloc nl il xid 1 ex_idx =
let all_nodes = getOnline nl
inst = Container.find xid il
ex_idx' = (Instance.pnode inst):ex_idx
valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes
valid_idxes = map Node.idx valid_nodes
- sols1 = map (\x -> let (mnl, _, _, _) =
- applyMove nl inst (ReplaceSecondary x)
- in (mnl, [Container.find x nl])
+ sols1 = map (\x -> let (mnl, i, _, _) =
+ applyMove nl inst (ReplaceSecondary x)
+ in (mnl, i, [Container.find x nl])
) valid_idxes
in return sols1
diff --git a/hail.hs b/hail.hs
index afc04887e..5c7f71ec0 100644
--- a/hail.hs
+++ b/hail.hs
@@ -44,6 +44,7 @@ import qualified Ganeti.HTools.CLI as CLI
import Ganeti.HTools.IAlloc
import Ganeti.HTools.Types
import Ganeti.HTools.Loader (RqType(..), Request(..))
+import Ganeti.HTools.Utils
-- | Command line options structure.
data Options = Options
@@ -74,15 +75,15 @@ options =
]
-filterFails :: (Monad m) => [(Maybe Node.List, [Node.Node])]
+filterFails :: (Monad m) => [(Maybe Node.List, Instance.Instance, [Node.Node])]
-> m [(Node.List, [Node.Node])]
filterFails sols =
if null sols then fail "No nodes onto which to allocate at all"
- else let sols' = filter (isJust . fst) sols
+ else let sols' = filter (isJust . fst3) sols
in if null sols' then
fail "No valid allocation solutions"
else
- return $ map (\(x, y) -> (fromJust x, y)) sols'
+ return $ map (\(x, _, y) -> (fromJust x, y)) sols'
processResults :: (Monad m) => [(Node.List, [Node.Node])]
-> m (String, [Node.Node])
diff --git a/hspace.hs b/hspace.hs
index 01aa28036..00d629c17 100644
--- a/hspace.hs
+++ b/hspace.hs
@@ -132,20 +132,20 @@ options =
"show help"
]
-filterFails :: (Monad m) => [(Maybe Node.List, [Node.Node])]
- -> m [(Node.List, [Node.Node])]
+filterFails :: (Monad m) => [(Maybe Node.List, Instance.Instance, [Node.Node])]
+ -> m [(Node.List, Instance.Instance, [Node.Node])]
filterFails sols =
if null sols then fail "No nodes onto which to allocate at all"
- else let sols' = filter (isJust . fst) sols
+ else let sols' = filter (isJust . fst3) sols
in if null sols' then
fail "No valid allocation solutions"
else
- return $ map (\(x, y) -> (fromJust x, y)) sols'
+ return $ map (\(x, y, z) -> (fromJust x, y, z)) sols'
-processResults :: (Monad m) => [(Node.List, [Node.Node])]
- -> m (Node.List, [Node.Node])
+processResults :: (Monad m) => [(Node.List, Instance.Instance, [Node.Node])]
+ -> m (Node.List, Instance.Instance, [Node.Node])
processResults sols =
- let sols' = map (\(nl', ns) -> (Cluster.compCV nl', (nl', ns))) sols
+ let sols' = map (\e@(nl', _, _) -> (Cluster.compCV nl', e)) sols
sols'' = sortBy (compare `on` fst) sols'
in return $ snd $ head sols''
@@ -153,21 +153,23 @@ iterateDepth :: Node.List
-> Instance.List
-> Instance.Instance
-> Int
- -> Int
- -> (Node.List, Int)
-iterateDepth nl il newinst nreq depth =
- let newname = printf "new-%d" depth
+ -> [Instance.Instance]
+ -> (Node.List, [Instance.Instance])
+iterateDepth nl il newinst nreq ixes =
+ let depth = length ixes
+ newname = printf "new-%d" depth
newidx = (length $ Container.elems il) + depth
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
sols = Cluster.tryAlloc nl il newi2 nreq
- orig = (nl, depth)
+ orig = (nl, ixes)
in
if isNothing sols then orig
else let sols' = fromJust sols
sols'' = filterFails sols'
in if isNothing sols'' then orig
- else let (xnl, _) = fromJust $ processResults $ fromJust sols''
- in iterateDepth xnl il newinst nreq (depth+1)
+ else let (xnl, xi, _) = fromJust $ processResults $
+ fromJust sols''
+ in iterateDepth xnl il newinst nreq (xi:ixes)
-- | Main function.
@@ -183,6 +185,7 @@ main = do
let verbose = optVerbose opts
(fixed_nl, il, csf) <- CLI.loadExternalData opts
+ let num_instances = length $ Container.elems il
let offline_names = optOffline opts
all_nodes = Container.elems fixed_nl
@@ -193,7 +196,7 @@ main = do
all_nodes
when (length offline_wrong > 0) $ do
- printf "Wrong node name(s) set as offline: %s\n"
+ printf "Error: Wrong node name(s) set as offline: %s\n"
(commaJoin offline_wrong)
exitWith $ ExitFailure 1
@@ -206,7 +209,7 @@ main = do
let bad_nodes = fst $ Cluster.computeBadItems nl il
when (length bad_nodes > 0) $ do
- putStrLn "Cluster not N+1, no space to allocate."
+ putStrLn "Error: Cluster not N+1, no space to allocate."
exitWith $ ExitFailure 1
when (optShowNodes opts) $
@@ -215,22 +218,42 @@ main = do
putStrLn $ Cluster.printNodes nl
let ini_cv = Cluster.compCV nl
+ (orig_mem, orig_disk) = Cluster.totalResources nl
(if verbose > 2 then
printf "Initial coefficients: overall %.8f, %s\n"
ini_cv (Cluster.printStats nl)
else
printf "Initial score: %.8f\n" ini_cv)
+ printf "Initial instances: %d\n" num_instances
+ printf "Initial free RAM: %d\n" orig_mem
+ printf "Initial free disk: %d\n" orig_disk
- let imlen = Container.maxNameLen il
- nmlen = Container.maxNameLen nl
+ let nmlen = Container.maxNameLen nl
newinst = Instance.create "new" (optIMem opts) (optIDsk opts)
"ADMIN_down" (-1) (-1)
- let (fin_nl, fin_depth) = iterateDepth nl il newinst (optINodes opts) 0
-
- unless (verbose == 0) $
- printf "Solution length=%d\n" fin_depth
+ let (fin_nl, ixes) =
+ iterateDepth nl il newinst (optINodes opts) []
+ allocs = length ixes
+ fin_instances = num_instances + allocs
+ fin_ixes = reverse ixes
+ ix_namelen = maximum . map (length . Instance.name) $ fin_ixes
+ (final_mem, final_disk) = Cluster.totalResources fin_nl
+
+ printf "Final score: %.8f\n" (Cluster.compCV fin_nl)
+ printf "Final instances: %d\n" (num_instances + allocs)
+ printf "Final free RAM: %d\n" final_mem
+ printf "Final free disk: %d\n" final_disk
+ printf "Usage: %.2f\n" (((fromIntegral num_instances)::Double) /
+ (fromIntegral fin_instances))
+ printf "Allocations: %d\n" allocs
+ when (verbose > 1) $ do
+ putStr . unlines . map (\i -> printf "Inst: %*s %-*s %-*s"
+ ix_namelen (Instance.name i)
+ nmlen (Container.nameOf fin_nl $ Instance.pnode i)
+ nmlen (Container.nameOf fin_nl $ Instance.snode i))
+ $ fin_ixes
when (optShowNodes opts) $
do
--
GitLab