Statistics
| Branch: | Tag: | Revision:

root / Ganeti / HTools / Cluster.hs @ 2485487d

History | View | Annotate | Download (24.4 kB)

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
{-
9

    
10
Copyright (C) 2009 Google Inc.
11

    
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.
16

    
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.
21

    
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
25
02110-1301, USA.
26

    
27
-}
28

    
29
module Ganeti.HTools.Cluster
30
    (
31
     -- * Types
32
      Placement
33
    , AllocSolution
34
    , Table(..)
35
    , Score
36
    , IMove(..)
37
    , CStats(..)
38
    -- * Generic functions
39
    , totalResources
40
    -- * First phase functions
41
    , computeBadItems
42
    -- * Second phase functions
43
    , printSolution
44
    , printSolutionLine
45
    , formatCmds
46
    , printNodes
47
    -- * Balacing functions
48
    , checkMove
49
    , compCV
50
    , printStats
51
    -- * IAllocator functions
52
    , tryAlloc
53
    , tryReloc
54
    , collapseFailures
55
    ) where
56

    
57
import Data.List
58
import Text.Printf (printf)
59
import Data.Function
60
import Control.Monad
61

    
62
import qualified Ganeti.HTools.Container as Container
63
import qualified Ganeti.HTools.Instance as Instance
64
import qualified Ganeti.HTools.Node as Node
65
import Ganeti.HTools.Types
66
import Ganeti.HTools.Utils
67

    
68
-- * Types
69

    
70
-- | A separate name for the cluster score type.
71
type Score = Double
72

    
73
-- | The description of an instance placement.
74
type Placement = (Idx, Ndx, Ndx, Score)
75

    
76
-- | Allocation\/relocation solution.
77
type AllocSolution = ([FailMode], Int, Maybe (Score, AllocElement))
78

    
79
-- | Allocation\/relocation element.
80
type AllocElement = (Node.List, Instance.Instance, [Node.Node])
81

    
82
-- | An instance move definition
83
data IMove = Failover                -- ^ Failover the instance (f)
84
           | ReplacePrimary Ndx      -- ^ Replace primary (f, r:np, f)
85
           | ReplaceSecondary Ndx    -- ^ Replace secondary (r:ns)
86
           | ReplaceAndFailover Ndx  -- ^ Replace secondary, failover (r:np, f)
87
           | FailoverAndReplace Ndx  -- ^ Failover, replace secondary (f, r:ns)
88
             deriving (Show)
89

    
90
-- | The complete state for the balancing solution
91
data Table = Table Node.List Instance.List Score [Placement]
92
             deriving (Show)
93

    
94
data CStats = CStats { cs_fmem :: Int    -- ^ Cluster free mem
95
                     , cs_fdsk :: Int    -- ^ Cluster free disk
96
                     , cs_amem :: Int    -- ^ Cluster allocatable mem
97
                     , cs_adsk :: Int    -- ^ Cluster allocatable disk
98
                     , cs_acpu :: Int    -- ^ Cluster allocatable cpus
99
                     , cs_mmem :: Int    -- ^ Max node allocatable mem
100
                     , cs_mdsk :: Int    -- ^ Max node allocatable disk
101
                     , cs_mcpu :: Int    -- ^ Max node allocatable cpu
102
                     , cs_imem :: Int    -- ^ Instance used mem
103
                     , cs_idsk :: Int    -- ^ Instance used disk
104
                     , cs_icpu :: Int    -- ^ Instance used cpu
105
                     , cs_tmem :: Double -- ^ Cluster total mem
106
                     , cs_tdsk :: Double -- ^ Cluster total disk
107
                     , cs_tcpu :: Double -- ^ Cluster total cpus
108
                     , cs_xmem :: Int    -- ^ Unnacounted for mem
109
                     , cs_nmem :: Int    -- ^ Node own memory
110
                     , cs_score :: Score -- ^ The cluster score
111
                     , cs_ninst :: Int   -- ^ The total number of instances
112
                     }
