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 qualified Version
  20 import Rapi
  21 import Utils
  22
  23 -- | Command line options structure.
  24 data Options = Options
  25     { optShowNodes :: Bool
  26     , optShowCmds  :: Bool
  27     , optOneline   :: Bool
  28     , optNodef     :: FilePath
  29     , optInstf     :: FilePath
  30     , optMaxLength :: Int
  31     , optMaster    :: String
  32     } deriving Show
  33
  34 -- | Default values for the command line options.
  35 defaultOptions :: Options
  36 defaultOptions  = Options
  37  { optShowNodes = False
  38  , optShowCmds  = False
  39  , optOneline   = False
  40  , optNodef     = "nodes"
  41  , optInstf     = "instances"
  42  , optMaxLength = -1
  43  , optMaster    = ""
  44  }
  45
  46 {- | Start computing the solution at the given depth and recurse until
  47 we find a valid solution or we exceed the maximum depth.
  48
  49 -}
  50 iterateDepth :: Cluster.Table    -- ^ The starting table
  51              -> Int              -- ^ Remaining length
  52              -> [(Int, String)]  -- ^ Node idx to name list
  53              -> [(Int, String)]  -- ^ Inst idx to name list
  54              -> Int              -- ^ Max node name len
  55              -> Int              -- ^ Max instance name len
  56              -> [[String]]       -- ^ Current command list
  57              -> Bool             -- ^ Wheter to be silent
  58              -> IO (Cluster.Table, [[String]]) -- ^ The resulting table and
  59                                                -- commands
  60 iterateDepth ini_tbl max_rounds ktn kti nmlen imlen cmd_strs oneline =
  61     let Cluster.Table ini_nl ini_il ini_cv ini_plc = ini_tbl
  62         all_inst = Container.elems ini_il
  63         node_idx = Container.keys ini_nl
  64         fin_tbl = Cluster.checkMove node_idx ini_tbl all_inst
  65         (Cluster.Table _ _ fin_cv fin_plc) = fin_tbl
  66         ini_plc_len = length ini_plc
  67         fin_plc_len = length fin_plc
  68         allowed_next = (max_rounds < 0 || length fin_plc < max_rounds)
  69     in
  70       do
  71         let
  72             (sol_line, cmds) = Cluster.printSolutionLine ini_il ktn kti
  73                                nmlen imlen (head fin_plc)
  74             upd_cmd_strs = cmds:cmd_strs
  75         unless (oneline || fin_plc_len == ini_plc_len) $ do
  76           putStrLn sol_line
  77           hFlush stdout
  78         (if fin_cv < ini_cv then -- this round made success, try deeper
  79              if allowed_next
  80              then iterateDepth fin_tbl max_rounds ktn kti
  81                   nmlen imlen upd_cmd_strs oneline
  82              -- don't go deeper, but return the better solution
  83              else return (fin_tbl, upd_cmd_strs)
  84          else
  85              return (ini_tbl, cmd_strs))
  86
  87 -- | Options list and functions
  88 options :: [OptDescr (Options -> Options)]
  89 options =
  90     [ Option ['p']     ["print-nodes"]
  91       (NoArg (\ opts -> opts { optShowNodes = True }))
  92       "print the final node list"
  93     , Option ['C']     ["print-commands"]
  94       (NoArg (\ opts -> opts { optShowCmds = True }))
  95       "print the ganeti command list for reaching the solution"
  96     , Option ['o']     ["oneline"]
  97       (NoArg (\ opts -> opts { optOneline = True }))
  98       "print the ganeti command list for reaching the solution"
  99      , Option ['n']     ["nodes"]
 100       (ReqArg (\ f opts -> opts { optNodef = f }) "FILE")
 101       "the node list FILE"
 102      , Option ['i']     ["instances"]
 103       (ReqArg (\ f opts -> opts { optInstf =  f }) "FILE")
 104       "the instance list FILE"
 105      , Option ['m']     ["master"]
 106       (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
 107       "collect data via RAPI at the given ADDRESS"
 108      , Option ['l']     ["max-length"]
 109       (ReqArg (\ i opts -> opts { optMaxLength =  (read i)::Int }) "N")
 110       "cap the solution at this many moves (useful for very unbalanced \
 111       \clusters)"
 112      ]
 113
 114 -- | Command line parser, using the 'options' structure.
 115 parseOpts :: [String] -> IO (Options, [String])
 116 parseOpts argv =
 117     case getOpt Permute options argv of
 118       (o,n,[]  ) ->
 119           return (foldl (flip id) defaultOptions o, n)
 120       (_,_,errs) ->
 121           ioError (userError (concat errs ++ usageInfo header options))
 122       where header = printf "hbal %s\nUsage: hbal [OPTION...]"
 123                      Version.version
 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   let mlen_fn = maximum . (map length) . snd . unzip
 169       imlen = mlen_fn kti
 170       nmlen = mlen_fn ktn
 171
 172   (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
 173                          ktn kti nmlen imlen [] oneline
 174   let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl
 175       ord_plc = reverse fin_plc
 176   unless oneline $ do
 177          (if null fin_plc
 178           then printf "No solution found\n"
 179           else printf "Final coefficients:   overall %.8f, %s\n"
 180                fin_cv (Cluster.printStats fin_nl))
 181
 182   unless oneline $ printf "Solution length=%d\n" (length ord_plc)
 183
 184   when (optShowCmds opts) $
 185        do
 186          putStrLn ""
 187          putStrLn "Commands to run to reach the above solution:"
 188          putStr . Cluster.formatCmds . reverse $ cmd_strs
 189   when (optShowNodes opts) $
 190        do
 191          let (orig_mem, orig_disk) = Cluster.totalResources nl
 192              (final_mem, final_disk) = Cluster.totalResources fin_nl
 193          putStrLn ""
 194          putStrLn "Final cluster status:"
 195          putStrLn $ Cluster.printNodes ktn fin_nl
 196          printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
 197          printf "Final:    mem=%d disk=%d\n" final_mem final_disk
 198   when oneline $ do
 199          printf "%.8f %d %.8f %8.3f\n"
 200                 ini_cv (length ord_plc) fin_cv (ini_cv / fin_cv)