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          putStr $ 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 -> (getNodes host >>= readData,
 152                      getInstances host >>= readData)
 153
 154   ldresult <- liftM2 Cluster.loadData node_data inst_data
 155   (loaded_nl, il, csf, ktn, kti) <-
 156       (case ldresult of
 157          Ok x -> return x
 158          Bad s -> do
 159            printf "Error: failed to load data. Details:\n%s\n" s
 160            exitWith $ ExitFailure 1
 161       )
 162   let (fix_msgs, nl) = Cluster.checkData loaded_nl il ktn kti
 163
 164   unless (null fix_msgs) $ do
 165          putStrLn "Warning: cluster has inconsistent data:"
 166          putStrLn . unlines . map (\s -> printf "  - %s" s) $ fix_msgs
 167
 168   printf "Loaded %d nodes, %d instances\n"
 169              (Container.size nl)
 170              (Container.size il)
 171
 172   when (length csf > 0) $ do
 173          printf "Note: Stripping common suffix of '%s' from names\n" csf
 174
 175   let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
 176   printf "Initial check done: %d bad nodes, %d bad instances.\n"
 177              (length bad_nodes) (length bad_instances)
 178
 179   when (null bad_instances) $ do
 180          putStrLn "Happy time! Cluster is fine, no need to burn CPU."
 181          exitWith ExitSuccess
 182
 183   when (length bad_instances < min_depth) $ do
 184          printf "Error: depth %d is higher than the number of bad instances.\n"
 185                 min_depth
 186          exitWith $ ExitFailure 2
 187
 188   let ini_cv = Cluster.compCV nl
 189   printf "Initial coefficients: overall %.8f, %s\n"
 190          ini_cv (Cluster.printStats nl)
 191
 192   putStr "Computing solution: depth "
 193   hFlush stdout
 194
 195   result <- iterateDepth nl bad_instances min_depth (optMaxRemovals opts)
 196             (optMinDelta opts) (optMaxDelta opts)
 197   let (min_d, solution) =
 198           case result of
 199             Just (Cluster.Solution a b) -> (a, reverse b)
 200             Nothing -> (-1, [])
 201   when (min_d == -1) $ do
 202          putStrLn "failed. Try to run with higher depth."
 203          exitWith $ ExitFailure 1
 204
 205   printf "found.\n"
 206
 207   let
 208       ns = Cluster.applySolution nl il solution
 209       fin_cv = Cluster.compCV ns
 210
 211   printf "Final coefficients:   overall %.8f, %s\n"
 212          fin_cv
 213          (Cluster.printStats ns)
 214
 215   printf "Solution (delta=%d):\n" $! min_d
 216   let (sol_strs, cmd_strs) = Cluster.printSolution il ktn kti solution
 217   putStr $ unlines $ sol_strs
 218   when (optShowCmds opts) $
 219        do
 220          putStrLn ""
 221          putStrLn "Commands to run to reach the above solution:"
 222          putStr . Cluster.formatCmds . reverse $ cmd_strs
 223
 224   when (optShowNodes opts) $
 225        do
 226          let (orig_mem, orig_disk) = Cluster.totalResources nl
 227              (final_mem, final_disk) = Cluster.totalResources ns
 228          putStrLn ""
 229          putStrLn "Final cluster status:"
 230          putStrLn $ Cluster.printNodes ktn ns
 231          printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
 232          printf "Final:    mem=%d disk=%d\n" final_mem final_disk