{-
-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
import Data.Ord (comparing)
import Monad
import System (exitWith, ExitCode(..))
+import System.FilePath
import System.IO
import qualified System
import Ganeti.HTools.Types
import Ganeti.HTools.CLI
import Ganeti.HTools.ExtLoader
+import Ganeti.HTools.Text (serializeCluster)
-- | Options list and functions
options :: [OptType]
, oMaxCpu
, oMinDisk
, oTieredSpec
+ , oSaveCluster
, oShowVer
, oShowHelp
]
, ("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
- [] -> Ok (Cluster.collapseFailures errs, nl, ixes)
- (_, (xnl, xi, _)):[] ->
- iterateDepth xnl il newinst nreq $! (xi:ixes)
- _ -> Bad "Internal error: multiple solutions for single\
- \ allocation"
-
-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 (comparing 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 =
-- this should be the final entry
printKeys [("OK", "1")]
-formatRSpec :: String -> RSpec -> [(String, String)]
-formatRSpec s r =
+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 :: Node.List -> Node.List -> IO ()
-printAllocationStats ini_nl fin_nl = do
+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 "USED" rini
- printKeys $ formatRSpec "POOL" ralo
- printKeys $ formatRSpec "UNAV" runa
+ 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
then '\'':v ++ "'"
else v
--- | Format a list of key/values as a shell fragment
+-- | 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))
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)) ]
all_names = map Node.name all_nodes
offline_wrong = filter (`notElem` all_names) offline_names
offline_indices = map Node.idx $
- filter (\n -> Node.name n `elem` 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
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
let bad_nodes = fst $ Cluster.computeBadItems nl il
stop_allocation = length bad_nodes > 0
- result_noalloc = ([(FailN1, 1)]::FailStats, nl, [])
+ 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 :: IO ()
(case optTieredSpec opts of
Nothing -> return ()
Just tspec -> do
- (_, trl_nl, trl_ixes) <-
+ (_, trl_nl, trl_il, trl_ixes) <-
if stop_allocation
then return result_noalloc
- else exitifbad (tieredAlloc nl il (iofspec tspec) req_nodes [])
+ 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))
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')]
- printAllocationStats nl trl_nl)
+ printAllocationStats m_cpu nl trl_nl)
-- Run the standard (avg-mode) allocation
- (ereason, fin_nl, ixes) <-
+ (ereason, fin_nl, fin_il, ixes) <-
if stop_allocation
then return result_noalloc
- else exitifbad (iterateDepth nl il reqinst req_nodes [])
+ else exitifbad (Cluster.iterateAlloc nl il reqinst req_nodes [])
let allocs = length ixes
fin_ixes = reverse ixes
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
projects / ganeti-local / blobdiff