X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/17e7af2b139193511bde20b486dbd6f414fe2ab5..4886952ee53106521c6548da5ff206c31974b64e:/hspace.hs?ds=sidebyside diff --git a/hspace.hs b/hspace.hs index 3ee89ee..90986d9 100644 --- a/hspace.hs +++ b/hspace.hs @@ -4,7 +4,7 @@ {- -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 @@ -25,12 +25,14 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA module Main (main) where -import Data.Char (toUpper) +import Data.Char (toUpper, isAlphaNum) import Data.List import Data.Function import Data.Maybe (isJust, fromJust) +import Data.Ord (comparing) import Monad -import System +import System (exitWith, ExitCode(..)) +import System.FilePath import System.IO import qualified System @@ -45,13 +47,13 @@ import Ganeti.HTools.Utils import Ganeti.HTools.Types import Ganeti.HTools.CLI import Ganeti.HTools.ExtLoader +import Ganeti.HTools.Text (serializeCluster) -- | Options list and functions options :: [OptType] options = [ oPrintNodes - , oNodeFile - , oInstFile + , oDataFile , oNodeSim , oRapiMaster , oLuxiSocket @@ -65,6 +67,7 @@ options = , oMaxCpu , oMinDisk , oTieredSpec + , oSaveCluster , oShowVer , oShowHelp ] @@ -89,7 +92,7 @@ statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore) \cs -> printf "%.8f" (fromIntegral (Cluster.csImem cs) / Cluster.csTmem cs)) , ("DSK_FREE", printf "%d" . Cluster.csFdsk) - , ("DSK_AVAIL", printf "%d ". Cluster.csAdsk) + , ("DSK_AVAIL", printf "%d". Cluster.csAdsk) , ("DSK_RESVD", \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs)) , ("DSK_INST", printf "%d" . Cluster.csIdsk) @@ -114,45 +117,9 @@ 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) ] --- | Recursively place instances on the cluster until we're out of space -iterateDepth :: Node.List - -> Instance.List - -> Instance.Instance - -> Int - -> [Instance.Instance] - -> Result (FailStats, 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 - newi2 = Instance.setIdx (Instance.setName newinst newname) newidx - in case Cluster.tryAlloc nl il newi2 nreq of - Bad s -> Bad s - Ok (errs, _, sols3) -> - case sols3 of - Nothing -> Ok (Cluster.collapseFailures errs, nl, ixes) - Just (_, (xnl, xi, _)) -> - iterateDepth xnl il newinst nreq $! (xi:ixes) - -tieredAlloc :: Node.List - -> Instance.List - -> Instance.Instance - -> Int - -> [Instance.Instance] - -> Result (FailStats, Node.List, [Instance.Instance]) -tieredAlloc nl il newinst nreq ixes = - case iterateDepth nl il newinst nreq ixes of - Bad s -> Bad s - Ok (errs, nl', ixes') -> - case Instance.shrinkByType newinst . fst . last $ - sortBy (compare `on` snd) errs of - Bad _ -> Ok (errs, nl', ixes') - Ok newinst' -> - tieredAlloc nl' il newinst' nreq ixes' - - -- | Function to print stats for a given phase printStats :: Phase -> Cluster.CStats -> [(String, String)] printStats ph cs = @@ -172,7 +139,7 @@ printResults fin_nl num_instances allocs sreason = do do hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\ \ != counted (%d)\n" (num_instances + allocs) - (Cluster.csNinst fin_stats) + (Cluster.csNinst fin_stats) :: IO () exitWith $ ExitFailure 1 printKeys $ printStats PFinal fin_stats @@ -187,16 +154,40 @@ printResults fin_nl num_instances allocs sreason = do -- this should be the final entry printKeys [("OK", "1")] --- | Format a list of key/values as a shell fragment +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) v) +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) + , 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) @@ -216,7 +207,7 @@ main = do ispec = optISpec opts shownodes = optShowNodes opts - (fixed_nl, il, csf) <- loadExternalData opts + (fixed_nl, il, _) <- loadExternalData opts printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ] @@ -226,9 +217,11 @@ main = do let offline_names = optOffline opts all_nodes = Container.elems fixed_nl all_names = map Node.name all_nodes - offline_wrong = filter (flip notElem 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 @@ -236,18 +229,20 @@ main = do when (length offline_wrong > 0) $ do hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n" - (commaJoin offline_wrong) + (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 + hPrintf stderr "Error: Invalid required nodes (%d)\n" + req_nodes :: IO () exitWith $ ExitFailure 1 - let nm = Container.map (\n -> if elem (Node.idx n) offline_indices + 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) $ hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf @@ -269,18 +264,15 @@ main = do printKeys $ printStats PInitial 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 + 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) "ADMIN_down" [] (-1) (-1) + (rspecCpu spx) "running" [] (-1) (-1) exitifbad val = (case val of Bad s -> do - hPrintf stderr "Failure: %s\n" s + hPrintf stderr "Failure: %s\n" s :: IO () exitWith $ ExitFailure 1 Ok x -> return x) @@ -292,8 +284,11 @@ main = do (case optTieredSpec opts of Nothing -> return () Just tspec -> do - let tresu = tieredAlloc nl il (iofspec tspec) req_nodes [] - (_, trl_nl, trl_ixes) <- exitifbad tresu + (_, 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)) @@ -314,17 +309,28 @@ main = do 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 trl_nl trl_il + 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')]) + printKeys [("TSPEC", intercalate " " spec_map')] + printAllocationStats m_cpu nl trl_nl) -- Run the standard (avg-mode) allocation - let result = iterateDepth nl il reqinst req_nodes [] - (ereason, fin_nl, ixes) <- exitifbad result + (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 (compare `on` snd) ereason + sreason = reverse $ sortBy (comparing snd) ereason when (verbose > 1) $ do hPutStrLn stderr "Instance map" @@ -337,4 +343,13 @@ main = do hPutStrLn stderr "Final cluster status:" hPutStrLn stderr $ Cluster.printNodes fin_nl (fromJust shownodes) + when (isJust $ optSaveCluster opts) $ + do + let out_path = (fromJust $ optSaveCluster opts) <.> "alloc" + adata = serializeCluster fin_nl fin_il + 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