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

   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   , exclStorage :: Bool   -- ^ Effective value of exclusive_storage
 145   } deriving (Show, Eq)
 146
 147 instance T.Element Node where
 148   nameOf = name
 149   idxOf = idx
 150   setAlias = setAlias
 151   setIdx = setIdx
 152   allNames n = [name n, alias n]
 153
 154 -- | A simple name for the int, node association list.
 155 type AssocList = [(T.Ndx, Node)]
 156
 157 -- | A simple name for a node map.
 158 type List = Container.Container Node
 159
 160 -- | A simple name for an allocation element (here just for logistic
 161 -- reasons).
 162 type AllocElement = (List, Instance.Instance, [Node], T.Score)
 163
 164 -- | Constant node index for a non-moveable instance.
 165 noSecondary :: T.Ndx
 166 noSecondary = -1
 167
 168 -- * Helper functions
 169
 170 -- | Add a tag to a tagmap.
 171 addTag :: TagMap -> String -> TagMap
 172 addTag t s = Map.insertWith (+) s 1 t
 173
 174 -- | Add multiple tags.
 175 addTags :: TagMap -> [String] -> TagMap
 176 addTags = foldl' addTag
 177
 178 -- | Adjust or delete a tag from a tagmap.
 179 delTag :: TagMap -> String -> TagMap
 180 delTag t s = Map.update (\v -> if v > 1
 181                                  then Just (v-1)
 182                                  else Nothing)
 183              s t
 184
 185 -- | Remove multiple tags.
 186 delTags :: TagMap -> [String] -> TagMap
 187 delTags = foldl' delTag
 188
 189 -- | Check if we can add a list of tags to a tagmap.
 190 rejectAddTags :: TagMap -> [String] -> Bool
 191 rejectAddTags t = any (`Map.member` t)
 192
 193 -- | Check how many primary instances have conflicting tags. The
 194 -- algorithm to compute this is to sum the count of all tags, then
 195 -- subtract the size of the tag map (since each tag has at least one,
 196 -- non-conflicting instance); this is equivalent to summing the
 197 -- values in the tag map minus one.
 198 conflictingPrimaries :: Node -> Int
 199 conflictingPrimaries (Node { pTags = t }) = Foldable.sum t - Map.size t
 200
 201 -- | Helper function to increment a base value depending on the passed
 202 -- boolean argument.
 203 incIf :: (Num a) => Bool -> a -> a -> a
 204 incIf True  base delta = base + delta
 205 incIf False base _     = base
 206
 207 -- | Helper function to decrement a base value depending on the passed
 208 -- boolean argument.
 209 decIf :: (Num a) => Bool -> a -> a -> a
 210 decIf True  base delta = base - delta
 211 decIf False base _     = base
 212
 213 -- * Initialization functions
 214
 215 -- | Create a new node.
 216 --
 217 -- The index and the peers maps are empty, and will be need to be
 218 -- update later via the 'setIdx' and 'buildPeers' functions.
 219 create :: String -> Double -> Int -> Int -> Double
 220        -> Int -> Double -> Bool -> Int -> T.Gdx -> Bool -> Node
 221 create name_init mem_t_init mem_n_init mem_f_init
 222        dsk_t_init dsk_f_init cpu_t_init offline_init spindles_init
 223        group_init excl_stor =
 224   Node { name = name_init
 225        , alias = name_init
 226        , tMem = mem_t_init
 227        , nMem = mem_n_init
 228        , fMem = mem_f_init
 229        , tDsk = dsk_t_init
 230        , fDsk = dsk_f_init
 231        , tCpu = cpu_t_init
 232        , spindleCount = spindles_init
 233        , uCpu = 0
 234        , pList = []
 235        , sList = []
 236        , failN1 = True
 237        , idx = -1
 238        , peers = P.empty
 239        , rMem = 0
 240        , pMem = fromIntegral mem_f_init / mem_t_init
 241        , pDsk = computePDsk dsk_f_init dsk_t_init
 242        , pRem = 0
 243        , pCpu = 0
 244        , offline = offline_init
 245        , isMaster = False
 246        , nTags = []
 247        , xMem = 0
 248        , mDsk = T.defReservedDiskRatio
 249        , loDsk = mDskToloDsk T.defReservedDiskRatio dsk_t_init
 250        , hiCpu = mCpuTohiCpu (T.iPolicyVcpuRatio T.defIPolicy) cpu_t_init
 251        , hiSpindles = computeHiSpindles (T.iPolicySpindleRatio T.defIPolicy)
 252                       spindles_init
 253        , instSpindles = 0
 254        , utilPool = T.baseUtil
 255        , utilLoad = T.zeroUtil
 256        , pTags = Map.empty
 257        , group = group_init
 258        , iPolicy = T.defIPolicy
 259        , exclStorage = excl_stor
 260        }
 261
 262 -- | Conversion formula from mDsk\/tDsk to loDsk.
 263 mDskToloDsk :: Double -> Double -> Int
 264 mDskToloDsk mval = floor . (mval *)
 265
 266 -- | Conversion formula from mCpu\/tCpu to hiCpu.
 267 mCpuTohiCpu :: Double -> Double -> Int
 268 mCpuTohiCpu mval = floor . (mval *)
 269
 270 -- | Conversiojn formula from spindles and spindle ratio to hiSpindles.
 271 computeHiSpindles :: Double -> Int -> Double
 272 computeHiSpindles spindle_ratio = (spindle_ratio *) . fromIntegral
 273
 274 -- | Changes the index.
 275 --
 276 -- This is used only during the building of the data structures.
 277 setIdx :: Node -> T.Ndx -> Node
 278 setIdx t i = t {idx = i}
 279
 280 -- | Changes the alias.
 281 --
 282 -- This is used only during the building of the data structures.
 283 setAlias :: Node -> String -> Node
 284 setAlias t s = t { alias = s }
 285
 286 -- | Sets the offline attribute.
 287 setOffline :: Node -> Bool -> Node
 288 setOffline t val = t { offline = val }
 289
 290 -- | Sets the master attribute
 291 setMaster :: Node -> Bool -> Node
 292 setMaster t val = t { isMaster = val }
 293
 294 -- | Sets the node tags attribute
 295 setNodeTags :: Node -> [String] -> Node
 296 setNodeTags t val = t { nTags = val }
 297
 298 -- | Sets the unnaccounted memory.
 299 setXmem :: Node -> Int -> Node
 300 setXmem t val = t { xMem = val }
 301
 302 -- | Sets the max disk usage ratio.
 303 setMdsk :: Node -> Double -> Node
 304 setMdsk t val = t { mDsk = val, loDsk = mDskToloDsk val (tDsk t) }
 305
 306 -- | Sets the max cpu usage ratio. This will update the node's
 307 -- ipolicy, losing sharing (but it should be a seldomly done operation).
 308 setMcpu :: Node -> Double -> Node
 309 setMcpu t val =
 310   let new_ipol = (iPolicy t) { T.iPolicyVcpuRatio = val }
 311   in t { hiCpu = mCpuTohiCpu val (tCpu t), iPolicy = new_ipol }
 312
 313 -- | Sets the policy.
 314 setPolicy :: T.IPolicy -> Node -> Node
 315 setPolicy pol node =
 316   node { iPolicy = pol
 317        , hiCpu = mCpuTohiCpu (T.iPolicyVcpuRatio pol) (tCpu node)
 318        , hiSpindles = computeHiSpindles (T.iPolicySpindleRatio pol)
 319                       (spindleCount node)
 320        }
 321
 322 -- | Computes the maximum reserved memory for peers from a peer map.
 323 computeMaxRes :: P.PeerMap -> P.Elem
 324 computeMaxRes = P.maxElem
 325
 326 -- | Builds the peer map for a given node.
 327 buildPeers :: Node -> Instance.List -> Node
 328 buildPeers t il =
 329   let mdata = map
 330               (\i_idx -> let inst = Container.find i_idx il
 331                              mem = if Instance.usesSecMem inst
 332                                      then Instance.mem inst
 333                                      else 0
 334                          in (Instance.pNode inst, mem))
 335               (sList t)
 336       pmap = P.accumArray (+) mdata
 337       new_rmem = computeMaxRes pmap
 338       new_failN1 = fMem t <= new_rmem
 339       new_prem = fromIntegral new_rmem / tMem t
 340   in t {peers=pmap, failN1 = new_failN1, rMem = new_rmem, pRem = new_prem}
 341
 342 -- | Calculate the new spindle usage
 343 calcSpindleUse :: Node -> Instance.Instance -> Double
 344 calcSpindleUse n i = incIf (Instance.usesLocalStorage i) (instSpindles n)
 345                        (fromIntegral $ Instance.spindleUse i)
 346
 347 -- | Assigns an instance to a node as primary and update the used VCPU
 348 -- count, utilisation data and tags map.
 349 setPri :: Node -> Instance.Instance -> Node
 350 setPri t inst = t { pList = Instance.idx inst:pList t
 351                   , uCpu = new_count
 352                   , pCpu = fromIntegral new_count / tCpu t
 353                   , utilLoad = utilLoad t `T.addUtil` Instance.util inst
 354                   , pTags = addTags (pTags t) (Instance.exclTags inst)
 355                   , instSpindles = calcSpindleUse t inst
 356                   }
 357   where new_count = Instance.applyIfOnline inst (+ Instance.vcpus inst)
 358                     (uCpu t )
 359
 360 -- | Assigns an instance to a node as secondary without other updates.
 361 setSec :: Node -> Instance.Instance -> Node
 362 setSec t inst = t { sList = Instance.idx inst:sList t
 363                   , utilLoad = old_load { T.dskWeight = T.dskWeight old_load +
 364                                           T.dskWeight (Instance.util inst) }
 365                   , instSpindles = calcSpindleUse t inst
 366                   }
 367   where old_load = utilLoad t
 368
 369 -- | Computes the new 'pDsk' value, handling nodes without local disk
 370 -- storage (we consider all their disk used).
 371 computePDsk :: Int -> Double -> Double
 372 computePDsk _    0     = 1
 373 computePDsk used total = fromIntegral used / total
 374
 375 -- * Update functions
 376
 377 -- | Sets the free memory.
 378 setFmem :: Node -> Int -> Node
 379 setFmem t new_mem =
 380   let new_n1 = new_mem < rMem t
 381       new_mp = fromIntegral new_mem / tMem t
 382   in t { fMem = new_mem, failN1 = new_n1, pMem = new_mp }
 383
 384 -- | Removes a primary instance.
 385 removePri :: Node -> Instance.Instance -> Node
 386 removePri t inst =
 387   let iname = Instance.idx inst
 388       i_online = Instance.notOffline inst
 389       uses_disk = Instance.usesLocalStorage inst
 390       new_plist = delete iname (pList t)
 391       new_mem = incIf i_online (fMem t) (Instance.mem inst)
 392       new_dsk = incIf uses_disk (fDsk t) (Instance.dsk inst)
 393       new_spindles = decIf uses_disk (instSpindles t) 1
 394       new_mp = fromIntegral new_mem / tMem t
 395       new_dp = computePDsk new_dsk (tDsk t)
 396       new_failn1 = new_mem <= rMem t
 397       new_ucpu = decIf i_online (uCpu t) (Instance.vcpus inst)
 398       new_rcpu = fromIntegral new_ucpu / tCpu t
 399       new_load = utilLoad t `T.subUtil` Instance.util inst
 400   in t { pList = new_plist, fMem = new_mem, fDsk = new_dsk
 401        , failN1 = new_failn1, pMem = new_mp, pDsk = new_dp
 402        , uCpu = new_ucpu, pCpu = new_rcpu, utilLoad = new_load
 403        , pTags = delTags (pTags t) (Instance.exclTags inst)
 404        , instSpindles = new_spindles
 405        }
 406
 407 -- | Removes a secondary instance.
 408 removeSec :: Node -> Instance.Instance -> Node
 409 removeSec t inst =
 410   let iname = Instance.idx inst
 411       uses_disk = Instance.usesLocalStorage inst
 412       cur_dsk = fDsk t
 413       pnode = Instance.pNode inst
 414       new_slist = delete iname (sList t)
 415       new_dsk = incIf uses_disk cur_dsk (Instance.dsk inst)
 416       new_spindles = decIf uses_disk (instSpindles t) 1
 417       old_peers = peers t
 418       old_peem = P.find pnode old_peers
 419       new_peem = decIf (Instance.usesSecMem inst) old_peem (Instance.mem inst)
 420       new_peers = if new_peem > 0
 421                     then P.add pnode new_peem old_peers
 422                     else P.remove pnode old_peers
 423       old_rmem = rMem t
 424       new_rmem = if old_peem < old_rmem
 425                    then old_rmem
 426                    else computeMaxRes new_peers
 427       new_prem = fromIntegral new_rmem / tMem t
 428       new_failn1 = fMem t <= new_rmem
 429       new_dp = computePDsk new_dsk (tDsk t)
 430       old_load = utilLoad t
 431       new_load = old_load { T.dskWeight = T.dskWeight old_load -
 432                                           T.dskWeight (Instance.util inst) }
 433   in t { sList = new_slist, fDsk = new_dsk, peers = new_peers
 434        , failN1 = new_failn1, rMem = new_rmem, pDsk = new_dp
 435        , pRem = new_prem, utilLoad = new_load
 436        , instSpindles = new_spindles
 437        }
 438
 439 -- | Adds a primary instance (basic version).
 440 addPri :: Node -> Instance.Instance -> T.OpResult Node
 441 addPri = addPriEx False
 442
 443 -- | Adds a primary instance (extended version).
 444 addPriEx :: Bool               -- ^ Whether to override the N+1 and
 445                                -- other /soft/ checks, useful if we
 446                                -- come from a worse status
 447                                -- (e.g. offline)
 448          -> Node               -- ^ The target node
 449          -> Instance.Instance  -- ^ The instance to add
 450          -> T.OpResult Node    -- ^ The result of the operation,
 451                                -- either the new version of the node
 452                                -- or a failure mode
 453 addPriEx force t inst =
 454   let iname = Instance.idx inst
 455       i_online = Instance.notOffline inst
 456       uses_disk = Instance.usesLocalStorage inst
 457       cur_dsk = fDsk t
 458       new_mem = decIf i_online (fMem t) (Instance.mem inst)
 459       new_dsk = decIf uses_disk cur_dsk (Instance.dsk inst)
 460       new_spindles = incIf uses_disk (instSpindles t) 1
 461       new_failn1 = new_mem <= rMem t
 462       new_ucpu = incIf i_online (uCpu t) (Instance.vcpus inst)
 463       new_pcpu = fromIntegral new_ucpu / tCpu t
 464       new_dp = computePDsk new_dsk (tDsk t)
 465       l_cpu = T.iPolicyVcpuRatio $ iPolicy t
 466       new_load = utilLoad t `T.addUtil` Instance.util inst
 467       inst_tags = Instance.exclTags inst
 468       old_tags = pTags t
 469       strict = not force
 470   in case () of
 471        _ | new_mem <= 0 -> Bad T.FailMem
 472          | uses_disk && new_dsk <= 0 -> Bad T.FailDisk
 473          | uses_disk && mDsk t > new_dp && strict -> Bad T.FailDisk
 474          | uses_disk && new_spindles > hiSpindles t
 475              && strict -> Bad T.FailDisk
 476          | new_failn1 && not (failN1 t) && strict -> Bad T.FailMem
 477          | l_cpu >= 0 && l_cpu < new_pcpu && strict -> Bad T.FailCPU
 478          | rejectAddTags old_tags inst_tags -> Bad T.FailTags
 479          | otherwise ->
 480            let new_plist = iname:pList t
 481                new_mp = fromIntegral new_mem / tMem t
 482                r = t { pList = new_plist, fMem = new_mem, fDsk = new_dsk
 483                      , failN1 = new_failn1, pMem = new_mp, pDsk = new_dp
 484                      , uCpu = new_ucpu, pCpu = new_pcpu
 485                      , utilLoad = new_load
 486                      , pTags = addTags old_tags inst_tags
 487                      , instSpindles = new_spindles
 488                      }
 489            in Ok r
 490
 491 -- | Adds a secondary instance (basic version).
 492 addSec :: Node -> Instance.Instance -> T.Ndx -> T.OpResult Node
 493 addSec = addSecEx False
 494
 495 -- | Adds a secondary instance (extended version).
 496 addSecEx :: Bool -> Node -> Instance.Instance -> T.Ndx -> T.OpResult Node
 497 addSecEx force t inst pdx =
 498   let iname = Instance.idx inst
 499       old_peers = peers t
 500       old_mem = fMem t
 501       new_dsk = fDsk t - Instance.dsk inst
 502       new_spindles = instSpindles t + 1
 503       secondary_needed_mem = if Instance.usesSecMem inst
 504                                then Instance.mem inst
 505                                else 0
 506       new_peem = P.find pdx old_peers + secondary_needed_mem
 507       new_peers = P.add pdx new_peem old_peers
 508       new_rmem = max (rMem t) new_peem
 509       new_prem = fromIntegral new_rmem / tMem t
 510       new_failn1 = old_mem <= new_rmem
 511       new_dp = computePDsk new_dsk (tDsk t)
 512       old_load = utilLoad t
 513       new_load = old_load { T.dskWeight = T.dskWeight old_load +
 514                                           T.dskWeight (Instance.util inst) }
 515       strict = not force
 516   in case () of
 517        _ | not (Instance.hasSecondary inst) -> Bad T.FailDisk
 518          | new_dsk <= 0 -> Bad T.FailDisk
 519          | mDsk t > new_dp && strict -> Bad T.FailDisk
 520          | new_spindles > hiSpindles t && strict -> Bad T.FailDisk
 521          | secondary_needed_mem >= old_mem && strict -> Bad T.FailMem
 522          | new_failn1 && not (failN1 t) && strict -> Bad T.FailMem
 523          | otherwise ->
 524            let new_slist = iname:sList t
 525                r = t { sList = new_slist, fDsk = new_dsk
 526                      , peers = new_peers, failN1 = new_failn1
 527                      , rMem = new_rmem, pDsk = new_dp
 528                      , pRem = new_prem, utilLoad = new_load
 529                      , instSpindles = new_spindles
 530                      }
 531            in Ok r
 532
 533 -- * Stats functions
 534
 535 -- | Computes the amount of available disk on a given node.
 536 availDisk :: Node -> Int
 537 availDisk t =
 538   let _f = fDsk t
 539       _l = loDsk t
 540   in if _f < _l
 541        then 0
 542        else _f - _l
 543
 544 -- | Computes the amount of used disk on a given node.
 545 iDsk :: Node -> Int
 546 iDsk t = truncate (tDsk t) - fDsk t
 547
 548 -- | Computes the amount of available memory on a given node.
 549 availMem :: Node -> Int
 550 availMem t =
 551   let _f = fMem t
 552       _l = rMem t
 553   in if _f < _l
 554        then 0
 555        else _f - _l
 556
 557 -- | Computes the amount of available memory on a given node.
 558 availCpu :: Node -> Int
 559 availCpu t =
 560   let _u = uCpu t
 561       _l = hiCpu t
 562   in if _l >= _u
 563        then _l - _u
 564        else 0
 565
 566 -- | The memory used by instances on a given node.
 567 iMem :: Node -> Int
 568 iMem t = truncate (tMem t) - nMem t - xMem t - fMem t
 569
 570 -- * Node graph functions
 571 -- These functions do the transformations needed so that nodes can be
 572 -- represented as a graph connected by the instances that are replicated
 573 -- on them.
 574
 575 -- * Making of a Graph from a node/instance list
 576
 577 -- | Transform an instance into a list of edges on the node graph
 578 instanceToEdges :: Instance.Instance -> [Graph.Edge]
 579 instanceToEdges i
 580   | Instance.hasSecondary i = [(pnode,snode), (snode,pnode)]
 581   | otherwise = []
 582     where pnode = Instance.pNode i
 583           snode = Instance.sNode i
 584
 585 -- | Transform the list of instances into list of destination edges
 586 instancesToEdges :: Instance.List -> [Graph.Edge]
 587 instancesToEdges = concatMap instanceToEdges . Container.elems
 588
 589 -- | Transform the list of nodes into vertices bounds.
 590 -- Returns Nothing is the list is empty.
 591 nodesToBounds :: List -> Maybe Graph.Bounds
 592 nodesToBounds nl = liftM2 (,) nmin nmax
 593     where nmin = fmap (fst . fst) (IntMap.minViewWithKey nl)
 594           nmax = fmap (fst . fst) (IntMap.maxViewWithKey nl)
 595
 596 -- | The clique of the primary nodes of the instances with a given secondary.
 597 -- Return the full graph of those nodes that are primary node of at least one
 598 -- instance that has the given node as secondary.
 599 nodeToSharedSecondaryEdge :: Instance.List -> Node -> [Graph.Edge]
 600 nodeToSharedSecondaryEdge il n = (,) <$> primaries <*> primaries
 601   where primaries = map (Instance.pNode . flip Container.find il) $ sList n
 602
 603
 604 -- | Predicate of an edge having both vertices in a set of nodes.
 605 filterValid :: List -> [Graph.Edge] -> [Graph.Edge]
 606 filterValid nl  =  filter $ \(x,y) -> IntMap.member x nl && IntMap.member y nl
 607
 608 -- | Transform a Node + Instance list into a NodeGraph type.
 609 -- Returns Nothing if the node list is empty.
 610 mkNodeGraph :: List -> Instance.List -> Maybe Graph.Graph
 611 mkNodeGraph nl il =
 612   liftM (`Graph.buildG` (filterValid nl . instancesToEdges $ il))
 613   (nodesToBounds nl)
 614
 615 -- | Transform a Nodes + Instances into a NodeGraph with all reboot exclusions.
 616 -- This includes edges between nodes that are the primary nodes of instances
 617 -- that have the same secondary node. Nodes not in the node list will not be
 618 -- part of the graph, but they are still considered for the edges arising from
 619 -- two instances having the same secondary node.
 620 -- Return Nothing if the node list is empty.
 621 mkRebootNodeGraph :: List -> List -> Instance.List -> Maybe Graph.Graph
 622 mkRebootNodeGraph allnodes nl il =
 623   liftM (`Graph.buildG` filterValid nl edges) (nodesToBounds nl)
 624   where
 625     edges = instancesToEdges il `union`
 626             (Container.elems allnodes >>= nodeToSharedSecondaryEdge il)
 627
 628 -- * Display functions
 629
 630 -- | Return a field for a given node.
 631 showField :: Node   -- ^ Node which we're querying
 632           -> String -- ^ Field name
 633           -> String -- ^ Field value as string
 634 showField t field =
 635   case field of
 636     "idx"  -> printf "%4d" $ idx t
 637     "name" -> alias t
 638     "fqdn" -> name t
 639     "status" -> case () of
 640                   _ | offline t -> "-"
 641                     | failN1 t -> "*"
 642                     | otherwise -> " "
 643     "tmem" -> printf "%5.0f" $ tMem t
 644     "nmem" -> printf "%5d" $ nMem t
 645     "xmem" -> printf "%5d" $ xMem t
 646     "fmem" -> printf "%5d" $ fMem t
 647     "imem" -> printf "%5d" $ iMem t
 648     "rmem" -> printf "%5d" $ rMem t
 649     "amem" -> printf "%5d" $ fMem t - rMem t
 650     "tdsk" -> printf "%5.0f" $ tDsk t / 1024
 651     "fdsk" -> printf "%5d" $ fDsk t `div` 1024
 652     "tcpu" -> printf "%4.0f" $ tCpu t
 653     "ucpu" -> printf "%4d" $ uCpu t
 654     "pcnt" -> printf "%3d" $ length (pList t)
 655     "scnt" -> printf "%3d" $ length (sList t)
 656     "plist" -> show $ pList t
 657     "slist" -> show $ sList t
 658     "pfmem" -> printf "%6.4f" $ pMem t
 659     "pfdsk" -> printf "%6.4f" $ pDsk t
 660     "rcpu"  -> printf "%5.2f" $ pCpu t
 661     "cload" -> printf "%5.3f" uC
 662     "mload" -> printf "%5.3f" uM
 663     "dload" -> printf "%5.3f" uD
 664     "nload" -> printf "%5.3f" uN
 665     "ptags" -> intercalate "," . map (uncurry (printf "%s=%d")) .
 666                Map.toList $ pTags t
 667     "peermap" -> show $ peers t
 668     "spindle_count" -> show $ spindleCount t
 669     "hi_spindles" -> show $ hiSpindles t
 670     "inst_spindles" -> show $ instSpindles t
 671     _ -> T.unknownField
 672   where
 673     T.DynUtil { T.cpuWeight = uC, T.memWeight = uM,
 674                 T.dskWeight = uD, T.netWeight = uN } = utilLoad t
 675
 676 -- | Returns the header and numeric propery of a field.
 677 showHeader :: String -> (String, Bool)
 678 showHeader field =
 679   case field of
 680     "idx" -> ("Index", True)
 681     "name" -> ("Name", False)
 682     "fqdn" -> ("Name", False)
 683     "status" -> ("F", False)
 684     "tmem" -> ("t_mem", True)
 685     "nmem" -> ("n_mem", True)
 686     "xmem" -> ("x_mem", True)
 687     "fmem" -> ("f_mem", True)
 688     "imem" -> ("i_mem", True)
 689     "rmem" -> ("r_mem", True)
 690     "amem" -> ("a_mem", True)
 691     "tdsk" -> ("t_dsk", True)
 692     "fdsk" -> ("f_dsk", True)
 693     "tcpu" -> ("pcpu", True)
 694     "ucpu" -> ("vcpu", True)
 695     "pcnt" -> ("pcnt", True)
 696     "scnt" -> ("scnt", True)
 697     "plist" -> ("primaries", True)
 698     "slist" -> ("secondaries", True)
 699     "pfmem" -> ("p_fmem", True)
 700     "pfdsk" -> ("p_fdsk", True)
 701     "rcpu"  -> ("r_cpu", True)
 702     "cload" -> ("lCpu", True)
 703     "mload" -> ("lMem", True)
 704     "dload" -> ("lDsk", True)
 705     "nload" -> ("lNet", True)
 706     "ptags" -> ("PrimaryTags", False)
 707     "peermap" -> ("PeerMap", False)
 708     "spindle_count" -> ("NodeSpindles", True)
 709     "hi_spindles" -> ("MaxSpindles", True)
 710     "inst_spindles" -> ("InstSpindles", True)
 711     -- TODO: add node fields (group.uuid, group)
 712     _ -> (T.unknownField, False)
 713
 714 -- | String converter for the node list functionality.
 715 list :: [String] -> Node -> [String]
 716 list fields t = map (showField t) fields
 717
 718 -- | Constant holding the fields we're displaying by default.
 719 defaultFields :: [String]
 720 defaultFields =
 721   [ "status", "name", "tmem", "nmem", "imem", "xmem", "fmem"
 722   , "rmem", "tdsk", "fdsk", "tcpu", "ucpu", "pcnt", "scnt"
 723   , "pfmem", "pfdsk", "rcpu"
 724   , "cload", "mload", "dload", "nload" ]
 725
 726 {-# ANN computeGroups "HLint: ignore Use alternative" #-}
 727 -- | Split a list of nodes into a list of (node group UUID, list of
 728 -- associated nodes).
 729 computeGroups :: [Node] -> [(T.Gdx, [Node])]
 730 computeGroups nodes =
 731   let nodes' = sortBy (comparing group) nodes
 732       nodes'' = groupBy ((==) `on` group) nodes'
 733   -- use of head here is OK, since groupBy returns non-empty lists; if
 734   -- you remove groupBy, also remove use of head
 735   in map (\nl -> (group (head nl), nl)) nodes''