X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/7e7f6ca279206f095cfbc1d51fdbb622446f503e..b513faa10514ee88b3166539288976eeccded381:/Ganeti/HTools/Cluster.hs diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs index a85b9ad..74f24d8 100644 --- a/Ganeti/HTools/Cluster.hs +++ b/Ganeti/HTools/Cluster.hs @@ -31,9 +31,6 @@ module Ganeti.HTools.Cluster , checkMove , compCV , printStats - -- * Loading functions - , loadData - , checkData ) where import Data.List @@ -45,12 +42,9 @@ import Control.Monad import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Instance as Instance import qualified Ganeti.HTools.Node as Node +import Ganeti.HTools.Types import Ganeti.HTools.Utils -type NodeList = Container.Container Node.Node -type InstanceList = Container.Container Instance.Instance --- | The type used to hold idx-to-name mappings -type NameList = [(Int, String)] -- | A separate name for the cluster score type type Score = Double @@ -85,10 +79,6 @@ data IMove = Failover -- ^ Failover the instance (f) data Table = Table NodeList InstanceList Score [Placement] deriving (Show) --- | Constant node index for a non-moveable instance -noSecondary :: Int -noSecondary = -1 - -- General functions -- | Cap the removal list if needed. @@ -480,7 +470,7 @@ checkMove nodes_idx ini_tbl victims = best_tbl = foldl' (\ step_tbl elem -> - if Instance.snode elem == noSecondary then step_tbl + if Instance.snode elem == Node.noSecondary then step_tbl else compareTables step_tbl $ checkInstanceMove nodes_idx ini_tbl elem) ini_tbl victims @@ -689,184 +679,3 @@ printStats nl = let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f, uf=%.3f" mem_cv res_cv dsk_cv n1_score off_score - --- Balancing functions - --- Loading functions - -{- | Convert newline and delimiter-separated text. - -This function converts a text in tabular format as generated by -@gnt-instance list@ and @gnt-node list@ to a list of objects using a -supplied conversion function. - --} -loadTabular :: (Monad m) => String -> ([String] -> m (String, a)) - -> (a -> Int -> a) -> m ([(String, Int)], [(Int, a)]) -loadTabular text_data convert_fn set_fn = do - let lines_data = lines text_data - rows = map (sepSplit '|') lines_data - kerows <- mapM convert_fn rows - let idxrows = map (\ (idx, (k, v)) -> ((k, idx), (idx, set_fn v idx))) - (zip [0..] kerows) - return $ unzip idxrows - --- | For each instance, add its index to its primary and secondary nodes -fixNodes :: [(Int, Node.Node)] - -> [(Int, Instance.Instance)] - -> [(Int, Node.Node)] -fixNodes nl il = - foldl' (\accu (idx, inst) -> - let - assocEqual = (\ (i, _) (j, _) -> i == j) - pdx = Instance.pnode inst - sdx = Instance.snode inst - pold = fromJust $ lookup pdx accu - pnew = Node.setPri pold idx - ac1 = deleteBy assocEqual (pdx, pold) accu - ac2 = (pdx, pnew):ac1 - in - if sdx /= noSecondary then - let - sold = fromJust $ lookup sdx accu - snew = Node.setSec sold idx - ac3 = deleteBy assocEqual (sdx, sold) ac2 - ac4 = (sdx, snew):ac3 - in ac4 - else - ac2 - ) nl il - --- | Compute the longest common suffix of a NameList list that --- | starts with a dot -longestDomain :: NameList -> String -longestDomain [] = "" -longestDomain ((_,x):xs) = - let - onlyStrings = snd $ unzip xs - in - foldr (\ suffix accu -> if all (isSuffixOf suffix) onlyStrings - then suffix - else accu) - "" $ filter (isPrefixOf ".") (tails x) - --- | Remove tails from the (Int, String) lists -stripSuffix :: String -> NameList -> NameList -stripSuffix suffix lst = - let sflen = length suffix in - map (\ (key, name) -> (key, take ((length name) - sflen) name)) lst - --- | Safe 'read' function returning data encapsulated in a Result -tryRead :: (Monad m, Read a) => String -> String -> m a -tryRead name s = - let sols = readsPrec 0 s - in case sols of - (v, ""):[] -> return v - (_, e):[] -> fail $ name ++ ": leftover characters when parsing '" - ++ s ++ "': '" ++ e ++ "'" - _ -> fail $ name ++ ": cannot parse string '" ++ s ++ "'" - --- | Lookups a node into an assoc list -lookupNode :: (Monad m) => String -> String -> [(String, Int)] -> m Int -lookupNode node inst ktn = - case lookup node ktn of - Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst - Just idx -> return idx - --- | Load a node from a field list -loadNode :: (Monad m) => [String] -> m (String, Node.Node) -loadNode (name:tm:nm:fm:td:fd:fo:[]) = do - new_node <- - if any (== "?") [tm,nm,fm,td,fd] || fo == "Y" then - return $ Node.create 0 0 0 0 0 True - else do - vtm <- tryRead name tm - vnm <- tryRead name nm - vfm <- tryRead name fm - vtd <- tryRead name td - vfd <- tryRead name fd - return $ Node.create vtm vnm vfm vtd vfd False - return (name, new_node) -loadNode s = fail $ "Invalid/incomplete node data: '" ++ (show s) ++ "'" - --- | Load an instance from a field list -loadInst :: (Monad m) => - [(String, Int)] -> [String] -> m (String, Instance.Instance) -loadInst ktn (name:mem:dsk:status:pnode:snode:[]) = do - pidx <- lookupNode pnode name ktn - sidx <- (if null snode then return noSecondary - else lookupNode snode name ktn) - vmem <- tryRead name mem - vdsk <- tryRead name dsk - when (sidx == pidx) $ fail $ "Instance " ++ name ++ - " has same primary and secondary node - " ++ pnode - let newinst = Instance.create vmem vdsk status pidx sidx - return (name, newinst) -loadInst _ s = fail $ "Invalid/incomplete instance data: '" ++ (show s) ++ "'" - -{-| Initializer function that loads the data from a node and list file - and massages it into the correct format. -} -loadData :: String -- ^ Node data in text format - -> String -- ^ Instance data in text format - -> Result (Container.Container Node.Node, - Container.Container Instance.Instance, - String, NameList, NameList) -loadData ndata idata = do - {- node file: name t_mem n_mem f_mem t_disk f_disk -} - (ktn, nl) <- loadTabular ndata loadNode Node.setIdx - {- instance file: name mem disk status pnode snode -} - (kti, il) <- loadTabular idata (loadInst ktn) Instance.setIdx - let - nl2 = fixNodes nl il - il3 = Container.fromAssocList il - nl3 = Container.fromAssocList - (map (\ (k, v) -> (k, Node.buildPeers v il3 (length nl2))) nl2) - xtn = swapPairs ktn - xti = swapPairs kti - common_suffix = longestDomain (xti ++ xtn) - stn = stripSuffix common_suffix xtn - sti = stripSuffix common_suffix xti - return (nl3, il3, common_suffix, stn, sti) - --- | Compute the amount of memory used by primary instances on a node. -nodeImem :: Node.Node -> InstanceList -> Int -nodeImem node il = - let rfind = flip Container.find $ il - in sum . map Instance.mem . - map rfind $ Node.plist node - --- | Compute the amount of disk used by instances on a node (either primary --- or secondary). -nodeIdsk :: Node.Node -> InstanceList -> Int -nodeIdsk node il = - let rfind = flip Container.find $ il - in sum . map Instance.dsk . - map rfind $ (Node.plist node) ++ (Node.slist node) - --- | Check cluster data for consistency -checkData :: NodeList -> InstanceList -> NameList -> NameList - -> ([String], NodeList) -checkData nl il ktn _ = - Container.mapAccum - (\ msgs node -> - let nname = fromJust $ lookup (Node.idx node) ktn - nilst = map (flip Container.find $ il) (Node.plist node) - dilst = filter (not . Instance.running) nilst - adj_mem = sum . map Instance.mem $ dilst - delta_mem = (truncate $ Node.t_mem node) - - (Node.n_mem node) - - (Node.f_mem node) - - (nodeImem node il) - + adj_mem - delta_dsk = (truncate $ Node.t_dsk node) - - (Node.f_dsk node) - - (nodeIdsk node il) - newn = Node.setFmem (Node.setXmem node delta_mem) - (Node.f_mem node - adj_mem) - umsg1 = if delta_mem > 512 || delta_dsk > 1024 - then [printf "node %s is missing %d MB ram \ - \and %d GB disk" - nname delta_mem (delta_dsk `div` 1024)] - else [] - in (msgs ++ umsg1, newn) - ) [] nl