add option --print-moves to hroller

If non-redundant instances are present in the cluster, hroller will
plan for them to move to other nodes while the group is rebooted.
This adds an option to also show this plan.

Signed-off-by: Klaus Aehlig <aehlig@google.com>
Reviewed-by: Thomas Thrainer <thomasth@google.com>

diff --git a/man/hroller.rst b/man/hroller.rst
index 4666fd8..61791e2 100644 (file)
--- a/man/hroller.rst
+++ b/man/hroller.rst
@@ -36,6 +36,7 @@ Reporting options:
 **[ -v... | -q ]**
 **[ -S *file* ]**
 **[ --one-step-only ]**
+**[ --print-moves ]**
 
 DESCRIPTION
 -----------
@@ -88,6 +89,10 @@ For a description of the standard options check **htools**\(7) and
 \--one-step-only
   Restrict to the first reboot group. Output the group one node per line.
 
+\--print-moves
+  After each group list for each affected non-redundant instance a node
+  where it can be evacuated to.
+
 
 BUGS
 ----
@@ -140,6 +145,36 @@ If all instances are shut down, usually larger node groups can be found.
     node8.example.com,node6.example.com,node2.example.com
     node7.example.com,node4.example.com
 
+Rolling reboots with non-redundant instances
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+By default, hroller plans capacity to move the non-redundant instances
+out of the nodes to be rebooted. If requested, apropriate locations for
+the non-redundant instances can be shown. The assumption is that instances
+are moved back to their original node after each reboot; these back moves
+are not part of the output.
+::
+
+    $ hroller --print-moves -L
+    'Node Reboot Groups'
+    node-01-002,node-01-003
+      inst-20 node-01-001
+      inst-21 node-01-000
+      inst-30 node-01-005
+      inst-31 node-01-004
+    node-01-004,node-01-005
+      inst-40 node-01-001
+      inst-41 node-01-000
+      inst-50 node-01-003
+      inst-51 node-01-002
+    node-01-001,node-01-000
+      inst-00 node-01-002
+      inst-01 node-01-003
+      inst-10 node-01-005
+      inst-11 node-01-004
+
+
+
 .. vim: set textwidth=72 :
 .. Local Variables:
 .. mode: rst

diff --git a/src/Ganeti/HTools/CLI.hs b/src/Ganeti/HTools/CLI.hs
index 38811b1..76e3369 100644 (file)
--- a/src/Ganeti/HTools/CLI.hs
+++ b/src/Ganeti/HTools/CLI.hs
@@ -77,6 +77,7 @@ module Ganeti.HTools.CLI
   , oOutputDir
   , oPrintCommands
   , oPrintInsts
+  , oPrintMoves
   , oPrintNodes
   , oQuiet
   , oRapiMaster
@@ -146,6 +147,7 @@ data Options = Options
   , optOfflineMaintenance :: Bool    -- ^ Pretend all instances are offline
   , optOneStepOnly :: Bool           -- ^ Only do the first step
   , optOutPath     :: FilePath       -- ^ Path to the output directory
+  , optPrintMoves  :: Bool           -- ^ Whether to show the instance moves
   , optSaveCluster :: Maybe FilePath -- ^ Save cluster state to this file
   , optShowCmds    :: Maybe FilePath -- ^ Whether to show the command list
   , optShowHelp    :: Bool           -- ^ Just show the help
@@ -199,6 +201,7 @@ defaultOptions  = Options
   , optOfflineMaintenance = False
   , optOneStepOnly = False
   , optOutPath     = "."
+  , optPrintMoves  = False
   , optSaveCluster = Nothing
   , optShowCmds    = Nothing
   , optShowHelp    = False
@@ -535,6 +538,13 @@ oPrintInsts =
    "print the final instance map",
    OptComplNone)
 
+oPrintMoves :: OptType
+oPrintMoves =
+  (Option "" ["print-moves"]
+   (NoArg (\ opts -> Ok opts { optPrintMoves = True }))
+   "print the moves of the instances",
+   OptComplNone)
+
 oPrintNodes :: OptType
 oPrintNodes =
   (Option "p" ["print-nodes"]

diff --git a/src/Ganeti/HTools/Program/Hroller.hs b/src/Ganeti/HTools/Program/Hroller.hs
index 271d90d..4d25dd6 100644 (file)
--- a/src/Ganeti/HTools/Program/Hroller.hs
+++ b/src/Ganeti/HTools/Program/Hroller.hs
@@ -30,10 +30,12 @@ module Ganeti.HTools.Program.Hroller
   ) where
 
 import Control.Applicative
+import Control.Arrow
 import Control.Monad
 import Data.Function
 import Data.List
 import Data.Ord
+import Text.Printf
 
 import qualified Data.IntMap as IntMap
 
