{-
-Copyright (C) 2009, 2010, 2011 Google Inc.
+Copyright (C) 2009, 2010, 2011, 2012 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
, EvacSolution(..)
, Table(..)
, CStats(..)
- , AllocStats
, AllocResult
, AllocMethod
-- * Generic functions
, genAllocNodes
, tryAlloc
, tryMGAlloc
- , tryReloc
, tryNodeEvac
, tryChangeGroup
, collapseFailures
, esFailed :: [(Idx, String)] -- ^ Instances which were not
-- relocated
, esOpCodes :: [[OpCodes.OpCode]] -- ^ List of jobs
- }
+ } deriving (Show)
-- | Allocation results, as used in 'iterateAlloc' and 'tieredAlloc'.
type AllocResult = (FailStats, Node.List, Instance.List,
deriving (Show, Read)
-- | Cluster statistics data type.
-data CStats = CStats { csFmem :: Integer -- ^ Cluster free mem
- , csFdsk :: Integer -- ^ Cluster free disk
- , csAmem :: Integer -- ^ Cluster allocatable mem
- , csAdsk :: Integer -- ^ Cluster allocatable disk
- , csAcpu :: Integer -- ^ Cluster allocatable cpus
- , csMmem :: Integer -- ^ Max node allocatable mem
- , csMdsk :: Integer -- ^ Max node allocatable disk
- , csMcpu :: Integer -- ^ Max node allocatable cpu
- , csImem :: Integer -- ^ Instance used mem
- , csIdsk :: Integer -- ^ Instance used disk
- , csIcpu :: Integer -- ^ Instance used cpu
- , csTmem :: Double -- ^ Cluster total mem
- , csTdsk :: Double -- ^ Cluster total disk
- , csTcpu :: Double -- ^ Cluster total cpus
- , csVcpu :: Integer -- ^ Cluster virtual cpus (if
- -- node pCpu has been set,
- -- otherwise -1)
- , csXmem :: Integer -- ^ Unnacounted for mem
- , csNmem :: Integer -- ^ Node own memory
- , csScore :: Score -- ^ The cluster score
- , csNinst :: Int -- ^ The total number of instances
- }
- deriving (Show, Read)
-
--- | Currently used, possibly to allocate, unallocable.
-type AllocStats = (RSpec, RSpec, RSpec)
+data CStats = CStats
+ { csFmem :: Integer -- ^ Cluster free mem
+ , csFdsk :: Integer -- ^ Cluster free disk
+ , csAmem :: Integer -- ^ Cluster allocatable mem
+ , csAdsk :: Integer -- ^ Cluster allocatable disk
+ , csAcpu :: Integer -- ^ Cluster allocatable cpus
+ , csMmem :: Integer -- ^ Max node allocatable mem
+ , csMdsk :: Integer -- ^ Max node allocatable disk
+ , csMcpu :: Integer -- ^ Max node allocatable cpu
+ , csImem :: Integer -- ^ Instance used mem
+ , csIdsk :: Integer -- ^ Instance used disk
+ , csIcpu :: Integer -- ^ Instance used cpu
+ , csTmem :: Double -- ^ Cluster total mem
+ , csTdsk :: Double -- ^ Cluster total disk
+ , csTcpu :: Double -- ^ Cluster total cpus
+ , csVcpu :: Integer -- ^ Cluster total virtual cpus
+ , csNcpu :: Double -- ^ Equivalent to 'csIcpu' but in terms of
+ -- physical CPUs, i.e. normalised used phys CPUs
+ , csXmem :: Integer -- ^ Unnacounted for mem
+ , csNmem :: Integer -- ^ Node own memory
+ , csScore :: Score -- ^ The cluster score
+ , csNinst :: Int -- ^ The total number of instances
+ } deriving (Show, Read)
-- | A simple type for allocation functions.
type AllocMethod = Node.List -- ^ Node list
in
(bad_nodes, bad_instances)
+-- | Extracts the node pairs for an instance. This can fail if the
+-- instance is single-homed. FIXME: this needs to be improved,
+-- together with the general enhancement for handling non-DRBD moves.
+instanceNodes :: Node.List -> Instance.Instance ->
+ (Ndx, Ndx, Node.Node, Node.Node)
+instanceNodes nl inst =
+ let old_pdx = Instance.pNode inst
+ old_sdx = Instance.sNode inst
+ old_p = Container.find old_pdx nl
+ old_s = Container.find old_sdx nl
+ in (old_pdx, old_sdx, old_p, old_s)
+
-- | 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
+emptyCStats = CStats 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
csMmem = x_mmem, csMdsk = x_mdsk, csMcpu = x_mcpu,
csImem = x_imem, csIdsk = x_idsk, csIcpu = x_icpu,
csTmem = x_tmem, csTdsk = x_tdsk, csTcpu = x_tcpu,
- csVcpu = x_vcpu,
+ csVcpu = x_vcpu, csNcpu = x_ncpu,
csXmem = x_xmem, csNmem = x_nmem, csNinst = x_ninst
}
= cs
inc_idsk = truncate (Node.tDsk node) - Node.fDsk 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)
, csAmem = x_amem + fromIntegral inc_amem'
, csTdsk = x_tdsk + Node.tDsk node
, csTcpu = x_tcpu + Node.tCpu node
, csVcpu = x_vcpu + fromIntegral inc_vcpu
+ , csNcpu = x_ncpu + inc_ncpu
, csXmem = x_xmem + fromIntegral (Node.xMem node)
, csNmem = x_nmem + fromIntegral (Node.nMem node)
, csNinst = x_ninst + length (Node.pList node)
-- was left unallocated.
computeAllocationDelta :: CStats -> CStats -> AllocStats
computeAllocationDelta cini cfin =
- let CStats {csImem = i_imem, csIdsk = i_idsk, csIcpu = i_icpu} = cini
+ let CStats {csImem = i_imem, csIdsk = i_idsk, csIcpu = i_icpu,
+ csNcpu = i_ncpu } = cini
CStats {csImem = f_imem, csIdsk = f_idsk, csIcpu = f_icpu,
- csTmem = t_mem, csTdsk = t_dsk, csVcpu = v_cpu } = cfin
- rini = RSpec (fromIntegral i_icpu) (fromIntegral i_imem)
- (fromIntegral i_idsk)
- rfin = RSpec (fromIntegral (f_icpu - i_icpu))
- (fromIntegral (f_imem - i_imem))
- (fromIntegral (f_idsk - i_idsk))
- un_cpu = fromIntegral (v_cpu - f_icpu)::Int
- runa = RSpec un_cpu (truncate t_mem - fromIntegral f_imem)
- (truncate t_dsk - fromIntegral f_idsk)
+ csTmem = t_mem, csTdsk = t_dsk, csVcpu = f_vcpu,
+ csNcpu = f_ncpu, csTcpu = f_tcpu } = cfin
+ rini = AllocInfo { allocInfoVCpus = fromIntegral i_icpu
+ , allocInfoNCpus = i_ncpu
+ , allocInfoMem = fromIntegral i_imem
+ , allocInfoDisk = fromIntegral i_idsk
+ }
+ 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)
+ }
+ 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
+ }
in (rini, rfin, runa)
-- | The names and weights of the individual elements in the CV list.
-> IMove -> OpResult (Node.List, Instance.Instance, Ndx, Ndx)
-- Failover (f)
applyMove nl inst Failover =
- let old_pdx = Instance.pNode inst
- old_sdx = Instance.sNode inst
- old_p = Container.find old_pdx nl
- old_s = Container.find old_sdx nl
+ let (old_pdx, old_sdx, old_p, old_s) = instanceNodes nl inst
int_p = Node.removePri old_p inst
int_s = Node.removeSec old_s inst
- force_p = Node.offline old_p
new_nl = do -- Maybe monad
- new_p <- Node.addPriEx force_p int_s inst
+ new_p <- Node.addPriEx (Node.offline old_p) int_s inst
new_s <- Node.addSec int_p inst old_sdx
let new_inst = Instance.setBoth inst old_sdx old_pdx
return (Container.addTwo old_pdx new_s old_sdx new_p nl,
-- Replace the primary (f:, r:np, f)
applyMove nl inst (ReplacePrimary new_pdx) =
- let old_pdx = Instance.pNode inst
- old_sdx = Instance.sNode inst
- old_p = Container.find old_pdx nl
- old_s = Container.find old_sdx nl
+ let (old_pdx, old_sdx, old_p, old_s) = instanceNodes nl inst
tgt_n = Container.find new_pdx nl
int_p = Node.removePri old_p inst
int_s = Node.removeSec old_s inst
-- Replace the secondary and failover (r:np, f)
applyMove nl inst (ReplaceAndFailover new_pdx) =
- let old_pdx = Instance.pNode inst
- old_sdx = Instance.sNode inst
- old_p = Container.find old_pdx nl
- old_s = Container.find old_sdx nl
+ let (old_pdx, old_sdx, old_p, old_s) = instanceNodes nl inst
tgt_n = Container.find new_pdx nl
int_p = Node.removePri old_p inst
int_s = Node.removeSec old_s inst
-- Failver and replace the secondary (f, r:ns)
applyMove nl inst (FailoverAndReplace new_sdx) =
- let old_pdx = Instance.pNode inst
- old_sdx = Instance.sNode inst
- old_p = Container.find old_pdx nl
- old_s = Container.find old_sdx nl
+ let (old_pdx, old_sdx, old_p, old_s) = instanceNodes nl inst
tgt_n = Container.find new_sdx nl
int_p = Node.removePri old_p inst
int_s = Node.removeSec old_s inst
allocateOnSingle nl inst new_pdx =
let p = Container.find new_pdx nl
new_inst = Instance.setBoth inst new_pdx Node.noSecondary
- in Node.addPri p inst >>= \new_p -> do
+ in do
+ Instance.instMatchesPolicy inst (Node.iPolicy p)
+ new_p <- Node.addPri p inst
let new_nl = Container.add new_pdx new_p nl
new_score = compCV nl
return (new_nl, new_inst, [new_p], new_score)
let tgt_p = Container.find new_pdx nl
tgt_s = Container.find new_sdx nl
in do
+ Instance.instMatchesPolicy inst (Node.iPolicy 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
checkInstanceMove nodes_idx disk_moves inst_moves ini_tbl target =
let opdx = Instance.pNode target
osdx = Instance.sNode target
- nodes = filter (\idx -> idx /= opdx && idx /= osdx) nodes_idx
+ bad_nodes = [opdx, osdx]
+ nodes = filter (`notElem` bad_nodes) nodes_idx
use_secondary = elem osdx nodes_idx && inst_moves
aft_failover = if use_secondary -- if allowed to failover
then checkSingleStep ini_tbl target ini_tbl Failover
goodSols = filterMGResults mggl sols
sortedSols = sortMGResults mggl goodSols
in if null sortedSols
- then Bad $ intercalate ", " all_msgs
+ then if null groups'
+ then Bad $ "no groups for evacuation: allowed groups was" ++
+ show allowed_gdxs ++ ", all groups: " ++
+ show (map fst groups)
+ else Bad $ intercalate ", " all_msgs
else let (final_group, final_sol) = head sortedSols
in return (final_group, final_sol, all_msgs)
selmsg = "Selected group: " ++ group_name
return $ solution { asLog = selmsg:all_msgs }
--- | Try to relocate an instance on the cluster.
-tryReloc :: (Monad m) =>
- Node.List -- ^ The node list
- -> Instance.List -- ^ The instance list
- -> Idx -- ^ The index of the instance to move
- -> Int -- ^ The number of nodes required
- -> [Ndx] -- ^ Nodes which should not be used
- -> m AllocSolution -- ^ Solution list
-tryReloc nl il xid 1 ex_idx =
- let all_nodes = getOnline nl
- inst = Container.find xid il
- ex_idx' = Instance.pNode inst:ex_idx
- valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes
- valid_idxes = map Node.idx valid_nodes
- sols1 = foldl' (\cstate x ->
- let em = do
- (mnl, i, _, _) <-
- applyMove nl inst (ReplaceSecondary x)
- return (mnl, i, [Container.find x mnl],
- compCV mnl)
- in concatAllocs cstate em
- ) emptyAllocSolution valid_idxes
- in return sols1
-
-tryReloc _ _ _ reqn _ = fail $ "Unsupported number of relocation \
- \destinations required (" ++ show reqn ++
- "), only one supported"
-
-- | Function which fails if the requested mode is change secondary.
--
-- This is useful since except DRBD, no other disk template can
failOnSecondaryChange mode dt >>
fail "Block device relocations not implemented yet"
+nodeEvacInstance _ _ mode (Instance.Instance
+ {Instance.diskTemplate = dt@DTRbd}) _ _ =
+ failOnSecondaryChange mode dt >>
+ fail "Rbd relocations not implemented yet"
+
nodeEvacInstance nl il ChangePrimary
inst@(Instance.Instance {Instance.diskTemplate = DTDrbd8})
_ _ =
iterateAlloc nl il limit newinst allocnodes ixes cstats =
let depth = length ixes
newname = printf "new-%d" depth::String
- newidx = length (Container.elems il) + depth
+ newidx = Container.size il
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
newlimit = fmap (flip (-) 1) limit
in case tryAlloc nl il newi2 allocnodes of
_ -> fs
snl = sortBy (comparing Node.idx) (Container.elems nl)
(header, isnum) = unzip $ map Node.showHeader fields
- in unlines . map ((:) ' ' . intercalate " ") $
+ in unlines . map ((:) ' ' . unwords) $
formatTable (header:map (Node.list fields) snl) isnum
-- | Print the instance list.
header = [ "F", "Name", "Pri_node", "Sec_node", "Auto_bal"
, "vcpu", "mem" , "dsk", "lCpu", "lMem", "lDsk", "lNet" ]
isnum = False:False:False:False:False:repeat True
- in unlines . map ((:) ' ' . intercalate " ") $
+ in unlines . map ((:) ' ' . unwords) $
formatTable (header:map helper sil) isnum
-- | Shows statistics for a given node list.
-printStats :: Node.List -> String
-printStats nl =
+printStats :: String -> Node.List -> String
+printStats lp nl =
let dcvs = compDetailedCV $ Container.elems nl
(weights, names) = unzip detailedCVInfo
hd = zip3 (weights ++ repeat 1) (names ++ repeat "unknown") dcvs
- formatted = map (\(w, header, val) ->
- printf "%s=%.8f(x%.2f)" header val w::String) hd
- in intercalate ", " formatted
+ header = [ "Field", "Value", "Weight" ]
+ formatted = map (\(w, h, val) ->
+ [ h
+ , printf "%.8f" val
+ , printf "x%.2f" w
+ ]) hd
+ in unlines . map ((++) lp) . map ((:) ' ' . unwords) $
+ formatTable (header:formatted) $ False:repeat True
-- | Convert a placement into a list of OpCodes (basically a job).
iMoveToJob :: Node.List -- ^ The node list; only used for node
projects / ganeti-local / blobdiff