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, csf, 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
 140   when (length csf > 0) $ do
 141          printf "Note: Stripping common suffix of '%s' from names\n" csf
 142
 143   let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
 144   printf "Initial check done: %d bad nodes, %d bad instances.\n"
 145              (length bad_nodes) (length bad_instances)
 146
 147   when (null bad_instances) $ do
 148          putStrLn "Happy time! Cluster is fine, no need to burn CPU."
 149          exitWith ExitSuccess
 150
 151   when (length bad_instances < min_depth) $ do
 152          printf "Error: depth %d is higher than the number of bad instances.\n"
 153                 min_depth
 154          exitWith $ ExitFailure 2
 155
 156   let ini_cv = Cluster.compCV nl
 157   printf "Initial coefficients: overall %.8f, %s\n"
 158          ini_cv (Cluster.printStats nl)
 159
 160   putStr "Computing solution: depth "
 161   hFlush stdout
 162
 163   result <- iterateDepth nl bad_instances min_depth (optMaxRemovals opts)
 164             (optMinDelta opts) (optMaxDelta opts)
 165   let (min_d, solution) =
 166           case result of
 167             Just (Cluster.Solution a b) -> (a, reverse b)
 168             Nothing -> (-1, [])
 169   when (min_d == -1) $ do
 170          putStrLn "failed. Try to run with higher depth."
 171          exitWith $ ExitFailure 1
 172
 173   printf "found.\n"
 174
 175   let
 176       ns = Cluster.applySolution nl il solution
 177       fin_cv = Cluster.compCV ns
 178
 179   printf "Final coefficients:   overall %.8f, %s\n"
 180          fin_cv
 181          (Cluster.printStats ns)
 182
 183   printf "Solution (delta=%d):\n" $! min_d
 184   let (sol_strs, cmd_strs) = Cluster.printSolution il ktn kti solution
 185   putStr $ unlines $ sol_strs
 186   when (optShowCmds opts) $
 187        do
 188          putStrLn ""
 189          putStrLn "Commands to run to reach the above solution:"
 190          putStr . Cluster.formatCmds . reverse $ cmd_strs
 191
 192   when (optShowNodes opts) $
 193        do
 194          let (orig_mem, orig_disk) = Cluster.totalResources nl
 195              (final_mem, final_disk) = Cluster.totalResources ns
 196          putStrLn ""
 197          putStrLn "Final cluster status:"
 198          putStrLn $ Cluster.printNodes ktn ns
 199          printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
 200          printf "Final:    mem=%d disk=%d\n" final_mem final_disk