Instance pinning is introduced in ganeti locations design document.
It adds new instance tag of form htools:desiredlocation:x where x is
a location tag of a desired primary node. This implemented by adding
second component to the instance locationScore.
The metric is extended with the following component:
* The number of instances tagged htools:desiredlocation:x where their
  primary node is not tagged with x.

Signed-off-by: Oleg Ponomarev <[email protected]>
---
 src/Ganeti/HTools/Cluster/Moves.hs  | 10 ++++++++--
 src/Ganeti/HTools/Instance.hs       |  4 ++++
 src/Ganeti/HTools/Loader.hs         | 21 +++++++++++++++++----
 src/Ganeti/HTools/Node.hs           |  2 +-
 src/Ganeti/HTools/Tags/Constants.hs |  7 ++++++-
 5 files changed, 36 insertions(+), 8 deletions(-)

diff --git a/src/Ganeti/HTools/Cluster/Moves.hs 
b/src/Ganeti/HTools/Cluster/Moves.hs
index 560c248..53ae4a5 100644
--- a/src/Ganeti/HTools/Cluster/Moves.hs
+++ b/src/Ganeti/HTools/Cluster/Moves.hs
@@ -57,6 +57,7 @@ instanceNodes nl inst =
       old_s = Container.find old_sdx nl
   in (old_pdx, old_sdx, old_p, old_s)
 
+
 -- | Sets the location score of an instance, given its primary
 -- and secondary node.
 setInstanceLocationScore :: Instance.Instance -- ^ the original instance
@@ -65,8 +66,13 @@ setInstanceLocationScore :: Instance.Instance -- ^ the 
original instance
                          -> Instance.Instance -- ^ the instance with the
                                               -- location score updated
 setInstanceLocationScore t p s =
-  t { Instance.locationScore =
-         Set.size $ Node.locationTags p `Set.intersection` Node.locationTags s 
}
+  t { Instance.locationScore = 
+        desiredLocationScore (Instance.dsrdLocTags t) (Node.locationTags p) +
+        Set.size (Node.locationTags p `Set.intersection` Node.locationTags s) }
+  where desiredLocationScore instTags nodeTags 
+          | Set.null instTags = 0 -- there are no desired location tags
+          | Set.null ( instTags `Set.intersection` nodeTags ) = 1
+          | otherwise = 0 -- desired location is satisfied
 
 -- | Applies an instance move to a given node list and instance.
 applyMoveEx :: Bool -- ^ whether to ignore soft errors
diff --git a/src/Ganeti/HTools/Instance.hs b/src/Ganeti/HTools/Instance.hs
index 6cf062e..b0c9ef4 100644
--- a/src/Ganeti/HTools/Instance.hs
+++ b/src/Ganeti/HTools/Instance.hs
@@ -70,6 +70,7 @@ module Ganeti.HTools.Instance
   ) where
 
 import Control.Monad (liftM2)
+import qualified Data.Set as Set
 
 import Ganeti.BasicTypes
 import qualified Ganeti.HTools.Types as T
@@ -103,8 +104,10 @@ data Instance = Instance
   , spindleUse   :: Int       -- ^ The numbers of used spindles
   , allTags      :: [String]  -- ^ List of all instance tags
   , exclTags     :: [String]  -- ^ List of instance exclusion tags
+  , dsrdLocTags  :: Set.Set String -- ^ Instance desired location tags
   , locationScore :: Int      -- ^ The number of common-failures between
                               -- primary and secondary node of the instance
+                              -- plus one for unsatisfied desired location
   , arPolicy     :: T.AutoRepairPolicy -- ^ Instance's auto-repair policy
   , nics         :: [Nic]     -- ^ NICs of the instance
   , forthcoming  :: Bool      -- ^ Is the instance is forthcoming?
@@ -209,6 +212,7 @@ create name_init mem_init dsk_init disks_init vcpus_init 
run_init tags_init
            , spindleUse = su
            , allTags = tags_init
            , exclTags = []
+           , dsrdLocTags = Set.empty
            , locationScore = 0
            , arPolicy = T.ArNotEnabled
            , nics = nics_init
diff --git a/src/Ganeti/HTools/Loader.hs b/src/Ganeti/HTools/Loader.hs
index 35f3e9f..2c9e06e 100644
--- a/src/Ganeti/HTools/Loader.hs
+++ b/src/Ganeti/HTools/Loader.hs
@@ -59,6 +59,7 @@ import Control.Monad
 import Data.List
 import qualified Data.Map as M
 import Data.Maybe
+import qualified Data.Set as Set
 import Text.Printf (printf)
 import System.Time (ClockTime(..))
 
