1 {-| Implementation of cluster-wide logic.
3 This module holds all pure cluster-logic; I\/O related functionality
4 goes into the "Main" module for the individual binaries.
8 module Ganeti.HTools.Cluster
20 -- * Generic functions
22 -- * First phase functions
24 -- * Second phase functions
31 -- * Balacing functions
39 import Data.Maybe (isNothing, fromJust)
40 import Text.Printf (printf)
44 import qualified Ganeti.HTools.Container as Container
45 import qualified Ganeti.HTools.Instance as Instance
46 import qualified Ganeti.HTools.Node as Node
47 import Ganeti.HTools.Types
48 import Ganeti.HTools.Utils
50 -- | A separate name for the cluster score type
53 -- | The description of an instance placement.
54 type Placement = (Int, Int, Int, Score)
56 {- | A cluster solution described as the solution delta and the list
60 data Solution = Solution Int [Placement]
61 deriving (Eq, Ord, Show)
63 -- | Returns the delta of a solution or -1 for Nothing
64 solutionDelta :: Maybe Solution -> Int
65 solutionDelta sol = case sol of
66 Just (Solution d _) -> d
70 data Removal = Removal NodeList [Instance.Instance]
72 -- | An instance move definition
73 data IMove = Failover -- ^ Failover the instance (f)
74 | ReplacePrimary Int -- ^ Replace primary (f, r:np, f)
75 | ReplaceSecondary Int -- ^ Replace secondary (r:ns)
76 | ReplaceAndFailover Int -- ^ Replace secondary, failover (r:np, f)
77 | FailoverAndReplace Int -- ^ Failover, replace secondary (f, r:ns)
80 -- | The complete state for the balancing solution
81 data Table = Table NodeList InstanceList Score [Placement]
86 -- | Cap the removal list if needed.
87 capRemovals :: [a] -> Int -> [a]
88 capRemovals removals max_removals =
89 if max_removals > 0 then
90 take max_removals removals
94 -- | Check if the given node list fails the N+1 check.
95 verifyN1Check :: [Node.Node] -> Bool
96 verifyN1Check nl = any Node.failN1 nl
98 -- | Verifies the N+1 status and return the affected nodes.
99 verifyN1 :: [Node.Node] -> [Node.Node]
100 verifyN1 nl = filter Node.failN1 nl
102 {-| Add an instance and return the new node and instance maps. -}
103 addInstance :: NodeList -> Instance.Instance ->
104 Node.Node -> Node.Node -> Maybe NodeList
105 addInstance nl idata pri sec =
106 let pdx = Node.idx pri
109 pnode <- Node.addPri pri idata
110 snode <- Node.addSec sec idata pdx
111 new_nl <- return $ Container.addTwo sdx snode
115 -- | Remove an instance and return the new node and instance maps.
116 removeInstance :: NodeList -> Instance.Instance -> NodeList
117 removeInstance nl idata =
118 let pnode = Instance.pnode idata
119 snode = Instance.snode idata
120 pn = Container.find pnode nl
121 sn = Container.find snode nl
122 new_nl = Container.addTwo
123 pnode (Node.removePri pn idata)
124 snode (Node.removeSec sn idata) nl in
127 -- | Remove an instance and return the new node map.
128 removeInstances :: NodeList -> [Instance.Instance] -> NodeList
129 removeInstances = foldl' removeInstance
131 -- | Compute the total free disk and memory in the cluster.
132 totalResources :: Container.Container Node.Node -> (Int, Int)
135 (\ (mem, dsk) node -> (mem + (Node.f_mem node),
136 dsk + (Node.f_dsk node)))
137 (0, 0) (Container.elems nl)
139 {- | Compute a new version of a cluster given a solution.
141 This is not used for computing the solutions, but for applying a
142 (known-good) solution to the original cluster for final display.
144 It first removes the relocated instances after which it places them on
148 applySolution :: NodeList -> InstanceList -> [Placement] -> NodeList
149 applySolution nl il sol =
150 let odxes = map (\ (a, b, c, _) -> (Container.find a il,
151 Node.idx (Container.find b nl),
152 Node.idx (Container.find c nl))
154 idxes = (\ (x, _, _) -> x) (unzip3 odxes)
155 nc = removeInstances nl idxes
157 foldl' (\ nz (a, b, c) ->
158 let new_p = Container.find b nz
159 new_s = Container.find c nz in
160 fromJust (addInstance nz a new_p new_s)
164 -- First phase functions
166 {- | Given a list 1,2,3..n build a list of pairs [(1, [2..n]), (2,
170 genParts :: [a] -> Int -> [(a, [a])]
175 if length l < count then
178 (x, xs) : (genParts xs count)
180 -- | Generates combinations of count items from the names list.
181 genNames :: Int -> [b] -> [[b]]
182 genNames count1 names1 =
183 let aux_fn count names current =
188 (\ (x, xs) -> aux_fn (count - 1) xs (x:current))
189 (genParts names count)
191 aux_fn count1 names1 []
193 {- | Computes the pair of bad nodes and instances.
195 The bad node list is computed via a simple 'verifyN1' check, and the
196 bad instance list is the list of primary and secondary instances of
200 computeBadItems :: NodeList -> InstanceList ->
201 ([Node.Node], [Instance.Instance])
202 computeBadItems nl il =
203 let bad_nodes = verifyN1 $ filter (not . Node.offline) $ Container.elems nl
204 bad_instances = map (\idx -> Container.find idx il) $
205 sort $ nub $ concat $
206 map (\ n -> (Node.slist n) ++ (Node.plist n)) bad_nodes
208 (bad_nodes, bad_instances)
211 {- | Checks if removal of instances results in N+1 pass.
213 Note: the check removal cannot optimize by scanning only the affected
214 nodes, since the cluster is known to be not healthy; only the check
215 placement can make this shortcut.
218 checkRemoval :: NodeList -> [Instance.Instance] -> Maybe Removal
219 checkRemoval nl victims =
220 let nx = removeInstances nl victims
221 failN1 = verifyN1Check (Container.elems nx)
226 Just $ Removal nx victims
229 -- | Computes the removals list for a given depth
230 computeRemovals :: NodeList
231 -> [Instance.Instance]
234 computeRemovals nl bad_instances depth =
235 map (checkRemoval nl) $ genNames depth bad_instances
237 -- Second phase functions
239 -- | Single-node relocation cost
240 nodeDelta :: Int -> Int -> Int -> Int
242 if i == p || i == s then
247 {-| Compute best solution.
249 This function compares two solutions, choosing the minimum valid
252 compareSolutions :: Maybe Solution -> Maybe Solution -> Maybe Solution
253 compareSolutions a b = case (a, b) of
258 -- | Compute best table. Note that the ordering of the arguments is important.
259 compareTables :: Table -> Table -> Table
260 compareTables a@(Table _ _ a_cv _) b@(Table _ _ b_cv _ ) =
261 if a_cv > b_cv then b else a
263 -- | Check if a given delta is worse then an existing solution.
264 tooHighDelta :: Maybe Solution -> Int -> Int -> Bool
265 tooHighDelta sol new_delta max_delta =
266 if new_delta > max_delta && max_delta >=0 then
271 Just (Solution old_delta _) -> old_delta <= new_delta
273 {-| Check if placement of instances still keeps the cluster N+1 compliant.
275 This is the workhorse of the allocation algorithm: given the
276 current node and instance maps, the list of instances to be
277 placed, and the current solution, this will return all possible
278 solution by recursing until all target instances are placed.
281 checkPlacement :: NodeList -- ^ The current node list
282 -> [Instance.Instance] -- ^ List of instances still to place
283 -> [Placement] -- ^ Partial solution until now
284 -> Int -- ^ The delta of the partial solution
285 -> Maybe Solution -- ^ The previous solution
286 -> Int -- ^ Abort if the we go above this delta
287 -> Maybe Solution -- ^ The new solution
288 checkPlacement nl victims current current_delta prev_sol max_delta =
289 let target = head victims
290 opdx = Instance.pnode target
291 osdx = Instance.snode target
293 have_tail = (length vtail) > 0
294 nodes = Container.elems nl
295 iidx = Instance.idx target
300 pri_idx = Node.idx pri
301 upri_delta = current_delta + nodeDelta pri_idx opdx osdx
302 new_pri = Node.addPri pri target
303 fail_delta1 = tooHighDelta accu_p upri_delta max_delta
305 if fail_delta1 || isNothing(new_pri) then accu_p
306 else let pri_nl = Container.add pri_idx (fromJust new_pri) nl in
310 sec_idx = Node.idx sec
311 upd_delta = upri_delta +
312 nodeDelta sec_idx opdx osdx
313 fail_delta2 = tooHighDelta accu upd_delta max_delta
314 new_sec = Node.addSec sec target pri_idx
316 if sec_idx == pri_idx || fail_delta2 ||
317 isNothing new_sec then accu
319 nx = Container.add sec_idx (fromJust new_sec) pri_nl
321 plc = (iidx, pri_idx, sec_idx, upd_cv)
325 checkPlacement nx vtail c2 upd_delta
328 Just (Solution upd_delta c2)
329 in compareSolutions accu result
334 applyMove :: NodeList -> Instance.Instance
335 -> IMove -> (Maybe NodeList, Instance.Instance, Int, Int)
337 applyMove nl inst Failover =
338 let old_pdx = Instance.pnode inst
339 old_sdx = Instance.snode inst
340 old_p = Container.find old_pdx nl
341 old_s = Container.find old_sdx nl
342 int_p = Node.removePri old_p inst
343 int_s = Node.removeSec old_s inst
344 new_nl = do -- Maybe monad
345 new_p <- Node.addPri int_s inst
346 new_s <- Node.addSec int_p inst old_sdx
347 return $ Container.addTwo old_pdx new_s old_sdx new_p nl
348 in (new_nl, Instance.setBoth inst old_sdx old_pdx, old_sdx, old_pdx)
350 -- Replace the primary (f:, r:np, f)
351 applyMove nl inst (ReplacePrimary new_pdx) =
352 let old_pdx = Instance.pnode inst
353 old_sdx = Instance.snode inst
354 old_p = Container.find old_pdx nl
355 old_s = Container.find old_sdx nl
356 tgt_n = Container.find new_pdx nl
357 int_p = Node.removePri old_p inst
358 int_s = Node.removeSec old_s inst
359 new_nl = do -- Maybe monad
360 new_p <- Node.addPri tgt_n inst
361 new_s <- Node.addSec int_s inst new_pdx
362 return $ Container.add new_pdx new_p $
363 Container.addTwo old_pdx int_p old_sdx new_s nl
364 in (new_nl, Instance.setPri inst new_pdx, new_pdx, old_sdx)
366 -- Replace the secondary (r:ns)
367 applyMove nl inst (ReplaceSecondary new_sdx) =
368 let old_pdx = Instance.pnode inst
369 old_sdx = Instance.snode inst
370 old_s = Container.find old_sdx nl
371 tgt_n = Container.find new_sdx nl
372 int_s = Node.removeSec old_s inst
373 new_nl = Node.addSec tgt_n inst old_pdx >>=
374 \new_s -> return $ Container.addTwo new_sdx
375 new_s old_sdx int_s nl
376 in (new_nl, Instance.setSec inst new_sdx, old_pdx, new_sdx)
378 -- Replace the secondary and failover (r:np, f)
379 applyMove nl inst (ReplaceAndFailover new_pdx) =
380 let old_pdx = Instance.pnode inst
381 old_sdx = Instance.snode inst
382 old_p = Container.find old_pdx nl
383 old_s = Container.find old_sdx nl
384 tgt_n = Container.find new_pdx nl
385 int_p = Node.removePri old_p inst
386 int_s = Node.removeSec old_s inst
387 new_nl = do -- Maybe monad
388 new_p <- Node.addPri tgt_n inst
389 new_s <- Node.addSec int_p inst new_pdx
390 return $ Container.add new_pdx new_p $
391 Container.addTwo old_pdx new_s old_sdx int_s nl
392 in (new_nl, Instance.setBoth inst new_pdx old_pdx, new_pdx, old_pdx)
394 -- Failver and replace the secondary (f, r:ns)
395 applyMove nl inst (FailoverAndReplace new_sdx) =
396 let old_pdx = Instance.pnode inst
397 old_sdx = Instance.snode inst
398 old_p = Container.find old_pdx nl
399 old_s = Container.find old_sdx nl
400 tgt_n = Container.find new_sdx nl
401 int_p = Node.removePri old_p inst
402 int_s = Node.removeSec old_s inst
403 new_nl = do -- Maybe monad
404 new_p <- Node.addPri int_s inst
405 new_s <- Node.addSec tgt_n inst old_sdx
406 return $ Container.add new_sdx new_s $
407 Container.addTwo old_sdx new_p old_pdx int_p nl
408 in (new_nl, Instance.setBoth inst old_sdx new_sdx, old_sdx, new_sdx)
410 checkSingleStep :: Table -- ^ The original table
411 -> Instance.Instance -- ^ The instance to move
412 -> Table -- ^ The current best table
413 -> IMove -- ^ The move to apply
414 -> Table -- ^ The final best table
415 checkSingleStep ini_tbl target cur_tbl move =
417 Table ini_nl ini_il _ ini_plc = ini_tbl
418 (tmp_nl, new_inst, pri_idx, sec_idx) = applyMove ini_nl target move
420 if isNothing tmp_nl then cur_tbl
422 let tgt_idx = Instance.idx target
423 upd_nl = fromJust tmp_nl
424 upd_cvar = compCV upd_nl
425 upd_il = Container.add tgt_idx new_inst ini_il
426 upd_plc = (tgt_idx, pri_idx, sec_idx, upd_cvar):ini_plc
427 upd_tbl = Table upd_nl upd_il upd_cvar upd_plc
429 compareTables cur_tbl upd_tbl
431 -- | Given the status of the current secondary as a valid new node
432 -- and the current candidate target node,
433 -- generate the possible moves for a instance.
434 possibleMoves :: Bool -> Int -> [IMove]
435 possibleMoves True tdx =
436 [ReplaceSecondary tdx,
437 ReplaceAndFailover tdx,
439 FailoverAndReplace tdx]
441 possibleMoves False tdx =
442 [ReplaceSecondary tdx,
443 ReplaceAndFailover tdx]
445 -- | Compute the best move for a given instance.
446 checkInstanceMove :: [Int] -- Allowed target node indices
447 -> Table -- Original table
448 -> Instance.Instance -- Instance to move
449 -> Table -- Best new table for this instance
450 checkInstanceMove nodes_idx ini_tbl target =
452 opdx = Instance.pnode target
453 osdx = Instance.snode target
454 nodes = filter (\idx -> idx /= opdx && idx /= osdx) nodes_idx
455 use_secondary = elem osdx nodes_idx
456 aft_failover = if use_secondary -- if allowed to failover
457 then checkSingleStep ini_tbl target ini_tbl Failover
459 all_moves = concatMap (possibleMoves use_secondary) nodes
461 -- iterate over the possible nodes for this instance
462 foldl' (checkSingleStep ini_tbl target) aft_failover all_moves
464 -- | Compute the best next move.
465 checkMove :: [Int] -- ^ Allowed target node indices
466 -> Table -- ^ The current solution
467 -> [Instance.Instance] -- ^ List of instances still to move
468 -> Table -- ^ The new solution
469 checkMove nodes_idx ini_tbl victims =
470 let Table _ _ _ ini_plc = ini_tbl
471 -- iterate over all instances, computing the best move
475 if Instance.snode elem == Node.noSecondary then step_tbl
476 else compareTables step_tbl $
477 checkInstanceMove nodes_idx ini_tbl elem)
479 Table _ _ _ best_plc = best_tbl
481 if length best_plc == length ini_plc then -- no advancement
486 {- | Auxiliary function for solution computation.
488 We write this in an explicit recursive fashion in order to control
489 early-abort in case we have met the min delta. We can't use foldr
490 instead of explicit recursion since we need the accumulator for the
494 advanceSolution :: [Maybe Removal] -- ^ The removal to process
495 -> Int -- ^ Minimum delta parameter
496 -> Int -- ^ Maximum delta parameter
497 -> Maybe Solution -- ^ Current best solution
498 -> Maybe Solution -- ^ New best solution
499 advanceSolution [] _ _ sol = sol
500 advanceSolution (Nothing:xs) m n sol = advanceSolution xs m n sol
501 advanceSolution ((Just (Removal nx removed)):xs) min_d max_d prev_sol =
502 let new_sol = checkPlacement nx removed [] 0 prev_sol max_d
503 new_delta = solutionDelta $! new_sol
505 if new_delta >= 0 && new_delta <= min_d then
508 advanceSolution xs min_d max_d new_sol
510 -- | Computes the placement solution.
511 solutionFromRemovals :: [Maybe Removal] -- ^ The list of (possible) removals
512 -> Int -- ^ Minimum delta parameter
513 -> Int -- ^ Maximum delta parameter
514 -> Maybe Solution -- ^ The best solution found
515 solutionFromRemovals removals min_delta max_delta =
516 advanceSolution removals min_delta max_delta Nothing
518 {- | Computes the solution at the given depth.
520 This is a wrapper over both computeRemovals and
521 solutionFromRemovals. In case we have no solution, we return Nothing.
524 computeSolution :: NodeList -- ^ The original node data
525 -> [Instance.Instance] -- ^ The list of /bad/ instances
526 -> Int -- ^ The /depth/ of removals
527 -> Int -- ^ Maximum number of removals to process
528 -> Int -- ^ Minimum delta parameter
529 -> Int -- ^ Maximum delta parameter
530 -> Maybe Solution -- ^ The best solution found (or Nothing)
531 computeSolution nl bad_instances depth max_removals min_delta max_delta =
533 removals = computeRemovals nl bad_instances depth
534 removals' = capRemovals removals max_removals
536 solutionFromRemovals removals' min_delta max_delta
538 -- Solution display functions (pure)
540 -- | Given the original and final nodes, computes the relocation description.
541 computeMoves :: String -- ^ The instance name
542 -> String -- ^ Original primary
543 -> String -- ^ Original secondary
544 -> String -- ^ New primary
545 -> String -- ^ New secondary
546 -> (String, [String])
547 -- ^ Tuple of moves and commands list; moves is containing
548 -- either @/f/@ for failover or @/r:name/@ for replace
549 -- secondary, while the command list holds gnt-instance
550 -- commands (without that prefix), e.g \"@failover instance1@\"
551 computeMoves i a b c d =
552 if c == a then {- Same primary -}
553 if d == b then {- Same sec??! -}
555 else {- Change of secondary -}
557 [printf "replace-disks -n %s %s" d i])
559 if c == b then {- Failover and ... -}
560 if d == a then {- that's all -}
561 ("f", [printf "migrate -f %s" i])
564 [printf "migrate -f %s" i,
565 printf "replace-disks -n %s %s" d i])
567 if d == a then {- ... and keep primary as secondary -}
569 [printf "replace-disks -n %s %s" c i,
570 printf "migrate -f %s" i])
572 if d == b then {- ... keep same secondary -}
573 (printf "f r:%s f" c,
574 [printf "migrate -f %s" i,
575 printf "replace-disks -n %s %s" c i,
576 printf "migrate -f %s" i])
578 else {- Nothing in common -}
579 (printf "r:%s f r:%s" c d,
580 [printf "replace-disks -n %s %s" c i,
581 printf "migrate -f %s" i,
582 printf "replace-disks -n %s %s" d i])
584 {-| Converts a placement to string format -}
585 printSolutionLine :: NodeList
591 -> (String, [String])
592 printSolutionLine nl il nmlen imlen plc pos =
594 pmlen = (2*nmlen + 1)
596 inst = Container.find i il
597 inam = Instance.name inst
600 opri = cNameOf nl $ Instance.pnode inst
601 osec = cNameOf nl $ Instance.snode inst
602 (moves, cmds) = computeMoves inam opri osec npri nsec
603 ostr = (printf "%s:%s" opri osec)::String
604 nstr = (printf "%s:%s" npri nsec)::String
606 (printf " %3d. %-*s %-*s => %-*s %.8f a=%s"
607 pos imlen inam pmlen ostr
611 formatCmds :: [[String]] -> String
612 formatCmds cmd_strs =
614 concat $ map (\(a, b) ->
615 (printf "echo step %d" (a::Int)):
617 (map ("gnt-instance " ++) b)) $
620 {-| Converts a solution to string format -}
621 printSolution :: NodeList
624 -> ([String], [[String]])
625 printSolution nl il sol =
627 nmlen = cMaxNamelen nl
628 imlen = cMaxNamelen il
630 unzip $ map (uncurry $ printSolutionLine nl il nmlen imlen) $
633 -- | Print the node list.
634 printNodes :: NodeList -> String
636 let snl = sortBy (compare `on` Node.idx) (Container.elems nl)
637 m_name = maximum . map (length . Node.name) $ snl
638 helper = Node.list m_name
640 "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %3s %3s %7s %7s"
642 "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem"
644 "pri" "sec" "p_fmem" "p_fdsk"
645 in unlines $ (header:map helper snl)
647 -- | Compute the mem and disk covariance.
648 compDetailedCV :: NodeList -> (Double, Double, Double, Double, Double)
651 all_nodes = Container.elems nl
652 (offline, nodes) = partition Node.offline all_nodes
653 mem_l = map Node.p_mem nodes
654 dsk_l = map Node.p_dsk nodes
655 mem_cv = varianceCoeff mem_l
656 dsk_cv = varianceCoeff dsk_l
657 n1_l = length $ filter Node.failN1 nodes
658 n1_score = (fromIntegral n1_l) / (fromIntegral $ length nodes)
659 res_l = map Node.p_rem nodes
660 res_cv = varianceCoeff res_l
661 offline_inst = sum . map (\n -> (length . Node.plist $ n) +
662 (length . Node.slist $ n)) $ offline
663 online_inst = sum . map (\n -> (length . Node.plist $ n) +
664 (length . Node.slist $ n)) $ nodes
665 off_score = (fromIntegral offline_inst) /
666 (fromIntegral $ online_inst + offline_inst)
667 in (mem_cv, dsk_cv, n1_score, res_cv, off_score)
669 -- | Compute the 'total' variance.
670 compCV :: NodeList -> Double
672 let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
673 in mem_cv + dsk_cv + n1_score + res_cv + off_score
675 printStats :: NodeList -> String
677 let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
678 in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f, uf=%.3f"
679 mem_cv res_cv dsk_cv n1_score off_score