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