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