code.grnet.gr Git - ganeti-local/blob - src/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 Container
  18 import qualified Instance
  19 import qualified Cluster
  20 import Utils
  21 import Rapi
  22
  23 -- | Command line options structure.
  24 data Options = Options
  25     { optShowNodes   :: Bool
  26     , optShowCmds    :: Bool
  27     , optNodef       :: FilePath
  28     , optInstf       :: FilePath
  29     , optMinDepth    :: Int
  30     , optMaxRemovals :: Int
  31     , optMinDelta    :: Int
  32     , optMaxDelta    :: Int
  33     , optMaster    :: String
  34     } deriving Show
  35
  36 -- | Default values for the command line options.
  37 defaultOptions :: Options
  38 defaultOptions    = Options
  39  { optShowNodes   = False
  40  , optShowCmds    = False
  41  , optNodef       = "nodes"
  42  , optInstf       = "instances"
  43  , optMinDepth    = 1
  44  , optMaxRemovals = -1
  45  , optMinDelta    = 0
  46  , optMaxDelta    = -1
  47  , optMaster    = ""
  48  }
  49
  50 {- | Start computing the solution at the given depth and recurse until
  51 we find a valid solution or we exceed the maximum depth.
  52
  53 -}
  54 iterateDepth :: Cluster.NodeList
  55              -> [Instance.Instance]
  56              -> Int
  57              -> Int
  58              -> Int
  59              -> Int
  60              -> IO (Maybe Cluster.Solution)
  61 iterateDepth nl bad_instances depth max_removals min_delta max_delta =
  62     let
  63         max_depth = length bad_instances
  64         sol = Cluster.computeSolution nl bad_instances depth
  65               max_removals min_delta max_delta
  66     in
  67       do
  68         printf "%d " depth
  69         hFlush stdout
  70         case sol `seq` sol of
  71           Nothing ->
  72               if depth > max_depth then
  73                   return Nothing
  74               else
  75                   iterateDepth nl bad_instances (depth + 1)
  76                                max_removals min_delta max_delta
  77           _ -> return sol
  78
  79 -- | Options list and functions
  80 options :: [OptDescr (Options -> Options)]
  81 options =
  82     [ Option ['p']     ["print-nodes"]
  83       (NoArg (\ opts -> opts { optShowNodes = True }))
  84       "print the final node list"
  85     , Option ['C']     ["print-commands"]
  86       (NoArg (\ opts -> opts { optShowCmds = True }))
  87       "print the ganeti command list for reaching the solution"
  88      , Option ['n']     ["nodes"]
  89       (ReqArg (\ f opts -> opts { optNodef = f }) "FILE")
  90       "the node list FILE"
  91      , Option ['i']     ["instances"]
  92       (ReqArg (\ f opts -> opts { optInstf =  f }) "FILE")
  93       "the instance list FILE"
  94      , Option ['d']     ["depth"]
  95       (ReqArg (\ i opts -> opts { optMinDepth =  (read i)::Int }) "D")
  96       "start computing the solution at depth D"
  97      , Option ['r']     ["max-removals"]
  98       (ReqArg (\ i opts -> opts { optMaxRemovals =  (read i)::Int }) "R")
  99       "do not process more than R removal sets (useful for high depths)"
 100      , Option ['L']     ["max-delta"]
 101       (ReqArg (\ i opts -> opts { optMaxDelta =  (read i)::Int }) "L")
 102       "refuse solutions with delta higher than L"
 103      , Option ['l']     ["min-delta"]
 104       (ReqArg (\ i opts -> opts { optMinDelta =  (read i)::Int }) "L")
 105       "return once a solution with delta L or lower has been found"
 106      , Option ['m']     ["master"]
 107       (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
 108       "collect data via RAPI at the given ADDRESS"
 109      ]
 110
 111 -- | Command line parser, using the 'options' structure.
 112 parseOpts :: [String] -> IO (Options, [String])
 113 parseOpts argv =
 114     case getOpt Permute options argv of
 115       (o,n,[]  ) ->
 116           return (foldl (flip id) defaultOptions o, n)
 117       (_,_,errs) ->
 118           ioError (userError (concat errs ++ usageInfo header options))
 119       where header = "Usage: hn1 [OPTION...]"
 120
 121 -- | Main function.
 122 main :: IO ()
 123 main = do
 124   cmd_args <- System.getArgs
 125   (opts, _) <- parseOpts cmd_args
 126   let min_depth = optMinDepth opts
 127   let (node_data, inst_data) =
 128           case optMaster opts of
 129             "" -> (readFile $ optNodef opts,
 130                    readFile $ optInstf opts)
 131             host -> (readData getNodes host,
 132                      readData getInstances host)
 133
 134   (nl, il, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
 135
 136   printf "Loaded %d nodes, %d instances\n"
 137              (Container.size nl)
 138              (Container.size il)
 139   let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
 140   printf "Initial check done: %d bad nodes, %d bad instances.\n"
 141              (length bad_nodes) (length bad_instances)
 142
 143   when (null bad_instances) $ do
 144          putStrLn "Happy time! Cluster is fine, no need to burn CPU."
 145          exitWith ExitSuccess
 146
 147   when (length bad_instances < min_depth) $ do
 148          printf "Error: depth %d is higher than the number of bad instances.\n"
 149                 min_depth
 150          exitWith $ ExitFailure 2
 151
 152   putStr "Computing solution: depth "
 153   hFlush stdout
 154
 155   result <- iterateDepth nl bad_instances min_depth (optMaxRemovals opts)
 156             (optMinDelta opts) (optMaxDelta opts)
 157   let (min_d, solution) =
 158           case result of
 159             Just (Cluster.Solution a b) -> (a, b)
 160             Nothing -> (-1, [])
 161   when (min_d == -1) $ do
 162          putStrLn "failed. Try to run with higher depth."
 163          exitWith $ ExitFailure 1
 164
 165   printf "found.\nSolution (delta=%d):\n" $! min_d
 166   let (sol_strs, cmd_strs) = Cluster.printSolution il ktn kti solution
 167   putStr $ unlines $ sol_strs
 168   when (optShowCmds opts) $
 169        do
 170          putStrLn ""
 171          putStrLn "Commands to run to reach the above solution:"
 172          putStr $ unlines $ map ("  echo gnt-instance " ++) $ concat cmd_strs
 173   when (optShowNodes opts) $
 174        do
 175          let (orig_mem, orig_disk) = Cluster.totalResources nl
 176              ns = Cluster.applySolution nl il solution
 177              (final_mem, final_disk) = Cluster.totalResources ns
 178          putStrLn ""
 179          putStrLn "Final cluster status:"
 180          putStrLn $ Cluster.printNodes ktn ns
 181          printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
 182          printf "Final:    mem=%d disk=%d\n" final_mem final_disk