X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/e7724ccc46708250aeed86898c6f119bac5fe03d..9b1584fcdc85d9b3409a0d9644273e291f38365c:/Ganeti/HTools/Loader.hs?ds=sidebyside diff --git a/Ganeti/HTools/Loader.hs b/Ganeti/HTools/Loader.hs index 2873688..dcaef80 100644 --- a/Ganeti/HTools/Loader.hs +++ b/Ganeti/HTools/Loader.hs @@ -7,7 +7,7 @@ has been loaded from external sources. {- -Copyright (C) 2009 Google Inc. +Copyright (C) 2009, 2010 Google Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -32,15 +32,13 @@ module Ganeti.HTools.Loader , assignIndices , lookupNode , lookupInstance - , stripSuffix + , commonSuffix , RqType(..) , Request(..) ) where -import Control.Monad (foldM) -import Data.Function (on) import Data.List -import Data.Maybe (fromJust) +import qualified Data.Map as M import Text.Printf (printf) import qualified Ganeti.HTools.Container as Container @@ -49,9 +47,15 @@ import qualified Ganeti.HTools.Node as Node import Ganeti.HTools.Types +-- * Constants + +-- | The exclusion tag prefix +exTagsPrefix :: String +exTagsPrefix = "htools:iextags:" + -- * Types -{-| The request type. +{-| The iallocator request type. This type denotes what request we got from Ganeti and also holds request-specific fields. @@ -61,60 +65,73 @@ data RqType = Allocate Instance.Instance Int -- ^ A new instance allocation | Relocate Idx Int [Ndx] -- ^ Move an instance to a new -- secondary node + | Evacuate [Ndx] -- ^ Evacuate nodes deriving (Show) -- | A complete request, as received from Ganeti. -data Request = Request RqType Node.List Instance.List String +data Request = Request RqType Node.List Instance.List [String] deriving (Show) -- * Functions -- | Lookups a node into an assoc list. -lookupNode :: (Monad m) => [(String, Ndx)] -> String -> String -> m Ndx +lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Ndx lookupNode ktn inst node = - case lookup node ktn of + case M.lookup node ktn of Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst Just idx -> return idx -- | Lookups an instance into an assoc list. -lookupInstance :: (Monad m) => [(String, Idx)] -> String -> m Idx +lookupInstance :: (Monad m) => NameAssoc -> String -> m Idx lookupInstance kti inst = - case lookup inst kti of + case M.lookup inst kti of Nothing -> fail $ "Unknown instance '" ++ inst ++ "'" Just idx -> return idx -- | Given a list of elements (and their names), assign indices to them. assignIndices :: (Element a) => [(String, a)] - -> (NameAssoc, [(Int, a)]) -assignIndices = - unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx))) - . zip [0..] - --- | Assoc element comparator -assocEqual :: (Eq a) => (a, b) -> (a, b) -> Bool -assocEqual = (==) `on` fst + -> (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.fromAssocList idx_node) -- | For each instance, add its index to its primary and secondary nodes. -fixNodes :: [(Ndx, Node.Node)] +fixNodes :: Node.List -> Instance.Instance - -> [(Ndx, Node.Node)] + -> Node.List fixNodes accu inst = let pdx = Instance.pNode inst sdx = Instance.sNode inst - pold = fromJust $ lookup pdx accu + pold = Container.find pdx accu pnew = Node.setPri pold inst - ac1 = deleteBy assocEqual (pdx, pold) accu - ac2 = (pdx, pnew):ac1 + ac2 = Container.add pdx pnew accu in if sdx /= Node.noSecondary - then let sold = fromJust $ lookup sdx accu + then let sold = Container.find sdx accu snew = Node.setSec sold inst - ac3 = deleteBy assocEqual (sdx, sold) ac2 - in (sdx, snew):ac3 + in Container.add sdx snew ac2 else ac2 +-- | Remove non-selected tags from the exclusion list +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 } + +-- | Update the movable attribute +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 + -- | Compute the longest common suffix of a list of strings that -- | starts with a dot. longestDomain :: [String] -> String @@ -125,34 +142,51 @@ longestDomain (x:xs) = else accu) "" $ filter (isPrefixOf ".") (tails x) --- | Remove tail suffix from a string. -stripSuffix :: Int -> String -> String -stripSuffix sflen name = take (length name - sflen) name +-- | Extracts the exclusion tags from the cluster configuration +extractExTags :: [String] -> [String] +extractExTags = + map (drop (length exTagsPrefix)) . + filter (isPrefixOf exTagsPrefix) + +-- | Extracts the common suffix from node\/instance names +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) -- | Initializer function that loads the data from a node and instance -- list and massages it into the correct format. mergeData :: [(String, DynUtil)] -- ^ Instance utilisation data - -> (Node.AssocList, - Instance.AssocList) -- ^ Data from either Text.loadData - -- or Rapi.loadData - -> Result (Node.List, Instance.List, String) -mergeData um (nl, il) = do - let il2 = Container.fromAssocList il - il3 <- foldM (\im (name, n_util) -> do - inst <- Container.findByName im name - let new_i = inst { Instance.util = n_util } - return $ Container.add (Instance.idx inst) new_i im - ) il2 um - let nl2 = foldl' fixNodes nl (Container.elems il3) - let nl3 = Container.fromAssocList - (map (\ (k, v) -> (k, Node.buildPeers v il3)) nl2) - node_names = map Node.name $ Container.elems nl3 - inst_names = map Instance.name $ Container.elems il3 + -> [String] -- ^ Exclusion tags + -> [String] -- ^ Untouchable instances + -> (Node.List, Instance.List, [String]) + -- ^ Data from backends + -> Result (Node.List, Instance.List, [String]) +mergeData um extags exinsts (nl, il2, tags) = + let il = Container.elems il2 + il3 = foldl' (\im (name, n_util) -> + case Container.findByName im name of + Nothing -> im -- skipping unknown instance + 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) - csl = length common_suffix - snl = Container.map (\n -> setName n (stripSuffix csl $ nameOf n)) nl3 - sil = Container.map (\i -> setName i (stripSuffix csl $ nameOf i)) il3 - return (snl, sil, common_suffix) + 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 (snl, sil, tags) -- | Checks the cluster data for consistency. checkData :: Node.List -> Instance.List @@ -161,7 +195,7 @@ checkData nl il = Container.mapAccum (\ msgs node -> let nname = Node.name node - nilst = map (flip Container.find il) (Node.pList 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)