{-
-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
, assignIndices
, lookupNode
, lookupInstance
- , stripSuffix
+ , lookupGroup
+ , 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
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
+-- * 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.
= 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 Group.List 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
+-- | Lookups a group into an assoc list.
+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
+
-- | 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
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
+ -> (Group.List, Node.List, Instance.List, [String])
+ -- ^ Data from backends
+ -> Result (Group.List, Node.List, Instance.List, [String])
+mergeData um extags exinsts (gl, 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 (gl, snl, sil, tags)
-- | Checks the cluster data for consistency.
checkData :: Node.List -> Instance.List
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)
projects / ganeti-local / blobdiff