X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/e2fa2baf98b1053969d985ce8040c5efa31cc663..e2af31560217ad78b44175bb922a9032c9149e7d:/Ganeti/HTools/Cluster.hs diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs index e7910e9..d3aec7c 100644 --- a/Ganeti/HTools/Cluster.hs +++ b/Ganeti/HTools/Cluster.hs @@ -30,6 +30,7 @@ module Ganeti.HTools.Cluster ( -- * Types Placement + , AllocSolution , Solution(..) , Table(..) , Removal @@ -78,6 +79,9 @@ type Score = Double -- | The description of an instance placement. type Placement = (Idx, Ndx, Ndx, Score) +-- | Allocation\/relocation solution. +type AllocSolution = [(Maybe Node.List, Instance.Instance, [Node.Node])] + -- | A cluster solution described as the solution delta and the list -- of placements. data Solution = Solution Int [Placement] @@ -140,15 +144,21 @@ computeBadItems nl il = (bad_nodes, bad_instances) -- | Compute the total free disk and memory in the cluster. -totalResources :: Node.List -> (Int, Int) +totalResources :: Node.List -> (Int, Int, Int, Int, Int) totalResources nl = foldl' - (\ (mem, dsk) node -> (mem + (Node.f_mem node), - dsk + (Node.f_dsk node))) - (0, 0) (Container.elems nl) + (\ (mem, dsk, amem, mmem, mdsk) node -> + let inc_amem = (Node.f_mem node) - (Node.r_mem node) + in (mem + (Node.f_mem node), + dsk + (Node.f_dsk node), + amem + (if inc_amem > 0 then inc_amem else 0), + max mmem inc_amem, + max mdsk (Node.f_dsk node) + ) + ) (0, 0, 0, 0, 0) (Container.elems nl) -- | Compute the mem and disk covariance. -compDetailedCV :: Node.List -> (Double, Double, Double, Double, Double) +compDetailedCV :: Node.List -> (Double, Double, Double, Double, Double, Double) compDetailedCV nl = let all_nodes = Container.elems nl @@ -158,22 +168,26 @@ compDetailedCV nl = mem_cv = varianceCoeff mem_l dsk_cv = varianceCoeff dsk_l n1_l = length $ filter Node.failN1 nodes - n1_score = (fromIntegral n1_l) / (fromIntegral $ length nodes) + n1_score = ((fromIntegral n1_l) / + (fromIntegral $ length nodes))::Double res_l = map Node.p_rem nodes res_cv = varianceCoeff res_l offline_inst = sum . map (\n -> (length . Node.plist $ n) + (length . Node.slist $ n)) $ offline online_inst = sum . map (\n -> (length . Node.plist $ n) + (length . Node.slist $ n)) $ nodes - off_score = (fromIntegral offline_inst) / - (fromIntegral $ online_inst + offline_inst) - in (mem_cv, dsk_cv, n1_score, res_cv, off_score) + off_score = ((fromIntegral offline_inst) / + (fromIntegral $ online_inst + offline_inst))::Double + cpu_l = map Node.p_cpu nodes + cpu_cv = varianceCoeff cpu_l + in (mem_cv, dsk_cv, n1_score, res_cv, off_score, cpu_cv) -- | Compute the /total/ variance. compCV :: Node.List -> Double compCV nl = - let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl - in mem_cv + dsk_cv + n1_score + res_cv + off_score + let (mem_cv, dsk_cv, n1_score, res_cv, off_score, cpu_cv) = + compDetailedCV nl + in mem_cv + dsk_cv + n1_score + res_cv + off_score + cpu_cv -- | Compute online nodes from a Node.List getOnline :: Node.List -> [Node.Node] @@ -467,8 +481,12 @@ applyMove nl inst (ReplacePrimary new_pdx) = int_p = Node.removePri old_p inst int_s = Node.removeSec old_s inst new_nl = do -- Maybe monad + -- check that the current secondary can host the instance + -- during the migration + tmp_s <- Node.addPri int_s inst + let tmp_s' = Node.removePri tmp_s inst new_p <- Node.addPri tgt_n inst - new_s <- Node.addSec int_s inst new_pdx + new_s <- Node.addSec tmp_s' inst new_pdx return $ Container.add new_pdx new_p $ Container.addTwo old_pdx int_p old_sdx new_s nl in (new_nl, Instance.setPri inst new_pdx, new_pdx, old_sdx) @@ -624,19 +642,20 @@ tryAlloc :: (Monad m) => -> Instance.List -- ^ The instance list -> Instance.Instance -- ^ The instance to allocate -> Int -- ^ Required number of nodes - -> m [(Maybe Node.List, [Node.Node])] -- ^ Possible solution list + -> m AllocSolution -- ^ Possible solution list tryAlloc nl _ inst 2 = let all_nodes = getOnline nl all_pairs = liftM2 (,) all_nodes all_nodes ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs - sols = map (\(p, s) -> - (fst $ allocateOnPair nl inst p s, [p, s])) + sols = map (\(p, s) -> let (mnl, i) = allocateOnPair nl inst p s + in (mnl, i, [p, s])) ok_pairs in return sols tryAlloc nl _ inst 1 = let all_nodes = getOnline nl - sols = map (\p -> (fst $ allocateOnSingle nl inst p, [p])) + sols = map (\p -> let (mnl, i) = allocateOnSingle nl inst p + in (mnl, i, [p])) all_nodes in return sols @@ -646,21 +665,21 @@ tryAlloc _ _ _ reqn = fail $ "Unsupported number of alllocation \ -- | Try to allocate 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 numver of nodes required - -> [Ndx] -- ^ Nodes which should not be used - -> m [(Maybe Node.List, [Node.Node])] -- ^ Solution list + Node.List -- ^ The node list + -> Instance.List -- ^ The instance list + -> Idx -- ^ The index of the instance to move + -> Int -- ^ The numver 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 = map (\x -> let (mnl, _, _, _) = - applyMove nl inst (ReplaceSecondary x) - in (mnl, [Container.find x nl]) + sols1 = map (\x -> let (mnl, i, _, _) = + applyMove nl inst (ReplaceSecondary x) + in (mnl, i, [Container.find x nl]) ) valid_idxes in return sols1 @@ -772,17 +791,20 @@ printNodes nl = let snl = sortBy (compare `on` Node.idx) (Container.elems nl) m_name = maximum . map (length . Node.name) $ snl helper = Node.list m_name - header = printf - "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %3s %3s %7s %7s" - " F" m_name "Name" - "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem" - "t_dsk" "f_dsk" - "pri" "sec" "p_fmem" "p_fdsk" + header = (printf + "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %4s %4s \ + \%3s %3s %6s %6s %5s" + " F" m_name "Name" + "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem" + "t_dsk" "f_dsk" "pcpu" "vcpu" + "pri" "sec" "p_fmem" "p_fdsk" "r_cpu")::String in unlines $ (header:map helper snl) -- | Shows statistics for a given node list. printStats :: Node.List -> String printStats nl = - let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl - in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f, uf=%.3f" - mem_cv res_cv dsk_cv n1_score off_score + let (mem_cv, dsk_cv, n1_score, res_cv, off_score, cpu_cv) = + compDetailedCV nl + in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f, \ + \uf=%.3f, r_cpu=%.3f" + mem_cv res_cv dsk_cv n1_score off_score cpu_cv