module Ganeti.HTools.Node
( Node(..)
, List
, create
, buildPeers
, setIdx
, setAlias
, setOffline
, setXmem
, setFmem
, setPri
, setSec
, setMaster
, setNodeTags
, 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
, mkRebootNodeGraph
, haveExclStorage
) where
import Control.Monad (liftM, liftM2)
import Control.Applicative ((<$>), (<*>))
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
, nCpu :: Int
, uCpu :: Int
, tSpindles :: Int
, fSpindles :: 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
, nTags :: [String]
, utilPool :: T.DynUtil
, utilLoad :: T.DynUtil
, pTags :: TagMap
, group :: T.Gdx
, iPolicy :: T.IPolicy
, exclStorage :: Bool
} 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
haveExclStorage :: List -> Bool
haveExclStorage nl =
any exclStorage $ Container.elems nl
create :: String -> Double -> Int -> Int
-> Double -> Int -> Double -> Int -> Bool
-> Int -> Int -> T.Gdx -> Bool
-> Node
create name_init mem_t_init mem_n_init mem_f_init
dsk_t_init dsk_f_init cpu_t_init cpu_n_init offline_init
spindles_t_init spindles_f_init group_init excl_stor =
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
, nCpu = cpu_n_init
, uCpu = cpu_n_init
, tSpindles = spindles_t_init
, fSpindles = spindles_f_init
, pList = []
, sList = []
, failN1 = True
, idx = 1
, peers = P.empty
, rMem = 0
, pMem = fromIntegral mem_f_init / mem_t_init
, pDsk = if excl_stor
then computePDsk spindles_f_init $ fromIntegral spindles_t_init
else computePDsk dsk_f_init dsk_t_init
, pRem = 0
, pCpu = fromIntegral cpu_n_init / cpu_t_init
, offline = offline_init
, isMaster = False
, nTags = []
, 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_t_init
, instSpindles = 0
, utilPool = T.baseUtil
, utilLoad = T.zeroUtil
, pTags = Map.empty
, group = group_init
, iPolicy = T.defIPolicy
, exclStorage = excl_stor
}
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 }
setNodeTags :: Node -> [String] -> Node
setNodeTags t val = t { nTags = 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)
(tSpindles 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 ::
Bool
-> Node -> Instance.Instance -> Double
calcSpindleUse _ (Node {exclStorage = True}) _ = 0.0
calcSpindleUse act n@(Node {exclStorage = False}) i =
f (Instance.usesLocalStorage i) (instSpindles n)
(fromIntegral $ Instance.spindleUse i)
where
f :: Bool -> Double -> Double -> Double
f = if act then incIf else decIf
calcNewFreeSpindles ::
Bool
-> Node -> Instance.Instance -> Int
calcNewFreeSpindles _ (Node {exclStorage = False}) _ = 0
calcNewFreeSpindles act n@(Node {exclStorage = True}) i =
case Instance.getTotalSpindles i of
Nothing -> if act
then 1
else fSpindles n
Just s -> (if act then () else (+)) (fSpindles n) s
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 True 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 True t inst
}
where old_load = utilLoad t
computePDsk :: Int -> Double -> Double
computePDsk _ 0 = 1
computePDsk free total = fromIntegral free / total
computeNewPDsk :: Node -> Int -> Int -> Double
computeNewPDsk node new_free_sp new_free_dsk =
if exclStorage node
then computePDsk new_free_sp . fromIntegral $ tSpindles node
else computePDsk new_free_dsk $ tDsk node
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_free_sp = calcNewFreeSpindles False t inst
new_inst_sp = calcSpindleUse False t inst
new_mp = fromIntegral new_mem / tMem t
new_dp = computeNewPDsk t new_free_sp new_dsk
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_inst_sp, fSpindles = new_free_sp
}
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_free_sp = calcNewFreeSpindles False t inst
new_inst_sp = calcSpindleUse False t inst
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 = computeNewPDsk t new_free_sp new_dsk
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_inst_sp, fSpindles = new_free_sp
}
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_free_sp = calcNewFreeSpindles True t inst
new_inst_sp = calcSpindleUse True t inst
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 = computeNewPDsk t new_free_sp new_dsk
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 && new_dsk < loDsk t && strict -> Bad T.FailDisk
| uses_disk && exclStorage t && new_free_sp < 0 -> Bad T.FailSpindles
| uses_disk && new_inst_sp > 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_inst_sp
, fSpindles = new_free_sp
}
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_free_sp = calcNewFreeSpindles True t inst
new_inst_sp = calcSpindleUse True t inst
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 = computeNewPDsk t new_free_sp new_dsk
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
| new_dsk < loDsk t && strict -> Bad T.FailDisk
| exclStorage t && new_free_sp < 0 -> Bad T.FailSpindles
| new_inst_sp > 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_inst_sp
, fSpindles = new_free_sp
}
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)
nodeToSharedSecondaryEdge :: Instance.List -> Node -> [Graph.Edge]
nodeToSharedSecondaryEdge il n = (,) <$> primaries <*> primaries
where primaries = map (Instance.pNode . flip Container.find il) $ sList n
filterValid :: List -> [Graph.Edge] -> [Graph.Edge]
filterValid nl = filter $ \(x,y) -> IntMap.member x nl && IntMap.member y nl
mkNodeGraph :: List -> Instance.List -> Maybe Graph.Graph
mkNodeGraph nl il =
liftM (`Graph.buildG` (filterValid nl . instancesToEdges $ il))
(nodesToBounds nl)
mkRebootNodeGraph :: List -> List -> Instance.List -> Maybe Graph.Graph
mkRebootNodeGraph allnodes nl il =
liftM (`Graph.buildG` filterValid nl edges) (nodesToBounds nl)
where
edges = instancesToEdges il `union`
(Container.elems allnodes >>= nodeToSharedSecondaryEdge il)
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 $ tSpindles 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''