X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/9fc183840eb27794f6b85eaa0c6296ac853e3b8a..2922d2c576d85983eb5f6ac82982b641aacc954b:/htools/Ganeti/HTools/Cluster.hs diff --git a/htools/Ganeti/HTools/Cluster.hs b/htools/Ganeti/HTools/Cluster.hs index 02dbe52..37af920 100644 --- a/htools/Ganeti/HTools/Cluster.hs +++ b/htools/Ganeti/HTools/Cluster.hs @@ -7,7 +7,7 @@ goes into the /Main/ module for the individual binaries. {- -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 @@ -33,7 +33,6 @@ module Ganeti.HTools.Cluster , EvacSolution(..) , Table(..) , CStats(..) - , AllocStats , AllocResult , AllocMethod -- * Generic functions @@ -62,7 +61,6 @@ module Ganeti.HTools.Cluster , genAllocNodes , tryAlloc , tryMGAlloc - , tryReloc , tryNodeEvac , tryChangeGroup , collapseFailures @@ -108,7 +106,7 @@ data EvacSolution = EvacSolution , 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, @@ -140,32 +138,29 @@ data Table = Table Node.List Instance.List Score [Placement] 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 @@ -200,9 +195,21 @@ computeBadItems nl il = 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 @@ -212,7 +219,7 @@ updateCStats cs node = 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 @@ -225,6 +232,8 @@ updateCStats cs node = 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' @@ -240,6 +249,7 @@ updateCStats cs node = , 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) @@ -259,17 +269,26 @@ totalResources nl = -- 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. @@ -358,15 +377,11 @@ applyMove :: Node.List -> Instance.Instance -> 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, @@ -375,10 +390,7 @@ applyMove nl inst Failover = -- 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 @@ -413,10 +425,7 @@ applyMove nl inst (ReplaceSecondary new_sdx) = -- 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 @@ -432,10 +441,7 @@ applyMove nl inst (ReplaceAndFailover new_pdx) = -- 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 @@ -455,7 +461,9 @@ allocateOnSingle :: Node.List -> Instance.Instance -> Ndx 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) @@ -467,6 +475,7 @@ allocateOnPair nl inst new_pdx new_sdx = 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 @@ -526,7 +535,8 @@ checkInstanceMove :: [Ndx] -- ^ Allowed target node indices 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 @@ -783,7 +793,11 @@ findBestAllocGroup mggl mgnl mgil allowed_gdxs inst cnt = 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) @@ -801,34 +815,6 @@ tryMGAlloc mggl mgnl mgil inst cnt = do 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 @@ -878,6 +864,11 @@ nodeEvacInstance _ _ mode (Instance.Instance 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}) _ _ = @@ -1158,7 +1149,7 @@ iterateAlloc :: AllocMethod 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 @@ -1308,7 +1299,7 @@ printNodes nl fs = _ -> 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. @@ -1335,18 +1326,23 @@ printInsts nl il = 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