hbal: print short names in steps list

[ganeti-local] / hbal.hs

diff --git a/hbal.hs b/hbal.hs
index e5dfd29..55f428d 100644 (file)
--- a/hbal.hs
+++ b/hbal.hs
@@ -28,15 +28,13 @@ module Main (main) where
 import Control.Concurrent (threadDelay)
 import Control.Exception (bracket)
 import Data.List
 import Control.Concurrent (threadDelay)
 import Control.Exception (bracket)
 import Data.List

-import Data.Function

 import Data.Maybe (isJust, fromJust)
 import Monad
 import Data.Maybe (isJust, fromJust)
 import Monad

-import System
+import System (exitWith, ExitCode(..))

 import System.IO
 import qualified System
 
 import Text.Printf (printf, hPrintf)
 import System.IO
 import qualified System
 
 import Text.Printf (printf, hPrintf)

-import Text.JSON (showJSON)

 
 import qualified Ganeti.HTools.Container as Container
 import qualified Ganeti.HTools.Cluster as Cluster
 
 import qualified Ganeti.HTools.Container as Container
 import qualified Ganeti.HTools.Cluster as Cluster

@@ -49,17 +47,17 @@ import Ganeti.HTools.Utils
 import Ganeti.HTools.Types
 
 import qualified Ganeti.Luxi as L
 import Ganeti.HTools.Types
 
 import qualified Ganeti.Luxi as L

-import qualified Ganeti.OpCodes as OpCodes

 import Ganeti.Jobs
 
 -- | Options list and functions
 options :: [OptType]
 options =
     [ oPrintNodes
 import Ganeti.Jobs
 
 -- | Options list and functions
 options :: [OptType]
 options =
     [ oPrintNodes

+    , oPrintInsts

     , oPrintCommands
     , oOneline
     , oPrintCommands
     , oOneline

-    , oNodeFile
-    , oInstFile
+    , oDataFile
+    , oEvacMode

     , oRapiMaster
     , oLuxiSocket
     , oExecJobs
     , oRapiMaster
     , oLuxiSocket
     , oExecJobs

@@ -71,6 +69,9 @@ options =
     , oMaxCpu
     , oMinDisk
     , oDiskMoves
     , oMaxCpu
     , oMinDisk
     , oDiskMoves

+    , oDynuFile
+    , oExTags
+    , oExInst

     , oShowVer
     , oShowHelp
     ]
     , oShowVer
     , oShowHelp
     ]

@@ -87,12 +88,16 @@ iterateDepth :: Cluster.Table    -- ^ The starting table
              -> [MoveJob]        -- ^ Current command list
              -> Bool             -- ^ Whether to be silent
              -> Score            -- ^ Score at which to stop
              -> [MoveJob]        -- ^ Current command list
              -> Bool             -- ^ Whether to be silent
              -> Score            -- ^ Score at which to stop

+             -> Bool             -- ^ Enable evacuation mode

              -> IO (Cluster.Table, [MoveJob]) -- ^ The resulting table
                                               -- and commands
 iterateDepth ini_tbl max_rounds disk_moves nmlen imlen
              -> IO (Cluster.Table, [MoveJob]) -- ^ The resulting table
                                               -- and commands
 iterateDepth ini_tbl max_rounds disk_moves nmlen imlen

-             cmd_strs oneline min_score =
+             cmd_strs oneline min_score evac_mode =

     let Cluster.Table ini_nl ini_il _ _ = ini_tbl
     let Cluster.Table ini_nl ini_il _ _ = ini_tbl

-        m_fin_tbl = Cluster.tryBalance ini_tbl max_rounds disk_moves min_score
+        allowed_next = Cluster.doNextBalance ini_tbl max_rounds min_score
+        m_fin_tbl = if allowed_next
+                    then Cluster.tryBalance ini_tbl disk_moves evac_mode
+                    else Nothing

     in
       case m_fin_tbl of
         Just fin_tbl ->
     in
       case m_fin_tbl of
         Just fin_tbl ->

@@ -110,6 +115,7 @@ iterateDepth ini_tbl max_rounds disk_moves nmlen imlen
                        hFlush stdout
               iterateDepth fin_tbl max_rounds disk_moves
                            nmlen imlen upd_cmd_strs oneline min_score
                        hFlush stdout
               iterateDepth fin_tbl max_rounds disk_moves
                            nmlen imlen upd_cmd_strs oneline min_score

+                           evac_mode

         Nothing -> return (ini_tbl, cmd_strs)
 
 -- | Formats the solution for the oneline display
         Nothing -> return (ini_tbl, cmd_strs)
 
 -- | Formats the solution for the oneline display

@@ -118,10 +124,6 @@ formatOneline ini_cv plc_len fin_cv =
     printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv
                (if fin_cv == 0 then 1 else ini_cv / fin_cv)
 
     printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv
                (if fin_cv == 0 then 1 else ini_cv / fin_cv)
 

