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 Node.List Instance.List [String] String
deriving (Show)
-- * Functions
filterExTags :: [String] -> Instance.Instance -> Instance.Instance
filterExTags tl inst =
let old_tags = Instance.tags inst
- new_tags = filter (\tag -> any (\extag -> isPrefixOf extag tag) tl)
+ 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
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)
+
-- | 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] -- ^ Untouchable instances
-> (Node.AssocList, Instance.AssocList, [String])
-- ^ Data from backends
-> Result (Node.List, Instance.List, [String], String)
-mergeData um extags (nl, il, tags) =
+mergeData um extags exinsts (nl, il, tags) =
let il2 = Container.fromAssocList il
il3 = foldl' (\im (name, n_util) ->
case Container.findByName im name of
let new_i = inst { Instance.util = n_util }
in Container.add (Instance.idx inst) new_i im
) il2 um
- il4 = Container.map (filterExTags extags) il3
+ allextags = extags ++ extractExTags tags
+ il4 = Container.map (filterExTags allextags .
+ updateMovable exinsts) il3
nl2 = foldl' fixNodes nl (Container.elems il4)
nl3 = Container.fromAssocList
(map (\ (k, v) -> (k, Node.buildPeers v il4)) nl2)
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)) il4
- in Ok (snl, sil, tags, common_suffix)
+ in if not $ all (`elem` inst_names) exinsts
+ then Bad $ "Some of the excluded instances are unknown: " ++
+ show (exinsts \\ inst_names)
+ else Ok (snl, sil, tags, common_suffix)
-- | 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)