module Ganeti.HTools.Node
( Node(..)
, List
, create
, buildPeers
, setIdx
, setAlias
, setOffline
, setXmem
, setFmem
, setPri
, setSec
, setMaster
, setMdsk
, setMcpu
, setPolicy
, addTags
, delTags
, rejectAddTags
, removePri
, removeSec
, addPri
, addPriEx
, addSec
, addSecEx
, availDisk
, availMem
, availCpu
, iMem
, iDsk
, conflictingPrimaries
, defaultFields
, showHeader
, showField
, list
, AssocList
, AllocElement
, noSecondary
, computeGroups
, mkNodeGraph
) where
import Control.Monad (liftM, liftM2)
import qualified Data.Foldable as Foldable
import Data.Function (on)
import qualified Data.Graph as Graph
import qualified Data.IntMap as IntMap
import Data.List hiding (group)
import qualified Data.Map as Map
import Data.Ord (comparing)
import Text.Printf (printf)
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.PeerMap as P
import Ganeti.BasicTypes
import qualified Ganeti.HTools.Types as T
type TagMap = Map.Map String Int
data Node = Node
{ name :: String
, alias :: String
, tMem :: Double
, nMem :: Int
, fMem :: Int
, xMem :: Int
, tDsk :: Double
, fDsk :: Int
, tCpu :: Double
, uCpu :: Int
, spindleCount :: Int
, pList :: [T.Idx]
, sList :: [T.Idx]
, idx :: T.Ndx
, peers :: P.PeerMap
, failN1 :: Bool
, rMem :: Int
, pMem :: Double
, pDsk :: Double
, pRem :: Double
, pCpu :: Double
, mDsk :: Double
, loDsk :: Int
, hiCpu :: Int
, hiSpindles :: Double
, instSpindles :: Double
, offline :: Bool
, isMaster :: Bool
, utilPool :: T.DynUtil
, utilLoad :: T.DynUtil
, pTags :: TagMap
, group :: T.Gdx
, iPolicy :: T.IPolicy
} deriving (Show, Eq)
instance T.Element Node where
nameOf = name
idxOf = idx
setAlias = setAlias
setIdx = setIdx
allNames n = [name n, alias n]
type AssocList = [(T.Ndx, Node)]
type List = Container.Container Node
type AllocElement = (List, Instance.Instance, [Node], T.Score)
noSecondary :: T.Ndx
noSecondary = 1
addTag :: TagMap -> String -> TagMap
addTag t s = Map.insertWith (+) s 1 t
addTags :: TagMap -> [String] -> TagMap
addTags = foldl' addTag
delTag :: TagMap -> String -> TagMap
delTag t s = Map.update (\v -> if v > 1
then Just (v1)
else Nothing)
s t
delTags :: TagMap -> [String] -> TagMap
delTags = foldl' delTag
rejectAddTags :: TagMap -> [String] -> Bool
rejectAddTags t = any (`Map.member` t)
conflictingPrimaries :: Node -> Int
conflictingPrimaries (Node { pTags = t }) = Foldable.sum t Map.size t
incIf :: (Num a) => Bool -> a -> a -> a
incIf True base delta = base + delta
incIf False base _ = base
decIf :: (Num a) => Bool -> a -> a -> a
decIf True base delta = base delta
decIf False base _ = base
create :: String -> Double -> Int -> Int -> Double
-> Int -> Double -> Bool -> Int -> T.Gdx -> Node
create name_init mem_t_init mem_n_init mem_f_init
dsk_t_init dsk_f_init cpu_t_init offline_init spindles_init
group_init =
Node { name = name_init
, alias = name_init
, tMem = mem_t_init
, nMem = mem_n_init
, fMem = mem_f_init
, tDsk = dsk_t_init
, fDsk = dsk_f_init
, tCpu = cpu_t_init
, spindleCount = spindles_init
, uCpu = 0
, pList = []
, sList = []
, failN1 = True
, idx = 1
, peers = P.empty
, rMem = 0
, pMem = fromIntegral mem_f_init / mem_t_init
, pDsk = computePDsk dsk_f_init dsk_t_init
, pRem = 0
, pCpu = 0
, offline = offline_init
, isMaster = False
, xMem = 0
, mDsk = T.defReservedDiskRatio
, loDsk = mDskToloDsk T.defReservedDiskRatio dsk_t_init
, hiCpu = mCpuTohiCpu (T.iPolicyVcpuRatio T.defIPolicy) cpu_t_init
, hiSpindles = computeHiSpindles (T.iPolicySpindleRatio T.defIPolicy)
spindles_init
, instSpindles = 0
, utilPool = T.baseUtil
, utilLoad = T.zeroUtil
, pTags = Map.empty
, group = group_init
, iPolicy = T.defIPolicy
}
mDskToloDsk :: Double -> Double -> Int
mDskToloDsk mval = floor . (mval *)
mCpuTohiCpu :: Double -> Double -> Int
mCpuTohiCpu mval = floor . (mval *)
computeHiSpindles :: Double -> Int -> Double
computeHiSpindles spindle_ratio = (spindle_ratio *) . fromIntegral
setIdx :: Node -> T.Ndx -> Node
setIdx t i = t {idx = i}
setAlias :: Node -> String -> Node
setAlias t s = t { alias = s }
setOffline :: Node -> Bool -> Node
setOffline t val = t { offline = val }
setMaster :: Node -> Bool -> Node
setMaster t val = t { isMaster = val }
setXmem :: Node -> Int -> Node
setXmem t val = t { xMem = val }
setMdsk :: Node -> Double -> Node
setMdsk t val = t { mDsk = val, loDsk = mDskToloDsk val (tDsk t) }
setMcpu :: Node -> Double -> Node
setMcpu t val =
let new_ipol = (iPolicy t) { T.iPolicyVcpuRatio = val }
in t { hiCpu = mCpuTohiCpu val (tCpu t), iPolicy = new_ipol }
setPolicy :: T.IPolicy -> Node -> Node
setPolicy pol node =
node { iPolicy = pol
, hiCpu = mCpuTohiCpu (T.iPolicyVcpuRatio pol) (tCpu node)
, hiSpindles = computeHiSpindles (T.iPolicySpindleRatio pol)
(spindleCount node)
}
computeMaxRes :: P.PeerMap -> P.Elem
computeMaxRes = P.maxElem
buildPeers :: Node -> Instance.List -> Node
buildPeers t il =
let mdata = map
(\i_idx -> let inst = Container.find i_idx il
mem = if Instance.usesSecMem inst
then Instance.mem inst
else 0
in (Instance.pNode inst, mem))
(sList t)
pmap = P.accumArray (+) mdata
new_rmem = computeMaxRes pmap
new_failN1 = fMem t <= new_rmem
new_prem = fromIntegral new_rmem / tMem t
in t {peers=pmap, failN1 = new_failN1, rMem = new_rmem, pRem = new_prem}
calcSpindleUse :: Node -> Instance.Instance -> Double
calcSpindleUse n i = incIf (Instance.usesLocalStorage i) (instSpindles n)
(fromIntegral $ Instance.spindleUse i)
setPri :: Node -> Instance.Instance -> Node
setPri t inst = t { pList = Instance.idx inst:pList t
, uCpu = new_count
, pCpu = fromIntegral new_count / tCpu t
, utilLoad = utilLoad t `T.addUtil` Instance.util inst
, pTags = addTags (pTags t) (Instance.exclTags inst)
, instSpindles = calcSpindleUse t inst
}
where new_count = Instance.applyIfOnline inst (+ Instance.vcpus inst)
(uCpu t )
setSec :: Node -> Instance.Instance -> Node
setSec t inst = t { sList = Instance.idx inst:sList t
, utilLoad = old_load { T.dskWeight = T.dskWeight old_load +
T.dskWeight (Instance.util inst) }
, instSpindles = calcSpindleUse t inst
}
where old_load = utilLoad t
computePDsk :: Int -> Double -> Double
computePDsk _ 0 = 1
computePDsk used total = fromIntegral used / total
setFmem :: Node -> Int -> Node
setFmem t new_mem =
let new_n1 = new_mem < rMem t
new_mp = fromIntegral new_mem / tMem t
in t { fMem = new_mem, failN1 = new_n1, pMem = new_mp }
removePri :: Node -> Instance.Instance -> Node
removePri t inst =
let iname = Instance.idx inst
i_online = Instance.notOffline inst
uses_disk = Instance.usesLocalStorage inst
new_plist = delete iname (pList t)
new_mem = incIf i_online (fMem t) (Instance.mem inst)
new_dsk = incIf uses_disk (fDsk t) (Instance.dsk inst)
new_spindles = decIf uses_disk (instSpindles t) 1
new_mp = fromIntegral new_mem / tMem t
new_dp = computePDsk new_dsk (tDsk t)
new_failn1 = new_mem <= rMem t
new_ucpu = decIf i_online (uCpu t) (Instance.vcpus inst)
new_rcpu = fromIntegral new_ucpu / tCpu t
new_load = utilLoad t `T.subUtil` Instance.util inst
in t { pList = new_plist, fMem = new_mem, fDsk = new_dsk
, failN1 = new_failn1, pMem = new_mp, pDsk = new_dp
, uCpu = new_ucpu, pCpu = new_rcpu, utilLoad = new_load
, pTags = delTags (pTags t) (Instance.exclTags inst)
, instSpindles = new_spindles
}
removeSec :: Node -> Instance.Instance -> Node
removeSec t inst =
let iname = Instance.idx inst
uses_disk = Instance.usesLocalStorage inst
cur_dsk = fDsk t
pnode = Instance.pNode inst
new_slist = delete iname (sList t)
new_dsk = incIf uses_disk cur_dsk (Instance.dsk inst)
new_spindles = decIf uses_disk (instSpindles t) 1
old_peers = peers t
old_peem = P.find pnode old_peers
new_peem = decIf (Instance.usesSecMem inst) old_peem (Instance.mem inst)
new_peers = if new_peem > 0
then P.add pnode new_peem old_peers
else P.remove pnode old_peers
old_rmem = rMem t
new_rmem = if old_peem < old_rmem
then old_rmem
else computeMaxRes new_peers
new_prem = fromIntegral new_rmem / tMem t
new_failn1 = fMem t <= new_rmem
new_dp = computePDsk new_dsk (tDsk t)
old_load = utilLoad t
new_load = old_load { T.dskWeight = T.dskWeight old_load
T.dskWeight (Instance.util inst) }
in t { sList = new_slist, fDsk = new_dsk, peers = new_peers
, failN1 = new_failn1, rMem = new_rmem, pDsk = new_dp
, pRem = new_prem, utilLoad = new_load
, instSpindles = new_spindles
}
addPri :: Node -> Instance.Instance -> T.OpResult Node
addPri = addPriEx False
addPriEx :: Bool
-> Node
-> Instance.Instance
-> T.OpResult Node
addPriEx force t inst =
let iname = Instance.idx inst
i_online = Instance.notOffline inst
uses_disk = Instance.usesLocalStorage inst
cur_dsk = fDsk t
new_mem = decIf i_online (fMem t) (Instance.mem inst)
new_dsk = decIf uses_disk cur_dsk (Instance.dsk inst)
new_spindles = incIf uses_disk (instSpindles t) 1
new_failn1 = new_mem <= rMem t
new_ucpu = incIf i_online (uCpu t) (Instance.vcpus inst)
new_pcpu = fromIntegral new_ucpu / tCpu t
new_dp = computePDsk new_dsk (tDsk t)
l_cpu = T.iPolicyVcpuRatio $ iPolicy t
new_load = utilLoad t `T.addUtil` Instance.util inst
inst_tags = Instance.exclTags inst
old_tags = pTags t
strict = not force
in case () of
_ | new_mem <= 0 -> Bad T.FailMem
| uses_disk && new_dsk <= 0 -> Bad T.FailDisk
| uses_disk && mDsk t > new_dp && strict -> Bad T.FailDisk
| uses_disk && new_spindles > hiSpindles t
&& strict -> Bad T.FailDisk
| new_failn1 && not (failN1 t) && strict -> Bad T.FailMem
| l_cpu >= 0 && l_cpu < new_pcpu && strict -> Bad T.FailCPU
| rejectAddTags old_tags inst_tags -> Bad T.FailTags
| otherwise ->
let new_plist = iname:pList t
new_mp = fromIntegral new_mem / tMem t
r = t { pList = new_plist, fMem = new_mem, fDsk = new_dsk
, failN1 = new_failn1, pMem = new_mp, pDsk = new_dp
, uCpu = new_ucpu, pCpu = new_pcpu
, utilLoad = new_load
, pTags = addTags old_tags inst_tags
, instSpindles = new_spindles
}
in Ok r
addSec :: Node -> Instance.Instance -> T.Ndx -> T.OpResult Node
addSec = addSecEx False
addSecEx :: Bool -> Node -> Instance.Instance -> T.Ndx -> T.OpResult Node
addSecEx force t inst pdx =
let iname = Instance.idx inst
old_peers = peers t
old_mem = fMem t
new_dsk = fDsk t Instance.dsk inst
new_spindles = instSpindles t + 1
secondary_needed_mem = if Instance.usesSecMem inst
then Instance.mem inst
else 0
new_peem = P.find pdx old_peers + secondary_needed_mem
new_peers = P.add pdx new_peem old_peers
new_rmem = max (rMem t) new_peem
new_prem = fromIntegral new_rmem / tMem t
new_failn1 = old_mem <= new_rmem
new_dp = computePDsk new_dsk (tDsk t)
old_load = utilLoad t
new_load = old_load { T.dskWeight = T.dskWeight old_load +
T.dskWeight (Instance.util inst) }
strict = not force
in case () of
_ | not (Instance.hasSecondary inst) -> Bad T.FailDisk
| new_dsk <= 0 -> Bad T.FailDisk
| mDsk t > new_dp && strict -> Bad T.FailDisk
| new_spindles > hiSpindles t && strict -> Bad T.FailDisk
| secondary_needed_mem >= old_mem && strict -> Bad T.FailMem
| new_failn1 && not (failN1 t) && strict -> Bad T.FailMem
| otherwise ->
let new_slist = iname:sList t
r = t { sList = new_slist, fDsk = new_dsk
, peers = new_peers, failN1 = new_failn1
, rMem = new_rmem, pDsk = new_dp
, pRem = new_prem, utilLoad = new_load
, instSpindles = new_spindles
}
in Ok r
availDisk :: Node -> Int
availDisk t =
let _f = fDsk t
_l = loDsk t
in if _f < _l
then 0
else _f _l
iDsk :: Node -> Int
iDsk t = truncate (tDsk t) fDsk t
availMem :: Node -> Int
availMem t =
let _f = fMem t
_l = rMem t
in if _f < _l
then 0
else _f _l
availCpu :: Node -> Int
availCpu t =
let _u = uCpu t
_l = hiCpu t
in if _l >= _u
then _l _u
else 0
iMem :: Node -> Int
iMem t = truncate (tMem t) nMem t xMem t fMem t
instanceToEdges :: Instance.Instance -> [Graph.Edge]
instanceToEdges i
| Instance.hasSecondary i = [(pnode,snode), (snode,pnode)]
| otherwise = []
where pnode = Instance.pNode i
snode = Instance.sNode i
instancesToEdges :: Instance.List -> [Graph.Edge]
instancesToEdges = concatMap instanceToEdges . Container.elems
nodesToBounds :: List -> Maybe Graph.Bounds
nodesToBounds nl = liftM2 (,) nmin nmax
where nmin = fmap (fst . fst) (IntMap.minViewWithKey nl)
nmax = fmap (fst . fst) (IntMap.maxViewWithKey nl)
mkNodeGraph :: List -> Instance.List -> Maybe Graph.Graph
mkNodeGraph nl il =
liftM (`Graph.buildG` instancesToEdges il) (nodesToBounds nl)
showField :: Node
-> String
-> String
showField t field =
case field of
"idx" -> printf "%4d" $ idx t
"name" -> alias t
"fqdn" -> name t
"status" -> case () of
_ | offline t -> "-"
| failN1 t -> "*"
| otherwise -> " "
"tmem" -> printf "%5.0f" $ tMem t
"nmem" -> printf "%5d" $ nMem t
"xmem" -> printf "%5d" $ xMem t
"fmem" -> printf "%5d" $ fMem t
"imem" -> printf "%5d" $ iMem t
"rmem" -> printf "%5d" $ rMem t
"amem" -> printf "%5d" $ fMem t rMem t
"tdsk" -> printf "%5.0f" $ tDsk t / 1024
"fdsk" -> printf "%5d" $ fDsk t `div` 1024
"tcpu" -> printf "%4.0f" $ tCpu t
"ucpu" -> printf "%4d" $ uCpu t
"pcnt" -> printf "%3d" $ length (pList t)
"scnt" -> printf "%3d" $ length (sList t)
"plist" -> show $ pList t
"slist" -> show $ sList t
"pfmem" -> printf "%6.4f" $ pMem t
"pfdsk" -> printf "%6.4f" $ pDsk t
"rcpu" -> printf "%5.2f" $ pCpu t
"cload" -> printf "%5.3f" uC
"mload" -> printf "%5.3f" uM
"dload" -> printf "%5.3f" uD
"nload" -> printf "%5.3f" uN
"ptags" -> intercalate "," . map (uncurry (printf "%s=%d")) .
Map.toList $ pTags t
"peermap" -> show $ peers t
"spindle_count" -> show $ spindleCount t
"hi_spindles" -> show $ hiSpindles t
"inst_spindles" -> show $ instSpindles t
_ -> T.unknownField
where
T.DynUtil { T.cpuWeight = uC, T.memWeight = uM,
T.dskWeight = uD, T.netWeight = uN } = utilLoad t
showHeader :: String -> (String, Bool)
showHeader field =
case field of
"idx" -> ("Index", True)
"name" -> ("Name", False)
"fqdn" -> ("Name", False)
"status" -> ("F", False)
"tmem" -> ("t_mem", True)
"nmem" -> ("n_mem", True)
"xmem" -> ("x_mem", True)
"fmem" -> ("f_mem", True)
"imem" -> ("i_mem", True)
"rmem" -> ("r_mem", True)
"amem" -> ("a_mem", True)
"tdsk" -> ("t_dsk", True)
"fdsk" -> ("f_dsk", True)
"tcpu" -> ("pcpu", True)
"ucpu" -> ("vcpu", True)
"pcnt" -> ("pcnt", True)
"scnt" -> ("scnt", True)
"plist" -> ("primaries", True)
"slist" -> ("secondaries", True)
"pfmem" -> ("p_fmem", True)
"pfdsk" -> ("p_fdsk", True)
"rcpu" -> ("r_cpu", True)
"cload" -> ("lCpu", True)
"mload" -> ("lMem", True)
"dload" -> ("lDsk", True)
"nload" -> ("lNet", True)
"ptags" -> ("PrimaryTags", False)
"peermap" -> ("PeerMap", False)
"spindle_count" -> ("NodeSpindles", True)
"hi_spindles" -> ("MaxSpindles", True)
"inst_spindles" -> ("InstSpindles", True)
_ -> (T.unknownField, False)
list :: [String] -> Node -> [String]
list fields t = map (showField t) fields
defaultFields :: [String]
defaultFields =
[ "status", "name", "tmem", "nmem", "imem", "xmem", "fmem"
, "rmem", "tdsk", "fdsk", "tcpu", "ucpu", "pcnt", "scnt"
, "pfmem", "pfdsk", "rcpu"
, "cload", "mload", "dload", "nload" ]
computeGroups :: [Node] -> [(T.Gdx, [Node])]
computeGroups nodes =
let nodes' = sortBy (comparing group) nodes
nodes'' = groupBy ((==) `on` group) nodes'
in map (\nl -> (group (head nl), nl)) nodes''