Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / HTools / Node.hs @ c09359ee

History | View | Annotate | Download (25.9 kB)

1
{-| Module describing a node.
2

    
3
    All updates are functional (copy-based) and return a new node with
4
    updated value.
5
-}
6

    
7
{-
8

    
9
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
10

    
11
This program is free software; you can redistribute it and/or modify
12
it under the terms of the GNU General Public License as published by
13
the Free Software Foundation; either version 2 of the License, or
14
(at your option) any later version.
15

    
16
This program is distributed in the hope that it will be useful, but
17
WITHOUT ANY WARRANTY; without even the implied warranty of
18
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19
General Public License for more details.
20

    
21
You should have received a copy of the GNU General Public License
22
along with this program; if not, write to the Free Software
23
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
24
02110-1301, USA.
25

    
26
-}
27

    
28
module Ganeti.HTools.Node
29
  ( Node(..)
30
  , List
31
  -- * Constructor
32
  , create
33
  -- ** Finalization after data loading
34
  , buildPeers
35
  , setIdx
36
  , setAlias
37
  , setOffline
38
  , setXmem
39
  , setFmem
40
  , setPri
41
  , setSec
42
  , setMaster
43
  , setNodeTags
44
  , setMdsk
45
  , setMcpu
46
  , setPolicy
47
  -- * Tag maps
48
  , addTags
49
  , delTags
50
  , rejectAddTags
51
  -- * Instance (re)location
52
  , removePri
53
  , removeSec
54
  , addPri
55
  , addPriEx
56
  , addSec
57
  , addSecEx
58
  -- * Stats
59
  , availDisk
60
  , availMem
61
  , availCpu
62
  , iMem
63
  , iDsk
64
  , conflictingPrimaries
65
  -- * Formatting
66
  , defaultFields
67
  , showHeader
68
  , showField
69
  , list
70
  -- * Misc stuff
71
  , AssocList
72
  , AllocElement
73
  , noSecondary
74
  , computeGroups
75
  , mkNodeGraph
76
  , mkRebootNodeGraph
77
  ) where
