code.grnet.gr Git - ganeti-local/blob - Ganeti/HTools/Cluster.hs

   1 {-| Implementation of cluster-wide logic.
   2
   3 This module holds all pure cluster-logic; I\/O related functionality
   4 goes into the "Main" module for the individual binaries.
   5
   6 -}
   7
   8 module Ganeti.HTools.Cluster
   9     (
  10      -- * Types
  11       Placement
  12     , Solution(..)
  13     , Table(..)
  14     , Removal
  15     , Score
  16     , IMove(..)
  17     -- * Generic functions
  18     , totalResources
  19     -- * First phase functions
  20     , computeBadItems
  21     -- * Second phase functions
  22     , computeSolution
  23     , applySolution
  24     , printSolution
  25     , printSolutionLine
  26     , formatCmds
  27     , printNodes
  28     -- * Balacing functions
  29     , applyMove
  30     , checkMove
  31     , compCV
  32     , printStats
  33     -- * IAllocator functions
  34     , allocateOnSingle
  35     , allocateOnPair
  36     ) where
  37
  38 import Data.List
  39 import Data.Maybe (isNothing, fromJust)
  40 import Text.Printf (printf)
  41 import Data.Function
  42 import Control.Monad
  43
  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
  49
  50 -- | A separate name for the cluster score type
  51 type Score = Double
  52
  53 -- | The description of an instance placement.
  54 type Placement = (Idx, Ndx, Ndx, Score)
  55
  56 {- | A cluster solution described as the solution delta and the list
  57 of placements.
  58
  59 -}
  60 data Solution = Solution Int [Placement]
  61                 deriving (Eq, Ord, Show)
  62
  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
  67                       _ -> -1
  68
  69 -- | A removal set.
  70 data Removal = Removal Node.List [Instance.Instance]
  71
  72 -- | An instance move definition
  73 data IMove = Failover                -- ^ Failover the instance (f)
  74            | ReplacePrimary Ndx      -- ^ Replace primary (f, r:np, f)
  75            | ReplaceSecondary Ndx    -- ^ Replace secondary (r:ns)
  76            | ReplaceAndFailover Ndx  -- ^ Replace secondary, failover (r:np, f)
  77            | FailoverAndReplace Ndx  -- ^ Failover, replace secondary (f, r:ns)
  78              deriving (Show)
  79
  80 -- | The complete state for the balancing solution
  81 data Table = Table Node.List Instance.List Score [Placement]
  82              deriving (Show)
  83
  84 -- General functions
  85
  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
  91     else
  92         removals
  93
  94 -- | Check if the given node list fails the N+1 check.
  95 verifyN1Check :: [Node.Node] -> Bool
  96 verifyN1Check nl = any Node.failN1 nl
  97
  98 -- | Verifies the N+1 status and return the affected nodes.
  99 verifyN1 :: [Node.Node] -> [Node.Node]
 100 verifyN1 nl = filter Node.failN1 nl
 101
 102 {-| Add an instance and return the new node and instance maps. -}
 103 addInstance :: Node.List -> Instance.Instance ->
 104                Node.Node -> Node.Node -> Maybe Node.List
 105 addInstance nl idata pri sec =
 106   let pdx = Node.idx pri
 107       sdx = Node.idx sec
 108   in do
 109       pnode <- Node.addPri pri idata
 110       snode <- Node.addSec sec idata pdx
 111       new_nl <- return $ Container.addTwo sdx snode
 112                          pdx pnode nl
 113       return new_nl
 114
 115 -- | Remove an instance and return the new node and instance maps.
 116 removeInstance :: Node.List -> Instance.Instance -> Node.List
 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
 125   new_nl
 126
 127 -- | Remove an instance and return the new node map.
 128 removeInstances :: Node.List -> [Instance.Instance] -> Node.List
 129 removeInstances = foldl' removeInstance
 130
 131 -- | Compute the total free disk and memory in the cluster.
 132 totalResources :: Container.Container Node.Node -> (Int, Int)
 133 totalResources nl =
 134     foldl'
 135     (\ (mem, dsk) node -> (mem + (Node.f_mem node),
 136                            dsk + (Node.f_dsk node)))
 137     (0, 0) (Container.elems nl)
 138
 139 {- | Compute a new version of a cluster given a solution.
 140
 141 This is not used for computing the solutions, but for applying a
 142 (known-good) solution to the original cluster for final display.
 143
 144 It first removes the relocated instances after which it places them on
 145 their new nodes.
 146
 147  -}
 148 applySolution :: Node.List -> Instance.List -> [Placement] -> Node.List
 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))
 153                     ) sol
 154         idxes = (\ (x, _, _) -> x) (unzip3 odxes)
 155         nc = removeInstances nl idxes
 156     in
 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)
 161            ) nc odxes
 162
 163
 164 -- First phase functions
 165
 166 {- | Given a list 1,2,3..n build a list of pairs [(1, [2..n]), (2,
 167     [3..n]), ...]
 168
 169 -}
 170 genParts :: [a] -> Int -> [(a, [a])]
 171 genParts l count =
 172     case l of
 173       [] -> []
 174       x:xs ->
 175           if length l < count then
 176               []
 177           else
 178               (x, xs) : (genParts xs count)
 179
 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 =
 184           case count of
 185             0 -> [current]
 186             _ ->
 187                 concatMap
 188                 (\ (x, xs) -> aux_fn (count - 1) xs (x:current))
 189                 (genParts names count)
 190   in
 191     aux_fn count1 names1 []
 192
 193 {- | Computes the pair of bad nodes and instances.
 194
 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
 197 those nodes.
 198
 199 -}
 200 computeBadItems :: Node.List -> Instance.List ->
 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
 207   in
 208     (bad_nodes, bad_instances)
 209
 210
 211 {- | Checks if removal of instances results in N+1 pass.
 212
 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.
 216
 217 -}
 218 checkRemoval :: Node.List -> [Instance.Instance] -> Maybe Removal
 219 checkRemoval nl victims =
 220   let nx = removeInstances nl victims
 221       failN1 = verifyN1Check (Container.elems nx)
 222   in
 223     if failN1 then
 224       Nothing
 225     else
 226       Just $ Removal nx victims
 227
 228
 229 -- | Computes the removals list for a given depth
 230 computeRemovals :: Node.List
 231                  -> [Instance.Instance]
 232                  -> Int
 233                  -> [Maybe Removal]
 234 computeRemovals nl bad_instances depth =
 235     map (checkRemoval nl) $ genNames depth bad_instances
 236
 237 -- Second phase functions
 238
 239 -- | Single-node relocation cost
 240 nodeDelta :: Ndx -> Ndx -> Ndx -> Int
 241 nodeDelta i p s =
 242     if i == p || i == s then
 243         0
 244     else
 245         1
 246
 247 {-| Compute best solution.
 248
 249     This function compares two solutions, choosing the minimum valid
 250     solution.
 251 -}
 252 compareSolutions :: Maybe Solution -> Maybe Solution -> Maybe Solution
 253 compareSolutions a b = case (a, b) of
 254   (Nothing, x) -> x
 255   (x, Nothing) -> x
 256   (x, y) -> min x y
 257
 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
 262
 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
 267         True
 268     else
 269         case sol of
 270           Nothing -> False
 271           Just (Solution old_delta _) -> old_delta <= new_delta
 272
 273 {-| Check if placement of instances still keeps the cluster N+1 compliant.
 274
 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.
 279
 280 -}
 281 checkPlacement :: Node.List            -- ^ 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
 292       vtail = tail victims
 293       have_tail = (length vtail) > 0
 294       nodes = Container.elems nl
 295       iidx = Instance.idx target
 296   in
 297     foldl'
 298     (\ accu_p pri ->
 299          let
 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
 304          in
 305            if fail_delta1 || isNothing(new_pri) then accu_p
 306            else let pri_nl = Container.add pri_idx (fromJust new_pri) nl in
 307                 foldl'
 308                 (\ accu sec ->
 309                      let
 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
 315                      in
 316                        if sec_idx == pri_idx || fail_delta2 ||
 317                           isNothing new_sec then accu
 318                        else let
 319                            nx = Container.add sec_idx (fromJust new_sec) pri_nl
 320                            upd_cv = compCV nx
 321                            plc = (iidx, pri_idx, sec_idx, upd_cv)
 322                            c2 = plc:current
 323                            result =
 324                                if have_tail then
 325                                    checkPlacement nx vtail c2 upd_delta
 326                                                   accu max_delta
 327                                else
 328                                    Just (Solution upd_delta c2)
 329                       in compareSolutions accu result
 330                 ) accu_p nodes
 331     ) prev_sol nodes
 332
 333 -- | Apply a move
 334 applyMove :: Node.List -> Instance.Instance
 335           -> IMove -> (Maybe Node.List, Instance.Instance, Ndx, Ndx)
 336 -- Failover (f)
 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)
 349
 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)
 365
 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)
 377
 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)
 393
 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)
 409
 410 allocateOnSingle :: Node.List -> Instance.Instance -> Node.Node
 411                  -> (Maybe Node.List, Instance.Instance)
 412 allocateOnSingle nl inst p =
 413     let new_pdx = Node.idx p
 414         new_nl = Node.addPri p inst >>= \new_p ->
 415                  return $ Container.add new_pdx new_p nl
 416     in (new_nl, Instance.setBoth inst new_pdx Node.noSecondary)
 417
 418 allocateOnPair :: Node.List -> Instance.Instance -> Node.Node -> Node.Node
 419                -> (Maybe Node.List, Instance.Instance)
 420 allocateOnPair nl inst tgt_p tgt_s =
 421     let new_pdx = Node.idx tgt_p
 422         new_sdx = Node.idx tgt_s
 423         new_nl = do -- Maybe monad
 424           new_p <- Node.addPri tgt_p inst
 425           new_s <- Node.addSec tgt_s inst new_pdx
 426           return $ Container.addTwo new_pdx new_p new_sdx new_s nl
 427     in (new_nl, Instance.setBoth inst new_pdx new_sdx)
 428
 429 checkSingleStep :: Table -- ^ The original table
 430                 -> Instance.Instance -- ^ The instance to move
 431                 -> Table -- ^ The current best table
 432                 -> IMove -- ^ The move to apply
 433                 -> Table -- ^ The final best table
 434 checkSingleStep ini_tbl target cur_tbl move =
 435     let
 436         Table ini_nl ini_il _ ini_plc = ini_tbl
 437         (tmp_nl, new_inst, pri_idx, sec_idx) = applyMove ini_nl target move
 438     in
 439       if isNothing tmp_nl then cur_tbl
 440       else
 441           let tgt_idx = Instance.idx target
 442               upd_nl = fromJust tmp_nl
 443               upd_cvar = compCV upd_nl
 444               upd_il = Container.add tgt_idx new_inst ini_il
 445               upd_plc = (tgt_idx, pri_idx, sec_idx, upd_cvar):ini_plc
 446               upd_tbl = Table upd_nl upd_il upd_cvar upd_plc
 447           in
 448             compareTables cur_tbl upd_tbl
 449
 450 -- | Given the status of the current secondary as a valid new node
 451 -- and the current candidate target node,
 452 -- generate the possible moves for a instance.
 453 possibleMoves :: Bool -> Ndx -> [IMove]
 454 possibleMoves True tdx =
 455     [ReplaceSecondary tdx,
 456      ReplaceAndFailover tdx,
 457      ReplacePrimary tdx,
 458      FailoverAndReplace tdx]
 459
 460 possibleMoves False tdx =
 461     [ReplaceSecondary tdx,
 462      ReplaceAndFailover tdx]
 463
 464 -- | Compute the best move for a given instance.
 465 checkInstanceMove :: [Ndx]             -- Allowed target node indices
 466                   -> Table             -- Original table
 467                   -> Instance.Instance -- Instance to move
 468                   -> Table             -- Best new table for this instance
 469 checkInstanceMove nodes_idx ini_tbl target =
 470     let
 471         opdx = Instance.pnode target
 472         osdx = Instance.snode target
 473         nodes = filter (\idx -> idx /= opdx && idx /= osdx) nodes_idx
 474         use_secondary = elem osdx nodes_idx
 475         aft_failover = if use_secondary -- if allowed to failover
 476                        then checkSingleStep ini_tbl target ini_tbl Failover
 477                        else ini_tbl
 478         all_moves = concatMap (possibleMoves use_secondary) nodes
 479     in
 480       -- iterate over the possible nodes for this instance
 481       foldl' (checkSingleStep ini_tbl target) aft_failover all_moves
 482
 483 -- | Compute the best next move.
 484 checkMove :: [Ndx]               -- ^ Allowed target node indices
 485           -> Table               -- ^ The current solution
 486           -> [Instance.Instance] -- ^ List of instances still to move
 487           -> Table               -- ^ The new solution
 488 checkMove nodes_idx ini_tbl victims =
 489     let Table _ _ _ ini_plc = ini_tbl
 490         -- iterate over all instances, computing the best move
 491         best_tbl =
 492             foldl'
 493             (\ step_tbl elem ->
 494                  if Instance.snode elem == Node.noSecondary then step_tbl
 495                     else compareTables step_tbl $
 496                          checkInstanceMove nodes_idx ini_tbl elem)
 497             ini_tbl victims
 498         Table _ _ _ best_plc = best_tbl
 499     in
 500       if length best_plc == length ini_plc then -- no advancement
 501           ini_tbl
 502       else
 503           best_tbl
 504
 505 {- | Auxiliary function for solution computation.
 506
 507 We write this in an explicit recursive fashion in order to control
 508 early-abort in case we have met the min delta. We can't use foldr
 509 instead of explicit recursion since we need the accumulator for the
 510 abort decision.
 511
 512 -}
 513 advanceSolution :: [Maybe Removal] -- ^ The removal to process
 514                 -> Int             -- ^ Minimum delta parameter
 515                 -> Int             -- ^ Maximum delta parameter
 516                 -> Maybe Solution  -- ^ Current best solution
 517                 -> Maybe Solution  -- ^ New best solution
 518 advanceSolution [] _ _ sol = sol
 519 advanceSolution (Nothing:xs) m n sol = advanceSolution xs m n sol
 520 advanceSolution ((Just (Removal nx removed)):xs) min_d max_d prev_sol =
 521     let new_sol = checkPlacement nx removed [] 0 prev_sol max_d
 522         new_delta = solutionDelta $! new_sol
 523     in
 524       if new_delta >= 0 && new_delta <= min_d then
 525           new_sol
 526       else
 527           advanceSolution xs min_d max_d new_sol
 528
 529 -- | Computes the placement solution.
 530 solutionFromRemovals :: [Maybe Removal] -- ^ The list of (possible) removals
 531                      -> Int             -- ^ Minimum delta parameter
 532                      -> Int             -- ^ Maximum delta parameter
 533                      -> Maybe Solution  -- ^ The best solution found
 534 solutionFromRemovals removals min_delta max_delta =
 535     advanceSolution removals min_delta max_delta Nothing
 536
 537 {- | Computes the solution at the given depth.
 538
 539 This is a wrapper over both computeRemovals and
 540 solutionFromRemovals. In case we have no solution, we return Nothing.
 541
 542 -}
 543 computeSolution :: Node.List        -- ^ The original node data
 544                 -> [Instance.Instance] -- ^ The list of /bad/ instances
 545                 -> Int             -- ^ The /depth/ of removals
 546                 -> Int             -- ^ Maximum number of removals to process
 547                 -> Int             -- ^ Minimum delta parameter
 548                 -> Int             -- ^ Maximum delta parameter
 549                 -> Maybe Solution  -- ^ The best solution found (or Nothing)
 550 computeSolution nl bad_instances depth max_removals min_delta max_delta =
 551   let
 552       removals = computeRemovals nl bad_instances depth
 553       removals' = capRemovals removals max_removals
 554   in
 555     solutionFromRemovals removals' min_delta max_delta
 556
 557 -- Solution display functions (pure)
 558
 559 -- | Given the original and final nodes, computes the relocation description.
 560 computeMoves :: String -- ^ The instance name
 561              -> String -- ^ Original primary
 562              -> String -- ^ Original secondary
 563              -> String -- ^ New primary
 564              -> String -- ^ New secondary
 565              -> (String, [String])
 566                 -- ^ Tuple of moves and commands list; moves is containing
 567                 -- either @/f/@ for failover or @/r:name/@ for replace
 568                 -- secondary, while the command list holds gnt-instance
 569                 -- commands (without that prefix), e.g \"@failover instance1@\"
 570 computeMoves i a b c d =
 571     if c == a then {- Same primary -}
 572         if d == b then {- Same sec??! -}
 573             ("-", [])
 574         else {- Change of secondary -}
 575             (printf "r:%s" d,
 576              [printf "replace-disks -n %s %s" d i])
 577     else
 578         if c == b then {- Failover and ... -}
 579             if d == a then {- that's all -}
 580                 ("f", [printf "migrate -f %s" i])
 581             else
 582                 (printf "f r:%s" d,
 583                  [printf "migrate -f %s" i,
 584                   printf "replace-disks -n %s %s" d i])
 585         else
 586             if d == a then {- ... and keep primary as secondary -}
 587                 (printf "r:%s f" c,
 588                  [printf "replace-disks -n %s %s" c i,
 589                   printf "migrate -f %s" i])
 590             else
 591                 if d == b then {- ... keep same secondary -}
 592                     (printf "f r:%s f" c,
 593                      [printf "migrate -f %s" i,
 594                       printf "replace-disks -n %s %s" c i,
 595                       printf "migrate -f %s" i])
 596
 597                 else {- Nothing in common -}
 598                     (printf "r:%s f r:%s" c d,
 599                      [printf "replace-disks -n %s %s" c i,
 600                       printf "migrate -f %s" i,
 601                       printf "replace-disks -n %s %s" d i])
 602
 603 {-| Converts a placement to string format -}
 604 printSolutionLine :: Node.List
 605                   -> Instance.List
 606                   -> Int
 607                   -> Int
 608                   -> Placement
 609                   -> Int
 610                   -> (String, [String])
 611 printSolutionLine nl il nmlen imlen plc pos =
 612     let
 613         pmlen = (2*nmlen + 1)
 614         (i, p, s, c) = plc
 615         inst = Container.find i il
 616         inam = Instance.name inst
 617         npri = Container.nameOf nl p
 618         nsec = Container.nameOf nl s
 619         opri = Container.nameOf nl $ Instance.pnode inst
 620         osec = Container.nameOf nl $ Instance.snode inst
 621         (moves, cmds) =  computeMoves inam opri osec npri nsec
 622         ostr = (printf "%s:%s" opri osec)::String
 623         nstr = (printf "%s:%s" npri nsec)::String
 624     in
 625       (printf "  %3d. %-*s %-*s => %-*s %.8f a=%s"
 626        pos imlen inam pmlen ostr
 627        pmlen nstr c moves,
 628        cmds)
 629
 630 formatCmds :: [[String]] -> String
 631 formatCmds cmd_strs =
 632     unlines $
 633     concat $ map (\(a, b) ->
 634         (printf "echo step %d" (a::Int)):
 635         (printf "check"):
 636         (map ("gnt-instance " ++) b)) $
 637         zip [1..] cmd_strs
 638
 639 {-| Converts a solution to string format -}
 640 printSolution :: Node.List
 641               -> Instance.List
 642               -> [Placement]
 643               -> ([String], [[String]])
 644 printSolution nl il sol =
 645     let
 646         nmlen = Container.maxNameLen nl
 647         imlen = Container.maxNameLen il
 648     in
 649       unzip $ map (uncurry $ printSolutionLine nl il nmlen imlen) $
 650             zip sol [1..]
 651
 652 -- | Print the node list.
 653 printNodes :: Node.List -> String
 654 printNodes nl =
 655     let snl = sortBy (compare `on` Node.idx) (Container.elems nl)
 656         m_name = maximum . map (length . Node.name) $ snl
 657         helper = Node.list m_name
 658         header = printf
 659                  "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %3s %3s %7s %7s"
 660                  " F" m_name "Name"
 661                  "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem"
 662                  "t_dsk" "f_dsk"
 663                  "pri" "sec" "p_fmem" "p_fdsk"
 664     in unlines $ (header:map helper snl)
 665
 666 -- | Compute the mem and disk covariance.
 667 compDetailedCV :: Node.List -> (Double, Double, Double, Double, Double)
 668 compDetailedCV nl =
 669     let
 670         all_nodes = Container.elems nl
 671         (offline, nodes) = partition Node.offline all_nodes
 672         mem_l = map Node.p_mem nodes
 673         dsk_l = map Node.p_dsk nodes
 674         mem_cv = varianceCoeff mem_l
 675         dsk_cv = varianceCoeff dsk_l
 676         n1_l = length $ filter Node.failN1 nodes
 677         n1_score = (fromIntegral n1_l) / (fromIntegral $ length nodes)
 678         res_l = map Node.p_rem nodes
 679         res_cv = varianceCoeff res_l
 680         offline_inst = sum . map (\n -> (length . Node.plist $ n) +
 681                                         (length . Node.slist $ n)) $ offline
 682         online_inst = sum . map (\n -> (length . Node.plist $ n) +
 683                                        (length . Node.slist $ n)) $ nodes
 684         off_score = (fromIntegral offline_inst) /
 685                     (fromIntegral $ online_inst + offline_inst)
 686     in (mem_cv, dsk_cv, n1_score, res_cv, off_score)
 687
 688 -- | Compute the 'total' variance.
 689 compCV :: Node.List -> Double
 690 compCV nl =
 691     let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
 692     in mem_cv + dsk_cv + n1_score + res_cv + off_score
 693
 694 printStats :: Node.List -> String
 695 printStats nl =
 696     let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
 697     in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f, uf=%.3f"
 698        mem_cv res_cv dsk_cv n1_score off_score