Commit ce6a0b53 authored by Iustin Pop's avatar Iustin Pop
Browse files

htools: implement post-alloc cluster status display



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: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent fda24caf
...@@ -50,7 +50,7 @@ import Ganeti.HTools.Utils ...@@ -50,7 +50,7 @@ import Ganeti.HTools.Utils
import Ganeti.HTools.Types import Ganeti.HTools.Types
-- | Type alias for the result of an IAllocator call. -- | 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. -- | Parse the basic specifications of an instance.
-- --
...@@ -229,7 +229,12 @@ formatEvacuate as = do ...@@ -229,7 +229,12 @@ formatEvacuate as = do
when (null elems) $ fail info when (null elems) $ fail info
let sols = map (\(_, inst, nl, _) -> Instance.name inst : map Node.name nl) let sols = map (\(_, inst, nl, _) -> Instance.name inst : map Node.name nl)
elems 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. -- | Convert allocation/relocation results into the result format.
formatAllocate :: Cluster.AllocSolution -> Result IAllocResult formatAllocate :: Cluster.AllocSolution -> Result IAllocResult
...@@ -237,7 +242,7 @@ formatAllocate as = do ...@@ -237,7 +242,7 @@ formatAllocate as = do
let info = describeSolution as let info = describeSolution as
case Cluster.asSolutions as of case Cluster.asSolutions as of
[] -> fail info [] -> 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" _ -> fail "Internal error: multiple allocation solutions"
-- | Convert a node-evacuation/change group result. -- | Convert a node-evacuation/change group result.
...@@ -246,7 +251,7 @@ formatNodeEvac :: Group.List ...@@ -246,7 +251,7 @@ formatNodeEvac :: Group.List
-> Instance.List -> Instance.List
-> (Node.List, Instance.List, Cluster.EvacSolution) -> (Node.List, Instance.List, Cluster.EvacSolution)
-> Result IAllocResult -> Result IAllocResult
formatNodeEvac gl nl il (_, _, es) = formatNodeEvac gl nl il (fin_nl, _, es) =
let iname = Instance.name . flip Container.find il let iname = Instance.name . flip Container.find il
nname = Node.name . flip Container.find nl nname = Node.name . flip Container.find nl
gname = Group.name . flip Container.find gl gname = Group.name . flip Container.find gl
...@@ -257,7 +262,7 @@ formatNodeEvac gl nl il (_, _, es) = ...@@ -257,7 +262,7 @@ formatNodeEvac gl nl il (_, _, es) =
moved = length mes moved = length mes
info = show failed ++ " instances failed to move and " ++ show moved ++ info = show failed ++ " instances failed to move and " ++ show moved ++
" were moved successfully" " 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 -- | Process a request and return new node lists
processRequest :: Request -> Result IAllocResult processRequest :: Request -> Result IAllocResult
...@@ -298,10 +303,12 @@ readRequest opts args = do ...@@ -298,10 +303,12 @@ readRequest opts args = do
else return r1) else return r1)
-- | Main iallocator pipeline. -- | Main iallocator pipeline.
runIAllocator :: Request -> String runIAllocator :: Request -> (Maybe Node.List, String)
runIAllocator request = runIAllocator request =
let (ok, info, result) = let (ok, info, result, nl) =
case processRequest request of case processRequest request of
Ok (msg, r) -> (True, "Request successful: " ++ msg, r) Ok (msg, r, nl) -> (True, "Request successful: " ++ msg, r,
Bad msg -> (False, "Request failed: " ++ msg, JSArray []) Just nl)
in formatResponse ok info result Bad msg -> (False, "Request failed: " ++ msg, JSArray [], Nothing)
rstring = formatResponse ok info result
in (nl, rstring)
...@@ -71,5 +71,9 @@ main = do ...@@ -71,5 +71,9 @@ main = do
hPutStrLn stderr $ Cluster.printNodes (cdNodes cdata) hPutStrLn stderr $ Cluster.printNodes (cdNodes cdata)
(fromJust shownodes) (fromJust shownodes)
let resp = runIAllocator request let (maybe_nl, resp) = runIAllocator request
fin_nl = maybe (cdNodes cdata) id maybe_nl
putStrLn resp putStrLn resp
when (isJust shownodes) $ do
hPutStrLn stderr "Final cluster status:"
hPutStrLn stderr $ Cluster.printNodes fin_nl (fromJust shownodes)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment