code.grnet.gr Git - ganeti-local/blob - hn1.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 Ganeti.HTools.Container as Container
  18 import qualified Ganeti.HTools.Instance as Instance
  19 import qualified Ganeti.HTools.Cluster as Cluster
  20 import qualified Ganeti.HTools.CLI as CLI
  21 import Ganeti.HTools.Rapi
  22 import Ganeti.HTools.Utils
  23
  24 -- | Command line options structure.
  25 data Options = Options
  26     { optShowNodes   :: Bool
  27     , optShowCmds    :: Bool
  28     , optNodef       :: FilePath
  29     , optNodeSet     :: Bool     -- ^ The nodes have been set by options
  30     , optInstf       :: FilePath -- ^ Path to the instances file
  31     , optInstSet     :: Bool     -- ^ The insts have been set by options
  32     , optMinDepth    :: Int
  33     , optMaxRemovals :: Int
  34     , optMinDelta    :: Int
  35     , optMaxDelta    :: Int
  36     , optMaster      :: String
  37     , optShowVer     :: Bool     -- ^ Just show the program version
  38     , optShowHelp    :: Bool     -- ^ Just show the help
  39     } deriving Show
  40
  41 -- | Default values for the command line options.
  42 defaultOptions :: Options
  43 defaultOptions    = Options
  44  { optShowNodes   = False
  45  , optShowCmds    = False
  46  , optNodef       = "nodes"
  47  , optNodeSet     = False
  48  , optInstf       = "instances"
  49  , optInstSet     = False
  50  , optMinDepth    = 1
  51  , optMaxRemovals = -1
  52  , optMinDelta    = 0
  53  , optMaxDelta    = -1
  54  , optMaster      = ""
  55  , optShowVer     = False
  56  , optShowHelp    = False
  57  }
  58
  59 {- | Start computing the solution at the given depth and recurse until
  60 we find a valid solution or we exceed the maximum depth.
  61
  62 -}
  63 iterateDepth :: Cluster.NodeList
  64              -> [Instance.Instance]
  65              -> Int
  66              -> Int
  67              -> Int
  68              -> Int
  69              -> IO (Maybe Cluster.Solution)
  70 iterateDepth nl bad_instances depth max_removals min_delta max_delta =
  71     let
  72         max_depth = length bad_instances
  73         sol = Cluster.computeSolution nl bad_instances depth
  74               max_removals min_delta max_delta
  75     in
  76       do
  77         printf "%d " depth
  78         hFlush stdout
  79         case sol `seq` sol of
  80           Nothing ->
  81               if depth > max_depth then
  82                   return Nothing
  83               else
  84                   iterateDepth nl bad_instances (depth + 1)
  85                                max_removals min_delta max_delta
  86           _ -> return sol
  87
  88 -- | Options list and functions
  89 options :: [OptDescr (Options -> Options)]
  90 options =
  91     [ Option ['p']     ["print-nodes"]
  92       (NoArg (\ opts -> opts { optShowNodes = True }))
  93       "print the final node list"
  94     , Option ['C']     ["print-commands"]
  95       (NoArg (\ opts -> opts { optShowCmds = True }))
  96       "print the ganeti command list for reaching the solution"
  97     , Option ['n']     ["nodes"]
  98       (ReqArg (\ f opts -> opts { optNodef = f, optNodeSet = True }) "FILE")
  99       "the node list FILE"
 100     , Option ['i']     ["instances"]
 101       (ReqArg (\ f opts -> opts { optInstf =  f, optInstSet = True }) "FILE")
 102       "the instance list FILE"
 103     , Option ['d']     ["depth"]
 104       (ReqArg (\ i opts -> opts { optMinDepth =  (read i)::Int }) "D")
 105       "start computing the solution at depth D"
 106     , Option ['r']     ["max-removals"]
 107       (ReqArg (\ i opts -> opts { optMaxRemovals =  (read i)::Int }) "R")
 108       "do not process more than R removal sets (useful for high depths)"
 109     , Option ['L']     ["max-delta"]
 110       (ReqArg (\ i opts -> opts { optMaxDelta =  (read i)::Int }) "L")
 111       "refuse solutions with delta higher than L"
 112     , Option ['l']     ["min-delta"]
 113       (ReqArg (\ i opts -> opts { optMinDelta =  (read i)::Int }) "L")
 114       "return once a solution with delta L or lower has been found"
 115     , Option ['m']     ["master"]
 116       (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
 117       "collect data via RAPI at the given ADDRESS"
 118     , Option ['V']     ["version"]
 119       (NoArg (\ opts -> opts { optShowVer = True}))
 120       "show the version of the program"
 121     , Option ['h']     ["help"]
 122       (NoArg (\ opts -> opts { optShowHelp = True}))
 123       "show help"
 124     ]
 125
 126 -- | Main function.
 127 main :: IO ()
 128 main = do
 129   cmd_args <- System.getArgs
 130   (opts, args) <- CLI.parseOpts cmd_args "hn1" options
 131                   defaultOptions optShowHelp
 132
 133   unless (null args) $ do
 134          hPutStrLn stderr "Error: this program doesn't take any arguments."
 135          exitWith $ ExitFailure 1
 136
 137   when (optShowVer opts) $ do
 138          printf $ CLI.showVersion "hn1"
 139          exitWith ExitSuccess
 140
 141   (env_node, env_inst) <- CLI.parseEnv ()
 142   let nodef = if optNodeSet opts then optNodef opts
 143               else env_node
 144       instf = if optInstSet opts then optInstf opts
 145               else env_inst
 146       min_depth = optMinDepth opts
 147       (node_data, inst_data) =
 148           case optMaster opts of
 149             "" -> (readFile nodef,
 150                    readFile instf)
 151             host -> (readData getNodes host,
 152                      readData getInstances host)
 153
 154   (loaded_nl, il, csf, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
 155
 156   let (fix_msgs, nl) = Cluster.checkData loaded_nl il ktn kti
 157
 158   unless (null fix_msgs) $ do
 159          putStrLn "Warning: cluster has inconsistent data:"
 160          putStrLn . unlines . map (\s -> printf "  - %s" s) $ fix_msgs
 161
 162   printf "Loaded %d nodes, %d instances\n"
 163              (Container.size nl)
 164              (Container.size il)
 165
 166   when (length csf > 0) $ do
 167          printf "Note: Stripping common suffix of '%s' from names\n" csf
 168
 169   let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
 170   printf "Initial check done: %d bad nodes, %d bad instances.\n"
 171              (length bad_nodes) (length bad_instances)
 172
 173   when (null bad_instances) $ do
 174          putStrLn "Happy time! Cluster is fine, no need to burn CPU."
 175          exitWith ExitSuccess
 176
 177   when (length bad_instances < min_depth) $ do
 178          printf "Error: depth %d is higher than the number of bad instances.\n"
 179                 min_depth
 180          exitWith $ ExitFailure 2
 181
 182   let ini_cv = Cluster.compCV nl
 183   printf "Initial coefficients: overall %.8f, %s\n"
 184          ini_cv (Cluster.printStats nl)
 185
 186   putStr "Computing solution: depth "
 187   hFlush stdout
 188
 189   result <- iterateDepth nl bad_instances min_depth (optMaxRemovals opts)
 190             (optMinDelta opts) (optMaxDelta opts)
 191   let (min_d, solution) =
 192           case result of
 193             Just (Cluster.Solution a b) -> (a, reverse b)
 194             Nothing -> (-1, [])
 195   when (min_d == -1) $ do
 196          putStrLn "failed. Try to run with higher depth."
 197          exitWith $ ExitFailure 1
 198
 199   printf "found.\n"
 200
 201   let
 202       ns = Cluster.applySolution nl il solution
 203       fin_cv = Cluster.compCV ns
 204
 205   printf "Final coefficients:   overall %.8f, %s\n"
 206          fin_cv
 207          (Cluster.printStats ns)
 208
 209   printf "Solution (delta=%d):\n" $! min_d
 210   let (sol_strs, cmd_strs) = Cluster.printSolution il ktn kti solution
 211   putStr $ unlines $ sol_strs
 212   when (optShowCmds opts) $
 213        do
 214          putStrLn ""
 215          putStrLn "Commands to run to reach the above solution:"
 216          putStr . Cluster.formatCmds . reverse $ cmd_strs
 217
 218   when (optShowNodes opts) $
 219        do
 220          let (orig_mem, orig_disk) = Cluster.totalResources nl
 221              (final_mem, final_disk) = Cluster.totalResources ns
 222          putStrLn ""
 223          putStrLn "Final cluster status:"
 224          putStrLn $ Cluster.printNodes ktn ns
 225          printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
 226          printf "Final:    mem=%d disk=%d\n" final_mem final_disk