Move part of the loader pipeline to ClusterData
[ganeti-local] / Ganeti / HTools / Node.hs
index f7f316f..73162e6 100644 (file)
@@ -6,7 +6,7 @@
 
 {-
 
-Copyright (C) 2009 Google Inc.
+Copyright (C) 2009, 2010 Google Inc.
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -49,7 +49,9 @@ module Ganeti.HTools.Node
     , removePri
     , removeSec
     , addPri
+    , addPriEx
     , addSec
+    , addSecEx
     -- * Stats
     , availDisk
     , availMem
@@ -64,11 +66,13 @@ module Ganeti.HTools.Node
     , AssocList
     , AllocElement
     , noSecondary
+    , computeGroups
     ) where
 
-import Data.List
+import Data.List hiding (group)
 import qualified Data.Map as Map
 import qualified Data.Foldable as Foldable
+import Data.Ord (comparing)
 import Text.Printf (printf)
 
 import qualified Ganeti.HTools.Container as Container
@@ -117,7 +121,8 @@ data Node = Node
     , utilPool :: T.DynUtil -- ^ Total utilisation capacity
     , utilLoad :: T.DynUtil -- ^ Sum of instance utilisation
     , pTags    :: TagMap    -- ^ Map of primary instance tags and their count
-    } deriving (Show)
+    , group    :: T.Gdx     -- ^ The node's group (index)
+    } deriving (Show, Eq)
 
 instance T.Element Node where
     nameOf = name
@@ -134,7 +139,7 @@ type List = Container.Container Node
 
 -- | A simple name for an allocation element (here just for logistic
 -- reasons)
-type AllocElement = (List, Instance.Instance, [Node])
+type AllocElement = (List, Instance.Instance, [Node], T.Score)
 
 -- | Constant node index for a non-moveable instance.
 noSecondary :: T.Ndx
@@ -180,9 +185,9 @@ conflictingPrimaries (Node { pTags = t }) = Foldable.sum t - Map.size t
 -- The index and the peers maps are empty, and will be need to be
 -- update later via the 'setIdx' and 'buildPeers' functions.
 create :: String -> Double -> Int -> Int -> Double
-       -> Int -> Double -> Bool -> Node
+       -> Int -> Double -> Bool -> T.Gdx -> Node
 create name_init mem_t_init mem_n_init mem_f_init
-       dsk_t_init dsk_f_init cpu_t_init offline_init =
+       dsk_t_init dsk_f_init cpu_t_init offline_init group_init =
     Node { name = name_init
          , alias = name_init
          , tMem = mem_t_init
@@ -211,6 +216,7 @@ create name_init mem_t_init mem_n_init mem_f_init
          , utilPool = T.baseUtil
          , utilLoad = T.zeroUtil
          , pTags = Map.empty
+         , group = group_init
          }
 
 -- | Conversion formula from mDsk\/tDsk to loDsk
@@ -339,9 +345,21 @@ removeSec t inst =
          , failN1 = new_failn1, rMem = new_rmem, pDsk = new_dp
          , pRem = new_prem, utilLoad = new_load }
 
--- | Adds a primary instance.
+-- | Adds a primary instance (basic version).
 addPri :: Node -> Instance.Instance -> T.OpResult Node
-addPri t inst =
+addPri = addPriEx False
+
+-- | Adds a primary instance (extended version).
+addPriEx :: Bool               -- ^ Whether to override the N+1 and
+                               -- other /soft/ checks, useful if we
+                               -- come from a worse status
+                               -- (e.g. offline)
+         -> Node               -- ^ The target node
+         -> Instance.Instance  -- ^ The instance to add
+         -> T.OpResult Node    -- ^ The result of the operation,
+                               -- either the new version of the node
+                               -- or a failure mode
+addPriEx force t inst =
     let iname = Instance.idx inst
         new_mem = fMem t - Instance.mem inst
         new_dsk = fDsk t - Instance.dsk inst
@@ -353,11 +371,13 @@ addPri t inst =
         new_load = utilLoad t `T.addUtil` Instance.util inst
         inst_tags = Instance.tags inst
         old_tags = pTags t
+        strict = not force
     in case () of
          _ | new_mem <= 0 -> T.OpFail T.FailMem
-           | new_dsk <= 0 || mDsk t > new_dp -> T.OpFail T.FailDisk
-           | new_failn1 && not (failN1 t) -> T.OpFail T.FailMem
-           | l_cpu >= 0 && l_cpu < new_pcpu -> T.OpFail T.FailCPU
+           | new_dsk <= 0 -> T.OpFail T.FailDisk
+           | mDsk t > new_dp && strict -> T.OpFail T.FailDisk
+           | new_failn1 && not (failN1 t) && strict -> T.OpFail T.FailMem
+           | l_cpu >= 0 && l_cpu < new_pcpu && strict -> T.OpFail T.FailCPU
            | rejectAddTags old_tags inst_tags -> T.OpFail T.FailTags
            | otherwise ->
                let new_plist = iname:pList t
@@ -369,9 +389,13 @@ addPri t inst =
                          , pTags = addTags old_tags inst_tags }
                in T.OpGood r
 
--- | Adds a secondary instance.
+-- | Adds a secondary instance (basic version).
 addSec :: Node -> Instance.Instance -> T.Ndx -> T.OpResult Node
-addSec t inst pdx =
+addSec = addSecEx False
+
+-- | Adds a secondary instance (extended version).
+addSecEx :: Bool -> Node -> Instance.Instance -> T.Ndx -> T.OpResult Node
+addSecEx force t inst pdx =
     let iname = Instance.idx inst
         old_peers = peers t
         old_mem = fMem t
@@ -385,10 +409,12 @@ addSec t inst pdx =
         old_load = utilLoad t
         new_load = old_load { T.dskWeight = T.dskWeight old_load +
                                             T.dskWeight (Instance.util inst) }
+        strict = not force
     in case () of
-         _ | new_dsk <= 0 || mDsk t > new_dp -> T.OpFail T.FailDisk
-           | Instance.mem inst >= old_mem -> T.OpFail T.FailMem
-           | new_failn1 && not (failN1 t) -> T.OpFail T.FailMem
+         _ | new_dsk <= 0 -> T.OpFail T.FailDisk
+           | mDsk t > new_dp && strict -> T.OpFail T.FailDisk
+           | Instance.mem inst >= old_mem && strict -> T.OpFail T.FailMem
+           | new_failn1 && not (failN1 t) && strict -> T.OpFail T.FailMem
            | otherwise ->
                let new_slist = iname:sList t
                    r = t { sList = new_slist, fDsk = new_dsk
@@ -499,6 +525,7 @@ showHeader field =
       "nload" -> ("lNet", True)
       "ptags" -> ("PrimaryTags", False)
       "peermap" -> ("PeerMap", False)
+      -- TODO: add node fields (group.uuid, group)
       _ -> (T.unknownField, False)
 
 -- | String converter for the node list functionality.
@@ -512,3 +539,11 @@ defaultFields =
     , "rmem", "tdsk", "fdsk", "tcpu", "ucpu", "pcnt", "scnt"
     , "pfmem", "pfdsk", "rcpu"
     , "cload", "mload", "dload", "nload" ]
+
+-- | Split a list of nodes into a list of (node group UUID, list of
+-- associated nodes)
+computeGroups :: [Node] -> [(T.Gdx, [Node])]
+computeGroups nodes =
+  let nodes' = sortBy (comparing group) nodes
+      nodes'' = groupBy (\a b -> group a == group b) nodes'
+  in map (\nl -> (group (head nl), nl)) nodes''