code.grnet.gr Git - ganeti-local/blob - 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 Data.Maybe (isJust, fromJust, fromMaybe)
  10 import Monad
  11 import System
  12 import System.IO
  13 import System.Console.GetOpt
  14 import qualified System
  15
  16 import Text.Printf (printf)
  17
  18 import qualified Ganeti.HTools.Container as Container
  19 import qualified Ganeti.HTools.Cluster as Cluster
  20 import qualified Ganeti.HTools.Node as Node
  21 import qualified Ganeti.HTools.CLI as CLI
  22 import Ganeti.HTools.Rapi
  23 import Ganeti.HTools.Utils
  24
  25 -- | Command line options structure.
  26 data Options = Options
  27     { optShowNodes :: Bool           -- ^ Whether to show node status
  28     , optShowCmds  :: Maybe FilePath -- ^ Whether to show the command list
  29     , optOneline   :: Bool           -- ^ Switch output to a single line
  30     , optNodef     :: FilePath       -- ^ Path to the nodes file
  31     , optNodeSet   :: Bool           -- ^ The nodes have been set by options
  32     , optInstf     :: FilePath       -- ^ Path to the instances file
  33     , optInstSet   :: Bool           -- ^ The insts have been set by options
  34     , optMaxLength :: Int            -- ^ Stop after this many steps
  35     , optMaster    :: String         -- ^ Collect data from RAPI
  36     , optVerbose   :: Int            -- ^ Verbosity level
  37     , optOffline   :: [String]       -- ^ Names of offline nodes
  38     , optMinScore  :: Cluster.Score  -- ^ The minimum score we aim for
  39     , optShowVer   :: Bool           -- ^ Just show the program version
  40     , optShowHelp  :: Bool           -- ^ Just show the help
  41     } deriving Show
  42
  43 -- | Default values for the command line options.
  44 defaultOptions :: Options
  45 defaultOptions  = Options
  46  { optShowNodes = False
  47  , optShowCmds  = Nothing
  48  , optOneline   = False
  49  , optNodef     = "nodes"
  50  , optNodeSet   = False
  51  , optInstf     = "instances"
  52  , optInstSet   = False
  53  , optMaxLength = -1
  54  , optMaster    = ""
  55  , optVerbose   = 1
  56  , optOffline   = []
  57  , optMinScore  = 1e-9
  58  , optShowVer   = False
  59  , optShowHelp  = False
  60  }
  61
  62 -- | Options list and functions
  63 options :: [OptDescr (Options -> Options)]
  64 options =
  65     [ Option ['p']     ["print-nodes"]
  66       (NoArg (\ opts -> opts { optShowNodes = True }))
  67       "print the final node list"
  68     , Option ['C']     ["print-commands"]
  69       (OptArg ((\ f opts -> opts { optShowCmds = Just f }) . fromMaybe "-")
  70                   "FILE")
  71       "print the ganeti command list for reaching the solution,\
  72       \if an argument is passed then write the commands to a file named\
  73       \ as such"
  74     , Option ['o']     ["oneline"]
  75       (NoArg (\ opts -> opts { optOneline = True }))
  76       "print the ganeti command list for reaching the solution"
  77     , Option ['n']     ["nodes"]
  78       (ReqArg (\ f opts -> opts { optNodef = f, optNodeSet = True }) "FILE")
  79       "the node list FILE"
  80     , Option ['i']     ["instances"]
  81       (ReqArg (\ f opts -> opts { optInstf =  f, optInstSet = True }) "FILE")
  82       "the instance list FILE"
  83     , Option ['m']     ["master"]
  84       (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
  85       "collect data via RAPI at the given ADDRESS"
  86     , Option ['l']     ["max-length"]
  87       (ReqArg (\ i opts -> opts { optMaxLength =  (read i)::Int }) "N")
  88       "cap the solution at this many moves (useful for very unbalanced \
  89       \clusters)"
  90     , Option ['v']     ["verbose"]
  91       (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 }))
  92       "increase the verbosity level"
  93     , Option ['q']     ["quiet"]
  94       (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) - 1 }))
  95       "decrease the verbosity level"
  96     , Option ['O']     ["offline"]
  97       (ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE")
  98       " set node as offline"
  99     , Option ['e']     ["min-score"]
 100       (ReqArg (\ e opts -> opts { optMinScore = read e }) "EPSILON")
 101       " mininum score to aim for"
 102     , Option ['V']     ["version"]
 103       (NoArg (\ opts -> opts { optShowVer = True}))
 104       "show the version of the program"
 105     , Option ['h']     ["help"]
 106       (NoArg (\ opts -> opts { optShowHelp = True}))
 107       "show help"
 108     ]
 109
 110 {- | Start computing the solution at the given depth and recurse until
 111 we find a valid solution or we exceed the maximum depth.
 112
 113 -}
 114 iterateDepth :: Cluster.Table    -- ^ The starting table
 115              -> Int              -- ^ Remaining length
 116              -> Cluster.NameList -- ^ Node idx to name list
 117              -> Cluster.NameList -- ^ Inst idx to name list
 118              -> Int              -- ^ Max node name len
 119              -> Int              -- ^ Max instance name len
 120              -> [[String]]       -- ^ Current command list
 121              -> Bool             -- ^ Wheter to be silent
 122              -> Cluster.Score    -- ^ Score at which to stop
 123              -> IO (Cluster.Table, [[String]]) -- ^ The resulting table and
 124                                                -- commands
 125 iterateDepth ini_tbl max_rounds ktn kti nmlen imlen
 126              cmd_strs oneline min_score =
 127     let Cluster.Table ini_nl ini_il ini_cv ini_plc = ini_tbl
 128         all_inst = Container.elems ini_il
 129         node_idx = map Node.idx . filter (not . Node.offline) $
 130                    Container.elems ini_nl
 131         fin_tbl = Cluster.checkMove node_idx ini_tbl all_inst
 132         (Cluster.Table _ _ fin_cv fin_plc) = fin_tbl
 133         ini_plc_len = length ini_plc
 134         fin_plc_len = length fin_plc
 135         allowed_next = (max_rounds < 0 || length fin_plc < max_rounds)
 136     in
 137       do
 138         let
 139             (sol_line, cmds) = Cluster.printSolutionLine ini_il ktn kti
 140                                nmlen imlen (head fin_plc) fin_plc_len
 141             upd_cmd_strs = cmds:cmd_strs
 142         unless (oneline || fin_plc_len == ini_plc_len) $ do
 143           putStrLn sol_line
 144           hFlush stdout
 145         (if fin_cv < ini_cv then -- this round made success, try deeper
 146              if allowed_next && fin_cv > min_score
 147              then iterateDepth fin_tbl max_rounds ktn kti
 148                   nmlen imlen upd_cmd_strs oneline min_score
 149              -- don't go deeper, but return the better solution
 150              else return (fin_tbl, upd_cmd_strs)
 151          else
 152              return (ini_tbl, cmd_strs))
 153
 154 -- | Formats the solution for the oneline display
 155 formatOneline :: Double -> Int -> Double -> String
 156 formatOneline ini_cv plc_len fin_cv =
 157     printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv
 158                (if fin_cv == 0 then 1 else (ini_cv / fin_cv))
 159
 160 -- | Main function.
 161 main :: IO ()
 162 main = do
 163   cmd_args <- System.getArgs
 164   (opts, args) <- CLI.parseOpts cmd_args "hbal" options
 165                   defaultOptions optShowHelp
 166
 167   unless (null args) $ do
 168          hPutStrLn stderr "Error: this program doesn't take any arguments."
 169          exitWith $ ExitFailure 1
 170
 171   when (optShowVer opts) $ do
 172          putStr $ CLI.showVersion "hbal"
 173          exitWith ExitSuccess
 174
 175   (env_node, env_inst) <- CLI.parseEnv ()
 176   let nodef = if optNodeSet opts then optNodef opts
 177               else env_node
 178       instf = if optInstSet opts then optInstf opts
 179               else env_inst
 180       oneline = optOneline opts
 181       verbose = optVerbose opts
 182       (node_data, inst_data) =
 183           case optMaster opts of
 184             "" -> (readFile nodef,
 185                    readFile instf)
 186             host -> (getNodes host >>= readData,
 187                      getInstances host >>= readData)
 188
 189   ldresult <- liftM2 Cluster.loadData node_data inst_data
 190   (loaded_nl, il, csf, ktn, kti) <-
 191       (case ldresult of
 192          Ok x -> return x
 193          Bad s -> do
 194            printf "Error: failed to load data. Details:\n%s\n" s
 195            exitWith $ ExitFailure 1
 196       )
 197   let (fix_msgs, fixed_nl) = Cluster.checkData loaded_nl il ktn kti
 198
 199   unless (null fix_msgs || verbose == 0) $ do
 200          putStrLn "Warning: cluster has inconsistent data:"
 201          putStrLn . unlines . map (\s -> printf "  - %s" s) $ fix_msgs
 202
 203   let offline_names = optOffline opts
 204       all_names = snd . unzip $ ktn
 205       offline_wrong = filter (\n -> not $ elem n all_names) offline_names
 206       offline_indices = fst . unzip .
 207                         filter (\(_, n) -> elem n offline_names) $ ktn
 208
 209   when (length offline_wrong > 0) $ do
 210          printf "Wrong node name(s) set as offline: %s\n"
 211                 (commaJoin offline_wrong)
 212          exitWith $ ExitFailure 1
 213
 214   let nl = Container.map (\n -> if elem (Node.idx n) offline_indices
 215                                 then Node.setOffline n True
 216                                 else n) fixed_nl
 217
 218   when (Container.size il == 0) $ do
 219          (if oneline then
 220               putStrLn $ formatOneline 0 0 0
 221           else
 222               printf "Cluster is empty, exiting.\n")
 223          exitWith ExitSuccess
 224
 225
 226   unless oneline $ printf "Loaded %d nodes, %d instances\n"
 227              (Container.size nl)
 228              (Container.size il)
 229
 230   when (length csf > 0 && not oneline && verbose > 1) $ do
 231          printf "Note: Stripping common suffix of '%s' from names\n" csf
 232
 233   let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
 234   unless (oneline || verbose == 0) $ printf
 235              "Initial check done: %d bad nodes, %d bad instances.\n"
 236              (length bad_nodes) (length bad_instances)
 237
 238   when (length bad_nodes > 0) $ do
 239          putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
 240                   \that the cluster will end N+1 happy."
 241
 242   when (optShowNodes opts) $
 243        do
 244          putStrLn "Initial cluster status:"
 245          putStrLn $ Cluster.printNodes ktn nl
 246
 247   let ini_cv = Cluster.compCV nl
 248       ini_tbl = Cluster.Table nl il ini_cv []
 249       min_cv = optMinScore opts
 250
 251   when (ini_cv < min_cv) $ do
 252          (if oneline then
 253               putStrLn $ formatOneline ini_cv 0 ini_cv
 254           else printf "Cluster is already well balanced (initial score %.6g,\n\
 255                       \minimum score %.6g).\nNothing to do, exiting\n"
 256                       ini_cv min_cv)
 257          exitWith ExitSuccess
 258
 259   unless oneline (if verbose > 2 then
 260                       printf "Initial coefficients: overall %.8f, %s\n"
 261                       ini_cv (Cluster.printStats nl)
 262                   else
 263                       printf "Initial score: %.8f\n" ini_cv)
 264
 265   unless oneline $ putStrLn "Trying to minimize the CV..."
 266   let mlen_fn = maximum . (map length) . snd . unzip
 267       imlen = mlen_fn kti
 268       nmlen = mlen_fn ktn
 269
 270   (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
 271                          ktn kti nmlen imlen [] oneline min_cv
 272   let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl
 273       ord_plc = reverse fin_plc
 274       sol_msg = if null fin_plc
 275                 then printf "No solution found\n"
 276                 else (if verbose > 2
 277                       then printf "Final coefficients:   overall %.8f, %s\n"
 278                            fin_cv (Cluster.printStats fin_nl)
 279                       else printf "Cluster score improved from %.8f to %.8f\n"
 280                            ini_cv fin_cv
 281                      )
 282
 283   unless oneline $ putStr sol_msg
 284
 285   unless (oneline || verbose == 0) $
 286          printf "Solution length=%d\n" (length ord_plc)
 287
 288   let cmd_data = Cluster.formatCmds . reverse $ cmd_strs
 289
 290   when (isJust $ optShowCmds opts) $
 291        do
 292          let out_path = fromJust $ optShowCmds opts
 293          putStrLn ""
 294          (if out_path == "-" then
 295               printf "Commands to run to reach the above solution:\n%s"
 296                      (unlines . map ("  " ++) .
 297                       filter (/= "check") .
 298                       lines $ cmd_data)
 299           else do
 300             writeFile out_path (CLI.shTemplate ++ cmd_data)
 301             printf "The commands have been written to file '%s'\n" out_path)
 302
 303   when (optShowNodes opts) $
 304        do
 305          let (orig_mem, orig_disk) = Cluster.totalResources nl
 306              (final_mem, final_disk) = Cluster.totalResources fin_nl
 307          putStrLn ""
 308          putStrLn "Final cluster status:"
 309          putStrLn $ Cluster.printNodes ktn fin_nl
 310          when (verbose > 3) $
 311               do
 312                 printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
 313                 printf "Final:    mem=%d disk=%d\n" final_mem final_disk
 314   when oneline $
 315          putStrLn $ formatOneline ini_cv (length ord_plc) fin_cv