Fix hspace's KM metrics

[ganeti-local] / Ganeti / HTools / Loader.hs

diff --git a/Ganeti/HTools/Loader.hs b/Ganeti/HTools/Loader.hs
index c1ad0a7..33e49f0 100644 (file)
--- a/Ganeti/HTools/Loader.hs
+++ b/Ganeti/HTools/Loader.hs
@@ -48,9 +48,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.
@@ -60,10 +66,11 @@ 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] String
     deriving (Show)
 
 -- * Functions
@@ -118,10 +125,18 @@ fixNodes accu inst =
 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
@@ -136,14 +151,21 @@ longestDomain (x:xs) =
 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
@@ -152,7 +174,9 @@ mergeData um extags (nl, il, tags) =
                               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)
@@ -162,7 +186,10 @@ mergeData um extags (nl, il, tags) =
       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
@@ -171,7 +198,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)