code.grnet.gr Git - ganeti-local/blob - 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 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     , setName
  37     , setOffline
  38     , setXmem
  39     , setFmem
  40     , setPri
  41     , setSec
  42     , setMdsk
  43     , setMcpu
  44     -- * Instance (re)location
  45     , removePri
  46     , removeSec
  47     , addPri
  48     , addSec
  49     -- * Stats
  50     , availDisk
  51     , conflictingPrimaries
  52     -- * Formatting
  53     , defaultFields
  54     , showHeader
  55     , showField
  56     , list
  57     -- * Misc stuff
  58     , AssocList
  59     , AllocElement
  60     , noSecondary
  61     ) where
  62
  63 import Data.List
  64 import qualified Data.Map as Map
  65 import qualified Data.Foldable as Foldable
  66 import Text.Printf (printf)
  67
  68 import qualified Ganeti.HTools.Container as Container
  69 import qualified Ganeti.HTools.Instance as Instance
  70 import qualified Ganeti.HTools.PeerMap as P
  71
  72 import qualified Ganeti.HTools.Types as T
  73
  74 -- * Type declarations
  75
  76 -- | The tag map type
  77 type TagMap = Map.Map String Int
  78
  79 -- | The node type.
  80 data Node = Node
  81     { name     :: String    -- ^ The node name
  82     , tMem     :: Double    -- ^ Total memory (MiB)
  83     , nMem     :: Int       -- ^ Node memory (MiB)
  84     , fMem     :: Int       -- ^ Free memory (MiB)
  85     , xMem     :: Int       -- ^ Unaccounted memory (MiB)
  86     , tDsk     :: Double    -- ^ Total disk space (MiB)
  87     , fDsk     :: Int       -- ^ Free disk space (MiB)
  88     , tCpu     :: Double    -- ^ Total CPU count
  89     , uCpu     :: Int       -- ^ Used VCPU count
  90     , pList    :: [T.Idx]   -- ^ List of primary instance indices
  91     , sList    :: [T.Idx]   -- ^ List of secondary instance indices
  92     , idx      :: T.Ndx     -- ^ Internal index for book-keeping
  93     , peers    :: P.PeerMap -- ^ Pnode to instance mapping
  94     , failN1   :: Bool      -- ^ Whether the node has failed n1
  95     , rMem     :: Int       -- ^ Maximum memory needed for failover by
  96                             -- primaries of this node
  97     , pMem     :: Double    -- ^ Percent of free memory
  98     , pDsk     :: Double    -- ^ Percent of free disk
  99     , pRem     :: Double    -- ^ Percent of reserved memory
 100     , pCpu     :: Double    -- ^ Ratio of virtual to physical CPUs
 101     , mDsk     :: Double    -- ^ Minimum free disk ratio
 102     , mCpu     :: Double    -- ^ Max ratio of virt-to-phys CPUs
 103     , loDsk    :: Int       -- ^ Autocomputed from mDsk low disk
 104                             -- threshold
 105     , hiCpu    :: Int       -- ^ Autocomputed from mCpu high cpu
 106                             -- threshold
 107     , offline  :: Bool      -- ^ Whether the node should not be used
 108                             -- for allocations and skipped from score
 109                             -- computations
 110     , utilPool :: T.DynUtil -- ^ Total utilisation capacity
 111     , utilLoad :: T.DynUtil -- ^ Sum of instance utilisation
 112     , pTags    :: TagMap    -- ^ Map of primary instance tags and their count
 113     } deriving (Show)
 114
 115 instance T.Element Node where
 116     nameOf = name
 117     idxOf = idx
 118     setName = setName
 119     setIdx = setIdx
 120
 121 -- | A simple name for the int, node association list.
 122 type AssocList = [(T.Ndx, Node)]
 123
 124 -- | A simple name for a node map.
 125 type List = Container.Container Node
 126
 127 -- | A simple name for an allocation element (here just for logistic
 128 -- reasons)
 129 type AllocElement = (List, Instance.Instance, [Node])
 130
 131 -- | Constant node index for a non-moveable instance.
 132 noSecondary :: T.Ndx
 133 noSecondary = -1
 134
 135 -- | No limit value
 136 noLimit :: Double
 137 noLimit = -1
 138
 139 -- | No limit int value
 140 noLimitInt :: Int
 141 noLimitInt = -1
 142
 143 -- * Helper functions
 144
 145 -- | Add a tag to a tagmap
 146 addTag :: TagMap -> String -> TagMap
 147 addTag t s = Map.insertWith (+) s 1 t
 148
 149 -- | Add multiple tags
 150 addTags :: TagMap -> [String] -> TagMap
 151 addTags = foldl' addTag
 152
 153 -- | Adjust or delete a tag from a tagmap
 154 delTag :: TagMap -> String -> TagMap
 155 delTag t s = Map.update (\v -> if v > 1
 156                                then Just (v-1)
 157                                else Nothing)
 158              s t
 159
 160 -- | Remove multiple tags
 161 delTags :: TagMap -> [String] -> TagMap
 162 delTags = foldl' delTag
 163
 164 -- | Check if we can add a list of tags to a tagmap
 165 rejectAddTags :: TagMap -> [String] -> Bool
 166 rejectAddTags t = any (`Map.member` t)
 167
 168 -- | Check how many primary instances have conflicting tags. The
 169 -- algorithm to compute this is to sum the count of all tags, then
 170 -- subtract the size of the tag map (since each tag has at least one,
 171 -- non-conflicting instance); this is equivalent to summing the
 172 -- values in the tag map minus one.
 173 conflictingPrimaries :: Node -> Int
 174 conflictingPrimaries (Node { pTags = t }) = Foldable.sum t - Map.size t
 175
 176 -- * Initialization functions
 177
 178 -- | Create a new node.
 179 --
 180 -- The index and the peers maps are empty, and will be need to be
 181 -- update later via the 'setIdx' and 'buildPeers' functions.
 182 create :: String -> Double -> Int -> Int -> Double
 183        -> Int -> Double -> Bool -> Node
 184 create name_init mem_t_init mem_n_init mem_f_init
 185        dsk_t_init dsk_f_init cpu_t_init offline_init =
 186     Node { name  = name_init
 187          , tMem = mem_t_init
 188          , nMem = mem_n_init
 189          , fMem = mem_f_init
 190          , tDsk = dsk_t_init
 191          , fDsk = dsk_f_init
 192          , tCpu = cpu_t_init
 193          , uCpu = 0
 194          , pList = []
 195          , sList = []
 196          , failN1 = True
 197          , idx = -1
 198          , peers = P.empty
 199          , rMem = 0
 200          , pMem = fromIntegral mem_f_init / mem_t_init
 201          , pDsk = fromIntegral dsk_f_init / dsk_t_init
 202          , pRem = 0
 203          , pCpu = 0
 204          , offline = offline_init
 205          , xMem = 0
 206          , mDsk = noLimit
 207          , mCpu = noLimit
 208          , loDsk = noLimitInt
 209          , hiCpu = noLimitInt
 210          , utilPool = T.baseUtil
 211          , utilLoad = T.zeroUtil
 212          , pTags = Map.empty
 213          }
 214
 215 -- | Changes the index.
 216 --
 217 -- This is used only during the building of the data structures.
 218 setIdx :: Node -> T.Ndx -> Node
 219 setIdx t i = t {idx = i}
 220
 221 -- | Changes the name.
 222 --
 223 -- This is used only during the building of the data structures.
 224 setName :: Node -> String -> Node
 225 setName t s = t {name = s}
 226
 227 -- | Sets the offline attribute.
 228 setOffline :: Node -> Bool -> Node
 229 setOffline t val = t { offline = val }
 230
 231 -- | Sets the unnaccounted memory.
 232 setXmem :: Node -> Int -> Node
 233 setXmem t val = t { xMem = val }
 234
 235 -- | Sets the max disk usage ratio
 236 setMdsk :: Node -> Double -> Node
 237 setMdsk t val = t { mDsk = val,
 238                     loDsk = if val == noLimit
 239                              then noLimitInt
 240                              else floor (val * tDsk t) }
 241
 242 -- | Sets the max cpu usage ratio
 243 setMcpu :: Node -> Double -> Node
 244 setMcpu t val = t { mCpu = val, hiCpu = floor (val * tCpu t) }
 245
 246 -- | Computes the maximum reserved memory for peers from a peer map.
 247 computeMaxRes :: P.PeerMap -> P.Elem
 248 computeMaxRes = P.maxElem
 249
 250 -- | Builds the peer map for a given node.
 251 buildPeers :: Node -> Instance.List -> Node
 252 buildPeers t il =
 253     let mdata = map
 254                 (\i_idx -> let inst = Container.find i_idx il
 255                            in (Instance.pNode inst, Instance.mem inst))
 256                 (sList t)
 257         pmap = P.accumArray (+) mdata
 258         new_rmem = computeMaxRes pmap
 259         new_failN1 = fMem t <= new_rmem
 260         new_prem = fromIntegral new_rmem / tMem t
 261     in t {peers=pmap, failN1 = new_failN1, rMem = new_rmem, pRem = new_prem}
 262
 263 -- | Assigns an instance to a node as primary and update the used VCPU
 264 -- count, utilisation data and tags map.
 265 setPri :: Node -> Instance.Instance -> Node
 266 setPri t inst = t { pList = Instance.idx inst:pList t
 267                   , uCpu = new_count
 268                   , pCpu = fromIntegral new_count / tCpu t
 269                   , utilLoad = utilLoad t `T.addUtil` Instance.util inst
 270                   , pTags = addTags (pTags t) (Instance.tags inst)
 271                   }
 272     where new_count = uCpu t + Instance.vcpus inst
 273
 274 -- | Assigns an instance to a node as secondary without other updates.
 275 setSec :: Node -> Instance.Instance -> Node
 276 setSec t inst = t { sList = Instance.idx inst:sList t
 277                   , utilLoad = old_load { T.dskWeight = T.dskWeight old_load +
 278                                           T.dskWeight (Instance.util inst) }
 279                   }
 280     where old_load = utilLoad t
 281
 282 -- * Update functions
 283
 284 -- | Sets the free memory.
 285 setFmem :: Node -> Int -> Node
 286 setFmem t new_mem =
 287     let new_n1 = new_mem <= rMem t
 288         new_mp = fromIntegral new_mem / tMem t
 289     in t { fMem = new_mem, failN1 = new_n1, pMem = new_mp }
 290
 291 -- | Removes a primary instance.
 292 removePri :: Node -> Instance.Instance -> Node
 293 removePri t inst =
 294     let iname = Instance.idx inst
 295         new_plist = delete iname (pList t)
 296         new_mem = fMem t + Instance.mem inst
 297         new_dsk = fDsk t + Instance.dsk inst
 298         new_mp = fromIntegral new_mem / tMem t
 299         new_dp = fromIntegral new_dsk / tDsk t
 300         new_failn1 = new_mem <= rMem t
 301         new_ucpu = uCpu t - Instance.vcpus inst
 302         new_rcpu = fromIntegral new_ucpu / tCpu t
 303         new_load = utilLoad t `T.subUtil` Instance.util inst
 304     in t { pList = new_plist, fMem = new_mem, fDsk = new_dsk
 305          , failN1 = new_failn1, pMem = new_mp, pDsk = new_dp
 306          , uCpu = new_ucpu, pCpu = new_rcpu, utilLoad = new_load
 307          , pTags = delTags (pTags t) (Instance.tags inst) }
 308
 309 -- | Removes a secondary instance.
 310 removeSec :: Node -> Instance.Instance -> Node
 311 removeSec t inst =
 312     let iname = Instance.idx inst
 313         pnode = Instance.pNode inst
 314         new_slist = delete iname (sList t)
 315         new_dsk = fDsk t + Instance.dsk inst
 316         old_peers = peers t
 317         old_peem = P.find pnode old_peers
 318         new_peem =  old_peem - Instance.mem inst
 319         new_peers = P.add pnode new_peem old_peers
 320         old_rmem = rMem t
 321         new_rmem = if old_peem < old_rmem
 322                    then old_rmem
 323                    else computeMaxRes new_peers
 324         new_prem = fromIntegral new_rmem / tMem t
 325         new_failn1 = fMem t <= new_rmem
 326         new_dp = fromIntegral new_dsk / tDsk t
 327         old_load = utilLoad t
 328         new_load = old_load { T.dskWeight = T.dskWeight old_load -
 329                                             T.dskWeight (Instance.util inst) }
 330     in t { sList = new_slist, fDsk = new_dsk, peers = new_peers
 331          , failN1 = new_failn1, rMem = new_rmem, pDsk = new_dp
 332          , pRem = new_prem, utilLoad = new_load }
 333
 334 -- | Adds a primary instance.
 335 addPri :: Node -> Instance.Instance -> T.OpResult Node
 336 addPri t inst =
 337     let iname = Instance.idx inst
 338         new_mem = fMem t - Instance.mem inst
 339         new_dsk = fDsk t - Instance.dsk inst
 340         new_failn1 = new_mem <= rMem t
 341         new_ucpu = uCpu t + Instance.vcpus inst
 342         new_pcpu = fromIntegral new_ucpu / tCpu t
 343         new_dp = fromIntegral new_dsk / tDsk t
 344         l_cpu = mCpu t
 345         new_load = utilLoad t `T.addUtil` Instance.util inst
 346         inst_tags = Instance.tags inst
 347         old_tags = pTags t
 348     in case () of
 349          _ | new_mem <= 0 -> T.OpFail T.FailMem
 350            | new_dsk <= 0 || mDsk t > new_dp -> T.OpFail T.FailDisk
 351            | new_failn1 && not (failN1 t) -> T.OpFail T.FailMem
 352            | l_cpu >= 0 && l_cpu < new_pcpu -> T.OpFail T.FailCPU
 353            | rejectAddTags old_tags inst_tags -> T.OpFail T.FailTags
 354            | otherwise ->
 355                let new_plist = iname:pList t
 356                    new_mp = fromIntegral new_mem / tMem t
 357                    r = t { pList = new_plist, fMem = new_mem, fDsk = new_dsk
 358                          , failN1 = new_failn1, pMem = new_mp, pDsk = new_dp
 359                          , uCpu = new_ucpu, pCpu = new_pcpu
 360                          , utilLoad = new_load
 361                          , pTags = addTags old_tags inst_tags }
 362                in T.OpGood r
 363
 364 -- | Adds a secondary instance.
 365 addSec :: Node -> Instance.Instance -> T.Ndx -> T.OpResult Node
 366 addSec t inst pdx =
 367     let iname = Instance.idx inst
 368         old_peers = peers t
 369         old_mem = fMem t
 370         new_dsk = fDsk t - Instance.dsk inst
 371         new_peem = P.find pdx old_peers + Instance.mem inst
 372         new_peers = P.add pdx new_peem old_peers
 373         new_rmem = max (rMem t) new_peem
 374         new_prem = fromIntegral new_rmem / tMem t
 375         new_failn1 = old_mem <= new_rmem
 376         new_dp = fromIntegral new_dsk / tDsk t
 377         old_load = utilLoad t
 378         new_load = old_load { T.dskWeight = T.dskWeight old_load +
 379                                             T.dskWeight (Instance.util inst) }
 380     in case () of
 381          _ | new_dsk <= 0 || mDsk t > new_dp -> T.OpFail T.FailDisk
 382            | Instance.mem inst >= old_mem -> T.OpFail T.FailMem
 383            | new_failn1 && not (failN1 t) -> T.OpFail T.FailMem
 384            | otherwise ->
 385                let new_slist = iname:sList t
 386                    r = t { sList = new_slist, fDsk = new_dsk
 387                          , peers = new_peers, failN1 = new_failn1
 388                          , rMem = new_rmem, pDsk = new_dp
 389                          , pRem = new_prem, utilLoad = new_load }
 390                in T.OpGood r
 391
 392 -- * Stats functions
 393
 394 -- | Computes the amount of available disk on a given node
 395 availDisk :: Node -> Int
 396 availDisk t =
 397     let _f = fDsk t
 398         _l = loDsk t
 399     in
 400       if _l == noLimitInt
 401       then _f
 402       else if _f < _l
 403            then 0
 404            else _f - _l
 405
 406 -- * Display functions
 407
 408 showField :: Node -> String -> String
 409 showField t field =
 410     case field of
 411       "name" -> name t
 412       "status" -> if offline t then "-"
 413                   else if failN1 t then "*" else " "
 414       "tmem" -> printf "%5.0f" $ tMem t
 415       "nmem" -> printf "%5d" $ nMem t
 416       "xmem" -> printf "%5d" $ xMem t
 417       "fmem" -> printf "%5d" $ fMem t
 418       "imem" -> printf "%5d" imem
 419       "rmem" -> printf "%5d" $ rMem t
 420       "amem" -> printf "%5d" $ fMem t - rMem t
 421       "tdsk" -> printf "%5.0f" $ tDsk t / 1024
 422       "fdsk" -> printf "%5d" $ fDsk t `div` 1024
 423       "tcpu" -> printf "%4.0f" $ tCpu t
 424       "ucpu" -> printf "%4d" $ uCpu t
 425       "plist" -> printf "%3d" $ length (pList t)
 426       "slist" -> printf "%3d" $ length (sList t)
 427       "pfmem" -> printf "%6.4f" $ pMem t
 428       "pfdsk" -> printf "%6.4f" $ pDsk t
 429       "rcpu"  -> printf "%5.2f" $ pCpu t
 430       "cload" -> printf "%5.3f" uC
 431       "mload" -> printf "%5.3f" uM
 432       "dload" -> printf "%5.3f" uD
 433       "nload" -> printf "%5.3f" uN
 434       "ptags" -> intercalate "," . map (\(k, v) -> printf "%s=%d" k v) .
 435                  Map.toList $ pTags t
 436       _ -> printf "<unknown field>"
 437     where
 438       T.DynUtil { T.cpuWeight = uC, T.memWeight = uM,
 439                   T.dskWeight = uD, T.netWeight = uN } = utilLoad t
 440       imem = truncate (tMem t) - nMem t - xMem t - fMem t
 441
 442 -- | Returns the header and numeric propery of a field
 443 showHeader :: String -> (String, Bool)
 444 showHeader field =
 445     case field of
 446       "name" -> ("Name", False)
 447       "status" -> ("F", False)
 448       "tmem" -> ("t_mem", True)
 449       "nmem" -> ("n_mem", True)
 450       "xmem" -> ("x_mem", True)
 451       "fmem" -> ("f_mem", True)
 452       "imem" -> ("i_mem", True)
 453       "rmem" -> ("r_mem", True)
 454       "amem" -> ("a_mem", True)
 455       "tdsk" -> ("t_dsk", True)
 456       "fdsk" -> ("f_dsk", True)
 457       "tcpu" -> ("pcpu", True)
 458       "ucpu" -> ("vcpu", True)
 459       "plist" -> ("pri", True)
 460       "slist" -> ("sec", True)
 461       "pfmem" -> ("p_fmem", True)
 462       "pfdsk" -> ("p_fdsk", True)
 463       "rcpu"  -> ("r_cpu", True)
 464       "cload" -> ("lCpu", True)
 465       "mload" -> ("lMem", True)
 466       "dload" -> ("lDsk", True)
 467       "nload" -> ("lNet", True)
 468       "ptags" -> ("PrimaryTags", False)
 469       _ -> ("<unknown field>", False)
 470
 471 -- | String converter for the node list functionality.
 472 list :: [String] -> Node -> [String]
 473 list fields t = map (showField t) fields
 474
 475
 476 defaultFields :: [String]
 477 defaultFields =
 478     [ "status", "name", "tmem", "nmem", "imem", "xmem", "fmem"
 479     , "rmem", "tdsk", "fdsk", "tcpu", "ucpu", "plist", "slist"
 480     , "pfmem", "pfdsk", "rcpu"
 481     , "cload", "mload", "dload", "nload" ]