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: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>

diff --git a/htools/Ganeti/HTools/IAlloc.hs b/htools/Ganeti/HTools/IAlloc.hs
index 1212946..598c82f 100644 (file)
--- 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 d283b08..2491f15 100644 (file)
--- 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)