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