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.
10 Copyright (C) 2009 Google Inc.
12 This program is free software; you can redistribute it and/or modify
13 it under the terms of the GNU General Public License as published by
14 the Free Software Foundation; either version 2 of the License, or
15 (at your option) any later version.
17 This program is distributed in the hope that it will be useful, but
18 WITHOUT ANY WARRANTY; without even the implied warranty of
19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 General Public License for more details.
22 You should have received a copy of the GNU General Public License
23 along with this program; if not, write to the Free Software
24 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
29 module Ganeti.HTools.Cluster
38 -- * Generic functions
40 -- * First phase functions
42 -- * Second phase functions
49 -- * Balacing functions
54 -- * IAllocator functions
62 import Data.Maybe (isNothing, fromJust)
63 import Text.Printf (printf)
67 import qualified Ganeti.HTools.Container as Container
68 import qualified Ganeti.HTools.Instance as Instance
69 import qualified Ganeti.HTools.Node as Node
70 import Ganeti.HTools.Types
71 import Ganeti.HTools.Utils
75 -- | A separate name for the cluster score type.
78 -- | The description of an instance placement.
79 type Placement = (Idx, Ndx, Ndx, Score)
81 -- | A cluster solution described as the solution delta and the list
83 data Solution = Solution Int [Placement]
84 deriving (Eq, Ord, Show)
87 data Removal = Removal Node.List [Instance.Instance]
89 -- | An instance move definition
90 data IMove = Failover -- ^ Failover the instance (f)
91 | ReplacePrimary Ndx -- ^ Replace primary (f, r:np, f)
92 | ReplaceSecondary Ndx -- ^ Replace secondary (r:ns)
93 | ReplaceAndFailover Ndx -- ^ Replace secondary, failover (r:np, f)
94 | FailoverAndReplace Ndx -- ^ Failover, replace secondary (f, r:ns)
97 -- | The complete state for the balancing solution
98 data Table = Table Node.List Instance.List Score [Placement]
101 -- * Utility functions
103 -- | Returns the delta of a solution or -1 for Nothing.
104 solutionDelta :: Maybe Solution -> Int
105 solutionDelta sol = case sol of
106 Just (Solution d _) -> d
109 -- | Cap the removal list if needed.
110 capRemovals :: [a] -> Int -> [a]
111 capRemovals removals max_removals =
112 if max_removals > 0 then
113 take max_removals removals
117 -- | Check if the given node list fails the N+1 check.
118 verifyN1Check :: [Node.Node] -> Bool
119 verifyN1Check nl = any Node.failN1 nl
121 -- | Verifies the N+1 status and return the affected nodes.
122 verifyN1 :: [Node.Node] -> [Node.Node]
123 verifyN1 nl = filter Node.failN1 nl
125 {-| Computes the pair of bad nodes and instances.
127 The bad node list is computed via a simple 'verifyN1' check, and the
128 bad instance list is the list of primary and secondary instances of
132 computeBadItems :: Node.List -> Instance.List ->
133 ([Node.Node], [Instance.Instance])
134 computeBadItems nl il =
135 let bad_nodes = verifyN1 $ getOnline nl
136 bad_instances = map (\idx -> Container.find idx il) $
137 sort $ nub $ concat $
138 map (\ n -> (Node.slist n) ++ (Node.plist n)) bad_nodes
140 (bad_nodes, bad_instances)
142 -- | Compute the total free disk and memory in the cluster.
143 totalResources :: Node.List -> (Int, Int)
146 (\ (mem, dsk) node -> (mem + (Node.f_mem node),
147 dsk + (Node.f_dsk node)))
148 (0, 0) (Container.elems nl)
150 -- | Compute the mem and disk covariance.
151 compDetailedCV :: Node.List -> (Double, Double, Double, Double, Double, Double)
154 all_nodes = Container.elems nl
155 (offline, nodes) = partition Node.offline all_nodes
156 mem_l = map Node.p_mem nodes
157 dsk_l = map Node.p_dsk nodes
158 mem_cv = varianceCoeff mem_l
159 dsk_cv = varianceCoeff dsk_l
160 n1_l = length $ filter Node.failN1 nodes
161 n1_score = (fromIntegral n1_l) / (fromIntegral $ length nodes)
162 res_l = map Node.p_rem nodes
163 res_cv = varianceCoeff res_l
164 offline_inst = sum . map (\n -> (length . Node.plist $ n) +
165 (length . Node.slist $ n)) $ offline
166 online_inst = sum . map (\n -> (length . Node.plist $ n) +
167 (length . Node.slist $ n)) $ nodes
168 off_score = (fromIntegral offline_inst) /
169 (fromIntegral $ online_inst + offline_inst)
170 cpu_l = map Node.p_cpu nodes
171 cpu_cv = varianceCoeff cpu_l
172 in (mem_cv, dsk_cv, n1_score, res_cv, off_score, cpu_cv)
174 -- | Compute the /total/ variance.
175 compCV :: Node.List -> Double
177 let (mem_cv, dsk_cv, n1_score, res_cv, off_score, cpu_cv) =
179 in mem_cv + dsk_cv + n1_score + res_cv + off_score + cpu_cv
181 -- | Compute online nodes from a Node.List
182 getOnline :: Node.List -> [Node.Node]
183 getOnline = filter (not . Node.offline) . Container.elems
187 -- | Add an instance and return the new node and instance maps.
188 addInstance :: Node.List -> Instance.Instance ->
189 Node.Node -> Node.Node -> Maybe Node.List
190 addInstance nl idata pri sec =
191 let pdx = Node.idx pri
194 pnode <- Node.addPri pri idata
195 snode <- Node.addSec sec idata pdx
196 new_nl <- return $ Container.addTwo sdx snode
200 -- | Remove an instance and return the new node and instance maps.
201 removeInstance :: Node.List -> Instance.Instance -> Node.List
202 removeInstance nl idata =
203 let pnode = Instance.pnode idata
204 snode = Instance.snode idata
205 pn = Container.find pnode nl
206 sn = Container.find snode nl
207 new_nl = Container.addTwo
208 pnode (Node.removePri pn idata)
209 snode (Node.removeSec sn idata) nl in
212 -- | Remove an instance and return the new node map.
213 removeInstances :: Node.List -> [Instance.Instance] -> Node.List
214 removeInstances = foldl' removeInstance
217 {-| Compute a new version of a cluster given a solution.
219 This is not used for computing the solutions, but for applying a
220 (known-good) solution to the original cluster for final display.
222 It first removes the relocated instances after which it places them on
226 applySolution :: Node.List -> Instance.List -> [Placement] -> Node.List
227 applySolution nl il sol =
228 let odxes = map (\ (a, b, c, _) -> (Container.find a il,
229 Node.idx (Container.find b nl),
230 Node.idx (Container.find c nl))
232 idxes = (\ (x, _, _) -> x) (unzip3 odxes)
233 nc = removeInstances nl idxes
235 foldl' (\ nz (a, b, c) ->
236 let new_p = Container.find b nz
237 new_s = Container.find c nz in
238 fromJust (addInstance nz a new_p new_s)
242 -- ** First phase functions
244 {-| Given a list 1,2,3..n build a list of pairs [(1, [2..n]), (2,
248 genParts :: [a] -> Int -> [(a, [a])]
253 if length l < count then
256 (x, xs) : (genParts xs count)
258 -- | Generates combinations of count items from the names list.
259 genNames :: Int -> [b] -> [[b]]
260 genNames count1 names1 =
261 let aux_fn count names current =
266 (\ (x, xs) -> aux_fn (count - 1) xs (x:current))
267 (genParts names count)
269 aux_fn count1 names1 []
271 {-| Checks if removal of instances results in N+1 pass.
273 Note: the check removal cannot optimize by scanning only the affected
274 nodes, since the cluster is known to be not healthy; only the check
275 placement can make this shortcut.
278 checkRemoval :: Node.List -> [Instance.Instance] -> Maybe Removal
279 checkRemoval nl victims =
280 let nx = removeInstances nl victims
281 failN1 = verifyN1Check (Container.elems nx)
286 Just $ Removal nx victims
289 -- | Computes the removals list for a given depth.
290 computeRemovals :: Node.List
291 -> [Instance.Instance]
294 computeRemovals nl bad_instances depth =
295 map (checkRemoval nl) $ genNames depth bad_instances
297 -- ** Second phase functions
299 -- | Single-node relocation cost.
300 nodeDelta :: Ndx -> Ndx -> Ndx -> Int
302 if i == p || i == s then
307 -- | Compute best solution.
309 -- This function compares two solutions, choosing the minimum valid
311 compareSolutions :: Maybe Solution -> Maybe Solution -> Maybe Solution
312 compareSolutions a b = case (a, b) of
317 -- | Check if a given delta is worse then an existing solution.
318 tooHighDelta :: Maybe Solution -> Int -> Int -> Bool
319 tooHighDelta sol new_delta max_delta =
320 if new_delta > max_delta && max_delta >=0 then
325 Just (Solution old_delta _) -> old_delta <= new_delta
327 {-| Check if placement of instances still keeps the cluster N+1 compliant.
329 This is the workhorse of the allocation algorithm: given the
330 current node and instance maps, the list of instances to be
331 placed, and the current solution, this will return all possible
332 solution by recursing until all target instances are placed.
335 checkPlacement :: Node.List -- ^ The current node list
336 -> [Instance.Instance] -- ^ List of instances still to place
337 -> [Placement] -- ^ Partial solution until now
338 -> Int -- ^ The delta of the partial solution
339 -> Maybe Solution -- ^ The previous solution
340 -> Int -- ^ Abort if the we go above this delta
341 -> Maybe Solution -- ^ The new solution
342 checkPlacement nl victims current current_delta prev_sol max_delta =
343 let target = head victims
344 opdx = Instance.pnode target
345 osdx = Instance.snode target
347 have_tail = (length vtail) > 0
348 nodes = Container.elems nl
349 iidx = Instance.idx target
354 pri_idx = Node.idx pri
355 upri_delta = current_delta + nodeDelta pri_idx opdx osdx
356 new_pri = Node.addPri pri target
357 fail_delta1 = tooHighDelta accu_p upri_delta max_delta
359 if fail_delta1 || isNothing(new_pri) then accu_p
360 else let pri_nl = Container.add pri_idx (fromJust new_pri) nl in
364 sec_idx = Node.idx sec
365 upd_delta = upri_delta +
366 nodeDelta sec_idx opdx osdx
367 fail_delta2 = tooHighDelta accu upd_delta max_delta
368 new_sec = Node.addSec sec target pri_idx
370 if sec_idx == pri_idx || fail_delta2 ||
371 isNothing new_sec then accu
373 nx = Container.add sec_idx (fromJust new_sec) pri_nl
375 plc = (iidx, pri_idx, sec_idx, upd_cv)
379 checkPlacement nx vtail c2 upd_delta
382 Just (Solution upd_delta c2)
383 in compareSolutions accu result
387 {-| Auxiliary function for solution computation.
389 We write this in an explicit recursive fashion in order to control
390 early-abort in case we have met the min delta. We can't use foldr
391 instead of explicit recursion since we need the accumulator for the
395 advanceSolution :: [Maybe Removal] -- ^ The removal to process
396 -> Int -- ^ Minimum delta parameter
397 -> Int -- ^ Maximum delta parameter
398 -> Maybe Solution -- ^ Current best solution
399 -> Maybe Solution -- ^ New best solution
400 advanceSolution [] _ _ sol = sol
401 advanceSolution (Nothing:xs) m n sol = advanceSolution xs m n sol
402 advanceSolution ((Just (Removal nx removed)):xs) min_d max_d prev_sol =
403 let new_sol = checkPlacement nx removed [] 0 prev_sol max_d
404 new_delta = solutionDelta $! new_sol
406 if new_delta >= 0 && new_delta <= min_d then
409 advanceSolution xs min_d max_d new_sol
411 -- | Computes the placement solution.
412 solutionFromRemovals :: [Maybe Removal] -- ^ The list of (possible) removals
413 -> Int -- ^ Minimum delta parameter
414 -> Int -- ^ Maximum delta parameter
415 -> Maybe Solution -- ^ The best solution found
416 solutionFromRemovals removals min_delta max_delta =
417 advanceSolution removals min_delta max_delta Nothing
419 {-| Computes the solution at the given depth.
421 This is a wrapper over both computeRemovals and
422 solutionFromRemovals. In case we have no solution, we return Nothing.
425 computeSolution :: Node.List -- ^ The original node data
426 -> [Instance.Instance] -- ^ The list of /bad/ instances
427 -> Int -- ^ The /depth/ of removals
428 -> Int -- ^ Maximum number of removals to process
429 -> Int -- ^ Minimum delta parameter
430 -> Int -- ^ Maximum delta parameter
431 -> Maybe Solution -- ^ The best solution found (or Nothing)
432 computeSolution nl bad_instances depth max_removals min_delta max_delta =
434 removals = computeRemovals nl bad_instances depth
435 removals' = capRemovals removals max_removals
437 solutionFromRemovals removals' min_delta max_delta
441 -- | Compute best table. Note that the ordering of the arguments is important.
442 compareTables :: Table -> Table -> Table
443 compareTables a@(Table _ _ a_cv _) b@(Table _ _ b_cv _ ) =
444 if a_cv > b_cv then b else a
446 -- | Applies an instance move to a given node list and instance.
447 applyMove :: Node.List -> Instance.Instance
448 -> IMove -> (Maybe Node.List, Instance.Instance, Ndx, Ndx)
450 applyMove nl inst Failover =
451 let old_pdx = Instance.pnode inst
452 old_sdx = Instance.snode inst
453 old_p = Container.find old_pdx nl
454 old_s = Container.find old_sdx nl
455 int_p = Node.removePri old_p inst
456 int_s = Node.removeSec old_s inst
457 new_nl = do -- Maybe monad
458 new_p <- Node.addPri int_s inst
459 new_s <- Node.addSec int_p inst old_sdx
460 return $ Container.addTwo old_pdx new_s old_sdx new_p nl
461 in (new_nl, Instance.setBoth inst old_sdx old_pdx, old_sdx, old_pdx)
463 -- Replace the primary (f:, r:np, f)
464 applyMove nl inst (ReplacePrimary new_pdx) =
465 let old_pdx = Instance.pnode inst
466 old_sdx = Instance.snode inst
467 old_p = Container.find old_pdx nl
468 old_s = Container.find old_sdx nl
469 tgt_n = Container.find new_pdx nl
470 int_p = Node.removePri old_p inst
471 int_s = Node.removeSec old_s inst
472 new_nl = do -- Maybe monad
473 -- check that the current secondary can host the instance
474 -- during the migration
475 tmp_s <- Node.addPri int_s inst
476 let tmp_s' = Node.removePri tmp_s inst
477 new_p <- Node.addPri tgt_n inst
478 new_s <- Node.addSec tmp_s' inst new_pdx
479 return $ Container.add new_pdx new_p $
480 Container.addTwo old_pdx int_p old_sdx new_s nl
481 in (new_nl, Instance.setPri inst new_pdx, new_pdx, old_sdx)
483 -- Replace the secondary (r:ns)
484 applyMove nl inst (ReplaceSecondary new_sdx) =
485 let old_pdx = Instance.pnode inst
486 old_sdx = Instance.snode inst
487 old_s = Container.find old_sdx nl
488 tgt_n = Container.find new_sdx nl
489 int_s = Node.removeSec old_s inst
490 new_nl = Node.addSec tgt_n inst old_pdx >>=
491 \new_s -> return $ Container.addTwo new_sdx
492 new_s old_sdx int_s nl
493 in (new_nl, Instance.setSec inst new_sdx, old_pdx, new_sdx)
495 -- Replace the secondary and failover (r:np, f)
496 applyMove nl inst (ReplaceAndFailover new_pdx) =
497 let old_pdx = Instance.pnode inst
498 old_sdx = Instance.snode inst
499 old_p = Container.find old_pdx nl
500 old_s = Container.find old_sdx nl
501 tgt_n = Container.find new_pdx nl
502 int_p = Node.removePri old_p inst
503 int_s = Node.removeSec old_s inst
504 new_nl = do -- Maybe monad
505 new_p <- Node.addPri tgt_n inst
506 new_s <- Node.addSec int_p inst new_pdx
507 return $ Container.add new_pdx new_p $
508 Container.addTwo old_pdx new_s old_sdx int_s nl
509 in (new_nl, Instance.setBoth inst new_pdx old_pdx, new_pdx, old_pdx)
511 -- Failver and replace the secondary (f, r:ns)
512 applyMove nl inst (FailoverAndReplace new_sdx) =
513 let old_pdx = Instance.pnode inst
514 old_sdx = Instance.snode inst
515 old_p = Container.find old_pdx nl
516 old_s = Container.find old_sdx nl
517 tgt_n = Container.find new_sdx nl
518 int_p = Node.removePri old_p inst
519 int_s = Node.removeSec old_s inst
520 new_nl = do -- Maybe monad
521 new_p <- Node.addPri int_s inst
522 new_s <- Node.addSec tgt_n inst old_sdx
523 return $ Container.add new_sdx new_s $
524 Container.addTwo old_sdx new_p old_pdx int_p nl
525 in (new_nl, Instance.setBoth inst old_sdx new_sdx, old_sdx, new_sdx)
527 -- | Tries to allocate an instance on one given node.
528 allocateOnSingle :: Node.List -> Instance.Instance -> Node.Node
529 -> (Maybe Node.List, Instance.Instance)
530 allocateOnSingle nl inst p =
531 let new_pdx = Node.idx p
532 new_nl = Node.addPri p inst >>= \new_p ->
533 return $ Container.add new_pdx new_p nl
534 in (new_nl, Instance.setBoth inst new_pdx Node.noSecondary)
536 -- | Tries to allocate an instance on a given pair of nodes.
537 allocateOnPair :: Node.List -> Instance.Instance -> Node.Node -> Node.Node
538 -> (Maybe Node.List, Instance.Instance)
539 allocateOnPair nl inst tgt_p tgt_s =
540 let new_pdx = Node.idx tgt_p
541 new_sdx = Node.idx tgt_s
542 new_nl = do -- Maybe monad
543 new_p <- Node.addPri tgt_p inst
544 new_s <- Node.addSec tgt_s inst new_pdx
545 return $ Container.addTwo new_pdx new_p new_sdx new_s nl
546 in (new_nl, Instance.setBoth inst new_pdx new_sdx)
548 -- | Tries to perform an instance move and returns the best table
549 -- between the original one and the new one.
550 checkSingleStep :: Table -- ^ The original table
551 -> Instance.Instance -- ^ The instance to move
552 -> Table -- ^ The current best table
553 -> IMove -- ^ The move to apply
554 -> Table -- ^ The final best table
555 checkSingleStep ini_tbl target cur_tbl move =
557 Table ini_nl ini_il _ ini_plc = ini_tbl
558 (tmp_nl, new_inst, pri_idx, sec_idx) = applyMove ini_nl target move
560 if isNothing tmp_nl then cur_tbl
562 let tgt_idx = Instance.idx target
563 upd_nl = fromJust tmp_nl
564 upd_cvar = compCV upd_nl
565 upd_il = Container.add tgt_idx new_inst ini_il
566 upd_plc = (tgt_idx, pri_idx, sec_idx, upd_cvar):ini_plc
567 upd_tbl = Table upd_nl upd_il upd_cvar upd_plc
569 compareTables cur_tbl upd_tbl
571 -- | Given the status of the current secondary as a valid new node
572 -- and the current candidate target node,
573 -- generate the possible moves for a instance.
574 possibleMoves :: Bool -> Ndx -> [IMove]
575 possibleMoves True tdx =
576 [ReplaceSecondary tdx,
577 ReplaceAndFailover tdx,
579 FailoverAndReplace tdx]
581 possibleMoves False tdx =
582 [ReplaceSecondary tdx,
583 ReplaceAndFailover tdx]
585 -- | Compute the best move for a given instance.
586 checkInstanceMove :: [Ndx] -- Allowed target node indices
587 -> Table -- Original table
588 -> Instance.Instance -- Instance to move
589 -> Table -- Best new table for this instance
590 checkInstanceMove nodes_idx ini_tbl target =
592 opdx = Instance.pnode target
593 osdx = Instance.snode target
594 nodes = filter (\idx -> idx /= opdx && idx /= osdx) nodes_idx
595 use_secondary = elem osdx nodes_idx
596 aft_failover = if use_secondary -- if allowed to failover
597 then checkSingleStep ini_tbl target ini_tbl Failover
599 all_moves = concatMap (possibleMoves use_secondary) nodes
601 -- iterate over the possible nodes for this instance
602 foldl' (checkSingleStep ini_tbl target) aft_failover all_moves
604 -- | Compute the best next move.
605 checkMove :: [Ndx] -- ^ Allowed target node indices
606 -> Table -- ^ The current solution
607 -> [Instance.Instance] -- ^ List of instances still to move
608 -> Table -- ^ The new solution
609 checkMove nodes_idx ini_tbl victims =
610 let Table _ _ _ ini_plc = ini_tbl
611 -- iterate over all instances, computing the best move
615 if Instance.snode elem == Node.noSecondary then step_tbl
616 else compareTables step_tbl $
617 checkInstanceMove nodes_idx ini_tbl elem)
619 Table _ _ _ best_plc = best_tbl
621 if length best_plc == length ini_plc then -- no advancement
626 -- * Alocation functions
628 -- | Try to allocate an instance on the cluster.
629 tryAlloc :: (Monad m) =>
630 Node.List -- ^ The node list
631 -> Instance.List -- ^ The instance list
632 -> Instance.Instance -- ^ The instance to allocate
633 -> Int -- ^ Required number of nodes
634 -> m [(Maybe Node.List, Instance.Instance, [Node.Node])]
635 -- ^ Possible solution list
636 tryAlloc nl _ inst 2 =
637 let all_nodes = getOnline nl
638 all_pairs = liftM2 (,) all_nodes all_nodes
639 ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs
640 sols = map (\(p, s) -> let (mnl, i) = allocateOnPair nl inst p s
645 tryAlloc nl _ inst 1 =
646 let all_nodes = getOnline nl
647 sols = map (\p -> let (mnl, i) = allocateOnSingle nl inst p
652 tryAlloc _ _ _ reqn = fail $ "Unsupported number of alllocation \
653 \destinations required (" ++ (show reqn) ++
654 "), only two supported"
656 -- | Try to allocate an instance on the cluster.
657 tryReloc :: (Monad m) =>
658 Node.List -- ^ The node list
659 -> Instance.List -- ^ The instance list
660 -> Idx -- ^ The index of the instance to move
661 -> Int -- ^ The numver of nodes required
662 -> [Ndx] -- ^ Nodes which should not be used
663 -> m [(Maybe Node.List, Instance.Instance, [Node.Node])]
665 tryReloc nl il xid 1 ex_idx =
666 let all_nodes = getOnline nl
667 inst = Container.find xid il
668 ex_idx' = (Instance.pnode inst):ex_idx
669 valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes
670 valid_idxes = map Node.idx valid_nodes
671 sols1 = map (\x -> let (mnl, i, _, _) =
672 applyMove nl inst (ReplaceSecondary x)
673 in (mnl, i, [Container.find x nl])
677 tryReloc _ _ _ reqn _ = fail $ "Unsupported number of relocation \
678 \destinations required (" ++ (show reqn) ++
679 "), only one supported"
681 -- * Formatting functions
683 -- | Given the original and final nodes, computes the relocation description.
684 computeMoves :: String -- ^ The instance name
685 -> String -- ^ Original primary
686 -> String -- ^ Original secondary
687 -> String -- ^ New primary
688 -> String -- ^ New secondary
689 -> (String, [String])
690 -- ^ Tuple of moves and commands list; moves is containing
691 -- either @/f/@ for failover or @/r:name/@ for replace
692 -- secondary, while the command list holds gnt-instance
693 -- commands (without that prefix), e.g \"@failover instance1@\"
694 computeMoves i a b c d =
695 if c == a then {- Same primary -}
696 if d == b then {- Same sec??! -}
698 else {- Change of secondary -}
700 [printf "replace-disks -n %s %s" d i])
702 if c == b then {- Failover and ... -}
703 if d == a then {- that's all -}
704 ("f", [printf "migrate -f %s" i])
707 [printf "migrate -f %s" i,
708 printf "replace-disks -n %s %s" d i])
710 if d == a then {- ... and keep primary as secondary -}
712 [printf "replace-disks -n %s %s" c i,
713 printf "migrate -f %s" i])
715 if d == b then {- ... keep same secondary -}
716 (printf "f r:%s f" c,
717 [printf "migrate -f %s" i,
718 printf "replace-disks -n %s %s" c i,
719 printf "migrate -f %s" i])
721 else {- Nothing in common -}
722 (printf "r:%s f r:%s" c d,
723 [printf "replace-disks -n %s %s" c i,
724 printf "migrate -f %s" i,
725 printf "replace-disks -n %s %s" d i])
727 -- | Converts a placement to string format.
728 printSolutionLine :: Node.List -- ^ The node list
729 -> Instance.List -- ^ The instance list
730 -> Int -- ^ Maximum node name length
731 -> Int -- ^ Maximum instance name length
732 -> Placement -- ^ The current placement
733 -> Int -- ^ The index of the placement in
735 -> (String, [String])
736 printSolutionLine nl il nmlen imlen plc pos =
738 pmlen = (2*nmlen + 1)
740 inst = Container.find i il
741 inam = Instance.name inst
742 npri = Container.nameOf nl p
743 nsec = Container.nameOf nl s
744 opri = Container.nameOf nl $ Instance.pnode inst
745 osec = Container.nameOf nl $ Instance.snode inst
746 (moves, cmds) = computeMoves inam opri osec npri nsec
747 ostr = (printf "%s:%s" opri osec)::String
748 nstr = (printf "%s:%s" npri nsec)::String
750 (printf " %3d. %-*s %-*s => %-*s %.8f a=%s"
751 pos imlen inam pmlen ostr
755 -- | Given a list of commands, prefix them with @gnt-instance@ and
756 -- also beautify the display a little.
757 formatCmds :: [[String]] -> String
758 formatCmds cmd_strs =
760 concat $ map (\(a, b) ->
761 (printf "echo step %d" (a::Int)):
763 (map ("gnt-instance " ++) b)) $
766 -- | Converts a solution to string format.
767 printSolution :: Node.List
770 -> ([String], [[String]])
771 printSolution nl il sol =
773 nmlen = Container.maxNameLen nl
774 imlen = Container.maxNameLen il
776 unzip $ map (uncurry $ printSolutionLine nl il nmlen imlen) $
779 -- | Print the node list.
780 printNodes :: Node.List -> String
782 let snl = sortBy (compare `on` Node.idx) (Container.elems nl)
783 m_name = maximum . map (length . Node.name) $ snl
784 helper = Node.list m_name
786 "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %3s %3s %7s %7s %7s"
788 "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem"
790 "pri" "sec" "p_fmem" "p_fdsk" "r_cpu"
791 in unlines $ (header:map helper snl)
793 -- | Shows statistics for a given node list.
794 printStats :: Node.List -> String
796 let (mem_cv, dsk_cv, n1_score, res_cv, off_score, cpu_cv) =
798 in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f, \
799 \uf=%.3f, r_cpu=%.3f"
800 mem_cv res_cv dsk_cv n1_score off_score cpu_cv