113

    
114
-- * Utility functions
115

    
116
-- | Verifies the N+1 status and return the affected nodes.
117
verifyN1 :: [Node.Node] -> [Node.Node]
118
verifyN1 = filter Node.failN1
119

    
120
{-| Computes the pair of bad nodes and instances.
121

    
122
The bad node list is computed via a simple 'verifyN1' check, and the
123
bad instance list is the list of primary and secondary instances of
124
those nodes.
125

    
126
-}
127
computeBadItems :: Node.List -> Instance.List ->
128
                   ([Node.Node], [Instance.Instance])
129
computeBadItems nl il =
130
  let bad_nodes = verifyN1 $ getOnline nl
131
      bad_instances = map (\idx -> Container.find idx il) .
132
                      sort . nub $
133
                      concatMap (\ n -> Node.slist n ++ Node.plist n) bad_nodes
134
  in
135
    (bad_nodes, bad_instances)
136

    
137
emptyCStats :: CStats
138
emptyCStats = CStats { cs_fmem = 0
139
                     , cs_fdsk = 0
140
                     , cs_amem = 0
141
                     , cs_adsk = 0
142
                     , cs_acpu = 0
143
                     , cs_mmem = 0
144
                     , cs_mdsk = 0
145
                     , cs_mcpu = 0
146
                     , cs_imem = 0
147
                     , cs_idsk = 0
148
                     , cs_icpu = 0
149
                     , cs_tmem = 0
150
                     , cs_tdsk = 0
151
                     , cs_tcpu = 0
152
                     , cs_xmem = 0
153
                     , cs_nmem = 0
154
                     , cs_score = 0
155
                     , cs_ninst = 0
156
                     }
157

    
158
updateCStats :: CStats -> Node.Node -> CStats
159
updateCStats cs node =
160
    let CStats { cs_fmem = x_fmem, cs_fdsk = x_fdsk,
161
                 cs_amem = x_amem, cs_acpu = x_acpu, cs_adsk = x_adsk,
162
                 cs_mmem = x_mmem, cs_mdsk = x_mdsk, cs_mcpu = x_mcpu,
163
                 cs_imem = x_imem, cs_idsk = x_idsk, cs_icpu = x_icpu,
164
                 cs_tmem = x_tmem, cs_tdsk = x_tdsk, cs_tcpu = x_tcpu,
165
                 cs_xmem = x_xmem, cs_nmem = x_nmem, cs_ninst = x_ninst
166
               }
167
            = cs
168
        inc_amem = Node.f_mem node - Node.r_mem node
169
        inc_amem' = if inc_amem > 0 then inc_amem else 0
170
        inc_adsk = Node.availDisk node
171
        inc_imem = truncate (Node.t_mem node) - Node.n_mem node
172
                   - Node.x_mem node - Node.f_mem node
173
        inc_icpu = Node.u_cpu node
174
        inc_idsk = truncate (Node.t_dsk node) - Node.f_dsk node
175

    
176
    in cs { cs_fmem = x_fmem + Node.f_mem node
177
          , cs_fdsk = x_fdsk + Node.f_dsk node
178
          , cs_amem = x_amem + inc_amem'
179
          , cs_adsk = x_adsk + inc_adsk
180
          , cs_acpu = x_acpu
181
          , cs_mmem = max x_mmem inc_amem'
182
          , cs_mdsk = max x_mdsk inc_adsk
183
          , cs_mcpu = x_mcpu
184
          , cs_imem = x_imem + inc_imem
185
          , cs_idsk = x_idsk + inc_idsk
186
          , cs_icpu = x_icpu + inc_icpu
187
          , cs_tmem = x_tmem + Node.t_mem node
188
          , cs_tdsk = x_tdsk + Node.t_dsk node
189
          , cs_tcpu = x_tcpu + Node.t_cpu node
190
          , cs_xmem = x_xmem + Node.x_mem node
191
          , cs_nmem = x_nmem + Node.n_mem node
192
          , cs_ninst = x_ninst + length (Node.plist node)
193
          }
194

    
195
-- | Compute the total free disk and memory in the cluster.
196
totalResources :: Node.List -> CStats
197
totalResources nl =
198
    let cs = foldl' updateCStats emptyCStats . Container.elems $ nl
