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