Add Cluster.splitCluster for node groups

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

diff --git a/Ganeti/HTools/Loader.hs b/Ganeti/HTools/Loader.hs
index b737a46..a0db67a 100644 (file)
--- a/Ganeti/HTools/Loader.hs
+++ b/Ganeti/HTools/Loader.hs
@@ -32,7 +32,7 @@ module Ganeti.HTools.Loader
     , assignIndices
     , lookupNode
     , lookupInstance
-    , stripSuffix
+    , commonSuffix
     , RqType(..)
     , Request(..)
     ) where
@@ -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]
     deriving (Show)
 
 -- * Functions
@@ -114,6 +121,22 @@ fixNodes accu inst =
            in (sdx, snew):ac3
       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
@@ -124,18 +147,28 @@ 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
+          -> [String]             -- ^ Exclusion tags
+          -> [String]             -- ^ Untouchable instances
+          -> (Node.AssocList, Instance.AssocList, [String])
+          -- ^ Data from backends
+          -> Result (Node.List, Instance.List, [String])
+mergeData um extags exinsts (nl, il, tags) =
   let il2 = Container.fromAssocList il
       il3 = foldl' (\im (name, n_util) ->
                         case Container.findByName im name of
@@ -144,16 +177,22 @@ mergeData um (nl, il) = do
                               let new_i = inst { Instance.util = n_util }
                               in 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
+      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)
+      node_names = map (Node.name . snd) nl
+      inst_names = map (Instance.name . snd) 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
@@ -162,7 +201,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)