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)
34 import qualified System
36 import Text.Printf (printf, hPrintf)
38 import qualified Ganeti.HTools.Container as Container
39 import qualified Ganeti.HTools.Cluster as Cluster
40 import qualified Ganeti.HTools.Node as Node
41 import qualified Ganeti.HTools.Instance as Instance
43 import Ganeti.HTools.Utils
44 import Ganeti.HTools.Types
45 import Ganeti.HTools.CLI
46 import Ganeti.HTools.ExtLoader
48 -- | 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 Nothing -> Ok (Cluster.collapseFailures errs, nl, ixes)
135 Just (_, (xnl, xi, _)) ->
136 iterateDepth xnl il newinst nreq $! (xi:ixes)
138 tieredAlloc :: Node.List
142 -> [Instance.Instance]
143 -> Result (FailStats, Node.List, [Instance.Instance])
144 tieredAlloc nl il newinst nreq ixes =
145 case iterateDepth nl il newinst nreq ixes of
147 Ok (errs, nl', ixes') ->
148 case Instance.shrinkByType newinst . fst . last $
149 sortBy (compare `on` snd) errs of
150 Bad _ -> Ok (errs, nl', ixes')
152 tieredAlloc nl' il newinst' nreq ixes'
155 -- | Function to print stats for a given phase
156 printStats :: Phase -> Cluster.CStats -> [(String, String)]
158 map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
159 where kind = case ph of
164 -- | Print final stats and related metrics
165 printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()
166 printResults fin_nl num_instances allocs sreason = do
167 let fin_stats = Cluster.totalResources fin_nl
168 fin_instances = num_instances + allocs
170 when (num_instances + allocs /= Cluster.csNinst fin_stats) $
172 hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
173 \ != counted (%d)\n" (num_instances + allocs)
174 (Cluster.csNinst fin_stats)
175 exitWith $ ExitFailure 1
177 printKeys $ printStats PFinal fin_stats
178 printKeys [ ("ALLOC_USAGE", printf "%.8f"
179 ((fromIntegral num_instances::Double) /
180 fromIntegral fin_instances))
181 , ("ALLOC_INSTANCES", printf "%d" allocs)
182 , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
184 printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
185 printf "%d" y)) sreason
186 -- this should be the final entry
187 printKeys [("OK", "1")]
189 -- | Format a list of key/values as a shell fragment
190 printKeys :: [(String, String)] -> IO ()
191 printKeys = mapM_ (\(k, v) -> printf "HTS_%s=%s\n" (map toUpper k) v)
193 printInstance :: Node.List -> Instance.Instance -> [String]
194 printInstance nl i = [ Instance.name i
195 , (Container.nameOf nl $ Instance.pNode i)
196 , (let sdx = Instance.sNode i
197 in if sdx == Node.noSecondary then ""
198 else Container.nameOf nl sdx)
199 , show (Instance.mem i)
200 , show (Instance.dsk i)
201 , show (Instance.vcpus i)
207 cmd_args <- System.getArgs
208 (opts, args) <- parseOpts cmd_args "hspace" options
210 unless (null args) $ do
211 hPutStrLn stderr "Error: this program doesn't take any arguments."
212 exitWith $ ExitFailure 1
214 let verbose = optVerbose opts
215 ispec = optISpec opts
217 (fixed_nl, il, csf) <- loadExternalData opts
219 printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
220 printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
222 let num_instances = length $ Container.elems il
224 let offline_names = optOffline opts
225 all_nodes = Container.elems fixed_nl
226 all_names = map Node.name all_nodes
227 offline_wrong = filter (flip notElem all_names) offline_names
228 offline_indices = map Node.idx $
229 filter (\n -> elem (Node.name n) offline_names)
231 req_nodes = optINodes opts
235 when (length offline_wrong > 0) $ do
236 hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
237 (commaJoin offline_wrong)
238 exitWith $ ExitFailure 1
240 when (req_nodes /= 1 && req_nodes /= 2) $ do
241 hPrintf stderr "Error: Invalid required nodes (%d)\n" req_nodes
242 exitWith $ ExitFailure 1
244 let nm = Container.map (\n -> if elem (Node.idx n) offline_indices
245 then Node.setOffline n True
247 nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
250 when (length csf > 0 && verbose > 1) $
251 hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
253 when (optShowNodes opts) $
255 hPutStrLn stderr "Initial cluster status:"
256 hPutStrLn stderr $ Cluster.printNodes nl
258 let ini_cv = Cluster.compCV nl
259 ini_stats = Cluster.totalResources nl
262 hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
263 ini_cv (Cluster.printStats nl)
265 printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
266 printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
267 printKeys $ printStats PInitial ini_stats
269 let bad_nodes = fst $ Cluster.computeBadItems nl il
270 when (length bad_nodes > 0) $ do
271 -- This is failn1 case, so we print the same final stats and
273 printResults nl num_instances 0 [(FailN1, 1)]
277 let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
278 (rspecCpu spx) "ADMIN_down" (-1) (-1)
279 exitifbad val = (case val of
281 hPrintf stderr "Failure: %s\n" s
282 exitWith $ ExitFailure 1
286 let reqinst = iofspec ispec
288 -- Run the tiered allocation, if enabled
290 (case optTieredSpec opts of
293 let tresu = tieredAlloc nl il (iofspec tspec) req_nodes []
294 (_, trl_nl, trl_ixes) <- exitifbad tresu
295 let fin_trl_ixes = reverse trl_ixes
297 when (verbose > 1) $ do
298 hPutStrLn stderr "Tiered allocation map"
299 hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
300 formatTable (map (printInstance trl_nl) fin_trl_ixes)
301 [False, False, False, True, True, True]
302 when (optShowNodes opts) $ do
304 hPutStrLn stderr "Tiered allocation status:"
305 hPutStrLn stderr $ Cluster.printNodes trl_nl
307 printKeys $ printStats PTiered (Cluster.totalResources trl_nl))
309 -- Run the standard (avg-mode) allocation
311 let result = iterateDepth nl il reqinst req_nodes []
312 (ereason, fin_nl, ixes) <- exitifbad result
314 let allocs = length ixes
315 fin_ixes = reverse ixes
316 sreason = reverse $ sortBy (compare `on` snd) ereason
318 when (verbose > 1) $ do
319 hPutStrLn stderr "Instance map"
320 hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
321 formatTable (map (printInstance fin_nl) fin_ixes)
322 [False, False, False, True, True, True]
323 when (optShowNodes opts) $
326 hPutStrLn stderr "Final cluster status:"
327 hPutStrLn stderr $ Cluster.printNodes fin_nl
329 printResults fin_nl num_instances allocs sreason