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
18 -- * Generic functions
20 -- * First phase functions
22 -- * Second phase functions
29 -- * Balacing functions
33 -- * Loading functions
39 import Data.Maybe (isNothing, fromJust)
40 import Text.Printf (printf)
43 import qualified Ganeti.HTools.Container as Container
44 import qualified Ganeti.HTools.Instance as Instance
45 import qualified Ganeti.HTools.Node as Node
46 import Ganeti.HTools.Utils
48 type NodeList = Container.Container Node.Node
49 type InstanceList = Container.Container Instance.Instance
50 -- | The type used to hold idx-to-name mappings
51 type NameList = [(Int, String)]
52 -- | A separate name for the cluster score type
55 -- | The description of an instance placement.
56 type Placement = (Int, Int, Int, Score)
58 {- | A cluster solution described as the solution delta and the list
62 data Solution = Solution Int [Placement]
63 deriving (Eq, Ord, Show)
65 -- | Returns the delta of a solution or -1 for Nothing
66 solutionDelta :: Maybe Solution -> Int
67 solutionDelta sol = case sol of
68 Just (Solution d _) -> d
72 data Removal = Removal NodeList [Instance.Instance]
74 -- | An instance move definition
75 data IMove = Failover -- ^ Failover the instance (f)
76 | ReplacePrimary Int -- ^ Replace primary (f, r:np, f)
77 | ReplaceSecondary Int -- ^ Replace secondary (r:ns)
78 | ReplaceAndFailover Int -- ^ Replace secondary, failover (r:np, f)
79 | FailoverAndReplace Int -- ^ Failover, replace secondary (f, r:ns)
82 -- | The complete state for the balancing solution
83 data Table = Table NodeList InstanceList Score [Placement]
88 -- | Cap the removal list if needed.
89 capRemovals :: [a] -> Int -> [a]
90 capRemovals removals max_removals =
91 if max_removals > 0 then
92 take max_removals removals
96 -- | Check if the given node list fails the N+1 check.
97 verifyN1Check :: [Node.Node] -> Bool
98 verifyN1Check nl = any Node.failN1 nl
100 -- | Verifies the N+1 status and return the affected nodes.
101 verifyN1 :: [Node.Node] -> [Node.Node]
102 verifyN1 nl = filter Node.failN1 nl
104 {-| Add an instance and return the new node and instance maps. -}
105 addInstance :: NodeList -> Instance.Instance ->
106 Node.Node -> Node.Node -> Maybe NodeList
107 addInstance nl idata pri sec =
108 let pdx = Node.idx pri
111 pnode <- Node.addPri pri idata
112 snode <- Node.addSec sec idata pdx
113 new_nl <- return $ Container.addTwo sdx snode
117 -- | Remove an instance and return the new node and instance maps.
118 removeInstance :: NodeList -> Instance.Instance -> NodeList
119 removeInstance nl idata =
120 let pnode = Instance.pnode idata
121 snode = Instance.snode idata
122 pn = Container.find pnode nl
123 sn = Container.find snode nl
124 new_nl = Container.addTwo
125 pnode (Node.removePri pn idata)
126 snode (Node.removeSec sn idata) nl in
129 -- | Remove an instance and return the new node map.
130 removeInstances :: NodeList -> [Instance.Instance] -> NodeList
131 removeInstances = foldl' removeInstance
133 -- | Compute the total free disk and memory in the cluster.
134 totalResources :: Container.Container Node.Node -> (Int, Int)
137 (\ (mem, dsk) node -> (mem + (Node.f_mem node),
138 dsk + (Node.f_dsk node)))
139 (0, 0) (Container.elems nl)
141 {- | Compute a new version of a cluster given a solution.
143 This is not used for computing the solutions, but for applying a
144 (known-good) solution to the original cluster for final display.
146 It first removes the relocated instances after which it places them on
150 applySolution :: NodeList -> InstanceList -> [Placement] -> NodeList
151 applySolution nl il sol =
152 let odxes = map (\ (a, b, c, _) -> (Container.find a il,
153 Node.idx (Container.find b nl),
154 Node.idx (Container.find c nl))
156 idxes = (\ (x, _, _) -> x) (unzip3 odxes)
157 nc = removeInstances nl idxes
159 foldl' (\ nz (a, b, c) ->
160 let new_p = Container.find b nz
161 new_s = Container.find c nz in
162 fromJust (addInstance nz a new_p new_s)
166 -- First phase functions
168 {- | Given a list 1,2,3..n build a list of pairs [(1, [2..n]), (2,
172 genParts :: [a] -> Int -> [(a, [a])]
177 if length l < count then
180 (x, xs) : (genParts xs count)
182 -- | Generates combinations of count items from the names list.
183 genNames :: Int -> [b] -> [[b]]
184 genNames count1 names1 =
185 let aux_fn count names current =
190 (\ (x, xs) -> aux_fn (count - 1) xs (x:current))
191 (genParts names count)
193 aux_fn count1 names1 []
195 {- | Computes the pair of bad nodes and instances.
197 The bad node list is computed via a simple 'verifyN1' check, and the
198 bad instance list is the list of primary and secondary instances of
202 computeBadItems :: NodeList -> InstanceList ->
203 ([Node.Node], [Instance.Instance])
204 computeBadItems nl il =
205 let bad_nodes = verifyN1 $ Container.elems nl
206 bad_instances = map (\idx -> Container.find idx il) $
207 sort $ nub $ concat $
208 map (\ n -> (Node.slist n) ++ (Node.plist n)) bad_nodes
210 (bad_nodes, bad_instances)
213 {- | Checks if removal of instances results in N+1 pass.
215 Note: the check removal cannot optimize by scanning only the affected
216 nodes, since the cluster is known to be not healthy; only the check
217 placement can make this shortcut.
220 checkRemoval :: NodeList -> [Instance.Instance] -> Maybe Removal
221 checkRemoval nl victims =
222 let nx = removeInstances nl victims
223 failN1 = verifyN1Check (Container.elems nx)
228 Just $ Removal nx victims
231 -- | Computes the removals list for a given depth
232 computeRemovals :: NodeList
233 -> [Instance.Instance]
236 computeRemovals nl bad_instances depth =
237 map (checkRemoval nl) $ genNames depth bad_instances
239 -- Second phase functions
241 -- | Single-node relocation cost
242 nodeDelta :: Int -> Int -> Int -> Int
244 if i == p || i == s then
249 {-| Compute best solution.
251 This function compares two solutions, choosing the minimum valid
254 compareSolutions :: Maybe Solution -> Maybe Solution -> Maybe Solution
255 compareSolutions a b = case (a, b) of
260 -- | Compute best table. Note that the ordering of the arguments is important.
261 compareTables :: Table -> Table -> Table
262 compareTables a@(Table _ _ a_cv _) b@(Table _ _ b_cv _ ) =
263 if a_cv > b_cv then b else a
265 -- | Check if a given delta is worse then an existing solution.
266 tooHighDelta :: Maybe Solution -> Int -> Int -> Bool
267 tooHighDelta sol new_delta max_delta =
268 if new_delta > max_delta && max_delta >=0 then
273 Just (Solution old_delta _) -> old_delta <= new_delta
275 {-| Check if placement of instances still keeps the cluster N+1 compliant.
277 This is the workhorse of the allocation algorithm: given the
278 current node and instance maps, the list of instances to be
279 placed, and the current solution, this will return all possible
280 solution by recursing until all target instances are placed.
283 checkPlacement :: NodeList -- ^ The current node list
284 -> [Instance.Instance] -- ^ List of instances still to place
285 -> [Placement] -- ^ Partial solution until now
286 -> Int -- ^ The delta of the partial solution
287 -> Maybe Solution -- ^ The previous solution
288 -> Int -- ^ Abort if the we go above this delta
289 -> Maybe Solution -- ^ The new solution
290 checkPlacement nl victims current current_delta prev_sol max_delta =
291 let target = head victims
292 opdx = Instance.pnode target
293 osdx = Instance.snode target
295 have_tail = (length vtail) > 0
296 nodes = Container.elems nl
297 iidx = Instance.idx target
302 pri_idx = Node.idx pri
303 upri_delta = current_delta + nodeDelta pri_idx opdx osdx
304 new_pri = Node.addPri pri target
305 fail_delta1 = tooHighDelta accu_p upri_delta max_delta
307 if fail_delta1 || isNothing(new_pri) then accu_p
308 else let pri_nl = Container.add pri_idx (fromJust new_pri) nl in
312 sec_idx = Node.idx sec
313 upd_delta = upri_delta +
314 nodeDelta sec_idx opdx osdx
315 fail_delta2 = tooHighDelta accu upd_delta max_delta
316 new_sec = Node.addSec sec target pri_idx
318 if sec_idx == pri_idx || fail_delta2 ||
319 isNothing new_sec then accu
321 nx = Container.add sec_idx (fromJust new_sec) pri_nl
323 plc = (iidx, pri_idx, sec_idx, upd_cv)
327 checkPlacement nx vtail c2 upd_delta
330 Just (Solution upd_delta c2)
331 in compareSolutions accu result
336 applyMove :: NodeList -> Instance.Instance
337 -> IMove -> (Maybe NodeList, Instance.Instance, Int, Int)
339 applyMove nl inst Failover =
340 let old_pdx = Instance.pnode inst
341 old_sdx = Instance.snode inst
342 old_p = Container.find old_pdx nl
343 old_s = Container.find old_sdx nl
344 int_p = Node.removePri old_p inst
345 int_s = Node.removeSec old_s inst
346 new_p = Node.addPri int_s inst
347 new_s = Node.addSec int_p inst old_sdx
348 new_nl = if isNothing(new_p) || isNothing(new_s) then Nothing
349 else Just $ Container.addTwo old_pdx (fromJust new_s)
350 old_sdx (fromJust new_p) nl
351 in (new_nl, Instance.setBoth inst old_sdx old_pdx, old_sdx, old_pdx)
353 -- Replace the primary (f:, r:np, f)
354 applyMove nl inst (ReplacePrimary new_pdx) =
355 let old_pdx = Instance.pnode inst
356 old_sdx = Instance.snode inst
357 old_p = Container.find old_pdx nl
358 old_s = Container.find old_sdx nl
359 tgt_n = Container.find new_pdx nl
360 int_p = Node.removePri old_p inst
361 int_s = Node.removeSec old_s inst
362 new_p = Node.addPri tgt_n inst
363 new_s = Node.addSec int_s inst new_pdx
364 new_nl = if isNothing(new_p) || isNothing(new_s) then Nothing
365 else Just $ Container.add new_pdx (fromJust new_p) $
366 Container.addTwo old_pdx int_p
367 old_sdx (fromJust new_s) nl
368 in (new_nl, Instance.setPri inst new_pdx, new_pdx, old_sdx)
370 -- Replace the secondary (r:ns)
371 applyMove nl inst (ReplaceSecondary new_sdx) =
372 let old_pdx = Instance.pnode inst
373 old_sdx = Instance.snode inst
374 old_s = Container.find old_sdx nl
375 tgt_n = Container.find new_sdx nl
376 int_s = Node.removeSec old_s inst
377 new_s = Node.addSec tgt_n inst old_pdx
378 new_nl = if isNothing(new_s) then Nothing
379 else Just $ Container.addTwo new_sdx (fromJust new_s)
381 in (new_nl, Instance.setSec inst new_sdx, old_pdx, new_sdx)
383 -- Replace the secondary and failover (r:np, f)
384 applyMove nl inst (ReplaceAndFailover new_pdx) =
385 let old_pdx = Instance.pnode inst
386 old_sdx = Instance.snode inst
387 old_p = Container.find old_pdx nl
388 old_s = Container.find old_sdx nl
389 tgt_n = Container.find new_pdx nl
390 int_p = Node.removePri old_p inst
391 int_s = Node.removeSec old_s inst
392 new_p = Node.addPri tgt_n inst
393 new_s = Node.addSec int_p inst new_pdx
394 new_nl = if isNothing(new_p) || isNothing(new_s) then Nothing
395 else Just $ Container.add new_pdx (fromJust new_p) $
396 Container.addTwo old_pdx (fromJust new_s)
398 in (new_nl, Instance.setBoth inst new_pdx old_pdx, new_pdx, old_pdx)
400 -- Failver and replace the secondary (f, r:ns)
401 applyMove nl inst (FailoverAndReplace new_sdx) =
402 let old_pdx = Instance.pnode inst
403 old_sdx = Instance.snode inst
404 old_p = Container.find old_pdx nl
405 old_s = Container.find old_sdx nl
406 tgt_n = Container.find new_sdx nl
407 int_p = Node.removePri old_p inst
408 int_s = Node.removeSec old_s inst
409 new_p = Node.addPri int_s inst
410 new_s = Node.addSec tgt_n inst old_sdx
411 new_nl = if isNothing(new_p) || isNothing(new_s) then Nothing
412 else Just $ Container.add new_sdx (fromJust new_s) $
413 Container.addTwo old_sdx (fromJust new_p)
415 in (new_nl, Instance.setBoth inst old_sdx new_sdx, old_sdx, new_sdx)
417 checkSingleStep :: Table -- ^ The original table
418 -> Instance.Instance -- ^ The instance to move
419 -> Table -- ^ The current best table
420 -> IMove -- ^ The move to apply
421 -> Table -- ^ The final best table
422 checkSingleStep ini_tbl target cur_tbl move =
424 Table ini_nl ini_il _ ini_plc = ini_tbl
425 (tmp_nl, new_inst, pri_idx, sec_idx) = applyMove ini_nl target move
427 if isNothing tmp_nl then cur_tbl
429 let tgt_idx = Instance.idx target
430 upd_nl = fromJust tmp_nl
431 upd_cvar = compCV upd_nl
432 upd_il = Container.add tgt_idx new_inst ini_il
433 upd_plc = (tgt_idx, pri_idx, sec_idx, upd_cvar):ini_plc
434 upd_tbl = Table upd_nl upd_il upd_cvar upd_plc
436 compareTables cur_tbl upd_tbl
438 -- | Given the status of the current secondary as a valid new node
439 -- and the current candidate target node,
440 -- generate the possible moves for a instance.
441 possibleMoves :: Bool -> Int -> [IMove]
442 possibleMoves True tdx =
443 [ReplaceSecondary tdx,
444 ReplaceAndFailover tdx,
446 FailoverAndReplace tdx]
448 possibleMoves False tdx =
449 [ReplaceSecondary tdx,
450 ReplaceAndFailover tdx]
452 -- | Compute the best move for a given instance.
453 checkInstanceMove :: [Int] -- Allowed target node indices
454 -> Table -- Original table
455 -> Instance.Instance -- Instance to move
456 -> Table -- Best new table for this instance
457 checkInstanceMove nodes_idx ini_tbl target =
459 opdx = Instance.pnode target
460 osdx = Instance.snode target
461 nodes = filter (\idx -> idx /= opdx && idx /= osdx) nodes_idx
462 use_secondary = elem osdx nodes_idx
463 aft_failover = if use_secondary -- if allowed to failover
464 then checkSingleStep ini_tbl target ini_tbl Failover
466 all_moves = concatMap (possibleMoves use_secondary) nodes
468 -- iterate over the possible nodes for this instance
469 foldl' (checkSingleStep ini_tbl target) aft_failover all_moves
471 -- | Compute the best next move.
472 checkMove :: [Int] -- ^ Allowed target node indices
473 -> Table -- ^ The current solution
474 -> [Instance.Instance] -- ^ List of instances still to move
475 -> Table -- ^ The new solution
476 checkMove nodes_idx ini_tbl victims =
477 let Table _ _ _ ini_plc = ini_tbl
478 -- iterate over all instances, computing the best move
481 (\ step_tbl elem -> compareTables step_tbl $
482 checkInstanceMove nodes_idx ini_tbl elem)
484 Table _ _ _ best_plc = best_tbl
486 if length best_plc == length ini_plc then -- no advancement
491 {- | Auxiliary function for solution computation.
493 We write this in an explicit recursive fashion in order to control
494 early-abort in case we have met the min delta. We can't use foldr
495 instead of explicit recursion since we need the accumulator for the
499 advanceSolution :: [Maybe Removal] -- ^ The removal to process
500 -> Int -- ^ Minimum delta parameter
501 -> Int -- ^ Maximum delta parameter
502 -> Maybe Solution -- ^ Current best solution
503 -> Maybe Solution -- ^ New best solution
504 advanceSolution [] _ _ sol = sol
505 advanceSolution (Nothing:xs) m n sol = advanceSolution xs m n sol
506 advanceSolution ((Just (Removal nx removed)):xs) min_d max_d prev_sol =
507 let new_sol = checkPlacement nx removed [] 0 prev_sol max_d
508 new_delta = solutionDelta $! new_sol
510 if new_delta >= 0 && new_delta <= min_d then
513 advanceSolution xs min_d max_d new_sol
515 -- | Computes the placement solution.
516 solutionFromRemovals :: [Maybe Removal] -- ^ The list of (possible) removals
517 -> Int -- ^ Minimum delta parameter
518 -> Int -- ^ Maximum delta parameter
519 -> Maybe Solution -- ^ The best solution found
520 solutionFromRemovals removals min_delta max_delta =
521 advanceSolution removals min_delta max_delta Nothing
523 {- | Computes the solution at the given depth.
525 This is a wrapper over both computeRemovals and
526 solutionFromRemovals. In case we have no solution, we return Nothing.
529 computeSolution :: NodeList -- ^ The original node data
530 -> [Instance.Instance] -- ^ The list of /bad/ instances
531 -> Int -- ^ The /depth/ of removals
532 -> Int -- ^ Maximum number of removals to process
533 -> Int -- ^ Minimum delta parameter
534 -> Int -- ^ Maximum delta parameter
535 -> Maybe Solution -- ^ The best solution found (or Nothing)
536 computeSolution nl bad_instances depth max_removals min_delta max_delta =
538 removals = computeRemovals nl bad_instances depth
539 removals' = capRemovals removals max_removals
541 solutionFromRemovals removals' min_delta max_delta
543 -- Solution display functions (pure)
545 -- | Given the original and final nodes, computes the relocation description.
546 computeMoves :: String -- ^ The instance name
547 -> String -- ^ Original primary
548 -> String -- ^ Original secondary
549 -> String -- ^ New primary
550 -> String -- ^ New secondary
551 -> (String, [String])
552 -- ^ Tuple of moves and commands list; moves is containing
553 -- either @/f/@ for failover or @/r:name/@ for replace
554 -- secondary, while the command list holds gnt-instance
555 -- commands (without that prefix), e.g \"@failover instance1@\"
556 computeMoves i a b c d =
557 if c == a then {- Same primary -}
558 if d == b then {- Same sec??! -}
560 else {- Change of secondary -}
562 [printf "replace-disks -n %s %s" d i])
564 if c == b then {- Failover and ... -}
565 if d == a then {- that's all -}
566 ("f", [printf "migrate -f %s" i])
569 [printf "migrate -f %s" i,
570 printf "replace-disks -n %s %s" d i])
572 if d == a then {- ... and keep primary as secondary -}
574 [printf "replace-disks -n %s %s" c i,
575 printf "migrate -f %s" i])
577 if d == b then {- ... keep same secondary -}
578 (printf "f r:%s f" c,
579 [printf "migrate -f %s" i,
580 printf "replace-disks -n %s %s" c i,
581 printf "migrate -f %s" i])
583 else {- Nothing in common -}
584 (printf "r:%s f r:%s" c d,
585 [printf "replace-disks -n %s %s" c i,
586 printf "migrate -f %s" i,
587 printf "replace-disks -n %s %s" d i])
589 {-| Converts a placement to string format -}
590 printSolutionLine :: InstanceList
597 -> (String, [String])
598 printSolutionLine il ktn kti nmlen imlen plc pos =
600 pmlen = (2*nmlen + 1)
602 inst = Container.find i il
603 inam = fromJust $ lookup (Instance.idx inst) kti
604 npri = fromJust $ lookup p ktn
605 nsec = fromJust $ lookup s ktn
606 opri = fromJust $ lookup (Instance.pnode inst) ktn
607 osec = fromJust $ lookup (Instance.snode inst) ktn
608 (moves, cmds) = computeMoves inam opri osec npri nsec
609 ostr = (printf "%s:%s" opri osec)::String
610 nstr = (printf "%s:%s" npri nsec)::String
612 (printf " %3d. %-*s %-*s => %-*s %.8f a=%s"
613 pos imlen inam pmlen ostr
617 formatCmds :: [[String]] -> String
618 formatCmds cmd_strs =
620 concat $ map (\(a, b) ->
621 (printf "echo step %d" (a::Int)):
623 (map ("gnt-instance " ++) b)) $
626 {-| Converts a solution to string format -}
627 printSolution :: InstanceList
631 -> ([String], [[String]])
632 printSolution il ktn kti sol =
634 mlen_fn = maximum . (map length) . snd . unzip
638 unzip $ map (uncurry $ printSolutionLine il ktn kti nmlen imlen) $
641 -- | Print the node list.
642 printNodes :: NameList -> NodeList -> String
644 let snl = sortBy (compare `on` Node.idx) (Container.elems nl)
645 snl' = map (\ n -> ((fromJust $ lookup (Node.idx n) ktn), n)) snl
646 m_name = maximum . (map length) . fst . unzip $ snl'
647 helper = Node.list m_name
649 "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %3s %3s %7s %7s"
651 "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem"
653 "pri" "sec" "p_fmem" "p_fdsk"
654 in unlines $ (header:map (uncurry helper) snl')
656 -- | Compute the mem and disk covariance.
657 compDetailedCV :: NodeList -> (Double, Double, Double, Double, Double)
660 all_nodes = Container.elems nl
661 (offline, nodes) = partition Node.offline all_nodes
662 mem_l = map Node.p_mem nodes
663 dsk_l = map Node.p_dsk nodes
664 mem_cv = varianceCoeff mem_l
665 dsk_cv = varianceCoeff dsk_l
666 n1_l = length $ filter Node.failN1 nodes
667 n1_score = (fromIntegral n1_l) / (fromIntegral $ length nodes)
668 res_l = map Node.p_rem nodes
669 res_cv = varianceCoeff res_l
670 offline_inst = sum . map (\n -> (length . Node.plist $ n) +
671 (length . Node.slist $ n)) $ offline
672 online_inst = sum . map (\n -> (length . Node.plist $ n) +
673 (length . Node.slist $ n)) $ nodes
674 off_score = (fromIntegral offline_inst) /
675 (fromIntegral $ online_inst + offline_inst)
676 in (mem_cv, dsk_cv, n1_score, res_cv, off_score)
678 -- | Compute the 'total' variance.
679 compCV :: NodeList -> Double
681 let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
682 in mem_cv + dsk_cv + n1_score + res_cv + off_score
684 printStats :: NodeList -> String
686 let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
687 in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f, uf=%.3f"
688 mem_cv res_cv dsk_cv n1_score off_score
690 -- Balancing functions
694 {- | Convert newline and delimiter-separated text.
696 This function converts a text in tabular format as generated by
697 @gnt-instance list@ and @gnt-node list@ to a list of objects using a
698 supplied conversion function.
701 loadTabular :: String -> ([String] -> (String, a))
702 -> (a -> Int -> a) -> ([(String, Int)], [(Int, a)])
703 loadTabular text_data convert_fn set_fn =
704 let lines_data = lines text_data
705 rows = map (sepSplit '|') lines_data
706 kerows = (map convert_fn rows)
707 idxrows = map (\ (idx, (k, v)) -> ((k, idx), (idx, set_fn v idx)))
711 -- | For each instance, add its index to its primary and secondary nodes
712 fixNodes :: [(Int, Node.Node)]
713 -> [(Int, Instance.Instance)]
714 -> [(Int, Node.Node)]
716 foldl' (\accu (idx, inst) ->
718 assocEqual = (\ (i, _) (j, _) -> i == j)
719 pdx = Instance.pnode inst
720 sdx = Instance.snode inst
721 pold = fromJust $ lookup pdx accu
722 sold = fromJust $ lookup sdx accu
723 pnew = Node.setPri pold idx
724 snew = Node.setSec sold idx
725 ac1 = deleteBy assocEqual (pdx, pold) accu
726 ac2 = deleteBy assocEqual (sdx, sold) ac1
727 ac3 = (pdx, pnew):(sdx, snew):ac2
730 -- | Compute the longest common suffix of a NameList list that
731 -- | starts with a dot
732 longestDomain :: NameList -> String
733 longestDomain [] = ""
734 longestDomain ((_,x):xs) =
736 onlyStrings = snd $ unzip xs
738 foldr (\ suffix accu -> if all (isSuffixOf suffix) onlyStrings
741 "" $ filter (isPrefixOf ".") (tails x)
743 -- | Remove tails from the (Int, String) lists
744 stripSuffix :: String -> NameList -> NameList
745 stripSuffix suffix lst =
746 let sflen = length suffix in
747 map (\ (key, name) -> (key, take ((length name) - sflen) name)) lst
749 {-| Initializer function that loads the data from a node and list file
750 and massages it into the correct format. -}
751 loadData :: String -- ^ Node data in text format
752 -> String -- ^ Instance data in text format
753 -> (Container.Container Node.Node,
754 Container.Container Instance.Instance,
755 String, NameList, NameList)
756 loadData ndata idata =
758 {- node file: name t_mem n_mem f_mem t_disk f_disk -}
759 (ktn, nl) = loadTabular ndata
760 (\ (name:tm:nm:fm:td:fd:[]) ->
762 Node.create (read tm) (read nm)
763 (read fm) (read td) (read fd)))
765 {- instance file: name mem disk status pnode snode -}
766 (kti, il) = loadTabular idata
767 (\ (name:mem:dsk:status:pnode:snode:[]) ->
769 Instance.create (read mem) (read dsk)
771 (fromJust $ lookup pnode ktn)
772 (fromJust $ lookup snode ktn)))
775 il3 = Container.fromAssocList il
776 nl3 = Container.fromAssocList
777 (map (\ (k, v) -> (k, Node.buildPeers v il3 (length nl2))) nl2)
780 common_suffix = longestDomain (xti ++ xtn)
781 stn = stripSuffix common_suffix xtn
782 sti = stripSuffix common_suffix xti
784 (nl3, il3, common_suffix, stn, sti)
786 -- | Compute the amount of memory used by primary instances on a node.
787 nodeImem :: Node.Node -> InstanceList -> Int
789 let rfind = flip Container.find $ il
790 in sum . map Instance.mem .
791 map rfind $ Node.plist node
793 -- | Compute the amount of disk used by instances on a node (either primary
795 nodeIdsk :: Node.Node -> InstanceList -> Int
797 let rfind = flip Container.find $ il
798 in sum . map Instance.dsk .
799 map rfind $ (Node.plist node) ++ (Node.slist node)
802 -- | Check cluster data for consistency
803 checkData :: NodeList -> InstanceList -> NameList -> NameList
804 -> ([String], NodeList)
805 checkData nl il ktn _ =
808 let nname = fromJust $ lookup (Node.idx node) ktn
809 nilst = map (flip Container.find $ il) (Node.plist node)
810 dilst = filter (not . Instance.running) nilst
811 adj_mem = sum . map Instance.mem $ dilst
812 delta_mem = (truncate $ Node.t_mem node)
817 delta_dsk = (truncate $ Node.t_dsk node)
820 newn = Node.setFmem (Node.setXmem node delta_mem)
821 (Node.f_mem node - adj_mem)
822 umsg1 = if delta_mem > 16 || delta_dsk > 1024
823 then [printf "node %s is missing %d MB ram \
825 nname delta_mem (delta_dsk `div` 1024)]
827 in (msgs ++ umsg1, newn)