diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs index 13a74870c644e1026306822cbbc0f8be99a7a239..1cfd48b2ad401837d3a93318483d9fbbdc8ba9b7 100644 --- a/Ganeti/HTools/Cluster.hs +++ b/Ganeti/HTools/Cluster.hs @@ -62,11 +62,14 @@ module Ganeti.HTools.Cluster -- * Allocation functions , iterateAlloc , tieredAlloc + , tieredSpecMap + -- * Node group functions , instanceGroup , findSplitInstances , splitCluster ) where +import Data.Function (on) import Data.List import Data.Ord (comparing) import Text.Printf (printf) @@ -762,6 +765,7 @@ iterateAlloc nl il newinst nreq ixes = _ -> Bad "Internal error: multiple solutions for single\ \ allocation" +-- | The core of the tiered allocation mode tieredAlloc :: Node.List -> Instance.List -> Instance.Instance @@ -779,6 +783,18 @@ tieredAlloc nl il newinst nreq ixes = Ok newinst' -> tieredAlloc nl' il' newinst' nreq ixes' +-- | Compute the tiered spec string description from a list of +-- allocated instances. +tieredSpecMap :: [Instance.Instance] + -> [String] +tieredSpecMap trl_ixes = + let fin_trl_ixes = reverse trl_ixes + ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes + spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs)) + ix_byspec + in map (\(spec, cnt) -> printf "%d,%d,%d=%d" (rspecMem spec) + (rspecDsk spec) (rspecCpu spec) cnt) spec_map + -- * Formatting functions -- | Given the original and final nodes, computes the relocation description. @@ -941,6 +957,8 @@ iMoveToJob nl il idx move = ReplaceAndFailover np -> [ opR np, opF ] FailoverAndReplace ns -> [ opF, opR ns ] +-- * Node group functions + -- | Computes the group of an instance instanceGroup :: Node.List -> Instance.Instance -> Result Gdx instanceGroup nl i = diff --git a/hspace.hs b/hspace.hs index 8410f46585e2f01bbbc81b9b6056e1a12ef63899..2678c9dae80d0f0c7b4b4ff3c57b3f0fafd31d28 100644 --- a/hspace.hs +++ b/hspace.hs @@ -27,7 +27,6 @@ module Main (main) where import Data.Char (toUpper, isAlphaNum) import Data.List -import Data.Function import Data.Maybe (isJust, fromJust) import Data.Ord (comparing) import Monad @@ -289,19 +288,12 @@ main = do then return result_noalloc else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec) req_nodes []) - let fin_trl_ixes = reverse trl_ixes - ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes - spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs)) - ix_byspec::[(RSpec, Int)] - spec_map' = map (\(spec, cnt) -> - printf "%d,%d,%d=%d" (rspecMem spec) - (rspecDsk spec) (rspecCpu spec) cnt) - spec_map::[String] + let spec_map' = Cluster.tieredSpecMap trl_ixes when (verbose > 1) $ do hPutStrLn stderr "Tiered allocation map" hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $ - formatTable (map (printInstance trl_nl) fin_trl_ixes) + formatTable (map (printInstance trl_nl) (reverse trl_ixes)) [False, False, False, True, True, True] when (isJust shownodes) $ do