1 {-| Cluster space sizing
7 Copyright (C) 2009 Google Inc.
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
14 This program is distributed in the hope that it will be useful, but
15 WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 module Main (main) where
28 import Data.Char (toUpper, isAlphaNum)
31 import Data.Maybe (isJust, fromJust)
32 import Data.Ord (comparing)
34 import System (exitWith, ExitCode(..))
36 import qualified System
38 import Text.Printf (printf, hPrintf)
40 import qualified Ganeti.HTools.Container as Container
41 import qualified Ganeti.HTools.Cluster as Cluster
42 import qualified Ganeti.HTools.Node as Node
43 import qualified Ganeti.HTools.Instance as Instance
45 import Ganeti.HTools.Utils
46 import Ganeti.HTools.Types
47 import Ganeti.HTools.CLI
48 import Ganeti.HTools.ExtLoader
50 -- | Options list and functions
72 -- | The allocation phase we're in (initial, after tiered allocs, or
73 -- after regular allocation).
78 statsData :: [(String, Cluster.CStats -> String)]
79 statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
80 , ("INST_CNT", printf "%d" . Cluster.csNinst)
81 , ("MEM_FREE", printf "%d" . Cluster.csFmem)
82 , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
84 \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
85 , ("MEM_INST", printf "%d" . Cluster.csImem)
87 \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
89 \cs -> printf "%.8f" (fromIntegral (Cluster.csImem cs) /
91 , ("DSK_FREE", printf "%d" . Cluster.csFdsk)
92 , ("DSK_AVAIL", printf "%d". Cluster.csAdsk)
94 \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
95 , ("DSK_INST", printf "%d" . Cluster.csIdsk)
97 \cs -> printf "%.8f" (fromIntegral (Cluster.csIdsk cs) /
99 , ("CPU_INST", printf "%d" . Cluster.csIcpu)
101 \cs -> printf "%.8f" (fromIntegral (Cluster.csIcpu cs) /
103 , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
104 , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
107 specData :: [(String, RSpec -> String)]
108 specData = [ ("MEM", printf "%d" . rspecMem)
109 , ("DSK", printf "%d" . rspecDsk)
110 , ("CPU", printf "%d" . rspecCpu)
113 clusterData :: [(String, Cluster.CStats -> String)]
114 clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
115 , ("DSK", printf "%.0f" . Cluster.csTdsk)
116 , ("CPU", printf "%.0f" . Cluster.csTcpu)
117 , ("VCPU", printf "%d" . Cluster.csVcpu)
120 -- | Recursively place instances on the cluster until we're out of space
121 iterateDepth :: Node.List
125 -> [Instance.Instance]
126 -> Result (FailStats, Node.List, [Instance.Instance])
127 iterateDepth nl il newinst nreq ixes =
128 let depth = length ixes
129 newname = printf "new-%d" depth::String
130 newidx = length (Container.elems il) + depth
131 newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
132 in case Cluster.tryAlloc nl il newi2 nreq of
134 Ok (errs, _, sols3) ->
136 [] -> Ok (Cluster.collapseFailures errs, nl, ixes)
137 (_, (xnl, xi, _)):[] ->
138 iterateDepth xnl il newinst nreq $! (xi:ixes)
139 _ -> Bad "Internal error: multiple solutions for single\
142 tieredAlloc :: Node.List
146 -> [Instance.Instance]
147 -> Result (FailStats, Node.List, [Instance.Instance])
148 tieredAlloc nl il newinst nreq ixes =
149 case iterateDepth nl il newinst nreq ixes of
151 Ok (errs, nl', ixes') ->
152 case Instance.shrinkByType newinst . fst . last $
153 sortBy (comparing snd) errs of
154 Bad _ -> Ok (errs, nl', ixes')
156 tieredAlloc nl' il newinst' nreq ixes'
159 -- | Function to print stats for a given phase
160 printStats :: Phase -> Cluster.CStats -> [(String, String)]
162 map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
163 where kind = case ph of
168 -- | Print final stats and related metrics
169 printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()
170 printResults fin_nl num_instances allocs sreason = do
171 let fin_stats = Cluster.totalResources fin_nl
172 fin_instances = num_instances + allocs
174 when (num_instances + allocs /= Cluster.csNinst fin_stats) $
176 hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
177 \ != counted (%d)\n" (num_instances + allocs)
178 (Cluster.csNinst fin_stats) :: IO ()
179 exitWith $ ExitFailure 1
181 printKeys $ printStats PFinal fin_stats
182 printKeys [ ("ALLOC_USAGE", printf "%.8f"
183 ((fromIntegral num_instances::Double) /
184 fromIntegral fin_instances))
185 , ("ALLOC_INSTANCES", printf "%d" allocs)
186 , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
188 printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
189 printf "%d" y)) sreason
190 -- this should be the final entry
191 printKeys [("OK", "1")]
193 formatRSpec :: String -> RSpec -> [(String, String)]
195 [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
196 , ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
197 , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
200 printAllocationStats :: Node.List -> Node.List -> IO ()
201 printAllocationStats ini_nl fin_nl = do
202 let ini_stats = Cluster.totalResources ini_nl
203 fin_stats = Cluster.totalResources fin_nl
204 (rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
205 printKeys $ formatRSpec "USED" rini
206 printKeys $ formatRSpec "POOL" ralo
207 printKeys $ formatRSpec "UNAV" runa
209 -- | Ensure a value is quoted if needed
210 ensureQuoted :: String -> String
211 ensureQuoted v = if not (all (\c -> (isAlphaNum c || c == '.')) v)
215 -- | Format a list of key/values as a shell fragment
216 printKeys :: [(String, String)] -> IO ()
217 printKeys = mapM_ (\(k, v) ->
218 printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
220 printInstance :: Node.List -> Instance.Instance -> [String]
221 printInstance nl i = [ Instance.name i
222 , Container.nameOf nl $ Instance.pNode i
223 , let sdx = Instance.sNode i
224 in if sdx == Node.noSecondary then ""
225 else Container.nameOf nl sdx
226 , show (Instance.mem i)
227 , show (Instance.dsk i)
228 , show (Instance.vcpus i)
234 cmd_args <- System.getArgs
235 (opts, args) <- parseOpts cmd_args "hspace" options
237 unless (null args) $ do
238 hPutStrLn stderr "Error: this program doesn't take any arguments."
239 exitWith $ ExitFailure 1
241 let verbose = optVerbose opts
242 ispec = optISpec opts
243 shownodes = optShowNodes opts
245 (fixed_nl, il, _, csf) <- loadExternalData opts
247 printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
248 printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
250 let num_instances = length $ Container.elems il
252 let offline_names = optOffline opts
253 all_nodes = Container.elems fixed_nl
254 all_names = map Node.name all_nodes
255 offline_wrong = filter (`notElem` all_names) offline_names
256 offline_indices = map Node.idx $
257 filter (\n -> Node.name n `elem` offline_names)
259 req_nodes = optINodes opts
263 when (length offline_wrong > 0) $ do
264 hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
265 (commaJoin offline_wrong) :: IO ()
266 exitWith $ ExitFailure 1
268 when (req_nodes /= 1 && req_nodes /= 2) $ do
269 hPrintf stderr "Error: Invalid required nodes (%d)\n"
271 exitWith $ ExitFailure 1
273 let nm = Container.map (\n -> if Node.idx n `elem` offline_indices
274 then Node.setOffline n True
276 nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
279 when (length csf > 0 && verbose > 1) $
280 hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
282 when (isJust shownodes) $
284 hPutStrLn stderr "Initial cluster status:"
285 hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes)
287 let ini_cv = Cluster.compCV nl
288 ini_stats = Cluster.totalResources nl
291 hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
292 ini_cv (Cluster.printStats nl)
294 printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
295 printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
296 printKeys $ printStats PInitial ini_stats
298 let bad_nodes = fst $ Cluster.computeBadItems nl il
299 when (length bad_nodes > 0) $ do
300 -- This is failn1 case, so we print the same final stats and
302 printResults nl num_instances 0 [(FailN1, 1)]
306 let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
307 (rspecCpu spx) "ADMIN_down" [] (-1) (-1)
308 exitifbad val = (case val of
310 hPrintf stderr "Failure: %s\n" s :: IO ()
311 exitWith $ ExitFailure 1
315 let reqinst = iofspec ispec
317 -- Run the tiered allocation, if enabled
319 (case optTieredSpec opts of
322 let tresu = tieredAlloc nl il (iofspec tspec) req_nodes []
323 (_, trl_nl, trl_ixes) <- exitifbad tresu
324 let fin_trl_ixes = reverse trl_ixes
325 ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
326 spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
327 ix_byspec::[(RSpec, Int)]
328 spec_map' = map (\(spec, cnt) ->
329 printf "%d,%d,%d=%d" (rspecMem spec)
330 (rspecDsk spec) (rspecCpu spec) cnt)
333 when (verbose > 1) $ do
334 hPutStrLn stderr "Tiered allocation map"
335 hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
336 formatTable (map (printInstance trl_nl) fin_trl_ixes)
337 [False, False, False, True, True, True]
339 when (isJust shownodes) $ do
341 hPutStrLn stderr "Tiered allocation status:"
342 hPutStrLn stderr $ Cluster.printNodes trl_nl (fromJust shownodes)
344 printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
345 printKeys [("TSPEC", intercalate " " spec_map')]
346 printAllocationStats nl trl_nl)
348 -- Run the standard (avg-mode) allocation
350 let result = iterateDepth nl il reqinst req_nodes []
351 (ereason, fin_nl, ixes) <- exitifbad result
353 let allocs = length ixes
354 fin_ixes = reverse ixes
355 sreason = reverse $ sortBy (comparing snd) ereason
357 when (verbose > 1) $ do
358 hPutStrLn stderr "Instance map"
359 hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
360 formatTable (map (printInstance fin_nl) fin_ixes)
361 [False, False, False, True, True, True]
362 when (isJust shownodes) $
365 hPutStrLn stderr "Final cluster status:"
366 hPutStrLn stderr $ Cluster.printNodes fin_nl (fromJust shownodes)
368 printResults fin_nl num_instances allocs sreason