| {-| Generic data loader. |
| |
| This module holds the common code for parsing the input data after it |
| has been loaded from external sources. |
| |
| -} |
| |
| {- |
| |
| Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
| modification, are permitted provided that the following conditions are |
| met: |
| |
| 1. Redistributions of source code must retain the above copyright notice, |
| this list of conditions and the following disclaimer. |
| |
| 2. Redistributions in binary form must reproduce the above copyright |
| notice, this list of conditions and the following disclaimer in the |
| documentation and/or other materials provided with the distribution. |
| |
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS |
| IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED |
| TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR |
| PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR |
| CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, |
| EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, |
| PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR |
| PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF |
| LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING |
| NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS |
| SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
| |
| -} |
| |
| module Ganeti.HTools.Loader |
| ( mergeData |
| , clearDynU |
| , checkData |
| , assignIndices |
| , setMaster |
| , lookupNode |
| , lookupInstance |
| , lookupGroup |
| , eitherLive |
| , commonSuffix |
| , extractExTags |
| , updateExclTags |
| , RqType(..) |
| , Request(..) |
| , ClusterData(..) |
| , emptyCluster |
| ) where |
| |
| import Control.Monad |
| import Data.List |
| import qualified Data.Map as M |
| import Data.Maybe |
| import Text.Printf (printf) |
| import System.Time (ClockTime(..)) |
| |
| 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 qualified Ganeti.HTools.Cluster as Cluster |
| |
| import Ganeti.BasicTypes |
| import qualified Ganeti.Constants as C |
| import Ganeti.HTools.Types |
| import Ganeti.Utils |
| import Ganeti.Types (EvacMode) |
| |
| -- * Constants |
| |
| -- | The exclusion tag prefix. |
| exTagsPrefix :: String |
| exTagsPrefix = "htools:iextags:" |
| |
| -- * Types |
| |
| {-| The iallocator request type. |
| |
| This type denotes what request we got from Ganeti and also holds |
| request-specific fields. |
| |
| -} |
| data RqType |
| = Allocate Instance.Instance Int -- ^ A new instance allocation |
| | Relocate Idx Int [Ndx] -- ^ Choose a new secondary node |
| | NodeEvacuate [Idx] EvacMode -- ^ node-evacuate mode |
| | ChangeGroup [Gdx] [Idx] -- ^ Multi-relocate mode |
| | MultiAllocate [(Instance.Instance, Int)] -- ^ Multi-allocate mode |
| deriving (Show) |
| |
| -- | A complete request, as received from Ganeti. |
| data Request = Request RqType ClusterData |
| deriving (Show) |
| |
| -- | The cluster state. |
| data ClusterData = ClusterData |
| { cdGroups :: Group.List -- ^ The node group list |
| , cdNodes :: Node.List -- ^ The node list |
| , cdInstances :: Instance.List -- ^ The instance list |
| , cdTags :: [String] -- ^ The cluster tags |
| , cdIPolicy :: IPolicy -- ^ The cluster instance policy |
| } deriving (Show, Eq) |
| |
| -- | An empty cluster. |
| emptyCluster :: ClusterData |
| emptyCluster = ClusterData Container.empty Container.empty Container.empty [] |
| defIPolicy |
| |
| -- * Functions |
| |
| -- | Lookups a node into an assoc list. |
| lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Ndx |
| lookupNode ktn inst node = |
| maybe (fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst) return $ |
| M.lookup node ktn |
| |
| -- | Lookups an instance into an assoc list. |
| lookupInstance :: (Monad m) => NameAssoc -> String -> m Idx |
| lookupInstance kti inst = |
| maybe (fail $ "Unknown instance '" ++ inst ++ "'") return $ M.lookup inst kti |
| |
| -- | Lookups a group into an assoc list. |
| lookupGroup :: (Monad m) => NameAssoc -> String -> String -> m Gdx |
| lookupGroup ktg nname gname = |
| maybe (fail $ "Unknown group '" ++ gname ++ "' for node " ++ nname) return $ |
| M.lookup gname ktg |
| |
| -- | Given a list of elements (and their names), assign indices to them. |
| assignIndices :: (Element a) => |
| [(String, a)] |
| -> (NameAssoc, Container.Container a) |
| assignIndices name_element = |
| let (name_idx, idx_element) = |
| unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx))) |
| . zip [0..] $ name_element |
| in (M.fromList name_idx, Container.fromList idx_element) |
| |
| -- | Given am indexed node list, and the name of the master, mark it as such. |
| setMaster :: (Monad m) => NameAssoc -> Node.List -> String -> m Node.List |
| setMaster node_names node_idx master = do |
| kmaster <- maybe (fail $ "Master node " ++ master ++ " unknown") return $ |
| M.lookup master node_names |
| let mnode = Container.find kmaster node_idx |
| return $ Container.add kmaster (Node.setMaster mnode True) node_idx |
| |
| -- | For each instance, add its index to its primary and secondary nodes. |
| 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 |
| |
| -- | Set the node's policy to its group one. Note that this requires |
| -- the group to exist (should have been checked before), otherwise it |
| -- will abort with a runtime error. |
| setNodePolicy :: Group.List -> Node.Node -> Node.Node |
| setNodePolicy gl node = |
| let grp = Container.find (Node.group node) gl |
| gpol = Group.iPolicy grp |
| in Node.setPolicy gpol node |
| |
| -- | Update instance with exclusion tags list. |
| updateExclTags :: [String] -> Instance.Instance -> Instance.Instance |
| updateExclTags tl inst = |
| let allTags = Instance.allTags inst |
| exclTags = filter (\tag -> any (`isPrefixOf` tag) tl) allTags |
| in inst { Instance.exclTags = exclTags } |
| |
| -- | Update the movable attribute. |
| updateMovable :: [String] -- ^ Selected instances (if not empty) |
| -> [String] -- ^ Excluded instances |
| -> Instance.Instance -- ^ Target Instance |
| -> Instance.Instance -- ^ Target Instance with updated attribute |
| updateMovable selinsts exinsts inst = |
| if Instance.name inst `elem` exinsts || |
| not (null selinsts || Instance.name inst `elem` selinsts) |
| then Instance.setMovable inst False |
| else inst |
| |
| -- | Disables moves for instances with a split group. |
| disableSplitMoves :: Node.List -> Instance.Instance -> Instance.Instance |
| disableSplitMoves nl inst = |
| if not . isOk . Cluster.instanceGroup nl $ inst |
| then Instance.setMovable inst False |
| else inst |
| |
| -- | Set the auto-repair policy for an instance. |
| setArPolicy :: [String] -- ^ Cluster tags |
| -> Group.List -- ^ List of node groups |
| -> Node.List -- ^ List of nodes |
| -> Instance.List -- ^ List of instances |
| -> ClockTime -- ^ Current timestamp, to evaluate ArSuspended |
| -> Instance.List -- ^ Updated list of instances |
| setArPolicy ctags gl nl il time = |
| let getArPolicy' = flip getArPolicy time |
| cpol = fromMaybe ArNotEnabled $ getArPolicy' ctags |
| gpols = Container.map (fromMaybe cpol . getArPolicy' . Group.allTags) gl |
| ipolfn = getArPolicy' . Instance.allTags |
| nlookup = flip Container.find nl . Instance.pNode |
| glookup = flip Container.find gpols . Node.group . nlookup |
| updateInstance inst = inst { |
| Instance.arPolicy = fromMaybe (glookup inst) $ ipolfn inst } |
| in |
| Container.map updateInstance il |
| |
| -- | Get the auto-repair policy from a list of tags. |
| -- |
| -- This examines the ganeti:watcher:autorepair and |
| -- ganeti:watcher:autorepair:suspend tags to determine the policy. If none of |
| -- these tags are present, Nothing (and not ArNotEnabled) is returned. |
| getArPolicy :: [String] -> ClockTime -> Maybe AutoRepairPolicy |
| getArPolicy tags time = |
| let enabled = mapMaybe (autoRepairTypeFromRaw <=< |
| chompPrefix C.autoRepairTagEnabled) tags |
| suspended = mapMaybe (chompPrefix C.autoRepairTagSuspended) tags |
| futureTs = filter (> time) . map (flip TOD 0) $ |
| mapMaybe (tryRead "auto-repair suspend time") suspended |
| in |
| case () of |
| -- Note how we must return ArSuspended even if "enabled" is empty, so that |
| -- node groups or instances can suspend repairs that were enabled at an |
| -- upper scope (cluster or node group). |
| _ | "" `elem` suspended -> Just $ ArSuspended Forever |
| | not $ null futureTs -> Just . ArSuspended . Until . maximum $ futureTs |
| | not $ null enabled -> Just $ ArEnabled (minimum enabled) |
| | otherwise -> Nothing |
| |
| -- | Compute the longest common suffix of a list of strings that |
| -- starts with a dot. |
| longestDomain :: [String] -> String |
| longestDomain [] = "" |
| longestDomain (x:xs) = |
| foldr (\ suffix accu -> if all (isSuffixOf suffix) xs |
| then suffix |
| else accu) |
| "" $ filter (isPrefixOf ".") (tails x) |
| |
| -- | Extracts the exclusion tags from the cluster configuration. |
| extractExTags :: [String] -> [String] |
| extractExTags = filter (not . null) . mapMaybe (chompPrefix 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 |
| -> [String] -- ^ Exclusion tags |
| -> [String] -- ^ Selected instances (if not empty) |
| -> [String] -- ^ Excluded instances |
| -> ClockTime -- ^ The current timestamp |
| -> ClusterData -- ^ Data from backends |
| -> Result ClusterData -- ^ Fixed cluster data |
| mergeData um extags selinsts exinsts time cdata@(ClusterData gl nl il ctags _) = |
| let il2 = setArPolicy ctags gl nl il time |
| 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 ctags |
| inst_names = map Instance.name $ Container.elems il3 |
| selinst_lkp = map (lookupName inst_names) selinsts |
| exinst_lkp = map (lookupName inst_names) exinsts |
| lkp_unknown = filter (not . goodLookupResult) (selinst_lkp ++ exinst_lkp) |
| selinst_names = map lrContent selinst_lkp |
| exinst_names = map lrContent exinst_lkp |
| node_names = map Node.name (Container.elems nl) |
| common_suffix = longestDomain (node_names ++ inst_names) |
| il4 = Container.map (computeAlias common_suffix . |
| updateExclTags allextags . |
| updateMovable selinst_names exinst_names) il3 |
| nl2 = foldl' fixNodes nl (Container.elems il4) |
| nl3 = Container.map (setNodePolicy gl . |
| computeAlias common_suffix . |
| (`Node.buildPeers` il4)) nl2 |
| il5 = Container.map (disableSplitMoves nl3) il4 |
| in if' (null lkp_unknown) |
| (Ok cdata { cdNodes = nl3, cdInstances = il5 }) |
| (Bad $ "Unknown instance(s): " ++ show(map lrContent lkp_unknown)) |
| |
| -- | In a cluster description, clear dynamic utilisation information. |
| clearDynU :: ClusterData -> Result ClusterData |
| clearDynU cdata@(ClusterData _ _ il _ _) = |
| let il2 = Container.map (\ inst -> inst {Instance.util = zeroUtil }) il |
| in Ok cdata { cdInstances = il2 } |
| |
| -- | Checks the cluster data for consistency. |
| 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 Instance.instanceDown 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 = |
| 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):msgs |
| else msgs |
| in (umsg1, newn) |
| ) [] nl |
| |
| -- | Compute the amount of memory used by primary instances on a node. |
| nodeImem :: Node.Node -> Instance.List -> Int |
| nodeImem node il = |
| let rfind = flip Container.find il |
| il' = map rfind $ Node.pList node |
| oil' = filter Instance.notOffline il' |
| in sum . map Instance.mem $ oil' |
| |
| |
| -- | Compute the amount of disk used by instances on a node (either primary |
| -- or secondary). |
| 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 |
| |
| -- | Get live information or a default value |
| eitherLive :: (Monad m) => Bool -> a -> m a -> m a |
| eitherLive True _ live_data = live_data |
| eitherLive False def_data _ = return def_data |
