, splitCluster
) where
+import Control.Applicative (liftA2)
+import Control.Arrow ((&&&))
import qualified Data.IntSet as IntSet
import Data.List
-import Data.Maybe (fromJust, isNothing)
+import Data.Maybe (fromJust, fromMaybe, isJust, isNothing)
import Data.Ord (comparing)
import Text.Printf (printf)
import Ganeti.BasicTypes
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Instance as Instance
+import qualified Ganeti.HTools.Nic as Nic
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Group as Group
import Ganeti.HTools.Types
import Ganeti.Compat
import qualified Ganeti.OpCodes as OpCodes
import Ganeti.Utils
-import Ganeti.Types (mkNonEmpty)
+import Ganeti.Types (EvacMode(..), mkNonEmpty)
-- * Types
data CStats = CStats
{ csFmem :: Integer -- ^ Cluster free mem
, csFdsk :: Integer -- ^ Cluster free disk
+ , csFspn :: Integer -- ^ Cluster free spindles
, csAmem :: Integer -- ^ Cluster allocatable mem
, csAdsk :: Integer -- ^ Cluster allocatable disk
, csAcpu :: Integer -- ^ Cluster allocatable cpus
, csMcpu :: Integer -- ^ Max node allocatable cpu
, csImem :: Integer -- ^ Instance used mem
, csIdsk :: Integer -- ^ Instance used disk
+ , csIspn :: Integer -- ^ Instance used spindles
, csIcpu :: Integer -- ^ Instance used cpu
, csTmem :: Double -- ^ Cluster total mem
, csTdsk :: Double -- ^ Cluster total disk
+ , csTspn :: Double -- ^ Cluster total spindles
, csTcpu :: Double -- ^ Cluster total cpus
, csVcpu :: Integer -- ^ Cluster total virtual cpus
, csNcpu :: Double -- ^ Equivalent to 'csIcpu' but in terms of
-- | Zero-initializer for the CStats type.
emptyCStats :: CStats
-emptyCStats = CStats 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+emptyCStats = CStats 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
-- | Update stats with data from a new node.
updateCStats :: CStats -> Node.Node -> CStats
csImem = x_imem, csIdsk = x_idsk, csIcpu = x_icpu,
csTmem = x_tmem, csTdsk = x_tdsk, csTcpu = x_tcpu,
csVcpu = x_vcpu, csNcpu = x_ncpu,
- csXmem = x_xmem, csNmem = x_nmem, csNinst = x_ninst
+ csXmem = x_xmem, csNmem = x_nmem, csNinst = x_ninst,
+ csFspn = x_fspn, csIspn = x_ispn, csTspn = x_tspn
}
= cs
inc_amem = Node.fMem node - Node.rMem node
- Node.xMem node - Node.fMem node
inc_icpu = Node.uCpu node
inc_idsk = truncate (Node.tDsk node) - Node.fDsk node
+ inc_ispn = Node.tSpindles node - Node.fSpindles node
inc_vcpu = Node.hiCpu node
inc_acpu = Node.availCpu node
inc_ncpu = fromIntegral (Node.uCpu node) /
iPolicyVcpuRatio (Node.iPolicy node)
in cs { csFmem = x_fmem + fromIntegral (Node.fMem node)
, csFdsk = x_fdsk + fromIntegral (Node.fDsk node)
+ , csFspn = x_fspn + fromIntegral (Node.fSpindles node)
, csAmem = x_amem + fromIntegral inc_amem'
, csAdsk = x_adsk + fromIntegral inc_adsk
, csAcpu = x_acpu + fromIntegral inc_acpu
, csMcpu = max x_mcpu (fromIntegral inc_acpu)
, csImem = x_imem + fromIntegral inc_imem
, csIdsk = x_idsk + fromIntegral inc_idsk
+ , csIspn = x_ispn + fromIntegral inc_ispn
, csIcpu = x_icpu + fromIntegral inc_icpu
, csTmem = x_tmem + Node.tMem node
, csTdsk = x_tdsk + Node.tDsk node
+ , csTspn = x_tspn + fromIntegral (Node.tSpindles node)
, csTcpu = x_tcpu + Node.tCpu node
, csVcpu = x_vcpu + fromIntegral inc_vcpu
, csNcpu = x_ncpu + inc_ncpu
computeAllocationDelta :: CStats -> CStats -> AllocStats
computeAllocationDelta cini cfin =
let CStats {csImem = i_imem, csIdsk = i_idsk, csIcpu = i_icpu,
- csNcpu = i_ncpu } = cini
+ csNcpu = i_ncpu, csIspn = i_ispn } = cini
CStats {csImem = f_imem, csIdsk = f_idsk, csIcpu = f_icpu,
csTmem = t_mem, csTdsk = t_dsk, csVcpu = f_vcpu,
- csNcpu = f_ncpu, csTcpu = f_tcpu } = cfin
+ csNcpu = f_ncpu, csTcpu = f_tcpu,
+ csIspn = f_ispn, csTspn = t_spn } = cfin
rini = AllocInfo { allocInfoVCpus = fromIntegral i_icpu
, allocInfoNCpus = i_ncpu
, allocInfoMem = fromIntegral i_imem
, allocInfoDisk = fromIntegral i_idsk
+ , allocInfoSpn = fromIntegral i_ispn
}
rfin = AllocInfo { allocInfoVCpus = fromIntegral (f_icpu - i_icpu)
, allocInfoNCpus = f_ncpu - i_ncpu
, allocInfoMem = fromIntegral (f_imem - i_imem)
, allocInfoDisk = fromIntegral (f_idsk - i_idsk)
+ , allocInfoSpn = fromIntegral (f_ispn - i_ispn)
}
runa = AllocInfo { allocInfoVCpus = fromIntegral (f_vcpu - f_icpu)
, allocInfoNCpus = f_tcpu - f_ncpu
, allocInfoMem = truncate t_mem - fromIntegral f_imem
, allocInfoDisk = truncate t_dsk - fromIntegral f_idsk
+ , allocInfoSpn = truncate t_spn - fromIntegral f_ispn
}
in (rini, rfin, runa)
let p = Container.find new_pdx nl
new_inst = Instance.setBoth inst new_pdx Node.noSecondary
in do
- Instance.instMatchesPolicy inst (Node.iPolicy p)
+ Instance.instMatchesPolicy inst (Node.iPolicy p) (Node.exclStorage p)
new_p <- Node.addPri p inst
let new_nl = Container.add new_pdx new_p nl
new_score = compCV new_nl
tgt_s = Container.find new_sdx nl
in do
Instance.instMatchesPolicy inst (Node.iPolicy tgt_p)
+ (Node.exclStorage tgt_p)
new_p <- Node.addPri tgt_p inst
new_s <- Node.addSec tgt_s inst new_pdx
let new_inst = Instance.setBoth inst new_pdx new_sdx
in return $ annotateSolution sols
-- | Given a group/result, describe it as a nice (list of) messages.
-solutionDescription :: Group.List -> (Gdx, Result AllocSolution) -> [String]
-solutionDescription gl (groupId, result) =
+solutionDescription :: (Group.Group, Result AllocSolution)
+ -> [String]
+solutionDescription (grp, result) =
case result of
Ok solution -> map (printf "Group %s (%s): %s" gname pol) (asLog solution)
Bad message -> [printf "Group %s: error %s" gname message]
- where grp = Container.find groupId gl
- gname = Group.name grp
+ where gname = Group.name grp
pol = allocPolicyToRaw (Group.allocPolicy grp)
-- | From a list of possibly bad and possibly empty solutions, filter
-- only the groups with a valid result. Note that the result will be
-- reversed compared to the original list.
-filterMGResults :: Group.List
- -> [(Gdx, Result AllocSolution)]
- -> [(Gdx, AllocSolution)]
-filterMGResults gl = foldl' fn []
- where unallocable = not . Group.isAllocable . flip Container.find gl
- fn accu (gdx, rasol) =
+filterMGResults :: [(Group.Group, Result AllocSolution)]
+ -> [(Group.Group, AllocSolution)]
+filterMGResults = foldl' fn []
+ where unallocable = not . Group.isAllocable
+ fn accu (grp, rasol) =
case rasol of
Bad _ -> accu
Ok sol | isNothing (asSolution sol) -> accu
- | unallocable gdx -> accu
- | otherwise -> (gdx, sol):accu
+ | unallocable grp -> accu
+ | otherwise -> (grp, sol):accu
-- | Sort multigroup results based on policy and score.
-sortMGResults :: Group.List
- -> [(Gdx, AllocSolution)]
- -> [(Gdx, AllocSolution)]
-sortMGResults gl sols =
+sortMGResults :: [(Group.Group, AllocSolution)]
+ -> [(Group.Group, AllocSolution)]
+sortMGResults sols =
let extractScore (_, _, _, x) = x
- solScore (gdx, sol) = (Group.allocPolicy (Container.find gdx gl),
+ solScore (grp, sol) = (Group.allocPolicy grp,
(extractScore . fromJust . asSolution) sol)
in sortBy (comparing solScore) sols
+-- | Removes node groups which can't accommodate the instance
+filterValidGroups :: [(Group.Group, (Node.List, Instance.List))]
+ -> Instance.Instance
+ -> ([(Group.Group, (Node.List, Instance.List))], [String])
+filterValidGroups [] _ = ([], [])
+filterValidGroups (ng:ngs) inst =
+ let (valid_ngs, msgs) = filterValidGroups ngs inst
+ hasNetwork nic = case Nic.network nic of
+ Just net -> net `elem` Group.networks (fst ng)
+ Nothing -> True
+ hasRequiredNetworks = all hasNetwork (Instance.nics inst)
+ in if hasRequiredNetworks
+ then (ng:valid_ngs, msgs)
+ else (valid_ngs,
+ ("group " ++ Group.name (fst ng) ++
+ " is not connected to a network required by instance " ++
+ Instance.name inst):msgs)
+
-- | Finds the best group for an instance on a multi-group cluster.
--
-- Only solutions in @preferred@ and @last_resort@ groups will be
-> Maybe [Gdx] -- ^ The allowed groups
-> Instance.Instance -- ^ The instance to allocate
-> Int -- ^ Required number of nodes
- -> Result (Gdx, AllocSolution, [String])
+ -> Result (Group.Group, AllocSolution, [String])
findBestAllocGroup mggl mgnl mgil allowed_gdxs inst cnt =
- let groups = splitCluster mgnl mgil
- groups' = maybe groups (\gs -> filter ((`elem` gs) . fst) groups)
+ let groups_by_idx = splitCluster mgnl mgil
+ groups = map (\(gid, d) -> (Container.find gid mggl, d)) groups_by_idx
+ groups' = maybe groups
+ (\gs -> filter ((`elem` gs) . Group.idx . fst) groups)
allowed_gdxs
- sols = map (\(gid, (nl, il)) ->
- (gid, genAllocNodes mggl nl cnt False >>=
- tryAlloc nl il inst))
- groups'::[(Gdx, Result AllocSolution)]
- all_msgs = concatMap (solutionDescription mggl) sols
- goodSols = filterMGResults mggl sols
- sortedSols = sortMGResults mggl goodSols
+ (groups'', filter_group_msgs) = filterValidGroups groups' inst
+ sols = map (\(gr, (nl, il)) ->
+ (gr, genAllocNodes mggl nl cnt False >>=
+ tryAlloc nl il inst))
+ groups''::[(Group.Group, Result AllocSolution)]
+ all_msgs = filter_group_msgs ++ concatMap solutionDescription sols
+ goodSols = filterMGResults sols
+ sortedSols = sortMGResults goodSols
in case sortedSols of
[] -> Bad $ if null groups'
then "no groups for evacuation: allowed groups was" ++
tryMGAlloc mggl mgnl mgil inst cnt = do
(best_group, solution, all_msgs) <-
findBestAllocGroup mggl mgnl mgil Nothing inst cnt
- let group_name = Group.name $ Container.find best_group mggl
+ let group_name = Group.name best_group
selmsg = "Selected group: " ++ group_name
return $ solution { asLog = selmsg:all_msgs }
let solution = do
let ncnt = Instance.requiredNodes $
Instance.diskTemplate inst
- (gdx, _, _) <- findBestAllocGroup gl nl il
+ (grp, _, _) <- findBestAllocGroup gl nl il
(Just target_gdxs) inst ncnt
+ let gdx = Group.idx grp
av_nodes <- availableGroupNodes group_ndx
excl_ndx gdx
nodeEvacInstance nl il ChangeAll inst gdx av_nodes
newlimit newinst allocnodes (xi:ixes)
(totalResources xnl:cstats)
+-- | Predicate whether shrinking a single resource can lead to a valid
+-- allocation.
+sufficesShrinking :: (Instance.Instance -> AllocSolution) -> Instance.Instance
+ -> FailMode -> Maybe Instance.Instance
+sufficesShrinking allocFn inst fm =
+ case dropWhile (isNothing . asSolution . fst)
+ . takeWhile (liftA2 (||) (elem fm . asFailures . fst)
+ (isJust . asSolution . fst))
+ . map (allocFn &&& id) $
+ iterateOk (`Instance.shrinkByType` fm) inst
+ of x:_ -> Just . snd $ x
+ _ -> Nothing
+
-- | Tiered allocation method.
--
-- This places instances on the cluster, and decreases the spec until
(stop, newlimit) = case limit of
Nothing -> (False, Nothing)
Just n -> (n <= ixes_cnt,
- Just (n - ixes_cnt)) in
- if stop then newsol else
- case Instance.shrinkByType newinst . fst . last $
- sortBy (comparing snd) errs of
- Bad _ -> newsol
- Ok newinst' -> tieredAlloc nl' il' newlimit
- newinst' allocnodes ixes' cstats'
+ Just (n - ixes_cnt))
+ sortedErrs = map fst $ sortBy (comparing snd) errs
+ suffShrink = sufficesShrinking (fromMaybe emptyAllocSolution
+ . flip (tryAlloc nl' il') allocnodes)
+ newinst
+ bigSteps = filter isJust . map suffShrink . reverse $ sortedErrs
+ in if stop then newsol else
+ case bigSteps of
+ Just newinst':_ -> tieredAlloc nl' il' newlimit
+ newinst' allocnodes ixes' cstats'
+ _ -> case Instance.shrinkByType newinst . last $ sortedErrs of
+ Bad _ -> newsol
+ Ok newinst' -> tieredAlloc nl' il' newlimit
+ newinst' allocnodes ixes' cstats'
-- * Formatting functions
Ok ne -> Just ne
opF = OpCodes.OpInstanceMigrate
{ OpCodes.opInstanceName = iname
+ , OpCodes.opInstanceUuid = Nothing
, OpCodes.opMigrationMode = Nothing -- default
, OpCodes.opOldLiveMode = Nothing -- default as well
, OpCodes.opTargetNode = Nothing -- this is drbd
+ , OpCodes.opTargetNodeUuid = Nothing
, OpCodes.opAllowRuntimeChanges = False
, OpCodes.opIgnoreIpolicy = False
, OpCodes.opMigrationCleanup = False
opFA n = opF { OpCodes.opTargetNode = lookNode n } -- not drbd
opR n = OpCodes.OpInstanceReplaceDisks
{ OpCodes.opInstanceName = iname
+ , OpCodes.opInstanceUuid = Nothing
, OpCodes.opEarlyRelease = False
, OpCodes.opIgnoreIpolicy = False
, OpCodes.opReplaceDisksMode = OpCodes.ReplaceNewSecondary
, OpCodes.opReplaceDisksList = []
, OpCodes.opRemoteNode = lookNode n
+ , OpCodes.opRemoteNodeUuid = Nothing
, OpCodes.opIallocator = Nothing
}
in case move of
[(Gdx, (Node.List, Instance.List))]
splitCluster nl il =
let ngroups = Node.computeGroups (Container.elems nl)
- in map (\(guuid, nodes) ->
+ in map (\(gdx, nodes) ->
let nidxs = map Node.idx nodes
nodes' = zip nidxs nodes
instances = Container.filter ((`elem` nidxs) . Instance.pNode) il
- in (guuid, (Container.fromList nodes', instances))) ngroups
+ in (gdx, (Container.fromList nodes', instances))) ngroups
-- | Compute the list of nodes that are to be evacuated, given a list
-- of instances and an evacuation mode.
projects / ganeti-local / blobdiff