Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / HTools / Node.hs @ 07ea9bf5

History | View | Annotate | Download (24.7 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
  ) where
77

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

    
88
import qualified Ganeti.HTools.Container as Container
89
import qualified Ganeti.HTools.Instance as Instance
90
import qualified Ganeti.HTools.PeerMap as P
91

    
92
import Ganeti.BasicTypes
93
import qualified Ganeti.HTools.Types as T
94

    
95
-- * Type declarations
96

    
97
-- | The tag map type.
98
type TagMap = Map.Map String Int
99

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

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

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

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

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

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

    
165
-- * Helper functions
166

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

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

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

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

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

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

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

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

    
210
-- * Initialization functions
211

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    
371
-- * Update functions
372

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

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

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

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

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

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

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

    
529
-- * Stats functions
530

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

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

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

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

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

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

    
571
-- * Making of a Graph from a node/instance list
572

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

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

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

    
592
-- | Transform a Node + Instance list into a NodeGraph type.
593
-- Returns Nothing if the node list is empty.
594
mkNodeGraph :: List -> Instance.List -> Maybe Graph.Graph
595
mkNodeGraph nl il =
596
  liftM (`Graph.buildG` (filterValid . instancesToEdges $ il))
597
  (nodesToBounds nl)
598
  where
599
    filterValid = filter (\(x,y) -> IntMap.member x nl && IntMap.member y nl)
600

    
601
-- * Display functions
602

    
603
-- | Return a field for a given node.
604
showField :: Node   -- ^ Node which we're querying
605
          -> String -- ^ Field name
606
          -> String -- ^ Field value as string
607
showField t field =
608
  case field of
609
    "idx"  -> printf "%4d" $ idx t
610
    "name" -> alias t
611
    "fqdn" -> name t
612
    "status" -> case () of
613
                  _ | offline t -> "-"
614
                    | failN1 t -> "*"
615
                    | otherwise -> " "
616
    "tmem" -> printf "%5.0f" $ tMem t
617
    "nmem" -> printf "%5d" $ nMem t
618
    "xmem" -> printf "%5d" $ xMem t
619
    "fmem" -> printf "%5d" $ fMem t
620
    "imem" -> printf "%5d" $ iMem t
621
    "rmem" -> printf "%5d" $ rMem t
622
    "amem" -> printf "%5d" $ fMem t - rMem t
623
    "tdsk" -> printf "%5.0f" $ tDsk t / 1024
624
    "fdsk" -> printf "%5d" $ fDsk t `div` 1024
625
    "tcpu" -> printf "%4.0f" $ tCpu t
626
    "ucpu" -> printf "%4d" $ uCpu t
627
    "pcnt" -> printf "%3d" $ length (pList t)
628
    "scnt" -> printf "%3d" $ length (sList t)
629
    "plist" -> show $ pList t
630
    "slist" -> show $ sList t
631
    "pfmem" -> printf "%6.4f" $ pMem t
632
    "pfdsk" -> printf "%6.4f" $ pDsk t
633
    "rcpu"  -> printf "%5.2f" $ pCpu t
634
    "cload" -> printf "%5.3f" uC
635
    "mload" -> printf "%5.3f" uM
636
    "dload" -> printf "%5.3f" uD
637
    "nload" -> printf "%5.3f" uN
638
    "ptags" -> intercalate "," . map (uncurry (printf "%s=%d")) .
639
               Map.toList $ pTags t
640
    "peermap" -> show $ peers t
641
    "spindle_count" -> show $ spindleCount t
642
    "hi_spindles" -> show $ hiSpindles t
643
    "inst_spindles" -> show $ instSpindles t
644
    _ -> T.unknownField
645
  where
646
    T.DynUtil { T.cpuWeight = uC, T.memWeight = uM,
647
                T.dskWeight = uD, T.netWeight = uN } = utilLoad t
648

    
649
-- | Returns the header and numeric propery of a field.
650
showHeader :: String -> (String, Bool)
651
showHeader field =
652
  case field of
653
    "idx" -> ("Index", True)
654
    "name" -> ("Name", False)
655
    "fqdn" -> ("Name", False)
656
    "status" -> ("F", False)
657
    "tmem" -> ("t_mem", True)
658
    "nmem" -> ("n_mem", True)
659
    "xmem" -> ("x_mem", True)
660
    "fmem" -> ("f_mem", True)
661
    "imem" -> ("i_mem", True)
662
    "rmem" -> ("r_mem", True)
663
    "amem" -> ("a_mem", True)
664
    "tdsk" -> ("t_dsk", True)
665
    "fdsk" -> ("f_dsk", True)
666
    "tcpu" -> ("pcpu", True)
667
    "ucpu" -> ("vcpu", True)
668
    "pcnt" -> ("pcnt", True)
669
    "scnt" -> ("scnt", True)
670
    "plist" -> ("primaries", True)
671
    "slist" -> ("secondaries", True)
672
    "pfmem" -> ("p_fmem", True)
673
    "pfdsk" -> ("p_fdsk", True)
674
    "rcpu"  -> ("r_cpu", True)
675
    "cload" -> ("lCpu", True)
676
    "mload" -> ("lMem", True)
677
    "dload" -> ("lDsk", True)
678
    "nload" -> ("lNet", True)
679
    "ptags" -> ("PrimaryTags", False)
680
    "peermap" -> ("PeerMap", False)
681
    "spindle_count" -> ("NodeSpindles", True)
682
    "hi_spindles" -> ("MaxSpindles", True)
683
    "inst_spindles" -> ("InstSpindles", True)
684
    -- TODO: add node fields (group.uuid, group)
685
    _ -> (T.unknownField, False)
686

    
687
-- | String converter for the node list functionality.
688
list :: [String] -> Node -> [String]
689
list fields t = map (showField t) fields
690

    
691
-- | Constant holding the fields we're displaying by default.
692
defaultFields :: [String]
693
defaultFields =
694
  [ "status", "name", "tmem", "nmem", "imem", "xmem", "fmem"
695
  , "rmem", "tdsk", "fdsk", "tcpu", "ucpu", "pcnt", "scnt"
696
  , "pfmem", "pfdsk", "rcpu"
697
  , "cload", "mload", "dload", "nload" ]
698

    
699
{-# ANN computeGroups "HLint: ignore Use alternative" #-}
700
-- | Split a list of nodes into a list of (node group UUID, list of
701
-- associated nodes).
702
computeGroups :: [Node] -> [(T.Gdx, [Node])]
703
computeGroups nodes =
704
  let nodes' = sortBy (comparing group) nodes
705
      nodes'' = groupBy ((==) `on` group) nodes'
706
  -- use of head here is OK, since groupBy returns non-empty lists; if
707
  -- you remove groupBy, also remove use of head
708
  in map (\nl -> (group (head nl), nl)) nodes''