Commit e86f7f65 authored by Iustin Pop's avatar Iustin Pop
Browse files

Further cleanup in hspace



This moves the checking of results from the allocation functions to a
separate function, so that we have less code duplication. It also does
a bit of simplification in the printing functions.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarMichael Hanselmann <hansmi@google.com>
parent 5296ee23
...@@ -34,6 +34,7 @@ module Ganeti.HTools.Cluster ...@@ -34,6 +34,7 @@ module Ganeti.HTools.Cluster
, Table(..) , Table(..)
, CStats(..) , CStats(..)
, AllocStats , AllocStats
, AllocResult
, AllocMethod , AllocMethod
-- * Generic functions -- * Generic functions
, totalResources , totalResources
......
...@@ -26,7 +26,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ...@@ -26,7 +26,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
module Ganeti.HTools.Program.Hspace (main) where module Ganeti.HTools.Program.Hspace (main) where
import Control.Monad import Control.Monad
import Data.Char (toUpper, isAlphaNum) import Data.Char (toUpper, isAlphaNum, toLower)
import Data.Function (on) import Data.Function (on)
import Data.List import Data.List
import Data.Ord (comparing) import Data.Ord (comparing)
...@@ -89,7 +89,7 @@ specPrefix SpecTiered = "TSPEC_INI" ...@@ -89,7 +89,7 @@ specPrefix SpecTiered = "TSPEC_INI"
-- | The description of a spec. -- | The description of a spec.
specDescription :: SpecType -> String specDescription :: SpecType -> String
specDescription SpecNormal = "Normal (fixed-size)" specDescription SpecNormal = "Standard (fixed-size)"
specDescription SpecTiered = "Tiered (initial size)" specDescription SpecTiered = "Tiered (initial size)"
-- | Efficiency generic function. -- | Efficiency generic function.
...@@ -262,7 +262,7 @@ printAllocationMap :: Int -> String ...@@ -262,7 +262,7 @@ printAllocationMap :: Int -> String
-> Node.List -> [Instance.Instance] -> IO () -> Node.List -> [Instance.Instance] -> IO ()
printAllocationMap verbose msg nl ixes = printAllocationMap verbose msg nl ixes =
when (verbose > 1) $ do when (verbose > 1) $ do
hPutStrLn stderr msg hPutStrLn stderr (msg ++ " map")
hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $ hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
formatTable (map (printInstance nl) (reverse ixes)) formatTable (map (printInstance nl) (reverse ixes))
-- This is the numberic-or-not field -- This is the numberic-or-not field
...@@ -351,6 +351,35 @@ exitIfBad (Bad s) = ...@@ -351,6 +351,35 @@ exitIfBad (Bad s) =
hPrintf stderr "Failure: %s\n" s >> exitWith (ExitFailure 1) hPrintf stderr "Failure: %s\n" s >> exitWith (ExitFailure 1)
exitIfBad (Ok v) = return v exitIfBad (Ok v) = return v
-- | Runs an allocation algorithm and saves cluster state.
runAllocation :: ClusterData -- ^ Cluster data
-> Maybe Cluster.AllocResult -- ^ Optional stop-allocation
-> Result Cluster.AllocResult -- ^ Allocation result
-> RSpec -- ^ Requested instance spec
-> SpecType -- ^ Allocation type
-> Options -- ^ CLI options
-> IO (FailStats, Node.List, Int, [(RSpec, Int)])
runAllocation cdata stop_allocation actual_result spec mode opts = do
(reasons, new_nl, new_il, new_ixes, _) <-
case stop_allocation of
Just result_noalloc -> return result_noalloc
Nothing -> exitIfBad actual_result
let name = head . words . specDescription $ mode
descr = name ++ " allocation"
ldescr = "after " ++ map toLower descr
printISpec (optMachineReadable opts) spec mode (optDiskTemplate opts)
printAllocationMap (optVerbose opts) descr new_nl new_ixes
maybePrintNodes (optShowNodes opts) descr (Cluster.printNodes new_nl)
maybeSaveData (optSaveCluster opts) (map toLower name) ldescr
(cdata { cdNodes = new_nl, cdInstances = new_il})
return (sortReasons reasons, new_nl, length new_ixes, tieredSpecMap new_ixes)
-- | Main function. -- | Main function.
main :: IO () main :: IO ()
main = do main = do
...@@ -363,49 +392,40 @@ main = do ...@@ -363,49 +392,40 @@ main = do
let verbose = optVerbose opts let verbose = optVerbose opts
ispec = optISpec opts ispec = optISpec opts
shownodes = optShowNodes opts
disk_template = optDiskTemplate opts disk_template = optDiskTemplate opts
req_nodes = Instance.requiredNodes disk_template req_nodes = Instance.requiredNodes disk_template
machine_r = optMachineReadable opts machine_r = optMachineReadable opts
(ClusterData gl fixed_nl il ctags) <- loadExternalData opts (ClusterData gl fixed_nl il ctags) <- loadExternalData opts
nl <- setNodeStatus opts fixed_nl
let num_instances = Container.size il let num_instances = Container.size il
all_nodes = Container.elems fixed_nl all_nodes = Container.elems fixed_nl
m_cpu = optMcpu opts cdata = ClusterData gl nl il ctags
csf = commonSuffix fixed_nl il csf = commonSuffix fixed_nl il
nl <- setNodeStatus opts fixed_nl
when (not (null csf) && verbose > 1) $ when (not (null csf) && verbose > 1) $
hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
maybePrintNodes shownodes "Initial cluster" (Cluster.printNodes nl) maybePrintNodes (optShowNodes opts) "Initial cluster" (Cluster.printNodes nl)
let ini_cv = Cluster.compCV nl
ini_stats = Cluster.totalResources nl
when (verbose > 2) $ when (verbose > 2) $
hPrintf stderr "Initial coefficients: overall %.8f, %s\n" hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
ini_cv (Cluster.printStats nl) (Cluster.compCV nl) (Cluster.printStats nl)
printCluster machine_r ini_stats (length all_nodes) printCluster machine_r (Cluster.totalResources nl) (length all_nodes)
printISpec machine_r ispec SpecNormal disk_template let stop_allocation = case Cluster.computeBadItems nl il of
([], _) -> Nothing
let bad_nodes = fst $ Cluster.computeBadItems nl il _ -> Just ([(FailN1, 1)]::FailStats, nl, il, [], [])
stop_allocation = not $ null bad_nodes alloclimit = if optMaxLength opts == -1
result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [], []) then Nothing
else Just (optMaxLength opts)
-- utility functions -- utility functions
let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx) let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
(rspecCpu spx) "running" [] True (-1) (-1) disk_template (rspecCpu spx) "running" [] True (-1) (-1) disk_template
let reqinst = iofspec ispec
alloclimit = if optMaxLength opts == -1
then Nothing
else Just (optMaxLength opts)
allocnodes <- exitIfBad $ Cluster.genAllocNodes gl nl req_nodes True allocnodes <- exitIfBad $ Cluster.genAllocNodes gl nl req_nodes True
-- Run the tiered allocation, if enabled -- Run the tiered allocation, if enabled
...@@ -413,44 +433,20 @@ main = do ...@@ -413,44 +433,20 @@ main = do
(case optTieredSpec opts of (case optTieredSpec opts of
Nothing -> return () Nothing -> return ()
Just tspec -> do Just tspec -> do
(treason, trl_nl, trl_il, trl_ixes, _) <- (treason, trl_nl, _, spec_map) <-
if stop_allocation runAllocation cdata stop_allocation
then return result_noalloc (Cluster.tieredAlloc nl il alloclimit (iofspec tspec)
else exitIfBad (Cluster.tieredAlloc nl il alloclimit (iofspec tspec) allocnodes [] []) tspec SpecTiered opts
allocnodes [] [])
let spec_map' = tieredSpecMap trl_ixes
treason' = sortReasons treason
printAllocationMap verbose "Tiered allocation map" trl_nl trl_ixes
maybePrintNodes shownodes "Tiered allocation"
(Cluster.printNodes trl_nl)
maybeSaveData (optSaveCluster opts) "tiered" "after tiered allocation" printTiered machine_r spec_map (optMcpu opts) nl trl_nl treason
(ClusterData gl trl_nl trl_il ctags)
printISpec machine_r tspec SpecTiered disk_template
printTiered machine_r spec_map' m_cpu nl trl_nl treason'
) )
-- Run the standard (avg-mode) allocation -- Run the standard (avg-mode) allocation
(ereason, fin_nl, fin_il, ixes, _) <- (sreason, fin_nl, allocs, _) <-
if stop_allocation runAllocation cdata stop_allocation
then return result_noalloc (Cluster.iterateAlloc nl il alloclimit (iofspec ispec)
else exitIfBad (Cluster.iterateAlloc nl il alloclimit allocnodes [] []) ispec SpecNormal opts
reqinst allocnodes [] [])
let allocs = length ixes
sreason = sortReasons ereason
printAllocationMap verbose "Standard allocation map" fin_nl ixes
maybePrintNodes shownodes "Standard allocation" (Cluster.printNodes fin_nl)
maybeSaveData (optSaveCluster opts) "alloc" "after standard allocation"
(ClusterData gl fin_nl fin_il ctags)
printResults machine_r nl fin_nl num_instances allocs sreason printResults machine_r nl fin_nl num_instances allocs sreason
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment