Add a command-line option to filter exclusion tags

Since we don't want all instance tags to be used for exclusion, we add a
command line option to filter on these. Since the iallocator protocol
cannot accept command line options, currently it's not possible to
specify these for hail, and thus it will never use any exclusion tags.

Ganeti/HTools/CLI.hs

@@ -59,6 +59,7 @@ module Ganeti.HTools.CLI
     , oDiskMoves
     , oDynuFile
     , oTieredSpec
+    , oExTags
     , oShowVer
     , oShowHelp
     ) where
@@ -106,6 +107,7 @@ data Options = Options
     , optMdsk        :: Double         -- ^ Max disk usage ratio for nodes
     , optDiskMoves   :: Bool           -- ^ Allow disk moves
     , optDynuFile    :: Maybe FilePath -- ^ Optional file with dynamic use data
+    , optExTags      :: Maybe [String] -- ^ Tags to use for exclusion
     , optVerbose     :: Int            -- ^ Verbosity level
     , optShowVer     :: Bool           -- ^ Just show the program version
     , optShowHelp    :: Bool           -- ^ Just show the help
@@ -138,6 +140,7 @@ defaultOptions  = Options
  , optMdsk        = -1
  , optDiskMoves   = True
  , optDynuFile    = Nothing
+ , optExTags      = Nothing
  , optVerbose     = 1
  , optShowVer     = False
  , optShowHelp    = False
@@ -293,6 +296,11 @@ oDynuFile = Option "U" ["dynu-file"]
             (ReqArg (\ f opts -> Ok opts { optDynuFile = Just f }) "FILE")
             "Import dynamic utilisation data from the given FILE"
 
+oExTags :: OptType
+oExTags = Option "" ["exclusion-tags"]
+            (ReqArg (\ f opts -> Ok opts { optExTags = Just $ sepSplit ',' f })
+             "TAG,...") "Enable instance exclusion based on given tag prefix"
+
 oTieredSpec :: OptType
 oTieredSpec = Option "" ["tiered-alloc"]
              (ReqArg (\ inp opts -> do

Ganeti/HTools/ExtLoader.hs

@@ -98,6 +98,10 @@ loadExternalData opts = do
       setSim = isJust simdata
       setFiles = optNodeSet opts || optInstSet opts
       allSet = filter id [setRapi, setLuxi, setFiles]
+      exTags = case optExTags opts of
+                 Nothing -> []
+                 Just etl -> map (++ ":") etl
+
   when (length allSet > 1) $
        do
          hPutStrLn stderr ("Error: Only one of the rapi, luxi, and data" ++
@@ -126,7 +130,7 @@ loadExternalData opts = do
           | setSim -> Simu.loadData $ fromJust simdata
           | otherwise -> wrapIO $ Text.loadData nodef instf
 
-  let ldresult = input_data >>= Loader.mergeData util_data'
+  let ldresult = input_data >>= Loader.mergeData util_data' exTags
   (loaded_nl, il, csf) <-
       (case ldresult of
          Ok x -> return x

Ganeti/HTools/IAlloc.hs

@@ -110,7 +110,7 @@ parseData body = do
   iobj <- mapM (\(x,y) ->
                     asJSObject y >>= parseInstance ktn x . fromJSObject) idata
   let (kti, il) = assignIndices iobj
-  (map_n, map_i, csf) <- mergeData [] (nl, il)
+  (map_n, map_i, csf) <- mergeData [] [] (nl, il)
   req_nodes <- fromObj "required_nodes" request
   optype <- fromObj "type" request
   rqtype <-

Ganeti/HTools/Loader.hs

@@ -114,6 +114,14 @@ 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 (\extag -> isPrefixOf extag tag) tl)
+                   old_tags
+    in inst { Instance.tags = new_tags }
+
 -- | Compute the longest common suffix of a list of strings that
 -- | starts with a dot.
 longestDomain :: [String] -> String
@@ -131,11 +139,12 @@ stripSuffix sflen name = take (length name - sflen) name
 -- | 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
           -> (Node.AssocList,
               Instance.AssocList) -- ^ Data from either Text.loadData
                                   -- or Rapi.loadData
           -> Result (Node.List, Instance.List, String)
-mergeData um (nl, il) =
+mergeData um extags (nl, il) =
   let il2 = Container.fromAssocList il
       il3 = foldl' (\im (name, n_util) ->
                         case Container.findByName im name of
@@ -144,15 +153,16 @@ mergeData um (nl, il) =
                               let new_i = inst { Instance.util = n_util }
                               in Container.add (Instance.idx inst) new_i im
                    ) il2 um
-      nl2 = foldl' fixNodes nl (Container.elems il3)
+      il4 = Container.map (filterExTags extags) il3
+      nl2 = foldl' fixNodes nl (Container.elems il4)
       nl3 = Container.fromAssocList
-            (map (\ (k, v) -> (k, Node.buildPeers v il3)) nl2)
+            (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
+      sil = Container.map (\i -> setName i (stripSuffix csl $ nameOf i)) il4
   in Ok (snl, sil, common_suffix)
 
 -- | Checks the cluster data for consistency.

hbal.hs

@@ -73,6 +73,7 @@ options =
     , oMinDisk
     , oDiskMoves
     , oDynuFile
+    , oExTags
     , oShowVer
     , oShowHelp
     ]

hscan.hs

@@ -137,7 +137,7 @@ main = do
               printf "%-*s " nlen name
               hFlush stdout
               input_data <- Rapi.loadData name
-              let ldresult = input_data >>= Loader.mergeData []
+              let ldresult = input_data >>= Loader.mergeData [] []
               (case ldresult of
                  Bad err -> printf "\nError: failed to load data. \
                                    \Details:\n%s\n" err