78

    
79
import Control.Monad (liftM, liftM2)
80
import Control.Applicative ((<$>), (<*>))
81
import qualified Data.Foldable as Foldable
82
import Data.Function (on)
83
import qualified Data.Graph as Graph
84
import qualified Data.IntMap as IntMap
85
import Data.List hiding (group)
86
import qualified Data.Map as Map
87
import Data.Ord (comparing)
88
import Text.Printf (printf)
89

    
90
import qualified Ganeti.HTools.Container as Container
91
import qualified Ganeti.HTools.Instance as Instance
92
import qualified Ganeti.HTools.PeerMap as P
93

    
94
import Ganeti.BasicTypes
95
import qualified Ganeti.HTools.Types as T
96

    
97
-- * Type declarations
98

    
99
-- | The tag map type.
100
type TagMap = Map.Map String Int
101

    
102
-- | The node type.
103
data Node = Node
104
  { name     :: String    -- ^ The node name
105
  , alias    :: String    -- ^ The shortened name (for display purposes)
106
  , tMem     :: Double    -- ^ Total memory (MiB)
107
  , nMem     :: Int       -- ^ Node memory (MiB)
108
  , fMem     :: Int       -- ^ Free memory (MiB)
109
  , xMem     :: Int       -- ^ Unaccounted memory (MiB)
110
  , tDsk     :: Double    -- ^ Total disk space (MiB)
111
  , fDsk     :: Int       -- ^ Free disk space (MiB)
112
  , tCpu     :: Double    -- ^ Total CPU count
113
  , uCpu     :: Int       -- ^ Used VCPU count
114
  , spindleCount :: Int   -- ^ Node spindles (spindle_count node parameter)
115
  , pList    :: [T.Idx]   -- ^ List of primary instance indices
116
  , sList    :: [T.Idx]   -- ^ List of secondary instance indices
117
  , idx      :: T.Ndx     -- ^ Internal index for book-keeping
118
  , peers    :: P.PeerMap -- ^ Pnode to instance mapping
119
  , failN1   :: Bool      -- ^ Whether the node has failed n1
120
  , rMem     :: Int       -- ^ Maximum memory needed for failover by
121
                          -- primaries of this node
122
  , pMem     :: Double    -- ^ Percent of free memory
123
  , pDsk     :: Double    -- ^ Percent of free disk
124
  , pRem     :: Double    -- ^ Percent of reserved memory
125
  , pCpu     :: Double    -- ^ Ratio of virtual to physical CPUs
126
  , mDsk     :: Double    -- ^ Minimum free disk ratio
127
  , loDsk    :: Int       -- ^ Autocomputed from mDsk low disk
128
                          -- threshold
129
  , hiCpu    :: Int       -- ^ Autocomputed from mCpu high cpu
130
                          -- threshold
131
  , hiSpindles :: Double  -- ^ Auto-computed from policy spindle_ratio
132
                          -- and the node spindle count
133
  , instSpindles :: Double -- ^ Spindles used by instances
134
  , offline  :: Bool      -- ^ Whether the node should not be used for
135
                          -- allocations and skipped from score
136
                          -- computations
137
  , isMaster :: Bool      -- ^ Whether the node is the master node
138
  , nTags    :: [String]  -- ^ The node tags for this node
139
  , utilPool :: T.DynUtil -- ^ Total utilisation capacity
140
  , utilLoad :: T.DynUtil -- ^ Sum of instance utilisation
141
  , pTags    :: TagMap    -- ^ Primary instance exclusion tags and their count
142
  , group    :: T.Gdx     -- ^ The node's group (index)
143
  , iPolicy  :: T.IPolicy -- ^ The instance policy (of the node's group)
144
  } deriving (Show, Eq)
145

    
146
instance T.Element Node where
147
  nameOf = name
148
  idxOf = idx
149
  setAlias = setAlias
150
  setIdx = setIdx
151
  allNames n = [name n, alias n]
152

    
153
-- | A simple name for the int, node association list.
154
type AssocList = [(T.Ndx, Node)]
155

    
156
-- | A simple name for a node map.
157
type List = Container.Container Node
158

    
159
-- | A simple name for an allocation element (here just for logistic
160
-- reasons).
161
type AllocElement = (List, Instance.Instance, [Node], T.Score)
162

    
163
-- | Constant node index for a non-moveable instance.
164
noSecondary :: T.Ndx
165
noSecondary = -1
166

    
167
-- * Helper functions
168

    
169
-- | Add a tag to a tagmap.
170
addTag :: TagMap -> String -> TagMap
171
addTag t s = Map.insertWith (+) s 1 t
172

    
173
-- | Add multiple tags.
174
addTags :: TagMap -> [String] -> TagMap
175
addTags = foldl' addTag
176

    
177
-- | Adjust or delete a tag from a tagmap.
178
delTag :: TagMap -> String -> TagMap
179
delTag t s = Map.update (\v -> if v > 1
180
                                 then Just (v-1)
181
                                 else Nothing)
182
             s t
183

    
184
-- | Remove multiple tags.
185
delTags :: TagMap -> [String] -> TagMap
186
delTags = foldl' delTag
187

    
188
-- | Check if we can add a list of tags to a tagmap.
189
rejectAddTags :: TagMap -> [String] -> Bool
190
rejectAddTags t = any (`Map.member` t)
191

    
192
-- | Check how many primary instances have conflicting tags. The
193
-- algorithm to compute this is to sum the count of all tags, then
194
-- subtract the size of the tag map (since each tag has at least one,
195
-- non-conflicting instance); this is equivalent to summing the
196
-- values in the tag map minus one.
197
conflictingPrimaries :: Node -> Int
198
conflictingPrimaries (Node { pTags = t }) = Foldable.sum t - Map.size t
199

    
200
-- | Helper function to increment a base value depending on the passed
201
-- boolean argument.
202
incIf :: (Num a) => Bool -> a -> a -> a
203
incIf True  base delta = base + delta
204
incIf False base _     = base
205

    
206
-- | Helper function to decrement a base value depending on the passed
207
-- boolean argument.
208
decIf :: (Num a) => Bool -> a -> a -> a
209
decIf True  base delta = base - delta
210
decIf False base _     = base
211

    
212
-- * Initialization functions
213

    
214
-- | Create a new node.
215
--
216
-- The index and the peers maps are empty, and will be need to be
217
-- update later via the 'setIdx' and 'buildPeers' functions.
218
create :: String -> Double -> Int -> Int -> Double
219
       -> Int -> Double -> Bool -> Int -> T.Gdx -> Node
220
create name_init mem_t_init mem_n_init mem_f_init
221
       dsk_t_init dsk_f_init cpu_t_init offline_init spindles_init
222
       group_init =
223
  Node { name = name_init
224
       , alias = name_init
225
       , tMem = mem_t_init
226
       , nMem = mem_n_init
227
       , fMem = mem_f_init
228
       , tDsk = dsk_t_init
229
       , fDsk = dsk_f_init
230
       , tCpu = cpu_t_init
231
       , spindleCount = spindles_init
232
       , uCpu = 0
233
       , pList = []
234
       , sList = []
235
       , failN1 = True
236
       , idx = -1
237
       , peers = P.empty
238
       , rMem = 0
239
       , pMem = fromIntegral mem_f_init / mem_t_init
240
       , pDsk = computePDsk dsk_f_init dsk_t_init
241
       , pRem = 0
242
       , pCpu = 0
243
       , offline = offline_init
244
       , isMaster = False
245
       , nTags = []
246
       , xMem = 0
247
       , mDsk = T.defReservedDiskRatio
248
       , loDsk = mDskToloDsk T.defReservedDiskRatio dsk_t_init
249
       , hiCpu = mCpuTohiCpu (T.iPolicyVcpuRatio T.defIPolicy) cpu_t_init
250
       , hiSpindles = computeHiSpindles (T.iPolicySpindleRatio T.defIPolicy)
251
                      spindles_init
252
       , instSpindles = 0
253
       , utilPool = T.baseUtil
254
       , utilLoad = T.zeroUtil
255
       , pTags = Map.empty
256
       , group = group_init
257
       , iPolicy = T.defIPolicy
258
       }
259

    
260
-- | Conversion formula from mDsk\/tDsk to loDsk.
261
mDskToloDsk :: Double -> Double -> Int
262
mDskToloDsk mval = floor . (mval *)
263

    
264
-- | Conversion formula from mCpu\/tCpu to hiCpu.
265
mCpuTohiCpu :: Double -> Double -> Int
266
mCpuTohiCpu mval = floor . (mval *)
267

    
268
-- | Conversiojn formula from spindles and spindle ratio to hiSpindles.
269
computeHiSpindles :: Double -> Int -> Double
270
computeHiSpindles spindle_ratio = (spindle_ratio *) . fromIntegral
271

    
272
-- | Changes the index.
273
--
274
-- This is used only during the building of the data structures.
275
setIdx :: Node -> T.Ndx -> Node
276
setIdx t i = t {idx = i}
277

    
278
-- | Changes the alias.
279
--
280
-- This is used only during the building of the data structures.
281
setAlias :: Node -> String -> Node
282
setAlias t s = t { alias = s }
283

    
284
-- | Sets the offline attribute.
285
setOffline :: Node -> Bool -> Node
286
setOffline t val = t { offline = val }
287

    
288
-- | Sets the master attribute
289
setMaster :: Node -> Bool -> Node
290
setMaster t val = t { isMaster = val }
291

    
292
-- | Sets the node tags attribute
293
setNodeTags :: Node -> [String] -> Node
294
setNodeTags t val = t { nTags = val }
295

    
296
-- | Sets the unnaccounted memory.
297
setXmem :: Node -> Int -> Node
298
setXmem t val = t { xMem = val }
299

    
300
-- | Sets the max disk usage ratio.
301
setMdsk :: Node -> Double -> Node
302
setMdsk t val = t { mDsk = val, loDsk = mDskToloDsk val (tDsk t) }
303

    
304
-- | Sets the max cpu usage ratio. This will update the node's
305
-- ipolicy, losing sharing (but it should be a seldomly done operation).
306
setMcpu :: Node -> Double -> Node
307
setMcpu t val =
308
  let new_ipol = (iPolicy t) { T.iPolicyVcpuRatio = val }
309
  in t { hiCpu = mCpuTohiCpu val (tCpu t), iPolicy = new_ipol }
310

    
311
-- | Sets the policy.
312
setPolicy :: T.IPolicy -> Node -> Node
313
setPolicy pol node =
314
  node { iPolicy = pol
315
       , hiCpu = mCpuTohiCpu (T.iPolicyVcpuRatio pol) (tCpu node)
316
       , hiSpindles = computeHiSpindles (T.iPolicySpindleRatio pol)
317
                      (spindleCount node)
318
       }
319

    
320
-- | Computes the maximum reserved memory for peers from a peer map.
321
computeMaxRes :: P.PeerMap -> P.Elem
322
computeMaxRes = P.maxElem
323

    
324
-- | Builds the peer map for a given node.
325
buildPeers :: Node -> Instance.List -> Node
326
buildPeers t il =
327
  let mdata = map
328
              (\i_idx -> let inst = Container.find i_idx il
329
                             mem = if Instance.usesSecMem inst
330
                                     then Instance.mem inst
331
                                     else 0
332
                         in (Instance.pNode inst, mem))
333
              (sList t)
334
      pmap = P.accumArray (+) mdata
335
      new_rmem = computeMaxRes pmap
336
      new_failN1 = fMem t <= new_rmem
337
      new_prem = fromIntegral new_rmem / tMem t
338
  in t {peers=pmap, failN1 = new_failN1, rMem = new_rmem, pRem = new_prem}
339

    
340
-- | Calculate the new spindle usage
341
calcSpindleUse :: Node -> Instance.Instance -> Double
342
calcSpindleUse n i = incIf (Instance.usesLocalStorage i) (instSpindles n)
343
                       (fromIntegral $ Instance.spindleUse i)
344

    
345
-- | Assigns an instance to a node as primary and update the used VCPU
346
-- count, utilisation data and tags map.
347
setPri :: Node -> Instance.Instance -> Node
348
setPri t inst = t { pList = Instance.idx inst:pList t
349
                  , uCpu = new_count
350
                  , pCpu = fromIntegral new_count / tCpu t
351
                  , utilLoad = utilLoad t `T.addUtil` Instance.util inst
352
                  , pTags = addTags (pTags t) (Instance.exclTags inst)
353
                  , instSpindles = calcSpindleUse t inst
354
                  }
355
  where new_count = Instance.applyIfOnline inst (+ Instance.vcpus inst)
356
                    (uCpu t )
357

    
358
-- | Assigns an instance to a node as secondary without other updates.
359
setSec :: Node -> Instance.Instance -> Node
360
setSec t inst = t { sList = Instance.idx inst:sList t
361
                  , utilLoad = old_load { T.dskWeight = T.dskWeight old_load +
362
                                          T.dskWeight (Instance.util inst) }
363
                  , instSpindles = calcSpindleUse t inst
364
                  }
365
  where old_load = utilLoad t
366

    
367
-- | Computes the new 'pDsk' value, handling nodes without local disk
368
-- storage (we consider all their disk used).
369
computePDsk :: Int -> Double -> Double
370
computePDsk _    0     = 1
371
computePDsk used total = fromIntegral used / total
372

    
373
-- * Update functions
374

    
375
-- | Sets the free memory.
376
setFmem :: Node -> Int -> Node
377
setFmem t new_mem =
378
  let new_n1 = new_mem < rMem t
379
      new_mp = fromIntegral new_mem / tMem t
380
  in t { fMem = new_mem, failN1 = new_n1, pMem = new_mp }
381

    
382
-- | Removes a primary instance.
383
removePri :: Node -> Instance.Instance -> Node
384
removePri t inst =
385
  let iname = Instance.idx inst
386
      i_online = Instance.notOffline inst
387
      uses_disk = Instance.usesLocalStorage inst
388
      new_plist = delete iname (pList t)
389
      new_mem = incIf i_online (fMem t) (Instance.mem inst)
390
      new_dsk = incIf uses_disk (fDsk t) (Instance.dsk inst)
391
      new_spindles = decIf uses_disk (instSpindles t) 1
392
      new_mp = fromIntegral new_mem / tMem t
393
      new_dp = computePDsk new_dsk (tDsk t)
394
      new_failn1 = new_mem <= rMem t
395
      new_ucpu = decIf i_online (uCpu t) (Instance.vcpus inst)
396
      new_rcpu = fromIntegral new_ucpu / tCpu t
397
      new_load = utilLoad t `T.subUtil` Instance.util inst
398
  in t { pList = new_plist, fMem = new_mem, fDsk = new_dsk
399
       , failN1 = new_failn1, pMem = new_mp, pDsk = new_dp
400
       , uCpu = new_ucpu, pCpu = new_rcpu, utilLoad = new_load
401
       , pTags = delTags (pTags t) (Instance.exclTags inst)
402
       , instSpindles = new_spindles
403
       }
404

    
405
-- | Removes a secondary instance.
406
removeSec :: Node -> Instance.Instance -> Node
407
removeSec t inst =
408
  let iname = Instance.idx inst
409
      uses_disk = Instance.usesLocalStorage inst
410
      cur_dsk = fDsk t
411
      pnode = Instance.pNode inst
412
      new_slist = delete iname (sList t)
413
      new_dsk = incIf uses_disk cur_dsk (Instance.dsk inst)
414
      new_spindles = decIf uses_disk (instSpindles t) 1
415
      old_peers = peers t
416
      old_peem = P.find pnode old_peers
417
      new_peem = decIf (Instance.usesSecMem inst) old_peem (Instance.mem inst)
418
      new_peers = if new_peem > 0
419
                    then P.add pnode new_peem old_peers
420
                    else P.remove pnode old_peers
421
      old_rmem = rMem t
422
      new_rmem = if old_peem < old_rmem
423
                   then old_rmem
424
                   else computeMaxRes new_peers
425
      new_prem = fromIntegral new_rmem / tMem t
426
      new_failn1 = fMem t <= new_rmem
427
      new_dp = computePDsk new_dsk (tDsk t)
428
      old_load = utilLoad t
429
      new_load = old_load { T.dskWeight = T.dskWeight old_load -
430
                                          T.dskWeight (Instance.util inst) }
431
  in t { sList = new_slist, fDsk = new_dsk, peers = new_peers
432
       , failN1 = new_failn1, rMem = new_rmem, pDsk = new_dp
433
       , pRem = new_prem, utilLoad = new_load
434
       , instSpindles = new_spindles
435
       }
436

    
437
-- | Adds a primary instance (basic version).
438
addPri :: Node -> Instance.Instance -> T.OpResult Node
439
addPri = addPriEx False
440

    
441
-- | Adds a primary instance (extended version).
442
addPriEx :: Bool               -- ^ Whether to override the N+1 and
443
                               -- other /soft/ checks, useful if we
444
                               -- come from a worse status
445
                               -- (e.g. offline)
446
         -> Node               -- ^ The target node
447
         -> Instance.Instance  -- ^ The instance to add
448
         -> T.OpResult Node    -- ^ The result of the operation,
449
                               -- either the new version of the node
450
                               -- or a failure mode
451
addPriEx force t inst =
452
  let iname = Instance.idx inst
453
      i_online = Instance.notOffline inst
454
      uses_disk = Instance.usesLocalStorage inst
455
      cur_dsk = fDsk t
456
      new_mem = decIf i_online (fMem t) (Instance.mem inst)
457
      new_dsk = decIf uses_disk cur_dsk (Instance.dsk inst)
458
      new_spindles = incIf uses_disk (instSpindles t) 1
459
      new_failn1 = new_mem <= rMem t
460
      new_ucpu = incIf i_online (uCpu t) (Instance.vcpus inst)
461
      new_pcpu = fromIntegral new_ucpu / tCpu t
462
      new_dp = computePDsk new_dsk (tDsk t)
463
      l_cpu = T.iPolicyVcpuRatio $ iPolicy t
464
      new_load = utilLoad t `T.addUtil` Instance.util inst
465
      inst_tags = Instance.exclTags inst
466
      old_tags = pTags t
467
      strict = not force
468
  in case () of
469
       _ | new_mem <= 0 -> Bad T.FailMem
470
         | uses_disk && new_dsk <= 0 -> Bad T.FailDisk
471
         | uses_disk && mDsk t > new_dp && strict -> Bad T.FailDisk
472
         | uses_disk && new_spindles > hiSpindles t
473
             && strict -> Bad T.FailDisk
474
         | new_failn1 && not (failN1 t) && strict -> Bad T.FailMem
475
         | l_cpu >= 0 && l_cpu < new_pcpu && strict -> Bad T.FailCPU
476
         | rejectAddTags old_tags inst_tags -> Bad T.FailTags
477
         | otherwise ->
478
           let new_plist = iname:pList t
479
               new_mp = fromIntegral new_mem / tMem t
480
               r = t { pList = new_plist, fMem = new_mem, fDsk = new_dsk
481
                     , failN1 = new_failn1, pMem = new_mp, pDsk = new_dp
482
                     , uCpu = new_ucpu, pCpu = new_pcpu
483
                     , utilLoad = new_load
484
                     , pTags = addTags old_tags inst_tags
485
                     , instSpindles = new_spindles
486
                     }
487
           in Ok r
488

    
489
-- | Adds a secondary instance (basic version).
490
addSec :: Node -> Instance.Instance -> T.Ndx -> T.OpResult Node
491
addSec = addSecEx False
492

    
493
-- | Adds a secondary instance (extended version).
494
addSecEx :: Bool -> Node -> Instance.Instance -> T.Ndx -> T.OpResult Node
495
addSecEx force t inst pdx =
496
  let iname = Instance.idx inst
497
      old_peers = peers t
498
      old_mem = fMem t
499
      new_dsk = fDsk t - Instance.dsk inst
500
      new_spindles = instSpindles t + 1
501
      secondary_needed_mem = if Instance.usesSecMem inst
502
                               then Instance.mem inst
503
                               else 0
504
      new_peem = P.find pdx old_peers + secondary_needed_mem
505
      new_peers = P.add pdx new_peem old_peers
506
      new_rmem = max (rMem t) new_peem
507
      new_prem = fromIntegral new_rmem / tMem t
508
      new_failn1 = old_mem <= new_rmem
509
      new_dp = computePDsk new_dsk (tDsk t)
510
      old_load = utilLoad t
511
      new_load = old_load { T.dskWeight = T.dskWeight old_load +
512
                                          T.dskWeight (Instance.util inst) }
513
      strict = not force
514
  in case () of
515
       _ | not (Instance.hasSecondary inst) -> Bad T.FailDisk
516
         | new_dsk <= 0 -> Bad T.FailDisk
517
         | mDsk t > new_dp && strict -> Bad T.FailDisk
518
         | new_spindles > hiSpindles t && strict -> Bad T.FailDisk
519
         | secondary_needed_mem >= old_mem && strict -> Bad T.FailMem
520
         | new_failn1 && not (failN1 t) && strict -> Bad T.FailMem
521
         | otherwise ->
522
           let new_slist = iname:sList t
523
               r = t { sList = new_slist, fDsk = new_dsk
524
                     , peers = new_peers, failN1 = new_failn1
525
                     , rMem = new_rmem, pDsk = new_dp
526
                     , pRem = new_prem, utilLoad = new_load
527
                     , instSpindles = new_spindles
528
                     }
529
           in Ok r
530

    
531
-- * Stats functions
532

    
533
-- | Computes the amount of available disk on a given node.
534
availDisk :: Node -> Int
535
availDisk t =
536
  let _f = fDsk t
537
      _l = loDsk t
538
  in if _f < _l
539
       then 0
540
       else _f - _l
541

    
542
-- | Computes the amount of used disk on a given node.
543
iDsk :: Node -> Int
544
iDsk t = truncate (tDsk t) - fDsk t
545

    
546
-- | Computes the amount of available memory on a given node.
547
availMem :: Node -> Int
548
availMem t =
549
  let _f = fMem t
550
      _l = rMem t
551
  in if _f < _l
552
       then 0
553
       else _f - _l
554

    
555
-- | Computes the amount of available memory on a given node.
556
availCpu :: Node -> Int
557
availCpu t =
558
  let _u = uCpu t
559
      _l = hiCpu t
560
  in if _l >= _u
561
       then _l - _u
562
       else 0
563

    
564
-- | The memory used by instances on a given node.
565
iMem :: Node -> Int
566
iMem t = truncate (tMem t) - nMem t - xMem t - fMem t
567

    
568
-- * Node graph functions
569
-- These functions do the transformations needed so that nodes can be
570
-- represented as a graph connected by the instances that are replicated
571
-- on them.
572

    
573
-- * Making of a Graph from a node/instance list
574

    
575
-- | Transform an instance into a list of edges on the node graph
576
instanceToEdges :: Instance.Instance -> [Graph.Edge]
577
instanceToEdges i
578
  | Instance.hasSecondary i = [(pnode,snode), (snode,pnode)]
579
  | otherwise = []
580
    where pnode = Instance.pNode i
581
          snode = Instance.sNode i
582

    
583
-- | Transform the list of instances into list of destination edges
584
instancesToEdges :: Instance.List -> [Graph.Edge]
585
instancesToEdges = concatMap instanceToEdges . Container.elems
586

    
587
-- | Transform the list of nodes into vertices bounds.
588
-- Returns Nothing is the list is empty.
589
nodesToBounds :: List -> Maybe Graph.Bounds
590
nodesToBounds nl = liftM2 (,) nmin nmax
591
    where nmin = fmap (fst . fst) (IntMap.minViewWithKey nl)
592
          nmax = fmap (fst . fst) (IntMap.maxViewWithKey nl)
593

    
594
-- | The clique of the primary nodes of the instances with a given secondary.
595
-- Return the full graph of those nodes that are primary node of at least one
596
-- instance that has the given node as secondary.
597
nodeToSharedSecondaryEdge :: Instance.List -> Node -> [Graph.Edge]
598
nodeToSharedSecondaryEdge il n = (,) <$> primaries <*> primaries
599
  where primaries = map (Instance.pNode . flip Container.find il) $ sList n
600

    
601

    
602
-- | Predicate of an edge having both vertices in a set of nodes.
603
filterValid :: List -> [Graph.Edge] -> [Graph.Edge]
604
filterValid nl  =  filter $ \(x,y) -> IntMap.member x nl && IntMap.member y nl
605

    
606
-- | Transform a Node + Instance list into a NodeGraph type.
607
-- Returns Nothing if the node list is empty.
608
mkNodeGraph :: List -> Instance.List -> Maybe Graph.Graph
609
mkNodeGraph nl il =
610
  liftM (`Graph.buildG` (filterValid nl . instancesToEdges $ il))
611
  (nodesToBounds nl)
612

    
613
-- | Transform a Nodes + Instances into a NodeGraph with all reboot exclusions.
614
-- This includes edges between nodes that are the primary nodes of instances
615
-- that have the same secondary node. Nodes not in the node list will not be
616
-- part of the graph, but they are still considered for the edges arising from
617
-- two instances having the same secondary node.
618
-- Return Nothing if the node list is empty.
619
mkRebootNodeGraph :: List -> List -> Instance.List -> Maybe Graph.Graph
620
mkRebootNodeGraph allnodes nl il =
621
  liftM (`Graph.buildG` filterValid nl edges) (nodesToBounds nl)
622
  where
623
    edges = instancesToEdges il `union`
624
            (Container.elems allnodes >>= nodeToSharedSecondaryEdge il) 
625

    
626
-- * Display functions
627

    
628
-- | Return a field for a given node.
629
showField :: Node   -- ^ Node which we're querying
630
          -> String -- ^ Field name
631
          -> String -- ^ Field value as string
632
showField t field =
633
  case field of
634
    "idx"  -> printf "%4d" $ idx t
635
    "name" -> alias t
636
    "fqdn" -> name t
637
    "status" -> case () of
638
                  _ | offline t -> "-"
639
                    | failN1 t -> "*"
640
                    | otherwise -> " "
641
    "tmem" -> printf "%5.0f" $ tMem t
642
    "nmem" -> printf "%5d" $ nMem t
643
    "xmem" -> printf "%5d" $ xMem t
644
    "fmem" -> printf "%5d" $ fMem t
645
    "imem" -> printf "%5d" $ iMem t
646
    "rmem" -> printf "%5d" $ rMem t
647
    "amem" -> printf "%5d" $ fMem t - rMem t
648
    "tdsk" -> printf "%5.0f" $ tDsk t / 1024
649
    "fdsk" -> printf "%5d" $ fDsk t `div` 1024
650
    "tcpu" -> printf "%4.0f" $ tCpu t
651
    "ucpu" -> printf "%4d" $ uCpu t
652
    "pcnt" -> printf "%3d" $ length (pList t)
653
    "scnt" -> printf "%3d" $ length (sList t)
654
    "plist" -> show $ pList t
655
    "slist" -> show $ sList t
656
    "pfmem" -> printf "%6.4f" $ pMem t
657
    "pfdsk" -> printf "%6.4f" $ pDsk t
658
    "rcpu"  -> printf "%5.2f" $ pCpu t
659
    "cload" -> printf "%5.3f" uC
660
    "mload" -> printf "%5.3f" uM
661
    "dload" -> printf "%5.3f" uD
662
    "nload" -> printf "%5.3f" uN
663
    "ptags" -> intercalate "," . map (uncurry (printf "%s=%d")) .
664
               Map.toList $ pTags t
665
    "peermap" -> show $ peers t
666
    "spindle_count" -> show $ spindleCount t
667
    "hi_spindles" -> show $ hiSpindles t
668
    "inst_spindles" -> show $ instSpindles t
669
    _ -> T.unknownField
670
  where
671
    T.DynUtil { T.cpuWeight = uC, T.memWeight = uM,
672
                T.dskWeight = uD, T.netWeight = uN } = utilLoad t
673

    
674
-- | Returns the header and numeric propery of a field.
675
showHeader :: String -> (String, Bool)
676
showHeader field =
677
  case field of
678
    "idx" -> ("Index", True)
679
    "name" -> ("Name", False)
680
    "fqdn" -> ("Name", False)
681
    "status" -> ("F", False)
682
    "tmem" -> ("t_mem", True)
683
    "nmem" -> ("n_mem", True)
684
    "xmem" -> ("x_mem", True)
685
    "fmem" -> ("f_mem", True)
686
    "imem" -> ("i_mem", True)
687
    "rmem" -> ("r_mem", True)
688
    "amem" -> ("a_mem", True)
689
    "tdsk" -> ("t_dsk", True)
690
    "fdsk" -> ("f_dsk", True)
691
    "tcpu" -> ("pcpu", True)
692
    "ucpu" -> ("vcpu", True)
693
    "pcnt" -> ("pcnt", True)
694
    "scnt" -> ("scnt", True)
695
    "plist" -> ("primaries", True)
696
    "slist" -> ("secondaries", True)
697
    "pfmem" -> ("p_fmem", True)
698
    "pfdsk" -> ("p_fdsk", True)
699
    "rcpu"  -> ("r_cpu", True)
700
    "cload" -> ("lCpu", True)
701
    "mload" -> ("lMem", True)
702
    "dload" -> ("lDsk", True)
703
    "nload" -> ("lNet", True)
704
    "ptags" -> ("PrimaryTags", False)
705
    "peermap" -> ("PeerMap", False)
706
    "spindle_count" -> ("NodeSpindles", True)
707
    "hi_spindles" -> ("MaxSpindles", True)
708
    "inst_spindles" -> ("InstSpindles", True)
709
    -- TODO: add node fields (group.uuid, group)
710
    _ -> (T.unknownField, False)
711

    
712
-- | String converter for the node list functionality.
713
list :: [String] -> Node -> [String]
714
list fields t = map (showField t) fields
715

    
716
-- | Constant holding the fields we're displaying by default.
717
defaultFields :: [String]
718
defaultFields =
719
  [ "status", "name", "tmem", "nmem", "imem", "xmem", "fmem"
720
  , "rmem", "tdsk", "fdsk", "tcpu", "ucpu", "pcnt", "scnt"
721
  , "pfmem", "pfdsk", "rcpu"
722
  , "cload", "mload", "dload", "nload" ]
723

    
724
{-# ANN computeGroups "HLint: ignore Use alternative" #-}
725
-- | Split a list of nodes into a list of (node group UUID, list of
726
-- associated nodes).
727
computeGroups :: [Node] -> [(T.Gdx, [Node])]
728
computeGroups nodes =
729
  let nodes' = sortBy (comparing group) nodes
730
      nodes'' = groupBy ((==) `on` group) nodes'
731
  -- use of head here is OK, since groupBy returns non-empty lists; if
732
  -- you remove groupBy, also remove use of head
733
  in map (\nl -> (group (head nl), nl)) nodes''