1 {-| Solver for N+1 cluster errors
5 module Main (main) where
12 import System.Console.GetOpt
13 import qualified System
15 import Text.Printf (printf)
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.Rapi
22 import Ganeti.HTools.Utils
24 -- | Command line options structure.
25 data Options = Options
26 { optShowNodes :: Bool
28 , optNodef :: FilePath
29 , optNodeSet :: Bool -- ^ The nodes have been set by options
30 , optInstf :: FilePath -- ^ Path to the instances file
31 , optInstSet :: Bool -- ^ The insts have been set by options
33 , optMaxRemovals :: Int
37 , optShowVer :: Bool -- ^ Just show the program version
38 , optShowHelp :: Bool -- ^ Just show the help
41 -- | Default values for the command line options.
42 defaultOptions :: Options
43 defaultOptions = Options
44 { optShowNodes = False
48 , optInstf = "instances"
59 {- | Start computing the solution at the given depth and recurse until
60 we find a valid solution or we exceed the maximum depth.
63 iterateDepth :: Cluster.NodeList
64 -> [Instance.Instance]
69 -> IO (Maybe Cluster.Solution)
70 iterateDepth nl bad_instances depth max_removals min_delta max_delta =
72 max_depth = length bad_instances
73 sol = Cluster.computeSolution nl bad_instances depth
74 max_removals min_delta max_delta
81 if depth > max_depth then
84 iterateDepth nl bad_instances (depth + 1)
85 max_removals min_delta max_delta
88 -- | Options list and functions
89 options :: [OptDescr (Options -> Options)]
91 [ Option ['p'] ["print-nodes"]
92 (NoArg (\ opts -> opts { optShowNodes = True }))
93 "print the final node list"
94 , Option ['C'] ["print-commands"]
95 (NoArg (\ opts -> opts { optShowCmds = True }))
96 "print the ganeti command list for reaching the solution"
97 , Option ['n'] ["nodes"]
98 (ReqArg (\ f opts -> opts { optNodef = f, optNodeSet = True }) "FILE")
100 , Option ['i'] ["instances"]
101 (ReqArg (\ f opts -> opts { optInstf = f, optInstSet = True }) "FILE")
102 "the instance list FILE"
103 , Option ['d'] ["depth"]
104 (ReqArg (\ i opts -> opts { optMinDepth = (read i)::Int }) "D")
105 "start computing the solution at depth D"
106 , Option ['r'] ["max-removals"]
107 (ReqArg (\ i opts -> opts { optMaxRemovals = (read i)::Int }) "R")
108 "do not process more than R removal sets (useful for high depths)"
109 , Option ['L'] ["max-delta"]
110 (ReqArg (\ i opts -> opts { optMaxDelta = (read i)::Int }) "L")
111 "refuse solutions with delta higher than L"
112 , Option ['l'] ["min-delta"]
113 (ReqArg (\ i opts -> opts { optMinDelta = (read i)::Int }) "L")
114 "return once a solution with delta L or lower has been found"
115 , Option ['m'] ["master"]
116 (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
117 "collect data via RAPI at the given ADDRESS"
118 , Option ['V'] ["version"]
119 (NoArg (\ opts -> opts { optShowVer = True}))
120 "show the version of the program"
121 , Option ['h'] ["help"]
122 (NoArg (\ opts -> opts { optShowHelp = True}))
129 cmd_args <- System.getArgs
130 (opts, args) <- CLI.parseOpts cmd_args "hn1" options
131 defaultOptions optShowHelp
133 unless (null args) $ do
134 hPutStrLn stderr "Error: this program doesn't take any arguments."
135 exitWith $ ExitFailure 1
137 when (optShowVer opts) $ do
138 printf $ CLI.showVersion "hn1"
141 (env_node, env_inst) <- CLI.parseEnv ()
142 let nodef = if optNodeSet opts then optNodef opts
144 instf = if optInstSet opts then optInstf opts
146 min_depth = optMinDepth opts
147 (node_data, inst_data) =
148 case optMaster opts of
149 "" -> (readFile nodef,
151 host -> (readData getNodes host,
152 readData getInstances host)
154 (loaded_nl, il, csf, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
156 let (fix_msgs, nl) = Cluster.checkData loaded_nl il ktn kti
158 unless (null fix_msgs) $ do
159 putStrLn "Warning: cluster has inconsistent data:"
160 putStrLn . unlines . map (\s -> printf " - %s" s) $ fix_msgs
162 printf "Loaded %d nodes, %d instances\n"
166 when (length csf > 0) $ do
167 printf "Note: Stripping common suffix of '%s' from names\n" csf
169 let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
170 printf "Initial check done: %d bad nodes, %d bad instances.\n"
171 (length bad_nodes) (length bad_instances)
173 when (null bad_instances) $ do
174 putStrLn "Happy time! Cluster is fine, no need to burn CPU."
177 when (length bad_instances < min_depth) $ do
178 printf "Error: depth %d is higher than the number of bad instances.\n"
180 exitWith $ ExitFailure 2
182 let ini_cv = Cluster.compCV nl
183 printf "Initial coefficients: overall %.8f, %s\n"
184 ini_cv (Cluster.printStats nl)
186 putStr "Computing solution: depth "
189 result <- iterateDepth nl bad_instances min_depth (optMaxRemovals opts)
190 (optMinDelta opts) (optMaxDelta opts)
191 let (min_d, solution) =
193 Just (Cluster.Solution a b) -> (a, reverse b)
195 when (min_d == -1) $ do
196 putStrLn "failed. Try to run with higher depth."
197 exitWith $ ExitFailure 1
202 ns = Cluster.applySolution nl il solution
203 fin_cv = Cluster.compCV ns
205 printf "Final coefficients: overall %.8f, %s\n"
207 (Cluster.printStats ns)
209 printf "Solution (delta=%d):\n" $! min_d
210 let (sol_strs, cmd_strs) = Cluster.printSolution il ktn kti solution
211 putStr $ unlines $ sol_strs
212 when (optShowCmds opts) $
215 putStrLn "Commands to run to reach the above solution:"
216 putStr . Cluster.formatCmds . reverse $ cmd_strs
218 when (optShowNodes opts) $
220 let (orig_mem, orig_disk) = Cluster.totalResources nl
221 (final_mem, final_disk) = Cluster.totalResources ns
223 putStrLn "Final cluster status:"
224 putStrLn $ Cluster.printNodes ktn ns
225 printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
226 printf "Final: mem=%d disk=%d\n" final_mem final_disk