import Data.List
import Data.Function
-import Data.Maybe (isJust, fromJust, isNothing)
import Monad
import System
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.CLI as CLI
import Ganeti.HTools.Utils
+import Ganeti.HTools.Types
-- | Command line options structure.
data Options = Options
instFile = optInstf
instSet = optInstSet
masterName = optMaster
- silent a = (optVerbose a) == 0
+ silent a = optVerbose a == 0
-- | Default values for the command line options.
defaultOptions :: Options
(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 }))
+ (NoArg (\ opts -> opts { optVerbose = optVerbose opts + 1 }))
"increase the verbosity level"
, Option ['q'] ["quiet"]
- (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) - 1 }))
+ (NoArg (\ opts -> opts { optVerbose = optVerbose opts - 1 }))
"decrease the verbosity level"
, Option ['O'] ["offline"]
(ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE")
"show help"
]
+-- | Build failure stats out of a list of failure reasons
+concatFailure :: [(FailMode, Int)] -> FailMode -> [(FailMode, Int)]
+concatFailure flst reason =
+ let cval = lookup reason flst
+ in case cval of
+ Nothing -> (reason, 1):flst
+ Just val -> let plain = filter (\(x, _) -> x /= reason) flst
+ in (reason, val+1):plain
+
+-- | Build list of failures and placements out of an list of possible
+-- | allocations
filterFails :: Cluster.AllocSolution
- -> Maybe [(Node.List, Instance.Instance, [Node.Node])]
+ -> ([(FailMode, Int)],
+ [(Node.List, Instance.Instance, [Node.Node])])
filterFails sols =
- if null sols then Nothing -- No nodes onto which to allocate at all
- else let sols' = filter (isJust . fst3) sols
- in if null sols' then
- Nothing -- No valid allocation solutions
- else
- return $ map (\(x, y, z) -> (fromJust x, y, z)) sols'
-
-processResults :: (Monad m) => [(Node.List, Instance.Instance, [Node.Node])]
- -> m (Node.List, Instance.Instance, [Node.Node])
+ let (alst, blst) = unzip . map (\ (onl, i, nn) ->
+ case onl of
+ OpFail reason -> ([reason], [])
+ OpGood gnl -> ([], [(gnl, i, nn)])
+ ) $ sols
+ aval = concat alst
+ bval = concat blst
+ in (foldl' concatFailure [] aval, bval)
+
+-- | Get the placement with best score out of a list of possible placements
+processResults :: [(Node.List, Instance.Instance, [Node.Node])]
+ -> (Node.List, Instance.Instance, [Node.Node])
processResults sols =
let sols' = map (\e@(nl', _, _) -> (Cluster.compCV nl', e)) sols
sols'' = sortBy (compare `on` fst) sols'
- in return $ snd $ head sols''
+ in snd $ head sols''
+-- | Recursively place instances on the cluster until we're out of space
iterateDepth :: Node.List
-> Instance.List
-> Instance.Instance
-> Int
-> [Instance.Instance]
- -> (Node.List, [Instance.Instance])
+ -> ([(FailMode, Int)], Node.List, [Instance.Instance])
iterateDepth nl il newinst nreq ixes =
let depth = length ixes
- newname = (printf "new-%d" depth)::String
- newidx = (length $ Container.elems il) + depth
+ newname = printf "new-%d" depth::String
+ newidx = length (Container.elems il) + depth
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
- sols = (Cluster.tryAlloc nl il newi2 nreq)::
- Maybe Cluster.AllocSolution
- orig = (nl, ixes)
- in
- if isNothing sols then orig
- else let sols' = fromJust sols
- sols'' = filterFails sols'
- in if isNothing sols'' then orig
- else let (xnl, xi, _) = fromJust $ processResults $
- fromJust sols''
- in iterateDepth xnl il newinst nreq (xi:ixes)
-
+ sols = Cluster.tryAlloc nl il newi2 nreq::
+ OpResult Cluster.AllocSolution
+ in case sols of
+ OpFail _ -> ([], nl, ixes)
+ OpGood sols' ->
+ let (errs, sols3) = filterFails sols'
+ in if null sols3
+ then (errs, nl, ixes)
+ else let (xnl, xi, _) = processResults sols3
+ in iterateDepth xnl il newinst nreq (xi:ixes)
+
+-- | Function to print stats for a given phase
printStats :: String -> Cluster.CStats -> IO ()
printStats kind cs = do
+ printf "%s score: %.8f\n" kind (Cluster.cs_score cs)
+ printf "%s instances: %d\n" kind (Cluster.cs_ninst cs)
printf "%s free RAM: %d\n" kind (Cluster.cs_fmem cs)
printf "%s allocatable RAM: %d\n" kind (Cluster.cs_amem cs)
- printf "%s reserved RAM: %d\n" kind ((Cluster.cs_fmem cs) -
- (Cluster.cs_amem cs))
+ printf "%s reserved RAM: %d\n" kind (Cluster.cs_fmem cs -
+ Cluster.cs_amem cs)
+ printf "%s instance RAM: %d\n" kind (Cluster.cs_imem cs)
+ printf "%s overhead RAM: %d\n" kind (Cluster.cs_xmem cs + Cluster.cs_nmem cs)
+ printf "%s RAM usage efficiency: %.8f\n"
+ kind (fromIntegral (Cluster.cs_imem cs) / Cluster.cs_tmem cs)
printf "%s free disk: %d\n" kind (Cluster.cs_fdsk cs)
printf "%s allocatable disk: %d\n" kind (Cluster.cs_adsk cs)
- printf "%s reserved disk: %d\n" kind ((Cluster.cs_fdsk cs) -
- (Cluster.cs_adsk cs))
+ printf "%s reserved disk: %d\n" kind (Cluster.cs_fdsk cs -
+ Cluster.cs_adsk cs)
+ printf "%s instance disk: %d\n" kind (Cluster.cs_idsk cs)
+ printf "%s disk usage efficiency: %.8f\n"
+ kind (fromIntegral (Cluster.cs_idsk cs) / Cluster.cs_tdsk cs)
+ printf "%s instance cpus: %d\n" kind (Cluster.cs_icpu cs)
+ printf "%s cpu usage efficiency: %.8f\n"
+ kind (fromIntegral (Cluster.cs_icpu cs) / Cluster.cs_tcpu cs)
printf "%s max node allocatable RAM: %d\n" kind (Cluster.cs_mmem cs)
printf "%s max node allocatable disk: %d\n" kind (Cluster.cs_mdsk cs)
+-- | 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.cs_ninst fin_stats) $
+ do
+ hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
+ \ != counted (%d)\n" (num_instances + allocs)
+ (Cluster.cs_ninst fin_stats)
+ exitWith $ ExitFailure 1
+
+ printStats "Final" fin_stats
+ printf "Usage: %.5f\n" ((fromIntegral num_instances::Double) /
+ fromIntegral fin_instances)
+ printf "Allocations: %d\n" allocs
+ putStr (unlines . map (\(x, y) -> printf "%s: %d" (show x) y) $ sreason)
+ printf "Most likely fail reason: %s\n" (show . fst . head $ sreason)
+
-- | Main function.
main :: IO ()
main = do
let verbose = optVerbose opts
(fixed_nl, il, csf) <- CLI.loadExternalData opts
+
+ printf "Spec RAM: %d\n" (optIMem opts)
+ printf "Spec disk: %d\n" (optIDsk opts)
+ printf "Spec CPUs: %d\n" (optIVCPUs opts)
+ printf "Spec nodes: %d\n" (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 (flip notElem all_names) offline_names
offline_indices = map Node.idx $
filter (\n -> elem (Node.name n) offline_names)
all_nodes
m_dsk = optMdsk opts
when (length offline_wrong > 0) $ do
- printf "Error: 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)
exitWith $ ExitFailure 1
when (req_nodes /= 1 && req_nodes /= 2) $ do
- printf "Error: Invalid required nodes (%d)\n" req_nodes
+ hPrintf stderr "Error: Invalid required nodes (%d)\n" req_nodes
exitWith $ ExitFailure 1
let nm = Container.map (\n -> if elem (Node.idx n) offline_indices
nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
nm
- 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 "Error: Cluster not N+1, no space to allocate."
- exitWith $ ExitFailure 1
+ when (length csf > 0 && verbose > 1) $
+ printf "Note: Stripping common suffix of '%s' from names\n" csf
when (optShowNodes opts) $
do
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)
- printf "Initial instances: %d\n" num_instances
+ when (verbose > 2) $ do
+ printf "Initial coefficients: overall %.8f, %s\n"
+ ini_cv (Cluster.printStats nl)
+
+ printf "Cluster RAM: %.0f\n" (Cluster.cs_tmem ini_stats)
+ printf "Cluster disk: %.0f\n" (Cluster.cs_tdsk ini_stats)
+ printf "Cluster cpus: %.0f\n" (Cluster.cs_tcpu ini_stats)
printStats "Initial" ini_stats
+ let bad_nodes = fst $ Cluster.computeBadItems nl il
+ when (length bad_nodes > 0) $ do
+ -- This is failn1 case, so we print the same final stats and
+ -- exit early
+ printResults nl num_instances 0 [(FailN1, 1)]
+ exitWith ExitSuccess
+
let nmlen = Container.maxNameLen nl
newinst = Instance.create "new" (optIMem opts) (optIDsk opts)
(optIVCPUs opts) "ADMIN_down" (-1) (-1)
- let (fin_nl, ixes) = iterateDepth nl il newinst req_nodes []
+ let (ereason, fin_nl, ixes) = iterateDepth nl il newinst req_nodes []
allocs = length ixes
- fin_instances = num_instances + allocs
fin_ixes = reverse ixes
ix_namelen = maximum . map (length . Instance.name) $ fin_ixes
- fin_stats = Cluster.totalResources fin_nl
+ sreason = reverse $ sortBy (compare `on` snd) ereason
- printf "Final score: %.8f\n" (Cluster.compCV fin_nl)
- printf "Final instances: %d\n" (num_instances + allocs)
- printStats "Final" fin_stats
- printf "Usage: %.5f\n" (((fromIntegral num_instances)::Double) /
- (fromIntegral fin_instances))
- printf "Allocations: %d\n" allocs
- when (verbose > 1) $ do
+ printResults fin_nl num_instances allocs sreason
+
+ when (verbose > 1) $
putStr . unlines . map (\i -> printf "Inst: %*s %-*s %-*s"
ix_namelen (Instance.name i)
nmlen (Container.nameOf fin_nl $ Instance.pnode i)
projects / ganeti-local / blobdiff