From ce6a0b539484f08b1034a6e36f47b48f7b2f573e Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Thu, 7 Jul 2011 18:48:30 +0200
Subject: [PATCH] htools: implement post-alloc cluster status display
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This patch changes the IAllocator result formatting workflow to return
the final node list, which can be then used to display the final node
status tooβcurrently only the initial status can be shown, which is
only half useful.
Note that as the FIXME in the code says, doing this right for the
evacuate mode is hard; however, as that mode is deprecated, we can
live it for the moment.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>
---
htools/Ganeti/HTools/IAlloc.hs | 27 +++++++++++++++++----------
htools/hail.hs | 6 +++++-
2 files changed, 22 insertions(+), 11 deletions(-)
diff --git a/htools/Ganeti/HTools/IAlloc.hs b/htools/Ganeti/HTools/IAlloc.hs
index 121294689..598c82fb5 100644
--- a/htools/Ganeti/HTools/IAlloc.hs
+++ b/htools/Ganeti/HTools/IAlloc.hs
@@ -50,7 +50,7 @@ import Ganeti.HTools.Utils
import Ganeti.HTools.Types
-- | Type alias for the result of an IAllocator call.
-type IAllocResult = (String, JSValue)
+type IAllocResult = (String, JSValue, Node.List)
-- | Parse the basic specifications of an instance.
--
@@ -229,7 +229,12 @@ formatEvacuate as = do
when (null elems) $ fail info
let sols = map (\(_, inst, nl, _) -> Instance.name inst : map Node.name nl)
elems
- return (info, showJSON sols)
+ -- FIXME: head elems is certainly not correct here, since we
+ -- don't always concat the elems and lists in the same order;
+ -- however, as the old evacuate mode is deprecated, we can leave
+ -- it like this for the moment
+ (head_nl, _, _, _) = head elems
+ return (info, showJSON sols, head_nl)
-- | Convert allocation/relocation results into the result format.
formatAllocate :: Cluster.AllocSolution -> Result IAllocResult
@@ -237,7 +242,7 @@ formatAllocate as = do
let info = describeSolution as
case Cluster.asSolutions as of
[] -> fail info
- (_, _, nodes, _):[] -> return (info, showJSON $ map (Node.name) nodes)
+ (nl, _, nodes, _):[] -> return (info, showJSON $ map (Node.name) nodes, nl)
_ -> fail "Internal error: multiple allocation solutions"
-- | Convert a node-evacuation/change group result.
@@ -246,7 +251,7 @@ formatNodeEvac :: Group.List
-> Instance.List
-> (Node.List, Instance.List, Cluster.EvacSolution)
-> Result IAllocResult
-formatNodeEvac gl nl il (_, _, es) =
+formatNodeEvac gl nl il (fin_nl, _, es) =
let iname = Instance.name . flip Container.find il
nname = Node.name . flip Container.find nl
gname = Group.name . flip Container.find gl
@@ -257,7 +262,7 @@ formatNodeEvac gl nl il (_, _, es) =
moved = length mes
info = show failed ++ " instances failed to move and " ++ show moved ++
" were moved successfully"
- in Ok (info, showJSON (mes, fes, Cluster.esOpCodes es))
+ in Ok (info, showJSON (mes, fes, Cluster.esOpCodes es), fin_nl)
-- | Process a request and return new node lists
processRequest :: Request -> Result IAllocResult
@@ -298,10 +303,12 @@ readRequest opts args = do
else return r1)
-- | Main iallocator pipeline.
-runIAllocator :: Request -> String
+runIAllocator :: Request -> (Maybe Node.List, String)
runIAllocator request =
- let (ok, info, result) =
+ let (ok, info, result, nl) =
case processRequest request of
- Ok (msg, r) -> (True, "Request successful: " ++ msg, r)
- Bad msg -> (False, "Request failed: " ++ msg, JSArray [])
- in formatResponse ok info result
+ Ok (msg, r, nl) -> (True, "Request successful: " ++ msg, r,
+ Just nl)
+ Bad msg -> (False, "Request failed: " ++ msg, JSArray [], Nothing)
+ rstring = formatResponse ok info result
+ in (nl, rstring)
diff --git a/htools/hail.hs b/htools/hail.hs
index d283b0813..2491f1588 100644
--- a/htools/hail.hs
+++ b/htools/hail.hs
@@ -71,5 +71,9 @@ main = do
hPutStrLn stderr $ Cluster.printNodes (cdNodes cdata)
(fromJust shownodes)
- let resp = runIAllocator request
+ let (maybe_nl, resp) = runIAllocator request
+ fin_nl = maybe (cdNodes cdata) id maybe_nl
putStrLn resp
+ when (isJust shownodes) $ do
+ hPutStrLn stderr "Final cluster status:"
+ hPutStrLn stderr $ Cluster.printNodes fin_nl (fromJust shownodes)
--
GitLab