{-
-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
+ , arguments
+ ) where
import Control.Monad
-import Data.Char (toUpper, isAlphaNum, toLower)
+import Data.Char (toUpper, toLower)
import Data.Function (on)
import Data.List
+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.BasicTypes
+import Ganeti.Common
import Ganeti.HTools.Types
import Ganeti.HTools.CLI
import Ganeti.HTools.ExtLoader
import Ganeti.HTools.Loader
+import Ganeti.Utils
-- | Options list and functions.
options :: [OptType]
options =
- [ oPrintNodes
- , oDataFile
- , oDiskTemplate
- , oNodeSim
- , oRapiMaster
- , oLuxiSocket
- , oVerbose
- , oQuiet
- , oOfflineNode
- , oIMem
- , oIDisk
- , oIVcpus
- , oMachineReadable
- , oMaxCpu
- , oMaxSolLength
- , oMinDisk
- , oTieredSpec
- , oSaveCluster
- , oShowVer
- , oShowHelp
- ]
+ [ oPrintNodes
+ , oDataFile
+ , oDiskTemplate
+ , oSpindleUse
+ , oNodeSim
+ , oRapiMaster
+ , oLuxiSocket
+ , oIAllocSrc
+ , oVerbose
+ , oQuiet
+ , oOfflineNode
+ , oMachineReadable
+ , oMaxCpu
+ , oMaxSolLength
+ , oMinDisk
+ , oStdSpec
+ , oTieredSpec
+ , oSaveCluster
+ ]
+
+-- | The list of arguments supported by the program.
+arguments :: [ArgCompletion]
+arguments = []
-- | The allocation phase we're in (initial, after tiered allocs, or
-- after regular allocation).
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"
cpuEff = effFn Cluster.csIcpu (fromIntegral . Cluster.csVcpu)
-- | Holds data for converting a 'Cluster.CStats' structure into
--- detailed statictics.
+-- detailed statistics.
statsData :: [(String, Cluster.CStats -> String)]
statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
, ("INST_CNT", printf "%d" . Cluster.csNinst)
PFinal -> "FIN"
PTiered -> "TRL"
+-- | 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 ()
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
+ 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 ()
- printf " - most likely failure reason: %s\n" $ failureReason sreason::IO ()
- printClusterScores ini_nl fin_nl
- printClusterEff (Cluster.totalResources fin_nl)
+ printFRScores ini_nl fin_nl sreason
-- | Prints the final @OK@ marker in machine readable output.
-printFinal :: Bool -> IO ()
-printFinal True =
- -- this should be the final entry
- printKeys [("OK", "1")]
-
-printFinal False = return ()
+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
+ 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)
+ map (\(spec, cnt) -> printf "%d,%d,%d=%d" (rspecMem spec)
+ (rspecDsk spec) (rspecCpu spec) cnt)
-- | Formats \"key-metrics\" values.
-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)
- ]
+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 :: Double -> Node.List -> Node.List -> IO ()
-printAllocationStats m_cpu ini_nl fin_nl = do
+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
-
--- | Ensure a value is quoted if needed.
-ensureQuoted :: String -> String
-ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v)
- then '\'':v ++ "'"
- else v
+ printKeysHTS $ formatRSpec "USED" rini
+ printKeysHTS $ formatRSpec "POOL" ralo
+ printKeysHTS $ formatRSpec "UNAV" runa
-- | 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))
+printKeysHTS :: [(String, String)] -> IO ()
+printKeysHTS = printKeys htsPrefix
-- | Converts instance data to a list of strings.
printInstance :: Node.List -> Instance.Instance -> [String]
printAllocationMap verbose msg nl ixes =
when (verbose > 1) $ do
hPutStrLn stderr (msg ++ " map")
- hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
+ hPutStr stderr . unlines . map ((:) ' ' . unwords) $
formatTable (map (printInstance nl) (reverse ixes))
-- This is the numberic-or-not field
-- specification; the first three fields are
-- | Print the cluster resources.
printCluster :: Bool -> Cluster.CStats -> Int -> IO ()
printCluster True ini_stats node_count = do
- printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
- printKeys [("CLUSTER_NODES", printf "%d" node_count)]
- printKeys $ printStats PInitial ini_stats
+ 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"
-- | Prints the normal instance spec.
printISpec :: Bool -> RSpec -> SpecType -> DiskTemplate -> IO ()
printISpec True ispec spec disk_template = do
- printKeys $ map (\(a, fn) -> (prefix ++ "_" ++ a, fn ispec)) specData
- printKeys [ (prefix ++ "_RQN", printf "%d" req_nodes) ]
- printKeys [ (prefix ++ "_DISK_TEMPLATE",
- diskTemplateToString disk_template) ]
+ 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
printf "%s instance spec is:\n %s, using disk\
\ template '%s'.\n"
(specDescription spec)
- (formatResources ispec specData) (diskTemplateToString disk_template)
+ (formatResources ispec specData) (diskTemplateToRaw disk_template)
-- | Prints the tiered results.
-printTiered :: Bool -> [(RSpec, Int)] -> Double
+printTiered :: Bool -> [(RSpec, Int)]
-> Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
-printTiered True spec_map m_cpu nl trl_nl _ = do
- printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
- printKeys [("TSPEC", intercalate " " (formatSpecMap spec_map))]
- printAllocationStats m_cpu nl trl_nl
+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
+printTiered False spec_map ini_nl fin_nl sreason = do
_ <- printf "Tiered allocation results:\n"
- mapM_ (\(ispec, cnt) ->
- printf " - %3d instances of spec %s\n" cnt
- (formatResources ispec specData)) spec_map
- printf " - most likely failure reason: %s\n" $ failureReason sreason::IO ()
- printClusterScores ini_nl fin_nl
- printClusterEff (Cluster.totalResources fin_nl)
+ 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 ()
-- | Displays the cluster efficiency.
printClusterEff :: Cluster.CStats -> IO ()
printClusterEff cs =
- mapM_ (\(s, fn) ->
- printf " - %s usage efficiency: %5.2f%%\n" s (fn cs * 100))
+ mapM_ (\(s, fn) ->
+ printf " - %s usage efficiency: %5.2f%%\n" s (fn cs * 100))
[("memory", memEff),
(" disk", dskEff),
(" vcpu", cpuEff)]
sortReasons :: [(FailMode, Int)] -> [(FailMode, Int)]
sortReasons = reverse . sortBy (comparing snd)
--- | Aborts the program if we get a bad value.
-exitIfBad :: Result a -> IO a
-exitIfBad (Bad s) =
- hPrintf stderr "Failure: %s\n" s >> exitWith (ExitFailure 1)
-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
+ -> DiskTemplate -- ^ Requested disk template
-> SpecType -- ^ Allocation type
-> Options -- ^ CLI options
-> IO (FailStats, Node.List, Int, [(RSpec, Int)])
-runAllocation cdata stop_allocation actual_result spec mode opts = do
+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 actual_result
+ 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 (optDiskTemplate opts)
+ printISpec (optMachineReadable opts) spec mode dt
printAllocationMap (optVerbose opts) descr new_nl new_ixes
return (sortReasons reasons, new_nl, length new_ixes, tieredSpecMap new_ixes)
--- | Main function.
-main :: IO ()
-main = do
- cmd_args <- System.getArgs
- (opts, args) <- parseOpts cmd_args "hspace" options
+-- | 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
- disk_template = optDiskTemplate opts
- req_nodes = Instance.requiredNodes disk_template
machine_r = optMachineReadable opts
- (ClusterData gl fixed_nl il ctags) <- loadExternalData opts
+ orig_cdata@(ClusterData gl fixed_nl il _ ipol) <- loadExternalData opts
nl <- setNodeStatus opts fixed_nl
+ cluster_disk_template <-
+ case iPolicyDiskTemplates ipol of
+ first_templ:_ -> return first_templ
+ _ -> exitErr "null list of disk templates received from cluster"
+
let num_instances = Container.size il
all_nodes = Container.elems fixed_nl
- cdata = ClusterData gl nl il ctags
+ 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 (not (null csf) && verbose > 1) $
hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
maybePrintNodes (optShowNodes opts) "Initial cluster" (Cluster.printNodes nl)
when (verbose > 2) $
- hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
- (Cluster.compCV nl) (Cluster.printStats nl)
+ hPrintf stderr "Initial coefficients: overall %.8f\n%s"
+ (Cluster.compCV nl) (Cluster.printStats " " nl)
printCluster machine_r (Cluster.totalResources nl) (length all_nodes)
then Nothing
else Just (optMaxLength opts)
- -- utility functions
- let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
- (rspecCpu spx) "running" [] True (-1) (-1) disk_template
+ allocnodes <- exitIfBad "failure during allocation" $
+ Cluster.genAllocNodes gl nl req_nodes True
- allocnodes <- exitIfBad $ Cluster.genAllocNodes gl nl req_nodes True
+ -- Run the tiered allocation
- -- Run the tiered allocation, if enabled
+ let tspec = fromMaybe (rspecFromISpec (iPolicyMaxSpec ipol))
+ (optTieredSpec opts)
- (case optTieredSpec opts of
- Nothing -> return ()
- Just tspec -> do
- (treason, trl_nl, _, spec_map) <-
- runAllocation cdata stop_allocation
- (Cluster.tieredAlloc nl il alloclimit (iofspec tspec)
- allocnodes [] []) tspec SpecTiered opts
+ (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
- printTiered machine_r spec_map (optMcpu opts) nl trl_nl treason
- )
+ printTiered machine_r spec_map nl trl_nl treason
-- Run the standard (avg-mode) allocation
+ let ispec = fromMaybe (rspecFromISpec (iPolicyStdSpec ipol))
+ (optStdSpec opts)
+
(sreason, fin_nl, allocs, _) <-
runAllocation cdata stop_allocation
- (Cluster.iterateAlloc nl il alloclimit (iofspec ispec)
- allocnodes [] []) ispec SpecNormal opts
+ (Cluster.iterateAlloc nl il alloclimit
+ (instFromSpec ispec disk_template su) allocnodes [] [])
+ ispec disk_template SpecNormal opts
printResults machine_r nl fin_nl num_instances allocs sreason
- printFinal machine_r
+ -- Print final result
+
+ printFinalHTS machine_r
projects / ganeti-local / blobdiff