module Ganeti.HTools.Loader
( mergeData
, checkData
, assignIndices
, lookupNode
, lookupInstance
, lookupGroup
, commonSuffix
, RqType(..)
, Request(..)
, ClusterData(..)
, emptyCluster
) where
import Data.List
import qualified Data.Map as M
import Text.Printf (printf)
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Group as Group
import Ganeti.HTools.Types
exTagsPrefix :: String
exTagsPrefix = "htools:iextags:"
data RqType
= Allocate Instance.Instance Int
| Relocate Idx Int [Ndx]
| Evacuate [Ndx]
deriving (Show, Read)
data Request = Request RqType ClusterData
deriving (Show, Read)
data ClusterData = ClusterData
{ cdGroups :: Group.List
, cdNodes :: Node.List
, cdInstances :: Instance.List
, cdTags :: [String]
} deriving (Show, Read)
emptyCluster :: ClusterData
emptyCluster = ClusterData Container.empty Container.empty Container.empty []
lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Ndx
lookupNode ktn inst node =
case M.lookup node ktn of
Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
Just idx -> return idx
lookupInstance :: (Monad m) => NameAssoc -> String -> m Idx
lookupInstance kti inst =
case M.lookup inst kti of
Nothing -> fail $ "Unknown instance '" ++ inst ++ "'"
Just idx -> return idx
lookupGroup :: (Monad m) => NameAssoc -> String -> String -> m Gdx
lookupGroup ktg nname gname =
case M.lookup gname ktg of
Nothing -> fail $ "Unknown group '" ++ gname ++ "' for node " ++ nname
Just idx -> return idx
assignIndices :: (Element a) =>
[(String, a)]
-> (NameAssoc, Container.Container a)
assignIndices nodes =
let (na, idx_node) =
unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx)))
. zip [0..] $ nodes
in (M.fromList na, Container.fromList idx_node)
fixNodes :: Node.List
-> Instance.Instance
-> Node.List
fixNodes accu inst =
let
pdx = Instance.pNode inst
sdx = Instance.sNode inst
pold = Container.find pdx accu
pnew = Node.setPri pold inst
ac2 = Container.add pdx pnew accu
in
if sdx /= Node.noSecondary
then let sold = Container.find sdx accu
snew = Node.setSec sold inst
in Container.add sdx snew ac2
else ac2
filterExTags :: [String] -> Instance.Instance -> Instance.Instance
filterExTags tl inst =
let old_tags = Instance.tags inst
new_tags = filter (\tag -> any (`isPrefixOf` tag) tl)
old_tags
in inst { Instance.tags = new_tags }
updateMovable :: [String] -> Instance.Instance -> Instance.Instance
updateMovable exinst inst =
if Instance.sNode inst == Node.noSecondary ||
Instance.name inst `elem` exinst
then Instance.setMovable inst False
else inst
longestDomain :: [String] -> String
longestDomain [] = ""
longestDomain (x:xs) =
foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
then suffix
else accu)
"" $ filter (isPrefixOf ".") (tails x)
extractExTags :: [String] -> [String]
extractExTags =
map (drop (length exTagsPrefix)) .
filter (isPrefixOf exTagsPrefix)
commonSuffix :: Node.List -> Instance.List -> String
commonSuffix nl il =
let node_names = map Node.name $ Container.elems nl
inst_names = map Instance.name $ Container.elems il
in longestDomain (node_names ++ inst_names)
mergeData :: [(String, DynUtil)]
-> [String]
-> [String]
-> ClusterData
-> Result ClusterData
mergeData um extags exinsts cdata@(ClusterData _ nl il2 tags) =
let il = Container.elems il2
il3 = foldl' (\im (name, n_util) ->
case Container.findByName im name of
Nothing -> im
Just inst ->
let new_i = inst { Instance.util = n_util }
in Container.add (Instance.idx inst) new_i im
) il2 um
allextags = extags ++ extractExTags tags
il4 = Container.map (filterExTags allextags .
updateMovable exinsts) il3
nl2 = foldl' fixNodes nl (Container.elems il4)
nl3 = Container.map (\node -> Node.buildPeers node il4) nl2
node_names = map Node.name (Container.elems nl)
inst_names = map Instance.name il
common_suffix = longestDomain (node_names ++ inst_names)
snl = Container.map (computeAlias common_suffix) nl3
sil = Container.map (computeAlias common_suffix) il4
all_inst_names = concatMap allNames $ Container.elems sil
in if not $ all (`elem` all_inst_names) exinsts
then Bad $ "Some of the excluded instances are unknown: " ++
show (exinsts \\ all_inst_names)
else Ok cdata { cdNodes = snl, cdInstances = sil }
checkData :: Node.List -> Instance.List
-> ([String], Node.List)
checkData nl il =
Container.mapAccum
(\ msgs node ->
let nname = Node.name node
nilst = map (`Container.find` il) (Node.pList node)
dilst = filter (not . Instance.running) nilst
adj_mem = sum . map Instance.mem $ dilst
delta_mem = truncate (Node.tMem node)
Node.nMem node
Node.fMem node
nodeImem node il
+ adj_mem
delta_dsk = truncate (Node.tDsk node)
Node.fDsk node
nodeIdsk node il
newn = Node.setFmem (Node.setXmem node delta_mem)
(Node.fMem node adj_mem)
umsg1 = [printf "node %s is missing %d MB ram \
\and %d GB disk"
nname delta_mem (delta_dsk `div` 1024) |
delta_mem > 512 || delta_dsk > 1024]::[String]
in (msgs ++ umsg1, newn)
) [] nl
nodeImem :: Node.Node -> Instance.List -> Int
nodeImem node il =
let rfind = flip Container.find il
in sum . map (Instance.mem . rfind)
$ Node.pList node
nodeIdsk :: Node.Node -> Instance.List -> Int
nodeIdsk node il =
let rfind = flip Container.find il
in sum . map (Instance.dsk . rfind)
$ Node.pList node ++ Node.sList node