1 {-| Solver for N+1 cluster errors
5 module Main (main) where
9 import Data.Maybe (isJust, fromJust, fromMaybe)
13 import System.Console.GetOpt
14 import qualified System
16 import Text.Printf (printf)
18 import qualified Ganeti.HTools.Container as Container
19 import qualified Ganeti.HTools.Cluster as Cluster
20 import qualified Ganeti.HTools.Node as Node
21 import qualified Ganeti.HTools.CLI as CLI
22 import qualified Ganeti.HTools.Rapi as Rapi
23 import qualified Ganeti.HTools.Text as Text
25 import Ganeti.HTools.Utils
27 -- | Command line options structure.
28 data Options = Options
29 { optShowNodes :: Bool -- ^ Whether to show node status
30 , optShowCmds :: Maybe FilePath -- ^ Whether to show the command list
31 , optOneline :: Bool -- ^ Switch output to a single line
32 , optNodef :: FilePath -- ^ Path to the nodes file
33 , optNodeSet :: Bool -- ^ The nodes have been set by options
34 , optInstf :: FilePath -- ^ Path to the instances file
35 , optInstSet :: Bool -- ^ The insts have been set by options
36 , optMaxLength :: Int -- ^ Stop after this many steps
37 , optMaster :: String -- ^ Collect data from RAPI
38 , optVerbose :: Int -- ^ Verbosity level
39 , optOffline :: [String] -- ^ Names of offline nodes
40 , optMinScore :: Cluster.Score -- ^ The minimum score we aim for
41 , optShowVer :: Bool -- ^ Just show the program version
42 , optShowHelp :: Bool -- ^ Just show the help
45 -- | Default values for the command line options.
46 defaultOptions :: Options
47 defaultOptions = Options
48 { optShowNodes = False
49 , optShowCmds = Nothing
53 , optInstf = "instances"
64 -- | Options list and functions
65 options :: [OptDescr (Options -> Options)]
67 [ Option ['p'] ["print-nodes"]
68 (NoArg (\ opts -> opts { optShowNodes = True }))
69 "print the final node list"
70 , Option ['C'] ["print-commands"]
71 (OptArg ((\ f opts -> opts { optShowCmds = Just f }) . fromMaybe "-")
73 "print the ganeti command list for reaching the solution,\
74 \if an argument is passed then write the commands to a file named\
76 , Option ['o'] ["oneline"]
77 (NoArg (\ opts -> opts { optOneline = True }))
78 "print the ganeti command list for reaching the solution"
79 , Option ['n'] ["nodes"]
80 (ReqArg (\ f opts -> opts { optNodef = f, optNodeSet = True }) "FILE")
82 , Option ['i'] ["instances"]
83 (ReqArg (\ f opts -> opts { optInstf = f, optInstSet = True }) "FILE")
84 "the instance list FILE"
85 , Option ['m'] ["master"]
86 (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
87 "collect data via RAPI at the given ADDRESS"
88 , Option ['l'] ["max-length"]
89 (ReqArg (\ i opts -> opts { optMaxLength = (read i)::Int }) "N")
90 "cap the solution at this many moves (useful for very unbalanced \
92 , Option ['v'] ["verbose"]
93 (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 }))
94 "increase the verbosity level"
95 , Option ['q'] ["quiet"]
96 (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) - 1 }))
97 "decrease the verbosity level"
98 , Option ['O'] ["offline"]
99 (ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE")
100 " set node as offline"
101 , Option ['e'] ["min-score"]
102 (ReqArg (\ e opts -> opts { optMinScore = read e }) "EPSILON")
103 " mininum score to aim for"
104 , Option ['V'] ["version"]
105 (NoArg (\ opts -> opts { optShowVer = True}))
106 "show the version of the program"
107 , Option ['h'] ["help"]
108 (NoArg (\ opts -> opts { optShowHelp = True}))
112 {- | Start computing the solution at the given depth and recurse until
113 we find a valid solution or we exceed the maximum depth.
116 iterateDepth :: Cluster.Table -- ^ The starting table
117 -> Int -- ^ Remaining length
118 -> Cluster.NameList -- ^ Node idx to name list
119 -> Cluster.NameList -- ^ Inst idx to name list
120 -> Int -- ^ Max node name len
121 -> Int -- ^ Max instance name len
122 -> [[String]] -- ^ Current command list
123 -> Bool -- ^ Wheter to be silent
124 -> Cluster.Score -- ^ Score at which to stop
125 -> IO (Cluster.Table, [[String]]) -- ^ The resulting table and
127 iterateDepth ini_tbl max_rounds ktn kti nmlen imlen
128 cmd_strs oneline min_score =
129 let Cluster.Table ini_nl ini_il ini_cv ini_plc = ini_tbl
130 all_inst = Container.elems ini_il
131 node_idx = map Node.idx . filter (not . Node.offline) $
132 Container.elems ini_nl
133 fin_tbl = Cluster.checkMove node_idx ini_tbl all_inst
134 (Cluster.Table _ _ fin_cv fin_plc) = fin_tbl
135 ini_plc_len = length ini_plc
136 fin_plc_len = length fin_plc
137 allowed_next = (max_rounds < 0 || length fin_plc < max_rounds)
141 (sol_line, cmds) = Cluster.printSolutionLine ini_il ktn kti
142 nmlen imlen (head fin_plc) fin_plc_len
143 upd_cmd_strs = cmds:cmd_strs
144 unless (oneline || fin_plc_len == ini_plc_len) $ do
147 (if fin_cv < ini_cv then -- this round made success, try deeper
148 if allowed_next && fin_cv > min_score
149 then iterateDepth fin_tbl max_rounds ktn kti
150 nmlen imlen upd_cmd_strs oneline min_score
151 -- don't go deeper, but return the better solution
152 else return (fin_tbl, upd_cmd_strs)
154 return (ini_tbl, cmd_strs))
156 -- | Formats the solution for the oneline display
157 formatOneline :: Double -> Int -> Double -> String
158 formatOneline ini_cv plc_len fin_cv =
159 printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv
160 (if fin_cv == 0 then 1 else (ini_cv / fin_cv))
165 cmd_args <- System.getArgs
166 (opts, args) <- CLI.parseOpts cmd_args "hbal" options
167 defaultOptions optShowHelp
169 unless (null args) $ do
170 hPutStrLn stderr "Error: this program doesn't take any arguments."
171 exitWith $ ExitFailure 1
173 when (optShowVer opts) $ do
174 putStr $ CLI.showVersion "hbal"
177 (env_node, env_inst) <- CLI.parseEnv ()
178 let nodef = if optNodeSet opts then optNodef opts
180 instf = if optInstSet opts then optInstf opts
182 oneline = optOneline opts
183 verbose = optVerbose opts
185 case optMaster opts of
186 "" -> Text.loadData nodef instf
187 host -> Rapi.loadData host
189 let ldresult = input_data >> Cluster.loadData
191 (loaded_nl, il, csf, ktn, kti) <-
195 printf "Error: failed to load data. Details:\n%s\n" s
196 exitWith $ ExitFailure 1
198 let (fix_msgs, fixed_nl) = Cluster.checkData loaded_nl il ktn kti
200 unless (null fix_msgs || verbose == 0) $ do
201 putStrLn "Warning: cluster has inconsistent data:"
202 putStrLn . unlines . map (\s -> printf " - %s" s) $ fix_msgs
204 let offline_names = optOffline opts
205 all_names = snd . unzip $ ktn
206 offline_wrong = filter (\n -> not $ elem n all_names) offline_names
207 offline_indices = fst . unzip .
208 filter (\(_, n) -> elem n offline_names) $ ktn
210 when (length offline_wrong > 0) $ do
211 printf "Wrong node name(s) set as offline: %s\n"
212 (commaJoin offline_wrong)
213 exitWith $ ExitFailure 1
215 let nl = Container.map (\n -> if elem (Node.idx n) offline_indices
216 then Node.setOffline n True
219 when (Container.size il == 0) $ do
221 putStrLn $ formatOneline 0 0 0
223 printf "Cluster is empty, exiting.\n")
227 unless oneline $ printf "Loaded %d nodes, %d instances\n"
231 when (length csf > 0 && not oneline && verbose > 1) $ do
232 printf "Note: Stripping common suffix of '%s' from names\n" csf
234 let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
235 unless (oneline || verbose == 0) $ printf
236 "Initial check done: %d bad nodes, %d bad instances.\n"
237 (length bad_nodes) (length bad_instances)
239 when (length bad_nodes > 0) $ do
240 putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
241 \that the cluster will end N+1 happy."
243 when (optShowNodes opts) $
245 putStrLn "Initial cluster status:"
246 putStrLn $ Cluster.printNodes ktn nl
248 let ini_cv = Cluster.compCV nl
249 ini_tbl = Cluster.Table nl il ini_cv []
250 min_cv = optMinScore opts
252 when (ini_cv < min_cv) $ do
254 putStrLn $ formatOneline ini_cv 0 ini_cv
255 else printf "Cluster is already well balanced (initial score %.6g,\n\
256 \minimum score %.6g).\nNothing to do, exiting\n"
260 unless oneline (if verbose > 2 then
261 printf "Initial coefficients: overall %.8f, %s\n"
262 ini_cv (Cluster.printStats nl)
264 printf "Initial score: %.8f\n" ini_cv)
266 unless oneline $ putStrLn "Trying to minimize the CV..."
267 let mlen_fn = maximum . (map length) . snd . unzip
271 (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
272 ktn kti nmlen imlen [] oneline min_cv
273 let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl
274 ord_plc = reverse fin_plc
275 sol_msg = if null fin_plc
276 then printf "No solution found\n"
278 then printf "Final coefficients: overall %.8f, %s\n"
279 fin_cv (Cluster.printStats fin_nl)
280 else printf "Cluster score improved from %.8f to %.8f\n"
284 unless oneline $ putStr sol_msg
286 unless (oneline || verbose == 0) $
287 printf "Solution length=%d\n" (length ord_plc)
289 let cmd_data = Cluster.formatCmds . reverse $ cmd_strs
291 when (isJust $ optShowCmds opts) $
293 let out_path = fromJust $ optShowCmds opts
295 (if out_path == "-" then
296 printf "Commands to run to reach the above solution:\n%s"
297 (unlines . map (" " ++) .
298 filter (/= "check") .
301 writeFile out_path (CLI.shTemplate ++ cmd_data)
302 printf "The commands have been written to file '%s'\n" out_path)
304 when (optShowNodes opts) $
306 let (orig_mem, orig_disk) = Cluster.totalResources nl
307 (final_mem, final_disk) = Cluster.totalResources fin_nl
309 putStrLn "Final cluster status:"
310 putStrLn $ Cluster.printNodes ktn fin_nl
313 printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
314 printf "Final: mem=%d disk=%d\n" final_mem final_disk
316 putStrLn $ formatOneline ini_cv (length ord_plc) fin_cv