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)
35 import qualified System
37 import Text.Printf (printf, hPrintf)
39 import qualified Ganeti.HTools.Container as Container
40 import qualified Ganeti.HTools.Cluster as Cluster
41 import qualified Ganeti.HTools.Node as Node
42 import qualified Ganeti.HTools.Instance as Instance
44 import Ganeti.HTools.Utils
45 import Ganeti.HTools.Types
46 import Ganeti.HTools.CLI
47 import Ganeti.HTools.ExtLoader
49 -- | Options list and functions
71 -- | The allocation phase we're in (initial, after tiered allocs, or
72 -- after regular allocation).
77 statsData :: [(String, Cluster.CStats -> String)]
78 statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
79 , ("INST_CNT", printf "%d" . Cluster.csNinst)
80 , ("MEM_FREE", printf "%d" . Cluster.csFmem)
81 , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
83 \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
84 , ("MEM_INST", printf "%d" . Cluster.csImem)
86 \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
88 \cs -> printf "%.8f" (fromIntegral (Cluster.csImem cs) /
90 , ("DSK_FREE", printf "%d" . Cluster.csFdsk)
91 , ("DSK_AVAIL", printf "%d". Cluster.csAdsk)
93 \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
94 , ("DSK_INST", printf "%d" . Cluster.csIdsk)
96 \cs -> printf "%.8f" (fromIntegral (Cluster.csIdsk cs) /
98 , ("CPU_INST", printf "%d" . Cluster.csIcpu)
100 \cs -> printf "%.8f" (fromIntegral (Cluster.csIcpu cs) /
102 , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
103 , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
106 specData :: [(String, RSpec -> String)]
107 specData = [ ("MEM", printf "%d" . rspecMem)
108 , ("DSK", printf "%d" . rspecDsk)
109 , ("CPU", printf "%d" . rspecCpu)
112 clusterData :: [(String, Cluster.CStats -> String)]
113 clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
114 , ("DSK", printf "%.0f" . Cluster.csTdsk)
115 , ("CPU", printf "%.0f" . Cluster.csTcpu)
118 -- | Recursively place instances on the cluster until we're out of space
119 iterateDepth :: Node.List
123 -> [Instance.Instance]
124 -> Result (FailStats, Node.List, [Instance.Instance])
125 iterateDepth nl il newinst nreq ixes =
126 let depth = length ixes
127 newname = printf "new-%d" depth::String
128 newidx = length (Container.elems il) + depth
129 newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
130 in case Cluster.tryAlloc nl il newi2 nreq of
132 Ok (errs, _, sols3) ->
134 [] -> Ok (Cluster.collapseFailures errs, nl, ixes)
135 (_, (xnl, xi, _)):[] ->
136 iterateDepth xnl il newinst nreq $! (xi:ixes)
137 _ -> Bad "Internal error: multiple solutions for single\
140 tieredAlloc :: Node.List
144 -> [Instance.Instance]
145 -> Result (FailStats, Node.List, [Instance.Instance])
146 tieredAlloc nl il newinst nreq ixes =
147 case iterateDepth nl il newinst nreq ixes of
149 Ok (errs, nl', ixes') ->
150 case Instance.shrinkByType newinst . fst . last $
151 sortBy (compare `on` snd) errs of
152 Bad _ -> Ok (errs, nl', ixes')
154 tieredAlloc nl' il newinst' nreq ixes'
157 -- | Function to print stats for a given phase
158 printStats :: Phase -> Cluster.CStats -> [(String, String)]
160 map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
161 where kind = case ph of
166 -- | Print final stats and related metrics
167 printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()
168 printResults fin_nl num_instances allocs sreason = do
169 let fin_stats = Cluster.totalResources fin_nl
170 fin_instances = num_instances + allocs
172 when (num_instances + allocs /= Cluster.csNinst fin_stats) $
174 hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
175 \ != counted (%d)\n" (num_instances + allocs)
176 (Cluster.csNinst fin_stats)
177 exitWith $ ExitFailure 1
179 printKeys $ printStats PFinal fin_stats
180 printKeys [ ("ALLOC_USAGE", printf "%.8f"
181 ((fromIntegral num_instances::Double) /
182 fromIntegral fin_instances))
183 , ("ALLOC_INSTANCES", printf "%d" allocs)
184 , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
186 printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
187 printf "%d" y)) sreason
188 -- this should be the final entry
189 printKeys [("OK", "1")]
191 -- | Ensure a value is quoted if needed
192 ensureQuoted :: String -> String
193 ensureQuoted v = if not (all (\c -> (isAlphaNum c || c == '.')) v)
197 -- | Format a list of key/values as a shell fragment
198 printKeys :: [(String, String)] -> IO ()
199 printKeys = mapM_ (\(k, v) ->
200 printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
202 printInstance :: Node.List -> Instance.Instance -> [String]
203 printInstance nl i = [ Instance.name i
204 , (Container.nameOf nl $ Instance.pNode i)
205 , (let sdx = Instance.sNode i
206 in if sdx == Node.noSecondary then ""
207 else Container.nameOf nl sdx)
208 , show (Instance.mem i)
209 , show (Instance.dsk i)
210 , show (Instance.vcpus i)
216 cmd_args <- System.getArgs
217 (opts, args) <- parseOpts cmd_args "hspace" options
219 unless (null args) $ do
220 hPutStrLn stderr "Error: this program doesn't take any arguments."
221 exitWith $ ExitFailure 1
223 let verbose = optVerbose opts
224 ispec = optISpec opts
225 shownodes = optShowNodes opts
227 (fixed_nl, il, _, csf) <- loadExternalData opts
229 printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
230 printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
232 let num_instances = length $ Container.elems il
234 let offline_names = optOffline opts
235 all_nodes = Container.elems fixed_nl
236 all_names = map Node.name all_nodes
237 offline_wrong = filter (flip notElem all_names) offline_names
238 offline_indices = map Node.idx $
239 filter (\n -> elem (Node.name n) offline_names)
241 req_nodes = optINodes opts
245 when (length offline_wrong > 0) $ do
246 hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
247 (commaJoin offline_wrong)
248 exitWith $ ExitFailure 1
250 when (req_nodes /= 1 && req_nodes /= 2) $ do
251 hPrintf stderr "Error: Invalid required nodes (%d)\n" req_nodes
252 exitWith $ ExitFailure 1
254 let nm = Container.map (\n -> if elem (Node.idx n) offline_indices
255 then Node.setOffline n True
257 nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
260 when (length csf > 0 && verbose > 1) $
261 hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
263 when (isJust shownodes) $
265 hPutStrLn stderr "Initial cluster status:"
266 hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes)
268 let ini_cv = Cluster.compCV nl
269 ini_stats = Cluster.totalResources nl
272 hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
273 ini_cv (Cluster.printStats nl)
275 printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
276 printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
277 printKeys $ printStats PInitial ini_stats
279 let bad_nodes = fst $ Cluster.computeBadItems nl il
280 when (length bad_nodes > 0) $ do
281 -- This is failn1 case, so we print the same final stats and
283 printResults nl num_instances 0 [(FailN1, 1)]
287 let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
288 (rspecCpu spx) "ADMIN_down" [] (-1) (-1)
289 exitifbad val = (case val of
291 hPrintf stderr "Failure: %s\n" s
292 exitWith $ ExitFailure 1
296 let reqinst = iofspec ispec
298 -- Run the tiered allocation, if enabled
300 (case optTieredSpec opts of
303 let tresu = tieredAlloc nl il (iofspec tspec) req_nodes []
304 (_, trl_nl, trl_ixes) <- exitifbad tresu
305 let fin_trl_ixes = reverse trl_ixes
306 ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
307 spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
308 ix_byspec::[(RSpec, Int)]
309 spec_map' = map (\(spec, cnt) ->
310 printf "%d,%d,%d=%d" (rspecMem spec)
311 (rspecDsk spec) (rspecCpu spec) cnt)
314 when (verbose > 1) $ do
315 hPutStrLn stderr "Tiered allocation map"
316 hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
317 formatTable (map (printInstance trl_nl) fin_trl_ixes)
318 [False, False, False, True, True, True]
320 when (isJust shownodes) $ do
322 hPutStrLn stderr "Tiered allocation status:"
323 hPutStrLn stderr $ Cluster.printNodes trl_nl (fromJust shownodes)
325 printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
326 printKeys [("TSPEC", intercalate " " spec_map')])
328 -- Run the standard (avg-mode) allocation
330 let result = iterateDepth nl il reqinst req_nodes []
331 (ereason, fin_nl, ixes) <- exitifbad result
333 let allocs = length ixes
334 fin_ixes = reverse ixes
335 sreason = reverse $ sortBy (compare `on` snd) ereason
337 when (verbose > 1) $ do
338 hPutStrLn stderr "Instance map"
339 hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
340 formatTable (map (printInstance fin_nl) fin_ixes)
341 [False, False, False, True, True, True]
342 when (isJust shownodes) $
345 hPutStrLn stderr "Final cluster status:"
346 hPutStrLn stderr $ Cluster.printNodes fin_nl (fromJust shownodes)
348 printResults fin_nl num_instances allocs sreason