199
    in cs { cs_score = compCV nl }
200

    
201
-- | Compute the mem and disk covariance.
202
compDetailedCV :: Node.List -> (Double, Double, Double, Double, Double, Double)
203
compDetailedCV nl =
204
    let
205
        all_nodes = Container.elems nl
206
        (offline, nodes) = partition Node.offline all_nodes
207
        mem_l = map Node.p_mem nodes
208
        dsk_l = map Node.p_dsk nodes
209
        mem_cv = varianceCoeff mem_l
210
        dsk_cv = varianceCoeff dsk_l
211
        n1_l = length $ filter Node.failN1 nodes
212
        n1_score = fromIntegral n1_l /
213
                   fromIntegral (length nodes)::Double
214
        res_l = map Node.p_rem nodes
215
        res_cv = varianceCoeff res_l
216
        offline_inst = sum . map (\n -> (length . Node.plist $ n) +
217
                                        (length . Node.slist $ n)) $ offline
218
        online_inst = sum . map (\n -> (length . Node.plist $ n) +
219
                                       (length . Node.slist $ n)) $ nodes
220
        off_score = if offline_inst == 0
221
                    then 0::Double
222
                    else fromIntegral offline_inst /
223
                         fromIntegral (offline_inst + online_inst)::Double
224
        cpu_l = map Node.p_cpu nodes
225
        cpu_cv = varianceCoeff cpu_l
226
    in (mem_cv, dsk_cv, n1_score, res_cv, off_score, cpu_cv)
227

    
228
-- | Compute the /total/ variance.
229
compCV :: Node.List -> Double
230
compCV nl =
231
    let (mem_cv, dsk_cv, n1_score, res_cv, off_score, cpu_cv) =
232
            compDetailedCV nl
233
    in mem_cv + dsk_cv + n1_score + res_cv + off_score + cpu_cv
234

    
235
-- | Compute online nodes from a Node.List
236
getOnline :: Node.List -> [Node.Node]
237
getOnline = filter (not . Node.offline) . Container.elems
238

    
239
-- * hbal functions
240

    
241
-- | Compute best table. Note that the ordering of the arguments is important.
242
compareTables :: Table -> Table -> Table
243
compareTables a@(Table _ _ a_cv _) b@(Table _ _ b_cv _ ) =
244
    if a_cv > b_cv then b else a
245

    
246
-- | Applies an instance move to a given node list and instance.
247
applyMove :: Node.List -> Instance.Instance
248
          -> IMove -> OpResult (Node.List, Instance.Instance, Ndx, Ndx)
249
-- Failover (f)
250
applyMove nl inst Failover =
251
    let old_pdx = Instance.pnode inst
252
        old_sdx = Instance.snode inst
253
        old_p = Container.find old_pdx nl
254
        old_s = Container.find old_sdx nl
255
        int_p = Node.removePri old_p inst
256
        int_s = Node.removeSec old_s inst
257
        new_nl = do -- Maybe monad
258
          new_p <- Node.addPri int_s inst
259
          new_s <- Node.addSec int_p inst old_sdx
260
          let new_inst = Instance.setBoth inst old_sdx old_pdx
261
          return (Container.addTwo old_pdx new_s old_sdx new_p nl,
262
                  new_inst, old_sdx, old_pdx)
263
    in new_nl
264

    
265
-- Replace the primary (f:, r:np, f)
266
applyMove nl inst (ReplacePrimary new_pdx) =
267
    let old_pdx = Instance.pnode inst
268
        old_sdx = Instance.snode inst
269
        old_p = Container.find old_pdx nl
270
        old_s = Container.find old_sdx nl
271
        tgt_n = Container.find new_pdx nl
272
        int_p = Node.removePri old_p inst
273
        int_s = Node.removeSec old_s inst
274
        new_nl = do -- Maybe monad
275
          -- check that the current secondary can host the instance
276
          -- during the migration
277
          tmp_s <- Node.addPri int_s inst
278
          let tmp_s' = Node.removePri tmp_s inst
279
          new_p <- Node.addPri tgt_n inst
