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