code.grnet.gr Git - ganeti-local/blob - src/hbal.hs

   1 {-| Solver for N+1 cluster errors
   2
   3 -}
   4
   5 module Main (main) where
   6
   7 import Data.List
   8 import Data.Function
   9 import Monad
  10 import System
  11 import System.IO
  12 import System.Console.GetOpt
  13 import qualified System
  14
  15 import Text.Printf (printf)
  16
  17 import qualified Container
  18 import qualified Cluster
  19 import Rapi
  20 import Utils
  21
  22 -- | Command line options structure.
  23 data Options = Options
  24     { optShowNodes :: Bool
  25     , optShowCmds  :: Bool
  26     , optOneline   :: Bool
  27     , optNodef     :: FilePath
  28     , optInstf     :: FilePath
  29     , optMaxRounds :: Int
  30     , optMaster    :: String
  31     } deriving Show
  32
  33 -- | Default values for the command line options.
  34 defaultOptions :: Options
  35 defaultOptions  = Options
  36  { optShowNodes = False
  37  , optShowCmds  = False
  38  , optOneline   = False
  39  , optNodef     = "nodes"
  40  , optInstf     = "instances"
  41  , optMaxRounds = -1
  42  , optMaster    = ""
  43  }
  44
  45 {- | Start computing the solution at the given depth and recurse until
  46 we find a valid solution or we exceed the maximum depth.
  47
  48 -}
  49 iterateDepth :: Cluster.Table    -- The starting table
  50              -> Int              -- ^ Current round
  51              -> Int              -- ^ Max rounds
  52              -> Bool             -- ^ Wheter to be silent
  53              -> IO Cluster.Table -- The resulting table
  54 iterateDepth ini_tbl cur_round max_rounds oneline =
  55     let Cluster.Table ini_nl ini_il ini_cv ini_plc = ini_tbl
  56         all_inst = Container.elems ini_il
  57         node_idx = Container.keys ini_nl
  58         fin_tbl = Cluster.checkMove node_idx ini_tbl all_inst
  59         (Cluster.Table _ _ fin_cv fin_plc) = fin_tbl
  60         ini_plc_len = length ini_plc
  61         fin_plc_len = length fin_plc
  62         allowed_next = (max_rounds < 0 || cur_round < max_rounds)
  63     in
  64       do
  65         unless oneline $ printf "  - round %d: " cur_round
  66         hFlush stdout
  67         let msg =
  68                 if fin_cv < ini_cv then
  69                     if not allowed_next then
  70                         printf "%.8f, %d moves (stopping due to round limit)\n"
  71                                fin_cv
  72                                (fin_plc_len - ini_plc_len)
  73                     else
  74                         printf "%.8f, %d moves\n" fin_cv
  75                                    (fin_plc_len - ini_plc_len)
  76                 else
  77                     "no improvement, stopping\n"
  78         unless oneline $ do
  79           putStr msg
  80           hFlush stdout
  81         (if fin_cv < ini_cv then -- this round made success, try deeper
  82              if allowed_next
  83              then iterateDepth fin_tbl (cur_round + 1) max_rounds oneline
  84              -- don't go deeper, but return the better solution
  85              else return fin_tbl
  86          else
  87              return ini_tbl)
  88
  89 -- | Options list and functions
  90 options :: [OptDescr (Options -> Options)]
  91 options =
  92     [ Option ['p']     ["print-nodes"]
  93       (NoArg (\ opts -> opts { optShowNodes = True }))
  94       "print the final node list"
  95     , Option ['C']     ["print-commands"]
  96       (NoArg (\ opts -> opts { optShowCmds = True }))
  97       "print the ganeti command list for reaching the solution"
  98     , Option ['o']     ["oneline"]
  99       (NoArg (\ opts -> opts { optOneline = True }))
 100       "print the ganeti command list for reaching the solution"
 101      , Option ['n']     ["nodes"]
 102       (ReqArg (\ f opts -> opts { optNodef = f }) "FILE")
 103       "the node list FILE"
 104      , Option ['i']     ["instances"]
 105       (ReqArg (\ f opts -> opts { optInstf =  f }) "FILE")
 106       "the instance list FILE"
 107      , Option ['m']     ["master"]
 108       (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
 109       "collect data via RAPI at the given ADDRESS"
 110      , Option ['r']     ["max-rounds"]
 111       (ReqArg (\ i opts -> opts { optMaxRounds =  (read i)::Int }) "N")
 112       "do not run for more than R rounds(useful for very unbalanced clusters)"
 113      ]
 114
 115 -- | Command line parser, using the 'options' structure.
 116 parseOpts :: [String] -> IO (Options, [String])
 117 parseOpts argv =
 118     case getOpt Permute options argv of
 119       (o,n,[]  ) ->
 120           return (foldl (flip id) defaultOptions o, n)
 121       (_,_,errs) ->
 122           ioError (userError (concat errs ++ usageInfo header options))
 123       where header = "Usage: hbal [OPTION...]"
 124
 125 -- | Main function.
 126 main :: IO ()
 127 main = do
 128   cmd_args <- System.getArgs
 129   (opts, _) <- parseOpts cmd_args
 130
 131   let oneline = optOneline opts
 132   let (node_data, inst_data) =
 133           case optMaster opts of
 134             "" -> (readFile $ optNodef opts,
 135                    readFile $ optInstf opts)
 136             host -> (readData getNodes host,
 137                      readData getInstances host)
 138
 139   (nl, il, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
 140
 141
 142   unless oneline $ printf "Loaded %d nodes, %d instances\n"
 143              (Container.size nl)
 144              (Container.size il)
 145   let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
 146   unless oneline $ printf
 147              "Initial check done: %d bad nodes, %d bad instances.\n"
 148              (length bad_nodes) (length bad_instances)
 149
 150   when (length bad_nodes > 0) $ do
 151          putStrLn "Cluster is not N+1 happy, continuing but no guarantee that cluster will end N+1 happy."
 152
 153   when (optShowNodes opts) $
 154        do
 155          putStrLn "Initial cluster status:"
 156          putStrLn $ Cluster.printNodes ktn nl
 157
 158   let ini_cv = Cluster.compCV nl
 159       ini_tbl = Cluster.Table nl il ini_cv []
 160   unless oneline $ printf "Initial coefficients: overall %.8f, %s\n"
 161          ini_cv (Cluster.printStats nl)
 162
 163   unless oneline $ putStrLn "Trying to minimize the CV..."
 164   fin_tbl <- iterateDepth ini_tbl 1 (optMaxRounds opts) oneline
 165   let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl
 166       ord_plc = reverse fin_plc
 167   unless oneline $ printf "Final coefficients:   overall %.8f, %s\n"
 168          fin_cv
 169          (Cluster.printStats fin_nl)
 170
 171   unless oneline $ printf "Solution length=%d\n" (length ord_plc)
 172
 173   let (sol_strs, cmd_strs) = Cluster.printSolution il ktn kti ord_plc
 174   unless oneline $ putStr $ unlines $ sol_strs
 175   when (optShowCmds opts) $
 176        do
 177          putStrLn ""
 178          putStrLn "Commands to run to reach the above solution:"
 179          putStr $ unlines $ map ("  echo gnt-instance " ++) $ concat cmd_strs
 180   when (optShowNodes opts) $
 181        do
 182          let (orig_mem, orig_disk) = Cluster.totalResources nl
 183              (final_mem, final_disk) = Cluster.totalResources fin_nl
 184          putStrLn ""
 185          putStrLn "Final cluster status:"
 186          putStrLn $ Cluster.printNodes ktn fin_nl
 187          printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
 188          printf "Final:    mem=%d disk=%d\n" final_mem final_disk
 189   when oneline $ do
 190          printf "%.8f %d %.8f %8.3f\n"
 191                 ini_cv (length ord_plc) fin_cv (ini_cv / fin_cv)