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