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, csf, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
 140
 141   unless oneline $ printf "Loaded %d nodes, %d instances\n"
 142              (Container.size nl)
 143              (Container.size il)
 144
 145   when (length csf > 0 && not oneline) $ do
 146          printf "Note: Stripping common suffix of '%s' from names\n" csf
 147
 148   let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
 149   unless oneline $ printf
 150              "Initial check done: %d bad nodes, %d bad instances.\n"
 151              (length bad_nodes) (length bad_instances)
 152
 153   when (length bad_nodes > 0) $ do
 154          putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
 155                   \that the cluster will end N+1 happy."
 156
 157   when (optShowNodes opts) $
 158        do
 159          putStrLn "Initial cluster status:"
 160          putStrLn $ Cluster.printNodes ktn nl
 161
 162   let ini_cv = Cluster.compCV nl
 163       ini_tbl = Cluster.Table nl il ini_cv []
 164   unless oneline $ printf "Initial coefficients: overall %.8f, %s\n"
 165          ini_cv (Cluster.printStats nl)
 166
 167   unless oneline $ putStrLn "Trying to minimize the CV..."
 168   fin_tbl <- iterateDepth ini_tbl 1 (optMaxRounds opts) oneline
 169   let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl
 170       ord_plc = reverse fin_plc
 171   unless oneline $ printf "Final coefficients:   overall %.8f, %s\n"
 172          fin_cv
 173          (Cluster.printStats fin_nl)
 174
 175   unless oneline $ printf "Solution length=%d\n" (length ord_plc)
 176
 177   let (sol_strs, cmd_strs) = Cluster.printSolution il ktn kti ord_plc
 178   unless oneline $ putStr $ unlines $ sol_strs
 179   when (optShowCmds opts) $
 180        do
 181          putStrLn ""
 182          putStrLn "Commands to run to reach the above solution:"
 183          putStr $ unlines $ map ("  echo gnt-instance " ++) $ concat cmd_strs
 184   when (optShowNodes opts) $
 185        do
 186          let (orig_mem, orig_disk) = Cluster.totalResources nl
 187              (final_mem, final_disk) = Cluster.totalResources fin_nl
 188          putStrLn ""
 189          putStrLn "Final cluster status:"
 190          putStrLn $ Cluster.printNodes ktn fin_nl
 191          printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
 192          printf "Final:    mem=%d disk=%d\n" final_mem final_disk
 193   when oneline $ do
 194          printf "%.8f %d %.8f %8.3f\n"
 195                 ini_cv (length ord_plc) fin_cv (ini_cv / fin_cv)