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)
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 in (mem_cv, dsk_cv, n1_score, res_cv, off_score)
172 -- | Compute the /total/ variance.
173 compCV :: Node.List -> Double
175 let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
176 in mem_cv + dsk_cv + n1_score + res_cv + off_score
178 -- | Compute online nodes from a Node.List
179 getOnline :: Node.List -> [Node.Node]
180 getOnline = filter (not . Node.offline) . Container.elems
184 -- | Add an instance and return the new node and instance maps.
185 addInstance :: Node.List -> Instance.Instance ->
186 Node.Node -> Node.Node -> Maybe Node.List
187 addInstance nl idata pri sec =
188 let pdx = Node.idx pri
191 pnode <- Node.addPri pri idata
192 snode <- Node.addSec sec idata pdx
193 new_nl <- return $ Container.addTwo sdx snode
197 -- | Remove an instance and return the new node and instance maps.
198 removeInstance :: Node.List -> Instance.Instance -> Node.List
199 removeInstance nl idata =
200 let pnode = Instance.pnode idata
201 snode = Instance.snode idata
202 pn = Container.find pnode nl
203 sn = Container.find snode nl
204 new_nl = Container.addTwo
205 pnode (Node.removePri pn idata)
206 snode (Node.removeSec sn idata) nl in
209 -- | Remove an instance and return the new node map.
210 removeInstances :: Node.List -> [Instance.Instance] -> Node.List
211 removeInstances = foldl' removeInstance
214 {-| Compute a new version of a cluster given a solution.
216 This is not used for computing the solutions, but for applying a
217 (known-good) solution to the original cluster for final display.
219 It first removes the relocated instances after which it places them on
223 applySolution :: Node.List -> Instance.List -> [Placement] -> Node.List
224 applySolution nl il sol =
225 let odxes = map (\ (a, b, c, _) -> (Container.find a il,
226 Node.idx (Container.find b nl),
227 Node.idx (Container.find c nl))
229 idxes = (\ (x, _, _) -> x) (unzip3 odxes)
230 nc = removeInstances nl idxes
232 foldl' (\ nz (a, b, c) ->
233 let new_p = Container.find b nz
234 new_s = Container.find c nz in
235 fromJust (addInstance nz a new_p new_s)
239 -- ** First phase functions
241 {-| Given a list 1,2,3..n build a list of pairs [(1, [2..n]), (2,
245 genParts :: [a] -> Int -> [(a, [a])]
250 if length l < count then
253 (x, xs) : (genParts xs count)
255 -- | Generates combinations of count items from the names list.
256 genNames :: Int -> [b] -> [[b]]
257 genNames count1 names1 =
258 let aux_fn count names current =
263 (\ (x, xs) -> aux_fn (count - 1) xs (x:current))
264 (genParts names count)
266 aux_fn count1 names1 []
268 {-| Checks if removal of instances results in N+1 pass.
270 Note: the check removal cannot optimize by scanning only the affected
271 nodes, since the cluster is known to be not healthy; only the check
272 placement can make this shortcut.
275 checkRemoval :: Node.List -> [Instance.Instance] -> Maybe Removal
276 checkRemoval nl victims =
277 let nx = removeInstances nl victims
278 failN1 = verifyN1Check (Container.elems nx)
283 Just $ Removal nx victims
286 -- | Computes the removals list for a given depth.
287 computeRemovals :: Node.List
288 -> [Instance.Instance]
291 computeRemovals nl bad_instances depth =
292 map (checkRemoval nl) $ genNames depth bad_instances
294 -- ** Second phase functions
296 -- | Single-node relocation cost.
297 nodeDelta :: Ndx -> Ndx -> Ndx -> Int
299 if i == p || i == s then
304 -- | Compute best solution.
306 -- This function compares two solutions, choosing the minimum valid
308 compareSolutions :: Maybe Solution -> Maybe Solution -> Maybe Solution
309 compareSolutions a b = case (a, b) of
314 -- | Check if a given delta is worse then an existing solution.
315 tooHighDelta :: Maybe Solution -> Int -> Int -> Bool
316 tooHighDelta sol new_delta max_delta =
317 if new_delta > max_delta && max_delta >=0 then
322 Just (Solution old_delta _) -> old_delta <= new_delta
324 {-| Check if placement of instances still keeps the cluster N+1 compliant.
326 This is the workhorse of the allocation algorithm: given the
327 current node and instance maps, the list of instances to be
328 placed, and the current solution, this will return all possible
329 solution by recursing until all target instances are placed.
332 checkPlacement :: Node.List -- ^ The current node list
333 -> [Instance.Instance] -- ^ List of instances still to place
334 -> [Placement] -- ^ Partial solution until now
335 -> Int -- ^ The delta of the partial solution
336 -> Maybe Solution -- ^ The previous solution
337 -> Int -- ^ Abort if the we go above this delta
338 -> Maybe Solution -- ^ The new solution
339 checkPlacement nl victims current current_delta prev_sol max_delta =
340 let target = head victims
341 opdx = Instance.pnode target
342 osdx = Instance.snode target
344 have_tail = (length vtail) > 0
345 nodes = Container.elems nl
346 iidx = Instance.idx target
351 pri_idx = Node.idx pri
352 upri_delta = current_delta + nodeDelta pri_idx opdx osdx
353 new_pri = Node.addPri pri target
354 fail_delta1 = tooHighDelta accu_p upri_delta max_delta
356 if fail_delta1 || isNothing(new_pri) then accu_p
357 else let pri_nl = Container.add pri_idx (fromJust new_pri) nl in
361 sec_idx = Node.idx sec
362 upd_delta = upri_delta +
363 nodeDelta sec_idx opdx osdx
364 fail_delta2 = tooHighDelta accu upd_delta max_delta
365 new_sec = Node.addSec sec target pri_idx
367 if sec_idx == pri_idx || fail_delta2 ||
368 isNothing new_sec then accu
370 nx = Container.add sec_idx (fromJust new_sec) pri_nl
372 plc = (iidx, pri_idx, sec_idx, upd_cv)
376 checkPlacement nx vtail c2 upd_delta
379 Just (Solution upd_delta c2)
380 in compareSolutions accu result
384 {-| Auxiliary function for solution computation.
386 We write this in an explicit recursive fashion in order to control
387 early-abort in case we have met the min delta. We can't use foldr
388 instead of explicit recursion since we need the accumulator for the
392 advanceSolution :: [Maybe Removal] -- ^ The removal to process
393 -> Int -- ^ Minimum delta parameter
394 -> Int -- ^ Maximum delta parameter
395 -> Maybe Solution -- ^ Current best solution
396 -> Maybe Solution -- ^ New best solution
397 advanceSolution [] _ _ sol = sol
398 advanceSolution (Nothing:xs) m n sol = advanceSolution xs m n sol
399 advanceSolution ((Just (Removal nx removed)):xs) min_d max_d prev_sol =
400 let new_sol = checkPlacement nx removed [] 0 prev_sol max_d
401 new_delta = solutionDelta $! new_sol
403 if new_delta >= 0 && new_delta <= min_d then
406 advanceSolution xs min_d max_d new_sol
408 -- | Computes the placement solution.
409 solutionFromRemovals :: [Maybe Removal] -- ^ The list of (possible) removals
410 -> Int -- ^ Minimum delta parameter
411 -> Int -- ^ Maximum delta parameter
412 -> Maybe Solution -- ^ The best solution found
413 solutionFromRemovals removals min_delta max_delta =
414 advanceSolution removals min_delta max_delta Nothing
416 {-| Computes the solution at the given depth.
418 This is a wrapper over both computeRemovals and
419 solutionFromRemovals. In case we have no solution, we return Nothing.
422 computeSolution :: Node.List -- ^ The original node data
423 -> [Instance.Instance] -- ^ The list of /bad/ instances
424 -> Int -- ^ The /depth/ of removals
425 -> Int -- ^ Maximum number of removals to process
426 -> Int -- ^ Minimum delta parameter
427 -> Int -- ^ Maximum delta parameter
428 -> Maybe Solution -- ^ The best solution found (or Nothing)
429 computeSolution nl bad_instances depth max_removals min_delta max_delta =
431 removals = computeRemovals nl bad_instances depth
432 removals' = capRemovals removals max_removals
434 solutionFromRemovals removals' min_delta max_delta
438 -- | Compute best table. Note that the ordering of the arguments is important.
439 compareTables :: Table -> Table -> Table
440 compareTables a@(Table _ _ a_cv _) b@(Table _ _ b_cv _ ) =
441 if a_cv > b_cv then b else a
443 -- | Applies an instance move to a given node list and instance.
444 applyMove :: Node.List -> Instance.Instance
445 -> IMove -> (Maybe Node.List, Instance.Instance, Ndx, Ndx)
447 applyMove nl inst Failover =
448 let old_pdx = Instance.pnode inst
449 old_sdx = Instance.snode inst
450 old_p = Container.find old_pdx nl
451 old_s = Container.find old_sdx nl
452 int_p = Node.removePri old_p inst
453 int_s = Node.removeSec old_s inst
454 new_nl = do -- Maybe monad
455 new_p <- Node.addPri int_s inst
456 new_s <- Node.addSec int_p inst old_sdx
457 return $ Container.addTwo old_pdx new_s old_sdx new_p nl
458 in (new_nl, Instance.setBoth inst old_sdx old_pdx, old_sdx, old_pdx)
460 -- Replace the primary (f:, r:np, f)
461 applyMove nl inst (ReplacePrimary new_pdx) =
462 let old_pdx = Instance.pnode inst
463 old_sdx = Instance.snode inst
464 old_p = Container.find old_pdx nl
465 old_s = Container.find old_sdx nl
466 tgt_n = Container.find new_pdx nl
467 int_p = Node.removePri old_p inst
468 int_s = Node.removeSec old_s inst
469 new_nl = do -- Maybe monad
470 -- check that the current secondary can host the instance
471 -- during the migration
472 tmp_s <- Node.addPri int_s inst
473 let tmp_s' = Node.removePri tmp_s inst
474 new_p <- Node.addPri tgt_n inst
475 new_s <- Node.addSec tmp_s' inst new_pdx
476 return $ Container.add new_pdx new_p $
477 Container.addTwo old_pdx int_p old_sdx new_s nl
478 in (new_nl, Instance.setPri inst new_pdx, new_pdx, old_sdx)
480 -- Replace the secondary (r:ns)
481 applyMove nl inst (ReplaceSecondary new_sdx) =
482 let old_pdx = Instance.pnode inst
483 old_sdx = Instance.snode inst
484 old_s = Container.find old_sdx nl
485 tgt_n = Container.find new_sdx nl
486 int_s = Node.removeSec old_s inst
487 new_nl = Node.addSec tgt_n inst old_pdx >>=
488 \new_s -> return $ Container.addTwo new_sdx
489 new_s old_sdx int_s nl
490 in (new_nl, Instance.setSec inst new_sdx, old_pdx, new_sdx)
492 -- Replace the secondary and failover (r:np, f)
493 applyMove nl inst (ReplaceAndFailover new_pdx) =
494 let old_pdx = Instance.pnode inst
495 old_sdx = Instance.snode inst
496 old_p = Container.find old_pdx nl
497 old_s = Container.find old_sdx nl
498 tgt_n = Container.find new_pdx nl
499 int_p = Node.removePri old_p inst
500 int_s = Node.removeSec old_s inst
501 new_nl = do -- Maybe monad
502 new_p <- Node.addPri tgt_n inst
503 new_s <- Node.addSec int_p inst new_pdx
504 return $ Container.add new_pdx new_p $
505 Container.addTwo old_pdx new_s old_sdx int_s nl
506 in (new_nl, Instance.setBoth inst new_pdx old_pdx, new_pdx, old_pdx)
508 -- Failver and replace the secondary (f, r:ns)
509 applyMove nl inst (FailoverAndReplace new_sdx) =
510 let old_pdx = Instance.pnode inst
511 old_sdx = Instance.snode inst
512 old_p = Container.find old_pdx nl
513 old_s = Container.find old_sdx nl
514 tgt_n = Container.find new_sdx nl
515 int_p = Node.removePri old_p inst
516 int_s = Node.removeSec old_s inst
517 new_nl = do -- Maybe monad
518 new_p <- Node.addPri int_s inst
519 new_s <- Node.addSec tgt_n inst old_sdx
520 return $ Container.add new_sdx new_s $
521 Container.addTwo old_sdx new_p old_pdx int_p nl
522 in (new_nl, Instance.setBoth inst old_sdx new_sdx, old_sdx, new_sdx)
524 -- | Tries to allocate an instance on one given node.
525 allocateOnSingle :: Node.List -> Instance.Instance -> Node.Node
526 -> (Maybe Node.List, Instance.Instance)
527 allocateOnSingle nl inst p =
528 let new_pdx = Node.idx p
529 new_nl = Node.addPri p inst >>= \new_p ->
530 return $ Container.add new_pdx new_p nl
531 in (new_nl, Instance.setBoth inst new_pdx Node.noSecondary)
533 -- | Tries to allocate an instance on a given pair of nodes.
534 allocateOnPair :: Node.List -> Instance.Instance -> Node.Node -> Node.Node
535 -> (Maybe Node.List, Instance.Instance)
536 allocateOnPair nl inst tgt_p tgt_s =
537 let new_pdx = Node.idx tgt_p
538 new_sdx = Node.idx tgt_s
539 new_nl = do -- Maybe monad
540 new_p <- Node.addPri tgt_p inst
541 new_s <- Node.addSec tgt_s inst new_pdx
542 return $ Container.addTwo new_pdx new_p new_sdx new_s nl
543 in (new_nl, Instance.setBoth inst new_pdx new_sdx)
545 -- | Tries to perform an instance move and returns the best table
546 -- between the original one and the new one.
547 checkSingleStep :: Table -- ^ The original table
548 -> Instance.Instance -- ^ The instance to move
549 -> Table -- ^ The current best table
550 -> IMove -- ^ The move to apply
551 -> Table -- ^ The final best table
552 checkSingleStep ini_tbl target cur_tbl move =
554 Table ini_nl ini_il _ ini_plc = ini_tbl
555 (tmp_nl, new_inst, pri_idx, sec_idx) = applyMove ini_nl target move
557 if isNothing tmp_nl then cur_tbl
559 let tgt_idx = Instance.idx target
560 upd_nl = fromJust tmp_nl
561 upd_cvar = compCV upd_nl
562 upd_il = Container.add tgt_idx new_inst ini_il
563 upd_plc = (tgt_idx, pri_idx, sec_idx, upd_cvar):ini_plc
564 upd_tbl = Table upd_nl upd_il upd_cvar upd_plc
566 compareTables cur_tbl upd_tbl
568 -- | Given the status of the current secondary as a valid new node
569 -- and the current candidate target node,
570 -- generate the possible moves for a instance.
571 possibleMoves :: Bool -> Ndx -> [IMove]
572 possibleMoves True tdx =
573 [ReplaceSecondary tdx,
574 ReplaceAndFailover tdx,
576 FailoverAndReplace tdx]
578 possibleMoves False tdx =
579 [ReplaceSecondary tdx,
580 ReplaceAndFailover tdx]
582 -- | Compute the best move for a given instance.
583 checkInstanceMove :: [Ndx] -- Allowed target node indices
584 -> Table -- Original table
585 -> Instance.Instance -- Instance to move
586 -> Table -- Best new table for this instance
587 checkInstanceMove nodes_idx ini_tbl target =
589 opdx = Instance.pnode target
590 osdx = Instance.snode target
591 nodes = filter (\idx -> idx /= opdx && idx /= osdx) nodes_idx
592 use_secondary = elem osdx nodes_idx
593 aft_failover = if use_secondary -- if allowed to failover
594 then checkSingleStep ini_tbl target ini_tbl Failover
596 all_moves = concatMap (possibleMoves use_secondary) nodes
598 -- iterate over the possible nodes for this instance
599 foldl' (checkSingleStep ini_tbl target) aft_failover all_moves
601 -- | Compute the best next move.
602 checkMove :: [Ndx] -- ^ Allowed target node indices
603 -> Table -- ^ The current solution
604 -> [Instance.Instance] -- ^ List of instances still to move
605 -> Table -- ^ The new solution
606 checkMove nodes_idx ini_tbl victims =
607 let Table _ _ _ ini_plc = ini_tbl
608 -- iterate over all instances, computing the best move
612 if Instance.snode elem == Node.noSecondary then step_tbl
613 else compareTables step_tbl $
614 checkInstanceMove nodes_idx ini_tbl elem)
616 Table _ _ _ best_plc = best_tbl
618 if length best_plc == length ini_plc then -- no advancement
623 -- * Alocation functions
625 -- | Try to allocate an instance on the cluster.
626 tryAlloc :: (Monad m) =>
627 Node.List -- ^ The node list
628 -> Instance.List -- ^ The instance list
629 -> Instance.Instance -- ^ The instance to allocate
630 -> Int -- ^ Required number of nodes
631 -> m [(Maybe Node.List, Instance.Instance, [Node.Node])]
632 -- ^ Possible solution list
633 tryAlloc nl _ inst 2 =
634 let all_nodes = getOnline nl
635 all_pairs = liftM2 (,) all_nodes all_nodes
636 ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs
637 sols = map (\(p, s) -> let (mnl, i) = allocateOnPair nl inst p s
642 tryAlloc nl _ inst 1 =
643 let all_nodes = getOnline nl
644 sols = map (\p -> let (mnl, i) = allocateOnSingle nl inst p
649 tryAlloc _ _ _ reqn = fail $ "Unsupported number of alllocation \
650 \destinations required (" ++ (show reqn) ++
651 "), only two supported"
653 -- | Try to allocate an instance on the cluster.
654 tryReloc :: (Monad m) =>
655 Node.List -- ^ The node list
656 -> Instance.List -- ^ The instance list
657 -> Idx -- ^ The index of the instance to move
658 -> Int -- ^ The numver of nodes required
659 -> [Ndx] -- ^ Nodes which should not be used
660 -> m [(Maybe Node.List, Instance.Instance, [Node.Node])]
662 tryReloc nl il xid 1 ex_idx =
663 let all_nodes = getOnline nl
664 inst = Container.find xid il
665 ex_idx' = (Instance.pnode inst):ex_idx
666 valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes
667 valid_idxes = map Node.idx valid_nodes
668 sols1 = map (\x -> let (mnl, i, _, _) =
669 applyMove nl inst (ReplaceSecondary x)
670 in (mnl, i, [Container.find x nl])
674 tryReloc _ _ _ reqn _ = fail $ "Unsupported number of relocation \
675 \destinations required (" ++ (show reqn) ++
676 "), only one supported"
678 -- * Formatting functions
680 -- | Given the original and final nodes, computes the relocation description.
681 computeMoves :: String -- ^ The instance name
682 -> String -- ^ Original primary
683 -> String -- ^ Original secondary
684 -> String -- ^ New primary
685 -> String -- ^ New secondary
686 -> (String, [String])
687 -- ^ Tuple of moves and commands list; moves is containing
688 -- either @/f/@ for failover or @/r:name/@ for replace
689 -- secondary, while the command list holds gnt-instance
690 -- commands (without that prefix), e.g \"@failover instance1@\"
691 computeMoves i a b c d =
692 if c == a then {- Same primary -}
693 if d == b then {- Same sec??! -}
695 else {- Change of secondary -}
697 [printf "replace-disks -n %s %s" d i])
699 if c == b then {- Failover and ... -}
700 if d == a then {- that's all -}
701 ("f", [printf "migrate -f %s" i])
704 [printf "migrate -f %s" i,
705 printf "replace-disks -n %s %s" d i])
707 if d == a then {- ... and keep primary as secondary -}
709 [printf "replace-disks -n %s %s" c i,
710 printf "migrate -f %s" i])
712 if d == b then {- ... keep same secondary -}
713 (printf "f r:%s f" c,
714 [printf "migrate -f %s" i,
715 printf "replace-disks -n %s %s" c i,
716 printf "migrate -f %s" i])
718 else {- Nothing in common -}
719 (printf "r:%s f r:%s" c d,
720 [printf "replace-disks -n %s %s" c i,
721 printf "migrate -f %s" i,
722 printf "replace-disks -n %s %s" d i])
724 -- | Converts a placement to string format.
725 printSolutionLine :: Node.List -- ^ The node list
726 -> Instance.List -- ^ The instance list
727 -> Int -- ^ Maximum node name length
728 -> Int -- ^ Maximum instance name length
729 -> Placement -- ^ The current placement
730 -> Int -- ^ The index of the placement in
732 -> (String, [String])
733 printSolutionLine nl il nmlen imlen plc pos =
735 pmlen = (2*nmlen + 1)
737 inst = Container.find i il
738 inam = Instance.name inst
739 npri = Container.nameOf nl p
740 nsec = Container.nameOf nl s
741 opri = Container.nameOf nl $ Instance.pnode inst
742 osec = Container.nameOf nl $ Instance.snode inst
743 (moves, cmds) = computeMoves inam opri osec npri nsec
744 ostr = (printf "%s:%s" opri osec)::String
745 nstr = (printf "%s:%s" npri nsec)::String
747 (printf " %3d. %-*s %-*s => %-*s %.8f a=%s"
748 pos imlen inam pmlen ostr
752 -- | Given a list of commands, prefix them with @gnt-instance@ and
753 -- also beautify the display a little.
754 formatCmds :: [[String]] -> String
755 formatCmds cmd_strs =
757 concat $ map (\(a, b) ->
758 (printf "echo step %d" (a::Int)):
760 (map ("gnt-instance " ++) b)) $
763 -- | Converts a solution to string format.
764 printSolution :: Node.List
767 -> ([String], [[String]])
768 printSolution nl il sol =
770 nmlen = Container.maxNameLen nl
771 imlen = Container.maxNameLen il
773 unzip $ map (uncurry $ printSolutionLine nl il nmlen imlen) $
776 -- | Print the node list.
777 printNodes :: Node.List -> String
779 let snl = sortBy (compare `on` Node.idx) (Container.elems nl)
780 m_name = maximum . map (length . Node.name) $ snl
781 helper = Node.list m_name
783 "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %3s %3s %7s %7s"
785 "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem"
787 "pri" "sec" "p_fmem" "p_fdsk"
788 in unlines $ (header:map helper snl)
790 -- | Shows statistics for a given node list.
791 printStats :: Node.List -> String
793 let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
794 in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f, uf=%.3f"
795 mem_cv res_cv dsk_cv n1_score off_score