--- | Submits a list of jobs and waits for all to finish execution
-execJobs :: L.Client -> [[OpCodes.OpCode]] -> IO (Result [String])
-execJobs client = L.submitManyJobs client . showJSON
-

 -- | Polls a set of jobs at a fixed interval until all are finished
 -- one way or another
 waitForJobs :: L.Client -> [String] -> IO (Result [JobStatus])
 -- | Polls a set of jobs at a fixed interval until all are finished
 -- one way or another
 waitForJobs :: L.Client -> [String] -> IO (Result [JobStatus])

@@ -129,7 +131,7 @@ waitForJobs client jids = do
   sts <- L.queryJobsStatus client jids
   case sts of
     Bad x -> return $ Bad x
   sts <- L.queryJobsStatus client jids
   case sts of
     Bad x -> return $ Bad x

-    Ok s -> if any (<= JobRunning) s
+    Ok s -> if any (<= JOB_STATUS_RUNNING) s

             then do
               -- TODO: replace hardcoded value with a better thing
               threadDelay (1000000 * 15)
             then do
               -- TODO: replace hardcoded value with a better thing
               threadDelay (1000000 * 15)

@@ -138,21 +140,21 @@ waitForJobs client jids = do
 
 -- | Check that a set of job statuses is all success
 checkJobsStatus :: [JobStatus] -> Bool
 
 -- | Check that a set of job statuses is all success
 checkJobsStatus :: [JobStatus] -> Bool

-checkJobsStatus = all (== JobSuccess)
+checkJobsStatus = all (== JOB_STATUS_SUCCESS)

 
 -- | Execute an entire jobset
 
 -- | Execute an entire jobset

-execJobSet :: String -> String -> Node.List
+execJobSet :: String -> Node.List

            -> Instance.List -> [JobSet] -> IO ()
            -> Instance.List -> [JobSet] -> IO ()

-execJobSet _      _   _  _  [] = return ()
-execJobSet master csf nl il (js:jss) = do
+execJobSet _      _  _  [] = return ()
+execJobSet master nl il (js:jss) = do

   -- map from jobset (htools list of positions) to [[opcodes]]
   let jobs = map (\(_, idx, move, _) ->
   -- map from jobset (htools list of positions) to [[opcodes]]
   let jobs = map (\(_, idx, move, _) ->

-                      Cluster.iMoveToJob csf nl il idx move) js
+                      Cluster.iMoveToJob nl il idx move) js

   let descr = map (\(_, idx, _, _) -> Container.nameOf il idx) js
   putStrLn $ "Executing jobset for instances " ++ commaJoin descr
   jrs <- bracket (L.getClient master) L.closeClient
          (\client -> do
   let descr = map (\(_, idx, _, _) -> Container.nameOf il idx) js
   putStrLn $ "Executing jobset for instances " ++ commaJoin descr
   jrs <- bracket (L.getClient master) L.closeClient
          (\client -> do

-            jids <- execJobs client jobs
+            jids <- L.submitManyJobs client jobs

             case jids of
               Bad x -> return $ Bad x
               Ok x -> do
             case jids of
               Bad x -> return $ Bad x
               Ok x -> do

@@ -164,7 +166,7 @@ execJobSet master csf nl il (js:jss) = do
        hPutStrLn stderr $ "Cannot compute job status, aborting: " ++ show x
        return ()
      Ok x -> if checkJobsStatus x
        hPutStrLn stderr $ "Cannot compute job status, aborting: " ++ show x
        return ()
      Ok x -> if checkJobsStatus x

-             then execJobSet master csf nl il jss
+             then execJobSet master nl il jss

              else do
                hPutStrLn stderr $ "Not all jobs completed successfully: " ++
                          show x
              else do
                hPutStrLn stderr $ "Not all jobs completed successfully: " ++
                          show x

@@ -182,30 +184,37 @@ main = do
 
   let oneline = optOneline opts
       verbose = optVerbose opts
 
   let oneline = optOneline opts
       verbose = optVerbose opts

+      shownodes = optShowNodes opts

 
 

-  (fixed_nl, il, csf) <- loadExternalData opts
+  (fixed_nl, il, ctags) <- loadExternalData opts

 
   let offline_names = optOffline opts
       all_nodes = Container.elems fixed_nl
 
   let offline_names = optOffline opts
       all_nodes = Container.elems fixed_nl

-      all_names = map Node.name all_nodes
-      offline_wrong = filter (flip notElem all_names) offline_names
+      all_names = concatMap allNames all_nodes
+      offline_wrong = filter (`notElem` all_names) offline_names

       offline_indices = map Node.idx $
       offline_indices = map Node.idx $

-                        filter (\n -> elem (Node.name n) offline_names)
+                        filter (\n ->
+                                 Node.name n `elem` offline_names ||
+                                 Node.alias n `elem` offline_names)

                                all_nodes
       m_cpu = optMcpu opts
       m_dsk = optMdsk opts
                                all_nodes
       m_cpu = optMcpu opts
       m_dsk = optMdsk opts

+      csf = commonSuffix fixed_nl il

 
   when (length offline_wrong > 0) $ do
          hPrintf stderr "Wrong node name(s) set as offline: %s\n"
 
   when (length offline_wrong > 0) $ do
          hPrintf stderr "Wrong node name(s) set as offline: %s\n"

-                     (commaJoin offline_wrong)
+                     (commaJoin offline_wrong) :: IO ()

          exitWith $ ExitFailure 1
 
          exitWith $ ExitFailure 1
 

-  let nm = Container.map (\n -> if elem (Node.idx n) offline_indices
+  let nm = Container.map (\n -> if Node.idx n `elem` offline_indices

                                 then Node.setOffline n True
                                 else n) fixed_nl
       nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
            nm
 
                                 then Node.setOffline n True
                                 else n) fixed_nl
       nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
            nm
 

+  when (not oneline && verbose > 1) $
+       putStrLn $ "Loaded cluster tags: " ++ intercalate "," ctags
+

   when (Container.size il == 0) $ do
          (if oneline then putStrLn $ formatOneline 0 0 0
           else printf "Cluster is empty, exiting.\n")
   when (Container.size il == 0) $ do
          (if oneline then putStrLn $ formatOneline 0 0 0
           else printf "Cluster is empty, exiting.\n")

@@ -227,10 +236,15 @@ main = do
          putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
                   \that the cluster will end N+1 happy."
 
          putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
                   \that the cluster will end N+1 happy."
 

-  when (optShowNodes opts) $
+  when (optShowInsts opts) $ do
+         putStrLn ""
+         putStrLn "Initial instance map:"
+         putStrLn $ Cluster.printInsts nl il
+
+  when (isJust shownodes) $

        do
          putStrLn "Initial cluster status:"
        do
          putStrLn "Initial cluster status:"

-         putStrLn $ Cluster.printNodes nl
+         putStrLn $ Cluster.printNodes nl (fromJust shownodes)

 
   let ini_cv = Cluster.compCV nl
       ini_tbl = Cluster.Table nl il ini_cv []
 
   let ini_cv = Cluster.compCV nl
       ini_tbl = Cluster.Table nl il ini_cv []

@@ -251,13 +265,13 @@ main = do
                       printf "Initial score: %.8f\n" ini_cv)
 
   unless oneline $ putStrLn "Trying to minimize the CV..."
                       printf "Initial score: %.8f\n" ini_cv)
 
   unless oneline $ putStrLn "Trying to minimize the CV..."

