X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/bef83fd1972100aca9f4e2acb6e82d6524e7d168..d52d41de85348cbf9c18156e122718471d4bbf1f:/htools/Ganeti/HTools/Cluster.hs diff --git a/htools/Ganeti/HTools/Cluster.hs b/htools/Ganeti/HTools/Cluster.hs index c725fdf..ecd6c91 100644 --- a/htools/Ganeti/HTools/Cluster.hs +++ b/htools/Ganeti/HTools/Cluster.hs @@ -52,6 +52,7 @@ module Ganeti.HTools.Cluster , doNextBalance , tryBalance , compCV + , compCVNodes , compDetailedCV , printStats , iMoveToJob @@ -78,6 +79,7 @@ module Ganeti.HTools.Cluster import Data.Function (on) import qualified Data.IntSet as IntSet import Data.List +import Data.Maybe (fromJust) import Data.Ord (comparing) import Text.Printf (printf) import Control.Monad @@ -283,10 +285,9 @@ detailedCVWeights :: [Double] detailedCVWeights = map fst detailedCVInfo -- | Compute the mem and disk covariance. -compDetailedCV :: Node.List -> [Double] -compDetailedCV nl = +compDetailedCV :: [Node.Node] -> [Double] +compDetailedCV all_nodes = let - all_nodes = Container.elems nl (offline, nodes) = partition Node.offline all_nodes mem_l = map Node.pMem nodes dsk_l = map Node.pDsk nodes @@ -328,8 +329,13 @@ compDetailedCV nl = , pri_tags_score ] -- | Compute the /total/ variance. +compCVNodes :: [Node.Node] -> Double +compCVNodes = sum . zipWith (*) detailedCVWeights . compDetailedCV + +-- | Wrapper over 'compCVNodes' for callers that have a 'Node.List'. compCV :: Node.List -> Double -compCV = sum . zipWith (*) detailedCVWeights . compDetailedCV +compCV = compCVNodes . Container.elems + -- | Compute online nodes from a 'Node.List'. getOnline :: Node.List -> [Node.Node] @@ -597,7 +603,8 @@ tryBalance ini_tbl disk_moves inst_moves evac_mode mg_limit min_gain = -- | Build failure stats out of a list of failures. collapseFailures :: [FailMode] -> FailStats collapseFailures flst = - map (\k -> (k, length $ filter (k ==) flst)) [minBound..maxBound] + map (\k -> (k, foldl' (\a e -> if e == k then a + 1 else a) 0 flst)) + [minBound..maxBound] -- | Update current Allocation solution and failure stats with new -- elements. @@ -918,9 +925,101 @@ nodeEvacInstance nl il ChangePrimary ops = iMoveToJob nl' il' idx Failover return (nl', il', ops) -nodeEvacInstance _ _ _ (Instance.Instance - {Instance.diskTemplate = DTDrbd8}) _ = - fail "DRBD relocations not implemented yet" +nodeEvacInstance nl il ChangeSecondary + inst@(Instance.Instance {Instance.diskTemplate = DTDrbd8}) + avail_nodes = + do + let gdx = instancePriGroup nl inst + (nl', inst', _, ndx) <- annotateResult "Can't find any good node" $ + eitherToResult $ + foldl' (evacDrbdSecondaryInner nl inst gdx) + (Left "no nodes available") avail_nodes + let idx = Instance.idx inst + il' = Container.add idx inst' il + ops = iMoveToJob nl' il' idx (ReplaceSecondary ndx) + return (nl', il', ops) + +nodeEvacInstance nl il ChangeAll + inst@(Instance.Instance {Instance.diskTemplate = DTDrbd8}) + avail_nodes = + do + let primary = Container.find (Instance.pNode inst) nl + idx = Instance.idx inst + gdx = instancePriGroup nl inst + no_nodes = Left "no nodes available" + -- if the primary is offline, then we first failover + (nl1, inst1, ops1) <- + if Node.offline primary + then do + (nl', inst', _, _) <- + annotateResult "Failing over to the secondary" $ + opToResult $ applyMove nl inst Failover + return (nl', inst', [Failover]) + else return (nl, inst, []) + -- we now need to execute a replace secondary to the future + -- primary node + (nl2, inst2, _, new_pdx) <- annotateResult "Searching for a new primary" $ + eitherToResult $ + foldl' (evacDrbdSecondaryInner nl1 inst1 gdx) + no_nodes avail_nodes + let ops2 = ReplaceSecondary new_pdx:ops1 + -- since we chose the new primary, we remove it from the list of + -- available nodes + let avail_nodes_sec = new_pdx `delete` avail_nodes + -- we now execute another failover, the primary stays fixed now + (nl3, inst3, _, _) <- annotateResult "Failing over to new primary" $ + opToResult $ applyMove nl2 inst2 Failover + let ops3 = Failover:ops2 + -- and finally another replace secondary, to the final secondary + (nl4, inst4, _, new_sdx) <- + annotateResult "Searching for a new secondary" $ + eitherToResult $ + foldl' (evacDrbdSecondaryInner nl3 inst3 gdx) no_nodes avail_nodes_sec + let ops4 = ReplaceSecondary new_sdx:ops3 + il' = Container.add idx inst4 il + ops = concatMap (iMoveToJob nl4 il' idx) $ reverse ops4 + return (nl4, il', ops) + +-- | Inner fold function for changing secondary of a DRBD instance. +-- +-- The "running" solution is either a @Left String@, which means we +-- don't have yet a working solution, or a @Right (...)@, which +-- represents a valid solution; it holds the modified node list, the +-- modified instance (after evacuation), the score of that solution, +-- and the new secondary node index. +evacDrbdSecondaryInner :: Node.List -- ^ Cluster node list + -> Instance.Instance -- ^ Instance being evacuated + -> Gdx -- ^ The group index of the instance + -> Either String ( Node.List + , Instance.Instance + , Score + , Ndx) -- ^ Current best solution + -> Ndx -- ^ Node we're evaluating as new secondary + -> Either String ( Node.List + , Instance.Instance + , Score + , Ndx) -- ^ New best solution +evacDrbdSecondaryInner nl inst gdx accu ndx = + case applyMove nl inst (ReplaceSecondary ndx) of + OpFail fm -> + case accu of + Right _ -> accu + Left _ -> Left $ "Node " ++ Container.nameOf nl ndx ++ + " failed: " ++ show fm + OpGood (nl', inst', _, _) -> + let nodes = Container.elems nl' + -- The fromJust below is ugly (it can fail nastily), but + -- at this point we should have any internal mismatches, + -- and adding a monad here would be quite involved + grpnodes = fromJust (gdx `lookup` (Node.computeGroups nodes)) + new_cv = compCVNodes grpnodes + new_accu = Right (nl', inst', new_cv, ndx) + in case accu of + Left _ -> new_accu + Right (_, _, old_cv, _) -> + if old_cv < new_cv + then accu + else new_accu -- | Computes the local nodes of a given instance which are available -- for allocation. @@ -975,45 +1074,58 @@ tryNodeEvac _ ini_nl ini_il mode idxs = -- | Recursively place instances on the cluster until we're out of space. iterateAlloc :: Node.List -> Instance.List + -> Maybe Int -> Instance.Instance -> AllocNodes -> [Instance.Instance] -> [CStats] -> Result AllocResult -iterateAlloc nl il newinst allocnodes ixes cstats = +iterateAlloc nl il limit newinst allocnodes ixes cstats = let depth = length ixes newname = printf "new-%d" depth::String newidx = length (Container.elems il) + depth newi2 = Instance.setIdx (Instance.setName newinst newname) newidx + newlimit = fmap (flip (-) 1) limit in case tryAlloc nl il newi2 allocnodes of Bad s -> Bad s Ok (AllocSolution { asFailures = errs, asSolutions = sols3 }) -> + let newsol = Ok (collapseFailures errs, nl, il, ixes, cstats) in case sols3 of - [] -> Ok (collapseFailures errs, nl, il, ixes, cstats) + [] -> newsol (xnl, xi, _, _):[] -> - iterateAlloc xnl (Container.add newidx xi il) - newinst allocnodes (xi:ixes) - (totalResources xnl:cstats) + if limit == Just 0 + then newsol + else iterateAlloc xnl (Container.add newidx xi il) + newlimit newinst allocnodes (xi:ixes) + (totalResources xnl:cstats) _ -> Bad "Internal error: multiple solutions for single\ \ allocation" -- | The core of the tiered allocation mode. tieredAlloc :: Node.List -> Instance.List + -> Maybe Int -> Instance.Instance -> AllocNodes -> [Instance.Instance] -> [CStats] -> Result AllocResult -tieredAlloc nl il newinst allocnodes ixes cstats = - case iterateAlloc nl il newinst allocnodes ixes cstats of +tieredAlloc nl il limit newinst allocnodes ixes cstats = + case iterateAlloc nl il limit newinst allocnodes ixes cstats of Bad s -> Bad s Ok (errs, nl', il', ixes', cstats') -> + let newsol = Ok (errs, nl', il', ixes', cstats') + ixes_cnt = length ixes' + (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 _ -> Ok (errs, nl', il', ixes', cstats') - Ok newinst' -> - tieredAlloc nl' il' newinst' allocnodes ixes' cstats' + Bad _ -> newsol + Ok newinst' -> tieredAlloc nl' il' newlimit + newinst' allocnodes ixes' cstats' -- | Compute the tiered spec string description from a list of -- allocated instances. @@ -1164,7 +1276,7 @@ printInsts nl il = -- | Shows statistics for a given node list. printStats :: Node.List -> String printStats nl = - let dcvs = compDetailedCV 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) ->