{-
-Copyright (C) 2009, 2010, 2011 Google Inc.
+Copyright (C) 2009, 2010, 2011, 2012 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
-}
-module Ganeti.HTools.Program.Hspace (main) where
+module Ganeti.HTools.Program.Hspace (main, options) where
import Control.Monad
-import Data.Char (toUpper, isAlphaNum)
+import Data.Char (toUpper, toLower)
+import Data.Function (on)
import Data.List
-import Data.Maybe (isJust, fromJust)
+import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
-import System (exitWith, ExitCode(..))
import System.IO
-import qualified System
import Text.Printf (printf, hPrintf)
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
-import Ganeti.HTools.Utils
import Ganeti.HTools.Types
import Ganeti.HTools.CLI
import Ganeti.HTools.ExtLoader
-import Ganeti.HTools.Loader (ClusterData(..))
+import Ganeti.HTools.Loader
+import Ganeti.Utils
--- | Options list and functions
+-- | Options list and functions.
options :: [OptType]
options =
- [ oPrintNodes
- , oDataFile
- , oDiskTemplate
- , oNodeSim
- , oRapiMaster
- , oLuxiSocket
- , oVerbose
- , oQuiet
- , oOfflineNode
- , oIMem
- , oIDisk
- , oIVcpus
- , oMaxCpu
- , oMinDisk
- , oTieredSpec
- , oSaveCluster
- , oShowVer
- , oShowHelp
- ]
+ [ oPrintNodes
+ , oDataFile
+ , oDiskTemplate
+ , oSpindleUse
+ , oNodeSim
+ , oRapiMaster
+ , oLuxiSocket
+ , oIAllocSrc
+ , oVerbose
+ , oQuiet
+ , oOfflineNode
+ , oMachineReadable
+ , oMaxCpu
+ , oMaxSolLength
+ , oMinDisk
+ , oStdSpec
+ , oTieredSpec
+ , oSaveCluster
+ ]
-- | The allocation phase we're in (initial, after tiered allocs, or
-- after regular allocation).
| PFinal
| PTiered
+-- | The kind of instance spec we print.
+data SpecType = SpecNormal
+ | SpecTiered
+
+-- | Prefix for machine readable names
+htsPrefix :: String
+htsPrefix = "HTS"
+
+-- | What we prefix a spec with.
+specPrefix :: SpecType -> String
+specPrefix SpecNormal = "SPEC"
+specPrefix SpecTiered = "TSPEC_INI"
+
+-- | The description of a spec.
+specDescription :: SpecType -> String
+specDescription SpecNormal = "Standard (fixed-size)"
+specDescription SpecTiered = "Tiered (initial size)"
+
+-- | Efficiency generic function.
+effFn :: (Cluster.CStats -> Integer)
+ -> (Cluster.CStats -> Double)
+ -> Cluster.CStats -> Double
+effFn fi ft cs = fromIntegral (fi cs) / ft cs
+
+-- | Memory efficiency.
+memEff :: Cluster.CStats -> Double
+memEff = effFn Cluster.csImem Cluster.csTmem
+
+-- | Disk efficiency.
+dskEff :: Cluster.CStats -> Double
+dskEff = effFn Cluster.csIdsk Cluster.csTdsk
+
+-- | Cpu efficiency.
+cpuEff :: Cluster.CStats -> Double
+cpuEff = effFn Cluster.csIcpu (fromIntegral . Cluster.csVcpu)
+
+-- | Holds data for converting a 'Cluster.CStats' structure into
+-- detailed statictics.
statsData :: [(String, Cluster.CStats -> String)]
statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
, ("INST_CNT", printf "%d" . Cluster.csNinst)
, ("MEM_INST", printf "%d" . Cluster.csImem)
, ("MEM_OVERHEAD",
\cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
- , ("MEM_EFF",
- \cs -> printf "%.8f" (fromIntegral (Cluster.csImem cs) /
- Cluster.csTmem cs))
+ , ("MEM_EFF", printf "%.8f" . memEff)
, ("DSK_FREE", printf "%d" . Cluster.csFdsk)
, ("DSK_AVAIL", printf "%d". Cluster.csAdsk)
, ("DSK_RESVD",
\cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
, ("DSK_INST", printf "%d" . Cluster.csIdsk)
- , ("DSK_EFF",
- \cs -> printf "%.8f" (fromIntegral (Cluster.csIdsk cs) /
- Cluster.csTdsk cs))
+ , ("DSK_EFF", printf "%.8f" . dskEff)
, ("CPU_INST", printf "%d" . Cluster.csIcpu)
- , ("CPU_EFF",
- \cs -> printf "%.8f" (fromIntegral (Cluster.csIcpu cs) /
- Cluster.csTcpu cs))
+ , ("CPU_EFF", printf "%.8f" . cpuEff)
, ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
, ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
]
+-- | List holding 'RSpec' formatting information.
specData :: [(String, RSpec -> String)]
specData = [ ("MEM", printf "%d" . rspecMem)
, ("DSK", printf "%d" . rspecDsk)
, ("CPU", printf "%d" . rspecCpu)
]
+-- | List holding 'Cluster.CStats' formatting information.
clusterData :: [(String, Cluster.CStats -> String)]
clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
, ("DSK", printf "%.0f" . Cluster.csTdsk)
, ("VCPU", printf "%d" . Cluster.csVcpu)
]
--- | Function to print stats for a given phase
+-- | Function to print stats for a given phase.
printStats :: Phase -> Cluster.CStats -> [(String, String)]
printStats ph cs =
map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
PFinal -> "FIN"
PTiered -> "TRL"
--- | Print final stats and related metrics
-printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()
-printResults fin_nl num_instances allocs sreason = do
+-- | Print failure reason and scores
+printFRScores :: Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
+printFRScores ini_nl fin_nl sreason = do
+ printf " - most likely failure reason: %s\n" $ failureReason sreason::IO ()
+ printClusterScores ini_nl fin_nl
+ printClusterEff (Cluster.totalResources fin_nl)
+
+-- | Print final stats and related metrics.
+printResults :: Bool -> Node.List -> Node.List -> Int -> Int
+ -> [(FailMode, Int)] -> IO ()
+printResults True _ fin_nl num_instances allocs sreason = do
let fin_stats = Cluster.totalResources fin_nl
fin_instances = num_instances + allocs
- when (num_instances + allocs /= Cluster.csNinst fin_stats) $
- do
- hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
- \ != counted (%d)\n" (num_instances + allocs)
- (Cluster.csNinst fin_stats) :: IO ()
- exitWith $ ExitFailure 1
-
- printKeys $ printStats PFinal fin_stats
- printKeys [ ("ALLOC_USAGE", printf "%.8f"
- ((fromIntegral num_instances::Double) /
- fromIntegral fin_instances))
- , ("ALLOC_INSTANCES", printf "%d" allocs)
- , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
- ]
- printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
- printf "%d" y)) sreason
- -- this should be the final entry
- printKeys [("OK", "1")]
-
-formatRSpec :: Double -> String -> RSpec -> [(String, String)]
-formatRSpec m_cpu s r =
- [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
- , ("KM_" ++ s ++ "_NPU", show $ fromIntegral (rspecCpu r) / m_cpu)
- , ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
- , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
- ]
-
-printAllocationStats :: Double -> Node.List -> Node.List -> IO ()
-printAllocationStats m_cpu ini_nl fin_nl = do
+ exitWhen (num_instances + allocs /= Cluster.csNinst fin_stats) $
+ printf "internal inconsistency, allocated (%d)\
+ \ != counted (%d)\n" (num_instances + allocs)
+ (Cluster.csNinst fin_stats)
+
+ printKeysHTS $ printStats PFinal fin_stats
+ printKeysHTS [ ("ALLOC_USAGE", printf "%.8f"
+ ((fromIntegral num_instances::Double) /
+ fromIntegral fin_instances))
+ , ("ALLOC_INSTANCES", printf "%d" allocs)
+ , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
+ ]
+ printKeysHTS $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
+ printf "%d" y)) sreason
+
+printResults False ini_nl fin_nl _ allocs sreason = do
+ putStrLn "Normal (fixed-size) allocation results:"
+ printf " - %3d instances allocated\n" allocs :: IO ()
+ printFRScores ini_nl fin_nl sreason
+
+-- | Prints the final @OK@ marker in machine readable output.
+printFinalHTS :: Bool -> IO ()
+printFinalHTS = printFinal htsPrefix
+
+-- | Compute the tiered spec counts from a list of allocated
+-- instances.
+tieredSpecMap :: [Instance.Instance]
+ -> [(RSpec, Int)]
+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 spec_map
+
+-- | Formats a spec map to strings.
+formatSpecMap :: [(RSpec, Int)] -> [String]
+formatSpecMap =
+ map (\(spec, cnt) -> printf "%d,%d,%d=%d" (rspecMem spec)
+ (rspecDsk spec) (rspecCpu spec) cnt)
+
+-- | Formats \"key-metrics\" values.
+formatRSpec :: String -> AllocInfo -> [(String, String)]
+formatRSpec s r =
+ [ ("KM_" ++ s ++ "_CPU", show $ allocInfoVCpus r)
+ , ("KM_" ++ s ++ "_NPU", show $ allocInfoNCpus r)
+ , ("KM_" ++ s ++ "_MEM", show $ allocInfoMem r)
+ , ("KM_" ++ s ++ "_DSK", show $ allocInfoDisk r)
+ ]
+
+-- | Shows allocations stats.
+printAllocationStats :: Node.List -> Node.List -> IO ()
+printAllocationStats ini_nl fin_nl = do
let ini_stats = Cluster.totalResources ini_nl
fin_stats = Cluster.totalResources fin_nl
(rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
- printKeys $ formatRSpec m_cpu "USED" rini
- printKeys $ formatRSpec m_cpu "POOL"ralo
- printKeys $ formatRSpec m_cpu "UNAV" runa
+ printKeysHTS $ formatRSpec "USED" rini
+ printKeysHTS $ formatRSpec "POOL" ralo
+ printKeysHTS $ formatRSpec "UNAV" runa
--- | Ensure a value is quoted if needed
-ensureQuoted :: String -> String
-ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v)
- then '\'':v ++ "'"
- else v
-
--- | Format a list of key\/values as a shell fragment
-printKeys :: [(String, String)] -> IO ()
-printKeys = mapM_ (\(k, v) ->
- printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
+-- | Format a list of key\/values as a shell fragment.
+printKeysHTS :: [(String, String)] -> IO ()
+printKeysHTS = printKeys htsPrefix
+-- | Converts instance data to a list of strings.
printInstance :: Node.List -> Instance.Instance -> [String]
printInstance nl i = [ Instance.name i
, Container.nameOf nl $ Instance.pNode i
, show (Instance.vcpus i)
]
--- | Optionally print the allocation map
+-- | Optionally print the allocation map.
printAllocationMap :: Int -> String
-> Node.List -> [Instance.Instance] -> IO ()
printAllocationMap verbose msg nl ixes =
when (verbose > 1) $ do
- hPutStrLn stderr msg
- hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
+ hPutStrLn stderr (msg ++ " map")
+ hPutStr stderr . unlines . map ((:) ' ' . unwords) $
formatTable (map (printInstance nl) (reverse ixes))
-- This is the numberic-or-not field
-- specification; the first three fields are
-- strings, whereas the rest are numeric
[False, False, False, True, True, True]
--- | Main function.
-main :: IO ()
-main = do
- cmd_args <- System.getArgs
- (opts, args) <- parseOpts cmd_args "hspace" options
+-- | Formats nicely a list of resources.
+formatResources :: a -> [(String, a->String)] -> String
+formatResources res =
+ intercalate ", " . map (\(a, fn) -> a ++ " " ++ fn res)
+
+-- | Print the cluster resources.
+printCluster :: Bool -> Cluster.CStats -> Int -> IO ()
+printCluster True ini_stats node_count = do
+ printKeysHTS $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
+ printKeysHTS [("CLUSTER_NODES", printf "%d" node_count)]
+ printKeysHTS $ printStats PInitial ini_stats
+
+printCluster False ini_stats node_count = do
+ printf "The cluster has %d nodes and the following resources:\n %s.\n"
+ node_count (formatResources ini_stats clusterData)::IO ()
+ printf "There are %s initial instances on the cluster.\n"
+ (if inst_count > 0 then show inst_count else "no" )
+ where inst_count = Cluster.csNinst ini_stats
+
+-- | Prints the normal instance spec.
+printISpec :: Bool -> RSpec -> SpecType -> DiskTemplate -> IO ()
+printISpec True ispec spec disk_template = do
+ printKeysHTS $ map (\(a, fn) -> (prefix ++ "_" ++ a, fn ispec)) specData
+ printKeysHTS [ (prefix ++ "_RQN", printf "%d" req_nodes) ]
+ printKeysHTS [ (prefix ++ "_DISK_TEMPLATE",
+ diskTemplateToRaw disk_template) ]
+ where req_nodes = Instance.requiredNodes disk_template
+ prefix = specPrefix spec
+
+printISpec False ispec spec disk_template =
+ printf "%s instance spec is:\n %s, using disk\
+ \ template '%s'.\n"
+ (specDescription spec)
+ (formatResources ispec specData) (diskTemplateToRaw disk_template)
+
+-- | Prints the tiered results.
+printTiered :: Bool -> [(RSpec, Int)]
+ -> Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
+printTiered True spec_map nl trl_nl _ = do
+ printKeysHTS $ printStats PTiered (Cluster.totalResources trl_nl)
+ printKeysHTS [("TSPEC", unwords (formatSpecMap spec_map))]
+ printAllocationStats nl trl_nl
+
+printTiered False spec_map ini_nl fin_nl sreason = do
+ _ <- printf "Tiered allocation results:\n"
+ if null spec_map
+ then putStrLn " - no instances allocated"
+ else mapM_ (\(ispec, cnt) ->
+ printf " - %3d instances of spec %s\n" cnt
+ (formatResources ispec specData)) spec_map
+ printFRScores ini_nl fin_nl sreason
+
+-- | Displays the initial/final cluster scores.
+printClusterScores :: Node.List -> Node.List -> IO ()
+printClusterScores ini_nl fin_nl = do
+ printf " - initial cluster score: %.8f\n" $ Cluster.compCV ini_nl::IO ()
+ printf " - final cluster score: %.8f\n" $ Cluster.compCV fin_nl
+
+-- | Displays the cluster efficiency.
+printClusterEff :: Cluster.CStats -> IO ()
+printClusterEff cs =
+ mapM_ (\(s, fn) ->
+ printf " - %s usage efficiency: %5.2f%%\n" s (fn cs * 100))
+ [("memory", memEff),
+ (" disk", dskEff),
+ (" vcpu", cpuEff)]
+
+-- | Computes the most likely failure reason.
+failureReason :: [(FailMode, Int)] -> String
+failureReason = show . fst . head
+
+-- | Sorts the failure reasons.
+sortReasons :: [(FailMode, Int)] -> [(FailMode, Int)]
+sortReasons = reverse . sortBy (comparing snd)
+
+-- | 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
+ -> DiskTemplate -- ^ Requested disk template
+ -> SpecType -- ^ Allocation type
+ -> Options -- ^ CLI options
+ -> IO (FailStats, Node.List, Int, [(RSpec, Int)])
+runAllocation cdata stop_allocation actual_result spec dt mode opts = do
+ (reasons, new_nl, new_il, new_ixes, _) <-
+ case stop_allocation of
+ Just result_noalloc -> return result_noalloc
+ Nothing -> exitIfBad "failure during allocation" actual_result
+
+ let name = head . words . specDescription $ mode
+ descr = name ++ " allocation"
+ ldescr = "after " ++ map toLower descr
+
+ printISpec (optMachineReadable opts) spec mode dt
+
+ 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)
+
+-- | Create an instance from a given spec.
+instFromSpec :: RSpec -> DiskTemplate -> Int -> Instance.Instance
+instFromSpec spx =
+ Instance.create "new" (rspecMem spx) (rspecDsk spx)
+ (rspecCpu spx) Running [] True (-1) (-1)
- unless (null args) $ do
- hPutStrLn stderr "Error: this program doesn't take any arguments."
- exitWith $ ExitFailure 1
+-- | Main function.
+main :: Options -> [String] -> IO ()
+main opts args = do
+ exitUnless (null args) "this program doesn't take any arguments"
let verbose = optVerbose opts
- ispec = optISpec opts
- shownodes = optShowNodes opts
- disk_template = optDiskTemplate opts
- req_nodes = Instance.requiredNodes disk_template
-
- (ClusterData gl fixed_nl il ctags) <- loadExternalData opts
+ machine_r = optMachineReadable opts
- printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
- printKeys [ ("SPEC_RQN", printf "%d" req_nodes) ]
- printKeys [ ("SPEC_DISK_TEMPLATE", dtToString disk_template) ]
+ orig_cdata@(ClusterData gl fixed_nl il _ ipol) <- loadExternalData opts
+ nl <- setNodeStatus opts fixed_nl
- let num_instances = length $ Container.elems il
+ cluster_disk_template <-
+ case iPolicyDiskTemplates ipol of
+ first_templ:_ -> return first_templ
+ _ -> exitErr "null list of disk templates received from cluster"
- let offline_names = optOffline opts
+ let num_instances = Container.size il
all_nodes = Container.elems fixed_nl
- all_names = map Node.name all_nodes
- offline_wrong = filter (`notElem` all_names) offline_names
- offline_indices = map Node.idx $
- filter (\n ->
- Node.name n `elem` offline_names ||
- Node.alias n `elem` offline_names)
- all_nodes
- m_cpu = optMcpu opts
- m_dsk = optMdsk opts
-
- when (length offline_wrong > 0) $ do
- hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
- (commaJoin offline_wrong) :: IO ()
- exitWith $ ExitFailure 1
-
- when (req_nodes /= 1 && req_nodes /= 2) $ do
- hPrintf stderr "Error: Invalid required nodes (%d)\n"
- req_nodes :: IO ()
- exitWith $ ExitFailure 1
-
- let nm = Container.map (\n -> if Node.idx n `elem` offline_indices
- then Node.setOffline n True
- else n) fixed_nl
- nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
- nm
+ cdata = orig_cdata { cdNodes = fixed_nl }
+ disk_template = fromMaybe cluster_disk_template (optDiskTemplate opts)
+ req_nodes = Instance.requiredNodes disk_template
csf = commonSuffix fixed_nl il
+ su = fromMaybe (iSpecSpindleUse $ iPolicyStdSpec ipol)
+ (optSpindleUse opts)
- when (length csf > 0 && verbose > 1) $
+ when (not (null csf) && verbose > 1) $
hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
- when (isJust shownodes) $
- do
- hPutStrLn stderr "Initial cluster status:"
- hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes)
-
- let ini_cv = Cluster.compCV nl
- ini_stats = Cluster.totalResources nl
+ maybePrintNodes (optShowNodes opts) "Initial cluster" (Cluster.printNodes nl)
when (verbose > 2) $
- hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
- ini_cv (Cluster.printStats nl)
-
- printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
- printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
- printKeys $ printStats PInitial ini_stats
+ hPrintf stderr "Initial coefficients: overall %.8f\n%s"
+ (Cluster.compCV nl) (Cluster.printStats " " nl)
- let bad_nodes = fst $ Cluster.computeBadItems nl il
- stop_allocation = length bad_nodes > 0
- result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [], [])
+ printCluster machine_r (Cluster.totalResources nl) (length all_nodes)
- -- utility functions
- let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
- (rspecCpu spx) "running" [] True (-1) (-1) disk_template
- exitifbad val = (case val of
- Bad s -> do
- hPrintf stderr "Failure: %s\n" s :: IO ()
- exitWith $ ExitFailure 1
- Ok x -> return x)
+ let stop_allocation = case Cluster.computeBadItems nl il of
+ ([], _) -> Nothing
+ _ -> Just ([(FailN1, 1)]::FailStats, nl, il, [], [])
+ alloclimit = if optMaxLength opts == -1
+ then Nothing
+ else Just (optMaxLength opts)
+ allocnodes <- exitIfBad "failure during allocation" $
+ Cluster.genAllocNodes gl nl req_nodes True
- let reqinst = iofspec ispec
+ -- Run the tiered allocation
- allocnodes <- exitifbad $ Cluster.genAllocNodes gl nl req_nodes True
+ let tspec = fromMaybe (rspecFromISpec (iPolicyMaxSpec ipol))
+ (optTieredSpec opts)
- -- Run the tiered allocation, if enabled
+ (treason, trl_nl, _, spec_map) <-
+ runAllocation cdata stop_allocation
+ (Cluster.tieredAlloc nl il alloclimit
+ (instFromSpec tspec disk_template su) allocnodes [] [])
+ tspec disk_template SpecTiered opts
- (case optTieredSpec opts of
- Nothing -> return ()
- Just tspec -> do
- (_, trl_nl, trl_il, trl_ixes, _) <-
- if stop_allocation
- then return result_noalloc
- else exitifbad (Cluster.tieredAlloc nl il Nothing (iofspec tspec)
- allocnodes [] [])
- let spec_map' = Cluster.tieredSpecMap trl_ixes
-
- printAllocationMap verbose "Tiered allocation map" trl_nl trl_ixes
-
- maybePrintNodes shownodes "Tiered allocation"
- (Cluster.printNodes trl_nl)
-
- maybeSaveData (optSaveCluster opts) "tiered" "after tiered allocation"
- (ClusterData gl trl_nl trl_il ctags)
-
- printKeys $ map (\(a, fn) -> ("TSPEC_INI_" ++ a, fn tspec)) specData
- printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
- printKeys [("TSPEC", intercalate " " spec_map')]
- printAllocationStats m_cpu nl trl_nl)
+ printTiered machine_r spec_map nl trl_nl treason
-- Run the standard (avg-mode) allocation
- (ereason, fin_nl, fin_il, ixes, _) <-
- if stop_allocation
- then return result_noalloc
- else exitifbad (Cluster.iterateAlloc nl il Nothing
- reqinst allocnodes [] [])
-
- let allocs = length ixes
- sreason = reverse $ sortBy (comparing snd) ereason
+ let ispec = fromMaybe (rspecFromISpec (iPolicyStdSpec ipol))
+ (optStdSpec opts)
- printAllocationMap verbose "Standard allocation map" fin_nl ixes
+ (sreason, fin_nl, allocs, _) <-
+ runAllocation cdata stop_allocation
+ (Cluster.iterateAlloc nl il alloclimit
+ (instFromSpec ispec disk_template su) allocnodes [] [])
+ ispec disk_template SpecNormal opts
- maybePrintNodes shownodes "Standard allocation" (Cluster.printNodes fin_nl)
+ printResults machine_r nl fin_nl num_instances allocs sreason
- maybeSaveData (optSaveCluster opts) "alloc" "after standard allocation"
- (ClusterData gl fin_nl fin_il ctags)
+ -- Print final result
- printResults fin_nl num_instances allocs sreason
+ printFinalHTS machine_r
projects / ganeti-local / blobdiff