280
          new_s <- Node.addSec tmp_s' inst new_pdx
281
          let new_inst = Instance.setPri inst new_pdx
282
          return (Container.add new_pdx new_p $
283
                  Container.addTwo old_pdx int_p old_sdx new_s nl,
284
                  new_inst, new_pdx, old_sdx)
285
    in new_nl
286

    
287
-- Replace the secondary (r:ns)
288
applyMove nl inst (ReplaceSecondary new_sdx) =
289
    let old_pdx = Instance.pnode inst
290
        old_sdx = Instance.snode inst
291
        old_s = Container.find old_sdx nl
292
        tgt_n = Container.find new_sdx nl
293
        int_s = Node.removeSec old_s inst
294
        new_inst = Instance.setSec inst new_sdx
295
        new_nl = Node.addSec tgt_n inst old_pdx >>=
296
                 \new_s -> return (Container.addTwo new_sdx
297
                                   new_s old_sdx int_s nl,
298
                                   new_inst, old_pdx, new_sdx)
299
    in new_nl
300

    
301
-- Replace the secondary and failover (r:np, f)
302
applyMove nl inst (ReplaceAndFailover new_pdx) =
303
    let old_pdx = Instance.pnode inst
304
        old_sdx = Instance.snode inst
305
        old_p = Container.find old_pdx nl
306
        old_s = Container.find old_sdx nl
307
        tgt_n = Container.find new_pdx nl
308
        int_p = Node.removePri old_p inst
309
        int_s = Node.removeSec old_s inst
310
        new_nl = do -- Maybe monad
311
          new_p <- Node.addPri tgt_n inst
312
          new_s <- Node.addSec int_p inst new_pdx
313
          let new_inst = Instance.setBoth inst new_pdx old_pdx
314
          return (Container.add new_pdx new_p $
315
                  Container.addTwo old_pdx new_s old_sdx int_s nl,
316
                  new_inst, new_pdx, old_pdx)
317
    in new_nl
318

    
319
-- Failver and replace the secondary (f, r:ns)
320
applyMove nl inst (FailoverAndReplace new_sdx) =
321
    let old_pdx = Instance.pnode inst
322
        old_sdx = Instance.snode inst
323
        old_p = Container.find old_pdx nl
324
        old_s = Container.find old_sdx nl
325
        tgt_n = Container.find new_sdx nl
326
        int_p = Node.removePri old_p inst
327
        int_s = Node.removeSec old_s inst
328
        new_nl = do -- Maybe monad
329
          new_p <- Node.addPri int_s inst
330
          new_s <- Node.addSec tgt_n inst old_sdx
331
          let new_inst = Instance.setBoth inst old_sdx new_sdx
332
          return (Container.add new_sdx new_s $
333
                  Container.addTwo old_sdx new_p old_pdx int_p nl,
334
                  new_inst, old_sdx, new_sdx)
335
    in new_nl
336

    
337
-- | Tries to allocate an instance on one given node.
338
allocateOnSingle :: Node.List -> Instance.Instance -> Node.Node
339
                 -> OpResult AllocElement
340
allocateOnSingle nl inst p =
341
    let new_pdx = Node.idx p
342
        new_inst = Instance.setBoth inst new_pdx Node.noSecondary
343
        new_nl = Node.addPri p inst >>= \new_p ->
344
                 return (Container.add new_pdx new_p nl, new_inst, [new_p])
345
    in new_nl
346

    
347
-- | Tries to allocate an instance on a given pair of nodes.
348
allocateOnPair :: Node.List -> Instance.Instance -> Node.Node -> Node.Node
349
               -> OpResult AllocElement
350
allocateOnPair nl inst tgt_p tgt_s =
351
    let new_pdx = Node.idx tgt_p
352
        new_sdx = Node.idx tgt_s
353
        new_nl = do -- Maybe monad
354
          new_p <- Node.addPri tgt_p inst
355
          new_s <- Node.addSec tgt_s inst new_pdx
356
          let new_inst = Instance.setBoth inst new_pdx new_sdx
357
          return (Container.addTwo new_pdx new_p new_sdx new_s nl, new_inst,
358
                 [new_p, new_s])
359
    in new_nl
360

    
361
-- | Tries to perform an instance move and returns the best table
362
-- between the original one and the new one.
363
checkSingleStep :: Table -- ^ The original table
364
                -> Instance.Instance -- ^ The instance to move
365
                -> Table -- ^ The current best table
366
                -> IMove -- ^ The move to apply
367
                -> Table -- ^ The final best table
368
checkSingleStep ini_tbl target cur_tbl move =
369
    let
370
        Table ini_nl ini_il _ ini_plc = ini_tbl
371
        tmp_resu = applyMove ini_nl target move
372
    in
373
      case tmp_resu of
374
        OpFail _ -> cur_tbl
375
        OpGood (upd_nl, new_inst, pri_idx, sec_idx)  ->
376
            let tgt_idx = Instance.idx target
377
                upd_cvar = compCV upd_nl
378
                upd_il = Container.add tgt_idx new_inst ini_il
379
                upd_plc = (tgt_idx, pri_idx, sec_idx, upd_cvar):ini_plc
380
                upd_tbl = Table upd_nl upd_il upd_cvar upd_plc
381
            in
382
              compareTables cur_tbl upd_tbl
383

    
384
-- | Given the status of the current secondary as a valid new node
385
-- and the current candidate target node,
386
-- generate the possible moves for a instance.
387
possibleMoves :: Bool -> Ndx -> [IMove]
388
possibleMoves True tdx =
389
    [ReplaceSecondary tdx,
390
     ReplaceAndFailover tdx,
391
     ReplacePrimary tdx,
392
     FailoverAndReplace tdx]
393

    
394
possibleMoves False tdx =
395
    [ReplaceSecondary tdx,
396
     ReplaceAndFailover tdx]
397

    
398
-- | Compute the best move for a given instance.
399
checkInstanceMove :: [Ndx]             -- Allowed target node indices
400
                  -> Table             -- Original table
401
                  -> Instance.Instance -- Instance to move
402
                  -> Table             -- Best new table for this instance
403
checkInstanceMove nodes_idx ini_tbl target =
404
    let
405
        opdx = Instance.pnode target
406
        osdx = Instance.snode target
407
        nodes = filter (\idx -> idx /= opdx && idx /= osdx) nodes_idx
408
        use_secondary = elem osdx nodes_idx
409
        aft_failover = if use_secondary -- if allowed to failover
410
                       then checkSingleStep ini_tbl target ini_tbl Failover
411
                       else ini_tbl
412
        all_moves = concatMap (possibleMoves use_secondary) nodes
413
    in
414
      -- iterate over the possible nodes for this instance
415
      foldl' (checkSingleStep ini_tbl target) aft_failover all_moves
416

    
417
-- | Compute the best next move.
418
checkMove :: [Ndx]               -- ^ Allowed target node indices
419
          -> Table               -- ^ The current solution
420
          -> [Instance.Instance] -- ^ List of instances still to move
421
          -> Table               -- ^ The new solution
422
checkMove nodes_idx ini_tbl victims =
423
    let Table _ _ _ ini_plc = ini_tbl
424
        -- iterate over all instances, computing the best move
425
        best_tbl =
426
            foldl'
427
            (\ step_tbl elem ->
428
                 if Instance.snode elem == Node.noSecondary then step_tbl
429
                    else compareTables step_tbl $
430
                         checkInstanceMove nodes_idx ini_tbl elem)
431
            ini_tbl victims
432
        Table _ _ _ best_plc = best_tbl
433
    in
434
      if length best_plc == length ini_plc then -- no advancement
435
          ini_tbl
436
      else
437
          best_tbl
438

    
439
-- * Allocation functions
440

    
441
-- | Build failure stats out of a list of failures
442
collapseFailures :: [FailMode] -> FailStats
443
collapseFailures flst =
444
    map (\k -> (k, length $ filter ((==) k) flst)) [minBound..maxBound]