@@ -68,6 +70,7 @@ options = do
     , oNodeTags
     , oSaveCluster
     , oGroup
+    , oPrintMoves
     , oSkipNonRedundant
     , oIgnoreNonRedundant
     , oForce
@@ -127,14 +130,14 @@ clearNodes (ndx:ndxs) targets conf@(nl, _) =
 
 -- | Parition a list of nodes into chunks according cluster capacity.
 partitionNonRedundant :: [Ndx] -> [Ndx] -> (Node.List, Instance.List)
-                         -> Result [[Ndx]]
+                         -> Result [([Ndx], (Node.List, Instance.List))]
 partitionNonRedundant [] _ _ = return []
 partitionNonRedundant ndxs targets conf = do
-  (grp, _) <- clearNodes ndxs targets conf
+  (grp, conf') <- clearNodes ndxs targets conf
   guard . not . null $ grp
   let remaining = ndxs \\ grp
   part <- partitionNonRedundant remaining targets conf
-  return $ grp : part
+  return $ (grp, conf') : part
 
 -- | Gather statistics for the coloring algorithms.
 -- Returns a string with a summary on how each algorithm has performed,
@@ -177,12 +180,22 @@ noNonRedundant :: (Node.List, Instance.List) -> Node.Node -> Bool
 noNonRedundant conf = null . nonRedundant conf . Node.idx
 
 -- | Put the master node last.
--- Reorder a list of lists of nodes such that the master node (if present)
--- is the last node of the last group.
-masterLast :: [[Node.Node]] -> [[Node.Node]]
+-- Reorder a list groups of nodes (with additional information) such that the
+-- master node (if present) is the last node of the last group.
+masterLast :: [([Node.Node], a)] -> [([Node.Node], a)]
 masterLast rebootgroups =
-  map (uncurry (++)) . uncurry (++) . partition (null . snd) $
-  map (partition (not . Node.isMaster)) rebootgroups
+  map (first $ uncurry (++)) . uncurry (++) . partition (null . snd . fst) $
+  map (first $ partition (not . Node.isMaster)) rebootgroups
+
+-- | From two configurations compute the list of moved instances.
+getMoves :: (Node.List, Instance.List) -> (Node.List, Instance.List)
+            -> [(Instance.Instance, Node.Node)]
+getMoves (_, il) (nl', il') = do
+  ix <- Container.keys il
+  let inst = Container.find ix il
+      inst' = Container.find ix il'
+  guard $ Instance.pNode inst /= Instance.pNode inst'
+  return (inst', Container.find (Instance.pNode inst') nl')
 
 -- | Main function.
 main :: Options -> [String] -> IO ()
@@ -245,29 +258,39 @@ main opts args = do
       splitted = mapM (\ grp -> partitionNonRedundant grp allNdx (nlf,ilf))
                  smallestColoring
   rebootGroups <- if optIgnoreNonRedundant opts
-                     then return smallestColoring
+                     then return $ zip smallestColoring (repeat (nlf, ilf))
                      else case splitted of
                             Ok splitgroups -> return $ concat splitgroups
                             Bad _ -> exitErr "Not enough capacity to move\ 
                                              \ non-redundant instances"
   let idToNode = (`Container.find` nodes)
       nodesRebootGroups =
-        map (map idToNode . filter (`IntMap.member` nodes)) rebootGroups
+        map (first $ map idToNode . filter (`IntMap.member` nodes)) rebootGroups
       outputRebootGroups = masterLast .
-                           sortBy (flip compare `on` length) $
+                           sortBy (flip compare `on` length . fst) $
                            nodesRebootGroups
-      outputRebootNames = map (map Node.name) outputRebootGroups
+      confToMoveNames = map (Instance.name *** Node.name) . getMoves (nlf, ilf)
+      namesAndMoves = map (map Node.name *** confToMoveNames) outputRebootGroups
 
   when (verbose > 1) . putStrLn $ getStats colorings
 
+  let showGroup = if optOneStepOnly opts
+                    then mapM_ putStrLn
+                    else putStrLn . commaJoin
+      showMoves = if optPrintMoves opts
+                    then mapM_ $ putStrLn . uncurry (printf "  %s %s")
+                    else const $ return ()
+      showBoth = liftM2 (>>) (showGroup . fst) (showMoves . snd)
+
+
   if optOneStepOnly opts
      then do
        unless (optNoHeaders opts) $
               putStrLn "'First Reboot Group'"
-       case outputRebootNames of
+       case namesAndMoves of
          [] -> return ()
-         y : _ -> mapM_ putStrLn y
+         y : _ -> showBoth y
      else do
        unless (optNoHeaders opts) $
               putStrLn "'Node Reboot Groups'"
-       mapM_ (putStrLn . commaJoin) outputRebootNames
+       mapM_ showBoth namesAndMoves