{-
-Copyright (C) 2009 Google Inc.
+Copyright (C) 2009, 2010 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 Main (main) where
+import Data.Char (toUpper, isAlphaNum)
import Data.List
import Data.Function
-import Data.Maybe (isJust, fromJust, fromMaybe, isNothing)
+import Data.Maybe (isJust, fromJust)
+import Data.Ord (comparing)
import Monad
-import System
+import System (exitWith, ExitCode(..))
+import System.FilePath
import System.IO
-import System.Console.GetOpt
import qualified System
-import Text.Printf (printf)
+import Text.Printf (printf, hPrintf)
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance
-import qualified Ganeti.HTools.CLI as CLI
import Ganeti.HTools.Utils
-
--- | Command line options structure.
-data Options = Options
- { optShowNodes :: Bool -- ^ Whether to show node status
- , optNodef :: FilePath -- ^ Path to the nodes file
- , optNodeSet :: Bool -- ^ The nodes have been set by options
- , optInstf :: FilePath -- ^ Path to the instances file
- , optInstSet :: Bool -- ^ The insts have been set by options
- , optMaster :: String -- ^ Collect data from RAPI
- , optVerbose :: Int -- ^ Verbosity level
- , optOffline :: [String] -- ^ Names of offline nodes
- , optIMem :: Int -- ^ Instance memory
- , optIDsk :: Int -- ^ Instance disk
- , optINodes :: Int -- ^ Nodes required for an instance
- , optShowVer :: Bool -- ^ Just show the program version
- , optShowHelp :: Bool -- ^ Just show the help
- } deriving Show
-
-instance CLI.CLIOptions Options where
- showVersion = optShowVer
- showHelp = optShowHelp
-
-instance CLI.EToolOptions Options where
- nodeFile = optNodef
- nodeSet = optNodeSet
- instFile = optInstf
- instSet = optInstSet
- masterName = optMaster
- silent a = (optVerbose a) == 0
-
--- | Default values for the command line options.
-defaultOptions :: Options
-defaultOptions = Options
- { optShowNodes = False
- , optNodef = "nodes"
- , optNodeSet = False
- , optInstf = "instances"
- , optInstSet = False
- , optMaster = ""
- , optVerbose = 1
- , optOffline = []
- , optIMem = 4096
- , optIDsk = 102400
- , optINodes = 2
- , optShowVer = False
- , optShowHelp = False
- }
+import Ganeti.HTools.Types
+import Ganeti.HTools.CLI
+import Ganeti.HTools.ExtLoader
+import Ganeti.HTools.Text (serializeCluster)
-- | Options list and functions
-options :: [OptDescr (Options -> Options)]
+options :: [OptType]
options =
- [ Option ['p'] ["print-nodes"]
- (NoArg (\ opts -> opts { optShowNodes = True }))
- "print the final node list"
- , Option ['n'] ["nodes"]
- (ReqArg (\ f opts -> opts { optNodef = f, optNodeSet = True }) "FILE")
- "the node list FILE"
- , Option ['i'] ["instances"]
- (ReqArg (\ f opts -> opts { optInstf = f, optInstSet = True }) "FILE")
- "the instance list FILE"
- , Option ['m'] ["master"]
- (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
- "collect data via RAPI at the given ADDRESS"
- , Option ['v'] ["verbose"]
- (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 }))
- "increase the verbosity level"
- , Option ['q'] ["quiet"]
- (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) - 1 }))
- "decrease the verbosity level"
- , Option ['O'] ["offline"]
- (ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE")
- "set node as offline"
- , Option [] ["memory"]
- (ReqArg (\ m opts -> opts { optIMem = read m }) "MEMORY")
- "memory size for instances"
- , Option [] ["disk"]
- (ReqArg (\ d opts -> opts { optIDsk = read d }) "DISK")
- "disk size for instances"
- , Option [] ["req-nodes"]
- (ReqArg (\ n opts -> opts { optINodes = read n }) "NODES")
- "number of nodes for the new instances (1=plain, 2=mirrored)"
- , Option ['V'] ["version"]
- (NoArg (\ opts -> opts { optShowVer = True}))
- "show the version of the program"
- , Option ['h'] ["help"]
- (NoArg (\ opts -> opts { optShowHelp = True}))
- "show help"
+ [ oPrintNodes
+ , oDataFile
+ , oNodeSim
+ , oRapiMaster
+ , oLuxiSocket
+ , oVerbose
+ , oQuiet
+ , oOfflineNode
+ , oIMem
+ , oIDisk
+ , oIVcpus
+ , oINodes
+ , oMaxCpu
+ , oMinDisk
+ , oTieredSpec
+ , oSaveCluster
+ , oShowVer
+ , oShowHelp
]
-filterFails :: (Monad m) => [(Maybe Node.List, [Node.Node])]
- -> m [(Node.List, [Node.Node])]
-filterFails sols =
- if null sols then fail "No nodes onto which to allocate at all"
- else let sols' = filter (isJust . fst) sols
- in if null sols' then
- fail "No valid allocation solutions"
- else
- return $ map (\(x, y) -> (fromJust x, y)) sols'
-
-processResults :: (Monad m) => [(Node.List, [Node.Node])]
- -> m (Node.List, [Node.Node])
-processResults sols =
- let sols' = map (\(nl', ns) -> (Cluster.compCV nl', (nl', ns))) sols
- sols'' = sortBy (compare `on` fst) sols'
- in return $ snd $ head sols''
-
-iterateDepth :: Node.List
- -> Instance.List
- -> Instance.Instance
- -> Int
- -> Int
- -> (Node.List, Int)
-iterateDepth nl il newinst nreq depth =
- let newname = printf "new-%d" depth
- newidx = (length $ Container.elems il) + depth
- newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
- sols = Cluster.tryAlloc nl il newi2 nreq
- orig = (nl, depth)
- in
- if isNothing sols then orig
- else let sols' = fromJust sols
- sols'' = filterFails sols'
- in if isNothing sols'' then orig
- else let (xnl, _) = fromJust $ processResults $ fromJust sols''
- in iterateDepth xnl il newinst nreq (depth+1)
+-- | The allocation phase we're in (initial, after tiered allocs, or
+-- after regular allocation).
+data Phase = PInitial
+ | PFinal
+ | PTiered
+
+statsData :: [(String, Cluster.CStats -> String)]
+statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
+ , ("INST_CNT", printf "%d" . Cluster.csNinst)
+ , ("MEM_FREE", printf "%d" . Cluster.csFmem)
+ , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
+ , ("MEM_RESVD",
+ \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
+ , ("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))
+ , ("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))
+ , ("CPU_INST", printf "%d" . Cluster.csIcpu)
+ , ("CPU_EFF",
+ \cs -> printf "%.8f" (fromIntegral (Cluster.csIcpu cs) /
+ Cluster.csTcpu cs))
+ , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
+ , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
+ ]
+
+specData :: [(String, RSpec -> String)]
+specData = [ ("MEM", printf "%d" . rspecMem)
+ , ("DSK", printf "%d" . rspecDsk)
+ , ("CPU", printf "%d" . rspecCpu)
+ ]
+
+clusterData :: [(String, Cluster.CStats -> String)]
+clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
+ , ("DSK", printf "%.0f" . Cluster.csTdsk)
+ , ("CPU", printf "%.0f" . Cluster.csTcpu)
+ , ("VCPU", printf "%d" . Cluster.csVcpu)
+ ]
+
+-- | 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
+ where kind = case ph of
+ PInitial -> "INI"
+ 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
+ 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
+ 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
+
+-- | 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))
+
+printInstance :: Node.List -> Instance.Instance -> [String]
+printInstance nl i = [ Instance.name i
+ , Container.nameOf nl $ Instance.pNode i
+ , let sdx = Instance.sNode i
+ in if sdx == Node.noSecondary then ""
+ else Container.nameOf nl sdx
+ , show (Instance.mem i)
+ , show (Instance.dsk i)
+ , show (Instance.vcpus i)
+ ]
-- | Main function.
main :: IO ()
main = do
cmd_args <- System.getArgs
- (opts, args) <- CLI.parseOpts cmd_args "hspace" options defaultOptions
+ (opts, args) <- parseOpts cmd_args "hspace" options
unless (null args) $ do
hPutStrLn stderr "Error: this program doesn't take any arguments."
exitWith $ ExitFailure 1
let verbose = optVerbose opts
+ ispec = optISpec opts
+ shownodes = optShowNodes opts
+
+ (gl, fixed_nl, il, ctags) <- loadExternalData opts
- (fixed_nl, il, csf) <- CLI.loadExternalData opts
+ printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
+ printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
+
+ let num_instances = length $ Container.elems il
let offline_names = optOffline opts
all_nodes = Container.elems fixed_nl
all_names = map Node.name all_nodes
- offline_wrong = filter (\n -> not $ elem n all_names) offline_names
+ offline_wrong = filter (`notElem` all_names) offline_names
offline_indices = map Node.idx $
- filter (\n -> elem (Node.name n) offline_names)
+ filter (\n ->
+ Node.name n `elem` offline_names ||
+ Node.alias n `elem` offline_names)
all_nodes
+ req_nodes = optINodes opts
+ m_cpu = optMcpu opts
+ m_dsk = optMdsk opts
when (length offline_wrong > 0) $ do
- printf "Wrong node name(s) set as offline: %s\n"
- (commaJoin offline_wrong)
+ hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
+ (commaJoin offline_wrong) :: IO ()
exitWith $ ExitFailure 1
- let nl = Container.map (\n -> if elem (Node.idx n) offline_indices
+ 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
+ csf = commonSuffix fixed_nl il
- when (length csf > 0 && verbose > 1) $ do
- printf "Note: Stripping common suffix of '%s' from names\n" csf
-
- let bad_nodes = fst $ Cluster.computeBadItems nl il
- when (length bad_nodes > 0) $ do
- putStrLn "Cluster not N+1, no space to allocate."
- exitWith $ ExitFailure 1
+ when (length csf > 0 && verbose > 1) $
+ hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
- when (optShowNodes opts) $
+ when (isJust shownodes) $
do
- putStrLn "Initial cluster status:"
- putStrLn $ Cluster.printNodes nl
+ hPutStrLn stderr "Initial cluster status:"
+ hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes)
let ini_cv = Cluster.compCV nl
+ ini_stats = Cluster.totalResources nl
- (if verbose > 2 then
- printf "Initial coefficients: overall %.8f, %s\n"
- ini_cv (Cluster.printStats nl)
- else
- printf "Initial score: %.8f\n" ini_cv)
+ when (verbose > 2) $
+ hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
+ ini_cv (Cluster.printStats nl)
- let imlen = Container.maxNameLen il
- nmlen = Container.maxNameLen nl
- newinst = Instance.create "new" (optIMem opts) (optIDsk opts)
- "ADMIN_down" (-1) (-1)
+ printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
+ printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
+ printKeys $ printStats PInitial ini_stats
- let (fin_nl, fin_depth) = iterateDepth nl il newinst (optINodes opts) 0
-
- unless (verbose == 0) $
- printf "Solution length=%d\n" fin_depth
+ let bad_nodes = fst $ Cluster.computeBadItems nl il
+ stop_allocation = length bad_nodes > 0
+ result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [])
+
+ -- utility functions
+ let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
+ (rspecCpu spx) "running" [] (-1) (-1)
+ exitifbad val = (case val of
+ Bad s -> do
+ hPrintf stderr "Failure: %s\n" s :: IO ()
+ exitWith $ ExitFailure 1
+ Ok x -> return x)
+
+
+ let reqinst = iofspec ispec
+
+ -- Run the tiered allocation, if enabled
+
+ (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 (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]
+
+ when (verbose > 1) $ do
+ hPutStrLn stderr "Tiered allocation map"
+ hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
+ formatTable (map (printInstance trl_nl) fin_trl_ixes)
+ [False, False, False, True, True, True]
+
+ when (isJust shownodes) $ do
+ hPutStrLn stderr ""
+ hPutStrLn stderr "Tiered allocation status:"
+ hPutStrLn stderr $ Cluster.printNodes trl_nl (fromJust shownodes)
+
+ when (isJust $ optSaveCluster opts) $
+ do
+ let out_path = (fromJust $ optSaveCluster opts) <.> "tiered"
+ adata = serializeCluster gl trl_nl trl_il ctags
+ writeFile out_path adata
+ hPrintf stderr "The cluster state after tiered allocation\
+ \ has been written to file '%s'\n"
+ out_path
+ printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
+ printKeys [("TSPEC", intercalate " " spec_map')]
+ printAllocationStats m_cpu nl trl_nl)
+
+ -- 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 reqinst req_nodes [])
+
+ let allocs = length ixes
+ fin_ixes = reverse ixes
+ sreason = reverse $ sortBy (comparing snd) ereason
+
+ when (verbose > 1) $ do
+ hPutStrLn stderr "Instance map"
+ hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
+ formatTable (map (printInstance fin_nl) fin_ixes)
+ [False, False, False, True, True, True]
+ when (isJust shownodes) $
+ do
+ hPutStrLn stderr ""
+ hPutStrLn stderr "Final cluster status:"
+ hPutStrLn stderr $ Cluster.printNodes fin_nl (fromJust shownodes)
- when (optShowNodes opts) $
+ when (isJust $ optSaveCluster opts) $
do
- let (orig_mem, orig_disk) = Cluster.totalResources nl
- (final_mem, final_disk) = Cluster.totalResources fin_nl
- putStrLn ""
- putStrLn "Final cluster status:"
- putStrLn $ Cluster.printNodes fin_nl
- when (verbose > 3) $
- do
- printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
- printf "Final: mem=%d disk=%d\n" final_mem final_disk
+ let out_path = (fromJust $ optSaveCluster opts) <.> "alloc"
+ adata = serializeCluster gl fin_nl fin_il ctags
+ writeFile out_path adata
+ hPrintf stderr "The cluster state after standard allocation\
+ \ has been written to file '%s'\n"
+ out_path
+
+ printResults fin_nl num_instances allocs sreason