, 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.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
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