X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/d752eb39e0c2c002d5b7bbd34cb64da18534164a..dca7f396cb33835c8b48aa580c3515d61d6e1c2e:/hspace.hs diff --git a/hspace.hs b/hspace.hs index 57de4ec..6ad59cc 100644 --- a/hspace.hs +++ b/hspace.hs @@ -27,7 +27,6 @@ module Main (main) where import Data.List import Data.Function -import Data.Maybe (isJust, fromJust, fromMaybe, isNothing) import Monad import System import System.IO @@ -43,6 +42,7 @@ import qualified Ganeti.HTools.Instance as Instance import qualified Ganeti.HTools.CLI as CLI import Ganeti.HTools.Utils +import Ganeti.HTools.Types -- | Command line options structure. data Options = Options @@ -58,6 +58,8 @@ data Options = Options , optIDsk :: Int -- ^ Instance disk , optIVCPUs :: Int -- ^ Instance VCPUs , optINodes :: Int -- ^ Nodes required for an instance + , optMcpu :: Double -- ^ Max cpu ratio for nodes + , optMdsk :: Double -- ^ Max disk usage ratio for nodes , optShowVer :: Bool -- ^ Just show the program version , optShowHelp :: Bool -- ^ Just show the help } deriving Show @@ -72,7 +74,7 @@ instance CLI.EToolOptions Options where 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 @@ -89,6 +91,8 @@ defaultOptions = Options , optIDsk = 102400 , optIVCPUs = 1 , optINodes = 2 + , optMcpu = -1 + , optMdsk = -1 , optShowVer = False , optShowHelp = False } @@ -109,10 +113,10 @@ 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") @@ -129,6 +133,12 @@ options = , Option [] ["req-nodes"] (ReqArg (\ n opts -> opts { optINodes = read n }) "NODES") "number of nodes for the new instances (1=plain, 2=mirrored)" + , Option [] ["max-cpu"] + (ReqArg (\ n opts -> opts { optMcpu = read n }) "RATIO") + "maximum virtual-to-physical cpu ratio for nodes" + , Option [] ["min-disk"] + (ReqArg (\ n opts -> opts { optMdsk = read n }) "RATIO") + "minimum free disk space for nodes (between 0 and 1)" , Option ['V'] ["version"] (NoArg (\ opts -> opts { optShowVer = True})) "show the version of the program" @@ -137,45 +147,89 @@ options = "show help" ] -filterFails :: (Monad m) => [(Maybe Node.List, Instance.Instance, [Node.Node])] - -> m [(Node.List, Instance.Instance, [Node.Node])] +-- | 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 + -> ([(FailMode, Int)], + [(Node.List, Instance.Instance, [Node.Node])]) filterFails sols = - if null sols then fail "No nodes onto which to allocate at all" - else let sols' = filter (isJust . fst3) sols - in if null sols' then - fail "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 - 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 - 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 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 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 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 + 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 + 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 () @@ -187,6 +241,11 @@ main = do hPutStrLn stderr "Error: this program doesn't take any arguments." exitWith $ ExitFailure 1 + 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 verbose = optVerbose opts (fixed_nl, il, csf) <- CLI.loadExternalData opts @@ -195,11 +254,13 @@ main = do 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 req_nodes = optINodes opts + m_cpu = optMcpu opts + m_dsk = optMdsk opts when (length offline_wrong > 0) $ do printf "Error: Wrong node name(s) set as offline: %s\n" @@ -210,17 +271,14 @@ main = do printf "Error: Invalid required nodes (%d)\n" req_nodes exitWith $ ExitFailure 1 - let nl = Container.map (\n -> if elem (Node.idx n) offline_indices + let nm = Container.map (\n -> if elem (Node.idx n) 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 - 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 @@ -228,7 +286,7 @@ main = do putStrLn $ Cluster.printNodes nl let ini_cv = Cluster.compCV nl - (orig_mem, orig_disk) = Cluster.totalResources nl + ini_stats = Cluster.totalResources nl (if verbose > 2 then printf "Initial coefficients: overall %.8f, %s\n" @@ -236,28 +294,28 @@ main = do else printf "Initial score: %.8f\n" ini_cv) printf "Initial instances: %d\n" num_instances - printf "Initial free RAM: %d\n" orig_mem - printf "Initial free disk: %d\n" orig_disk + 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 - (final_mem, final_disk) = 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) - printf "Final free RAM: %d\n" final_mem - printf "Final free disk: %d\n" final_disk - 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) @@ -268,12 +326,6 @@ main = do when (optShowNodes 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