X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/d85a0a0f8cdb9ee0d804b6b2f588f497b838edf9..e2af31560217ad78b44175bb922a9032c9149e7d:/Ganeti/HTools/Cluster.hs diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs index adb6634..d3aec7c 100644 --- a/Ganeti/HTools/Cluster.hs +++ b/Ganeti/HTools/Cluster.hs @@ -5,10 +5,32 @@ goes into the "Main" module for the individual binaries. -} +{- + +Copyright (C) 2009 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 +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +02110-1301, USA. + +-} + module Ganeti.HTools.Cluster ( -- * Types Placement + , AllocSolution , Solution(..) , Table(..) , Removal @@ -33,6 +55,8 @@ module Ganeti.HTools.Cluster -- * IAllocator functions , allocateOnSingle , allocateOnPair + , tryAlloc + , tryReloc ) where import Data.List @@ -55,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] @@ -109,7 +136,7 @@ those nodes. computeBadItems :: Node.List -> Instance.List -> ([Node.Node], [Instance.Instance]) computeBadItems nl il = - let bad_nodes = verifyN1 $ filter (not . Node.offline) $ Container.elems nl + let bad_nodes = verifyN1 $ getOnline nl bad_instances = map (\idx -> Container.find idx il) $ sort $ nub $ concat $ map (\ n -> (Node.slist n) ++ (Node.plist n)) bad_nodes @@ -117,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 @@ -135,22 +168,30 @@ 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] +getOnline = filter (not . Node.offline) . Container.elems -- * hn1 functions @@ -440,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) @@ -589,6 +634,58 @@ checkMove nodes_idx ini_tbl victims = else best_tbl +-- * Alocation functions + +-- | Try to allocate an instance on the cluster. +tryAlloc :: (Monad m) => + Node.List -- ^ The node list + -> Instance.List -- ^ The instance list + -> Instance.Instance -- ^ The instance to allocate + -> Int -- ^ Required number of nodes + -> 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) -> 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 -> let (mnl, i) = allocateOnSingle nl inst p + in (mnl, i, [p])) + all_nodes + in return sols + +tryAlloc _ _ _ reqn = fail $ "Unsupported number of alllocation \ + \destinations required (" ++ (show reqn) ++ + "), only two supported" + +-- | 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 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, i, _, _) = + applyMove nl inst (ReplaceSecondary x) + in (mnl, i, [Container.find x nl]) + ) valid_idxes + in return sols1 + +tryReloc _ _ _ reqn _ = fail $ "Unsupported number of relocation \ + \destinations required (" ++ (show reqn) ++ + "), only one supported" -- * Formatting functions @@ -694,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