-  let imlen = Container.maxNameLen il
-      nmlen = Container.maxNameLen nl
+  let imlen = maximum . map (length . Instance.alias) $ Container.elems il
+      nmlen = maximum . map (length . Node.alias) $ Container.elems nl

 
   (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
                          (optDiskMoves opts)
 
   (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
                          (optDiskMoves opts)

-                         nmlen imlen [] oneline min_cv
-  let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl
+                         nmlen imlen [] oneline min_cv (optEvacMode opts)
+  let (Cluster.Table fin_nl fin_il fin_cv fin_plc) = fin_tbl

       ord_plc = reverse fin_plc
       sol_msg = if null fin_plc
                 then printf "No solution found\n"
       ord_plc = reverse fin_plc
       sol_msg = if null fin_plc
                 then printf "No solution found\n"

@@ -294,19 +308,24 @@ main = do
               Nothing -> do
                 hPutStrLn stderr "Execution of commands possible only on LUXI"
                 exitWith $ ExitFailure 1
               Nothing -> do
                 hPutStrLn stderr "Execution of commands possible only on LUXI"
                 exitWith $ ExitFailure 1

-              Just master -> execJobSet master csf fin_nl il cmd_jobs)
+              Just master -> execJobSet master fin_nl il cmd_jobs)
+
+  when (optShowInsts opts) $ do
+         putStrLn ""
+         putStrLn "Final instance map:"
+         putStr $ Cluster.printInsts fin_nl fin_il

 
 

-  when (optShowNodes opts) $
+  when (isJust shownodes) $

        do
          let ini_cs = Cluster.totalResources nl
              fin_cs = Cluster.totalResources fin_nl
          putStrLn ""
          putStrLn "Final cluster status:"
        do
          let ini_cs = Cluster.totalResources nl
              fin_cs = Cluster.totalResources fin_nl
          putStrLn ""
          putStrLn "Final cluster status:"

-         putStrLn $ Cluster.printNodes fin_nl
+         putStrLn $ Cluster.printNodes fin_nl (fromJust shownodes)

          when (verbose > 3) $
               do
                 printf "Original: mem=%d disk=%d\n"
          when (verbose > 3) $
               do
                 printf "Original: mem=%d disk=%d\n"

-                       (Cluster.csFmem ini_cs) (Cluster.csFdsk ini_cs)
+                       (Cluster.csFmem ini_cs) (Cluster.csFdsk ini_cs) :: IO ()

                 printf "Final:    mem=%d disk=%d\n"
                        (Cluster.csFmem fin_cs) (Cluster.csFdsk fin_cs)
   when oneline $
                 printf "Final:    mem=%d disk=%d\n"
                        (Cluster.csFmem fin_cs) (Cluster.csFdsk fin_cs)
   when oneline $