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