445

    
446
-- | Update current Allocation solution and failure stats with new
447
-- elements
448
concatAllocs :: AllocSolution -> OpResult AllocElement -> AllocSolution
449
concatAllocs (flst, succ, sols) (OpFail reason) = (reason:flst, succ, sols)
450

    
451
concatAllocs (flst, succ, osols) (OpGood ns@(nl, _, _)) =
452
    let nscore = compCV nl
453
        -- Choose the old or new solution, based on the cluster score
454
        nsols = case osols of
455
                  Nothing -> Just (nscore, ns)
456
                  Just (oscore, _) ->
457
                      if oscore < nscore
458
                      then osols
459
                      else Just (nscore, ns)
460
        nsuc = succ + 1
461
    -- Note: we force evaluation of nsols here in order to keep the
462
    -- memory profile low - we know that we will need nsols for sure
463
    -- in the next cycle, so we force evaluation of nsols, since the
464
    -- foldl' in the caller will only evaluate the tuple, but not the
465
    -- elements of the tuple
466
    in nsols `seq` nsuc `seq` (flst, nsuc, nsols)
467

    
468
-- | Try to allocate an instance on the cluster.
469
tryAlloc :: (Monad m) =>
470
            Node.List         -- ^ The node list
471
         -> Instance.List     -- ^ The instance list
472
         -> Instance.Instance -- ^ The instance to allocate
473
         -> Int               -- ^ Required number of nodes
474
         -> m AllocSolution   -- ^ Possible solution list
475
tryAlloc nl _ inst 2 =
476
    let all_nodes = getOnline nl
477
        all_pairs = liftM2 (,) all_nodes all_nodes
478
        ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs
479
        sols = foldl' (\cstate (p, s) ->
480
                           concatAllocs cstate $ allocateOnPair nl inst p s
481
                      ) ([], 0, Nothing) ok_pairs
482
    in return sols
483

    
484
tryAlloc nl _ inst 1 =
485
    let all_nodes = getOnline nl
486
        sols = foldl' (\cstate ->
487
                           concatAllocs cstate . allocateOnSingle nl inst
488
                      ) ([], 0, Nothing) all_nodes
489
    in return sols
490

    
491
tryAlloc _ _ _ reqn = fail $ "Unsupported number of allocation \
492
                             \destinations required (" ++ show reqn ++
493
                                               "), only two supported"
494

    
495
-- | Try to allocate an instance on the cluster.
496
tryReloc :: (Monad m) =>
497
            Node.List       -- ^ The node list
498
         -> Instance.List   -- ^ The instance list
499
         -> Idx             -- ^ The index of the instance to move
500
         -> Int             -- ^ The number of nodes required
501
         -> [Ndx]           -- ^ Nodes which should not be used
502
         -> m AllocSolution -- ^ Solution list
503
tryReloc nl il xid 1 ex_idx =
504
    let all_nodes = getOnline nl
505
        inst = Container.find xid il
506
        ex_idx' = Instance.pnode inst:ex_idx
507
        valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes
508
        valid_idxes = map Node.idx valid_nodes
509
        sols1 = foldl' (\cstate x ->
510
                            let elem = do
511
                                  (mnl, i, _, _) <-
512
                                      applyMove nl inst (ReplaceSecondary x)
513
                                  return (mnl, i, [Container.find x mnl])
514
                            in concatAllocs cstate elem
515
                       ) ([], 0, Nothing) valid_idxes
516
    in return sols1
