Revision e19ee6e4 htools/Ganeti/HTools/Program/Hbal.hs
b/htools/Ganeti/HTools/Program/Hbal.hs | ||
---|---|---|
60 | 60 |
[ oPrintNodes |
61 | 61 |
, oPrintInsts |
62 | 62 |
, oPrintCommands |
63 |
, oOneline |
|
64 | 63 |
, oDataFile |
65 | 64 |
, oEvacMode |
66 | 65 |
, oRapiMaster |
... | ... | |
98 | 97 |
-> Int -- ^ Max node name len |
99 | 98 |
-> Int -- ^ Max instance name len |
100 | 99 |
-> [MoveJob] -- ^ Current command list |
101 |
-> Bool -- ^ Whether to be silent |
|
102 | 100 |
-> Score -- ^ Score at which to stop |
103 | 101 |
-> Score -- ^ Min gain limit |
104 | 102 |
-> Score -- ^ Min score gain |
... | ... | |
106 | 104 |
-> IO (Cluster.Table, [MoveJob]) -- ^ The resulting table |
107 | 105 |
-- and commands |
108 | 106 |
iterateDepth ini_tbl max_rounds disk_moves inst_moves nmlen imlen |
109 |
cmd_strs oneline min_score mg_limit min_gain evac_mode =
|
|
107 |
cmd_strs min_score mg_limit min_gain evac_mode = |
|
110 | 108 |
let Cluster.Table ini_nl ini_il _ _ = ini_tbl |
111 | 109 |
allowed_next = Cluster.doNextBalance ini_tbl max_rounds min_score |
112 | 110 |
m_fin_tbl = if allowed_next |
... | ... | |
125 | 123 |
nmlen imlen cur_plc fin_plc_len |
126 | 124 |
afn = Cluster.involvedNodes ini_il cur_plc |
127 | 125 |
upd_cmd_strs = (afn, idx, move, cmds):cmd_strs |
128 |
unless oneline $ do |
|
129 |
putStrLn sol_line |
|
130 |
hFlush stdout |
|
126 |
putStrLn sol_line |
|
127 |
hFlush stdout |
|
131 | 128 |
iterateDepth fin_tbl max_rounds disk_moves inst_moves |
132 |
nmlen imlen upd_cmd_strs oneline min_score
|
|
129 |
nmlen imlen upd_cmd_strs min_score |
|
133 | 130 |
mg_limit min_gain evac_mode |
134 | 131 |
Nothing -> return (ini_tbl, cmd_strs) |
135 | 132 |
|
136 |
-- | Formats the solution for the oneline display. |
|
137 |
formatOneline :: Double -> Int -> Double -> String |
|
138 |
formatOneline ini_cv plc_len fin_cv = |
|
139 |
printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv |
|
140 |
(if fin_cv == 0 then 1 else ini_cv / fin_cv) |
|
141 |
|
|
142 | 133 |
-- | Displays the cluster stats. |
143 | 134 |
printStats :: Node.List -> Node.List -> IO () |
144 | 135 |
printStats ini_nl fin_nl = do |
... | ... | |
324 | 315 |
Just cdata -> return (Group.name grp, cdata) |
325 | 316 |
|
326 | 317 |
-- | Do a few checks on the cluster data. |
327 |
checkCluster :: Bool -> Int -> Node.List -> Instance.List -> IO ()
|
|
328 |
checkCluster oneline verbose nl il = do
|
|
318 |
checkCluster :: Int -> Node.List -> Instance.List -> IO () |
|
319 |
checkCluster verbose nl il = do |
|
329 | 320 |
-- nothing to do on an empty cluster |
330 | 321 |
when (Container.null il) $ do |
331 |
(if oneline then putStrLn $ formatOneline 0 0 0 |
|
332 |
else printf "Cluster is empty, exiting.\n") |
|
322 |
printf "Cluster is empty, exiting.\n"::IO () |
|
333 | 323 |
exitWith ExitSuccess |
334 | 324 |
|
335 | 325 |
-- hbal doesn't currently handle split clusters |
... | ... | |
340 | 330 |
hPutStrLn stderr "Aborting." |
341 | 331 |
exitWith $ ExitFailure 1 |
342 | 332 |
|
343 |
unless oneline $ printf "Loaded %d nodes, %d instances\n"
|
|
333 |
printf "Loaded %d nodes, %d instances\n" |
|
344 | 334 |
(Container.size nl) |
345 |
(Container.size il) |
|
335 |
(Container.size il)::IO ()
|
|
346 | 336 |
|
347 | 337 |
let csf = commonSuffix nl il |
348 |
when (not (null csf) && not oneline && verbose > 1) $
|
|
338 |
when (not (null csf) && verbose > 1) $ |
|
349 | 339 |
printf "Note: Stripping common suffix of '%s' from names\n" csf |
350 | 340 |
|
351 | 341 |
-- | Do a few checks on the selected group data. |
352 |
checkGroup :: Bool -> Int -> String -> Node.List -> Instance.List -> IO ()
|
|
353 |
checkGroup oneline verbose gname nl il = do
|
|
354 |
unless oneline $ printf "Group size %d nodes, %d instances\n"
|
|
342 |
checkGroup :: Int -> String -> Node.List -> Instance.List -> IO () |
|
343 |
checkGroup verbose gname nl il = do |
|
344 |
printf "Group size %d nodes, %d instances\n" |
|
355 | 345 |
(Container.size nl) |
356 |
(Container.size il) |
|
346 |
(Container.size il)::IO ()
|
|
357 | 347 |
|
358 | 348 |
putStrLn $ "Selected node group: " ++ gname |
359 | 349 |
|
360 | 350 |
let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il |
361 |
unless (oneline || verbose == 0) $ printf
|
|
351 |
unless (verbose == 0) $ printf |
|
362 | 352 |
"Initial check done: %d bad nodes, %d bad instances.\n" |
363 | 353 |
(length bad_nodes) (length bad_instances) |
364 | 354 |
|
... | ... | |
370 | 360 |
checkNeedRebalance :: Options -> Score -> IO () |
371 | 361 |
checkNeedRebalance opts ini_cv = do |
372 | 362 |
let min_cv = optMinScore opts |
373 |
oneline = optOneline opts |
|
374 | 363 |
when (ini_cv < min_cv) $ do |
375 |
(if oneline then |
|
376 |
putStrLn $ formatOneline ini_cv 0 ini_cv |
|
377 |
else printf "Cluster is already well balanced (initial score %.6g,\n\ |
|
378 |
\minimum score %.6g).\nNothing to do, exiting\n" |
|
379 |
ini_cv min_cv) |
|
364 |
printf "Cluster is already well balanced (initial score %.6g,\n\ |
|
365 |
\minimum score %.6g).\nNothing to do, exiting\n" |
|
366 |
ini_cv min_cv:: IO () |
|
380 | 367 |
exitWith ExitSuccess |
381 | 368 |
|
382 | 369 |
-- | Main function. |
... | ... | |
389 | 376 |
hPutStrLn stderr "Error: this program doesn't take any arguments." |
390 | 377 |
exitWith $ ExitFailure 1 |
391 | 378 |
|
392 |
let oneline = optOneline opts |
|
393 |
verbose = optVerbose opts |
|
379 |
let verbose = optVerbose opts |
|
394 | 380 |
shownodes = optShowNodes opts |
395 | 381 |
showinsts = optShowInsts opts |
396 | 382 |
|
397 | 383 |
ini_cdata@(ClusterData gl fixed_nl ilf ctags) <- loadExternalData opts |
398 | 384 |
|
399 |
when (not oneline && verbose > 1) $
|
|
385 |
when (verbose > 1) $ |
|
400 | 386 |
putStrLn $ "Loaded cluster tags: " ++ intercalate "," ctags |
401 | 387 |
|
402 | 388 |
nlf <- setNodesStatus opts fixed_nl |
403 |
checkCluster oneline verbose nlf ilf
|
|
389 |
checkCluster verbose nlf ilf |
|
404 | 390 |
|
405 | 391 |
maybeSaveData (optSaveCluster opts) "original" "before balancing" ini_cdata |
406 | 392 |
|
407 | 393 |
(gname, (nl, il)) <- selectGroup opts gl nlf ilf |
408 | 394 |
|
409 |
checkGroup oneline verbose gname nl il
|
|
395 |
checkGroup verbose gname nl il |
|
410 | 396 |
|
411 | 397 |
maybePrintInsts showinsts "Initial" (Cluster.printInsts nl il) |
412 | 398 |
|
... | ... | |
418 | 404 |
|
419 | 405 |
checkNeedRebalance opts ini_cv |
420 | 406 |
|
421 |
unless oneline (if verbose > 2 then |
|
422 |
printf "Initial coefficients: overall %.8f, %s\n" |
|
423 |
ini_cv (Cluster.printStats nl) |
|
424 |
else |
|
425 |
printf "Initial score: %.8f\n" ini_cv) |
|
407 |
(if verbose > 2 |
|
408 |
then printf "Initial coefficients: overall %.8f, %s\n" |
|
409 |
ini_cv (Cluster.printStats nl)::IO () |
|
410 |
else printf "Initial score: %.8f\n" ini_cv) |
|
426 | 411 |
|
427 |
unless oneline $ putStrLn "Trying to minimize the CV..."
|
|
412 |
putStrLn "Trying to minimize the CV..." |
|
428 | 413 |
let imlen = maximum . map (length . Instance.alias) $ Container.elems il |
429 | 414 |
nmlen = maximum . map (length . Node.alias) $ Container.elems nl |
430 | 415 |
|
431 | 416 |
(fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts) |
432 | 417 |
(optDiskMoves opts) |
433 | 418 |
(optInstMoves opts) |
434 |
nmlen imlen [] oneline min_cv
|
|
419 |
nmlen imlen [] min_cv |
|
435 | 420 |
(optMinGainLim opts) (optMinGain opts) |
436 | 421 |
(optEvacMode opts) |
437 | 422 |
let (Cluster.Table fin_nl fin_il fin_cv fin_plc) = fin_tbl |
... | ... | |
445 | 430 |
printf "Cluster score improved from %.8f to %.8f\n" |
446 | 431 |
ini_cv fin_cv ::String |
447 | 432 |
|
448 |
unless oneline $ putStr sol_msg
|
|
433 |
putStr sol_msg |
|
449 | 434 |
|
450 |
unless (oneline || verbose == 0) $
|
|
435 |
unless (verbose == 0) $ |
|
451 | 436 |
printf "Solution length=%d\n" (length ord_plc) |
452 | 437 |
|
453 | 438 |
let cmd_jobs = Cluster.splitJobs cmd_strs |
... | ... | |
464 | 449 |
|
465 | 450 |
when (verbose > 3) $ printStats nl fin_nl |
466 | 451 |
|
467 |
when oneline $ putStrLn $ formatOneline ini_cv (length ord_plc) fin_cv |
|
468 |
|
|
469 | 452 |
eval <- maybeExecJobs opts ord_plc fin_nl il cmd_jobs |
470 | 453 |
unless eval (exitWith (ExitFailure 1)) |
Also available in: Unified diff