@@ -208,6 +209,12 @@ updateExclTags tl inst =
       exclTags = filter (\tag -> any (`isPrefixOf` tag) tl) allTags
   in inst { Instance.exclTags = exclTags }
 
+-- | Update instance with desired location tags list.
+updateDesiredLocationTags :: [String] -> Instance.Instance -> Instance.Instance
+updateDesiredLocationTags tl inst =
+  inst { Instance.dsrdLocTags = extractDesiredLocations tl }
+
+
 -- | Update the movable attribute.
 updateMovable :: [String]           -- ^ Selected instances (if not empty)
               -> [String]           -- ^ Excluded instances
@@ -281,6 +288,11 @@ longestDomain (x:xs) =
 extractExTags :: [String] -> [String]
 extractExTags = filter (not . null) . mapMaybe (chompPrefix TagsC.exTagsPrefix)
 
+-- | Extracts the desired locations from the instance tags.
+extractDesiredLocations :: [String] -> Set.Set String
+extractDesiredLocations = Set.fromList . 
+  filter (not . null) . mapMaybe (chompPrefix TagsC.desiredLocationPrefix)
+
 -- | Extracts the common suffix from node\/instance names.
 commonSuffix :: Node.List -> Instance.List -> String
 commonSuffix nl il =
@@ -337,15 +349,16 @@ mergeData um extags selinsts exinsts time 
cdata@(ClusterData gl nl il ctags _) =
                            updateExclTags allextags .
                            updateMovable selinst_names exinst_names) il3
       nl2 = Container.map (addLocationTags ctags) nl
-      il5 = Container.map (setLocationScore nl2) il4
-      nl3 = foldl' fixNodes nl2 (Container.elems il5)
+      il5 = Container.map (updateDesiredLocationTags ctags) il4
+      il6 = Container.map (setLocationScore nl2) il5
+      nl3 = foldl' fixNodes nl2 (Container.elems il6)
       nl4 = Container.map (setNodePolicy gl .
                            computeAlias common_suffix .
                            (`Node.buildPeers` il4)) nl3
-      il6 = Container.map (disableSplitMoves nl3) il5
+      il7 = Container.map (disableSplitMoves nl3) il6
       nl5 = Container.map (addMigrationTags ctags) nl4
   in if' (null lkp_unknown)
-         (Ok cdata { cdNodes = nl5, cdInstances = il6 })
+         (Ok cdata { cdNodes = nl5, cdInstances = il7 })
          (Bad $ "Unknown instance(s): " ++ show(map lrContent lkp_unknown))
 
 -- | In a cluster description, clear dynamic utilisation information.
diff --git a/src/Ganeti/HTools/Node.hs b/src/Ganeti/HTools/Node.hs
index fd3b33a..fbe2466 100644
--- a/src/Ganeti/HTools/Node.hs
+++ b/src/Ganeti/HTools/Node.hs
@@ -208,7 +208,7 @@ data Node = Node
   , rmigTags :: Set.Set String -- ^ migration tags able to receive
   , locationTags :: Set.Set String -- ^ common-failure domains the node belongs
                                    -- to
-  , locationScore :: Int
+  , locationScore :: Int -- ^ Sum of instance location score
   } deriving (Show, Eq)
 {- A note on how we handle spindles
 
diff --git a/src/Ganeti/HTools/Tags/Constants.hs 
b/src/Ganeti/HTools/Tags/Constants.hs
index 47bf8db..3b741ac 100644
--- a/src/Ganeti/HTools/Tags/Constants.hs
+++ b/src/Ganeti/HTools/Tags/Constants.hs
@@ -43,6 +43,7 @@ module Ganeti.HTools.Tags.Constants
   , migrationPrefix
   , allowMigrationPrefix
   , locationPrefix
+  , desiredLocationPrefix
   , standbyAuto
   , autoRepairTagPrefix
   , autoRepairTagEnabled
@@ -70,10 +71,14 @@ migrationPrefix = "htools:migration:"
 allowMigrationPrefix :: String
 allowMigrationPrefix = "htools:allowmigration:"
 
--- | The prefix for location tags.
+-- | The prefix for node location tags.
 locationPrefix :: String
 locationPrefix = "htools:nlocation:"
 
+-- | The prefix for instance desired location tags.
+desiredLocationPrefix :: String
+desiredLocationPrefix = "htools:desiredlocation:"
+
 -- | The tag to be added to nodes that were shutdown by hsqueeze.
 standbyAuto :: String
 standbyAuto = "htools:standby:auto"
-- 
1.9.1

Reply via email to