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