517

    
518
tryReloc _ _ _ reqn _  = fail $ "Unsupported number of relocation \
519
                                \destinations required (" ++ show reqn ++
520
                                                  "), only one supported"
521

    
522
-- * Formatting functions
523

    
524
-- | Given the original and final nodes, computes the relocation description.
525
computeMoves :: String -- ^ The instance name
526
             -> String -- ^ Original primary
527
             -> String -- ^ Original secondary
528
             -> String -- ^ New primary
529
             -> String -- ^ New secondary
530
             -> (String, [String])
531
                -- ^ Tuple of moves and commands list; moves is containing
532
                -- either @/f/@ for failover or @/r:name/@ for replace
533
                -- secondary, while the command list holds gnt-instance
534
                -- commands (without that prefix), e.g \"@failover instance1@\"
535
computeMoves i a b c d
536
    -- same primary
537
    | c == a =
538
        if d == b
539
        then {- Same sec??! -} ("-", [])
540
        else {- Change of secondary -}
541
            (printf "r:%s" d, [rep d])
542
    -- failover and ...
543
    | c == b =
544
        if d == a
545
        then {- that's all -} ("f", [mig])
546
        else (printf "f r:%s" d, [mig, rep d])
547
    -- ... and keep primary as secondary
548
    | d == a =
549
        (printf "r:%s f" c, [rep c, mig])
550
    -- ... keep same secondary
551
    | d == b =
552
        (printf "f r:%s f" c, [mig, rep c, mig])
553
    -- nothing in common -
554
    | otherwise =
555
        (printf "r:%s f r:%s" c d, [rep c, mig, rep d])
556
    where mig = printf "migrate -f %s" i::String
557
          rep n = printf "replace-disks -n %s %s" n i
558

    
559
-- | Converts a placement to string format.
560
printSolutionLine :: Node.List     -- ^ The node list
561
                  -> Instance.List -- ^ The instance list
562
                  -> Int           -- ^ Maximum node name length
563
                  -> Int           -- ^ Maximum instance name length
564
                  -> Placement     -- ^ The current placement
565
                  -> Int           -- ^ The index of the placement in
566
                                   -- the solution
567
                  -> (String, [String])
568
printSolutionLine nl il nmlen imlen plc pos =
569
    let
570
        pmlen = (2*nmlen + 1)
571
        (i, p, s, c) = plc
572
        inst = Container.find i il
573
        inam = Instance.name inst
574
        npri = Container.nameOf nl p
575
        nsec = Container.nameOf nl s
576
        opri = Container.nameOf nl $ Instance.pnode inst
577
        osec = Container.nameOf nl $ Instance.snode inst
578
        (moves, cmds) =  computeMoves inam opri osec npri nsec
579
        ostr = printf "%s:%s" opri osec::String
580
        nstr = printf "%s:%s" npri nsec::String
581
    in
582
      (printf "  %3d. %-*s %-*s => %-*s %.8f a=%s"
583
       pos imlen inam pmlen ostr
584
       pmlen nstr c moves,
585
       cmds)
586

    
587
-- | Given a list of commands, prefix them with @gnt-instance@ and
588
-- also beautify the display a little.
589
formatCmds :: [[String]] -> String
590
formatCmds =
591
    unlines .
592
    concatMap (\(a, b) ->
593
               printf "echo step %d" (a::Int):
594
               printf "check":
595
               map ("gnt-instance " ++) b
596
              ) .
597
    zip [1..]
598

    
599
-- | Converts a solution to string format.
600
printSolution :: Node.List
601
              -> Instance.List
602
              -> [Placement]
603
              -> ([String], [[String]])
604
printSolution nl il sol =
605
    let
606
        nmlen = Container.maxNameLen nl
607
        imlen = Container.maxNameLen il
608
    in
609
      unzip $ zipWith (printSolutionLine nl il nmlen imlen) sol [1..]
610

    
611
-- | Print the node list.
612
printNodes :: Node.List -> String
613
printNodes nl =
614
    let snl = sortBy (compare `on` Node.idx) (Container.elems nl)
615
        m_name = maximum . map (length . Node.name) $ snl
616
        helper = Node.list m_name
617
        header = printf
618
                 "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %4s %4s \
619
                 \%3s %3s %6s %6s %5s"
620
                 " F" m_name "Name"
621
                 "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem"
622
                 "t_dsk" "f_dsk" "pcpu" "vcpu"
623
                 "pri" "sec" "p_fmem" "p_fdsk" "r_cpu"::String
624
    in unlines (header:map helper snl)
625

    
626
-- | Shows statistics for a given node list.
627
printStats :: Node.List -> String
628
printStats nl =
629
    let (mem_cv, dsk_cv, n1_score, res_cv, off_score, cpu_cv) =
630
            compDetailedCV nl
631
    in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f, \
632
              \uf=%.3f, r_cpu=%.3f"
633
       mem_cv res_cv dsk_cv n1_score off_score cpu_cv