1 {-| Cluster space sizing
7 Copyright (C) 2009, 2010 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)
30 import Data.Maybe (isJust, fromJust)
31 import Data.Ord (comparing)
33 import System (exitWith, ExitCode(..))
34 import System.FilePath
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
49 import Ganeti.HTools.Text (serializeCluster)
51 -- | Options list and functions
74 -- | The allocation phase we're in (initial, after tiered allocs, or
75 -- after regular allocation).
80 statsData :: [(String, Cluster.CStats -> String)]
81 statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
82 , ("INST_CNT", printf "%d" . Cluster.csNinst)
83 , ("MEM_FREE", printf "%d" . Cluster.csFmem)
84 , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
86 \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
87 , ("MEM_INST", printf "%d" . Cluster.csImem)
89 \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
91 \cs -> printf "%.8f" (fromIntegral (Cluster.csImem cs) /
93 , ("DSK_FREE", printf "%d" . Cluster.csFdsk)
94 , ("DSK_AVAIL", printf "%d". Cluster.csAdsk)
96 \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
97 , ("DSK_INST", printf "%d" . Cluster.csIdsk)
99 \cs -> printf "%.8f" (fromIntegral (Cluster.csIdsk cs) /
101 , ("CPU_INST", printf "%d" . Cluster.csIcpu)
103 \cs -> printf "%.8f" (fromIntegral (Cluster.csIcpu cs) /
105 , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
106 , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
109 specData :: [(String, RSpec -> String)]
110 specData = [ ("MEM", printf "%d" . rspecMem)
111 , ("DSK", printf "%d" . rspecDsk)
112 , ("CPU", printf "%d" . rspecCpu)
115 clusterData :: [(String, Cluster.CStats -> String)]
116 clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
117 , ("DSK", printf "%.0f" . Cluster.csTdsk)
118 , ("CPU", printf "%.0f" . Cluster.csTcpu)
119 , ("VCPU", printf "%d" . Cluster.csVcpu)
122 -- | Function to print stats for a given phase
123 printStats :: Phase -> Cluster.CStats -> [(String, String)]
125 map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
126 where kind = case ph of
131 -- | Print final stats and related metrics
132 printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()
133 printResults fin_nl num_instances allocs sreason = do
134 let fin_stats = Cluster.totalResources fin_nl
135 fin_instances = num_instances + allocs
137 when (num_instances + allocs /= Cluster.csNinst fin_stats) $
139 hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
140 \ != counted (%d)\n" (num_instances + allocs)
141 (Cluster.csNinst fin_stats) :: IO ()
142 exitWith $ ExitFailure 1
144 printKeys $ printStats PFinal fin_stats
145 printKeys [ ("ALLOC_USAGE", printf "%.8f"
146 ((fromIntegral num_instances::Double) /
147 fromIntegral fin_instances))
148 , ("ALLOC_INSTANCES", printf "%d" allocs)
149 , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
151 printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
152 printf "%d" y)) sreason
153 -- this should be the final entry
154 printKeys [("OK", "1")]
156 formatRSpec :: Double -> String -> RSpec -> [(String, String)]
157 formatRSpec m_cpu s r =
158 [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
159 , ("KM_" ++ s ++ "_NPU", show $ fromIntegral (rspecCpu r) / m_cpu)
160 , ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
161 , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
164 printAllocationStats :: Double -> Node.List -> Node.List -> IO ()
165 printAllocationStats m_cpu ini_nl fin_nl = do
166 let ini_stats = Cluster.totalResources ini_nl
167 fin_stats = Cluster.totalResources fin_nl
168 (rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
169 printKeys $ formatRSpec m_cpu "USED" rini
170 printKeys $ formatRSpec m_cpu "POOL"ralo
171 printKeys $ formatRSpec m_cpu "UNAV" runa
173 -- | Ensure a value is quoted if needed
174 ensureQuoted :: String -> String
175 ensureQuoted v = if not (all (\c -> (isAlphaNum c || c == '.')) v)
179 -- | Format a list of key\/values as a shell fragment
180 printKeys :: [(String, String)] -> IO ()
181 printKeys = mapM_ (\(k, v) ->
182 printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
184 printInstance :: Node.List -> Instance.Instance -> [String]
185 printInstance nl i = [ Instance.name i
186 , Container.nameOf nl $ Instance.pNode i
187 , let sdx = Instance.sNode i
188 in if sdx == Node.noSecondary then ""
189 else Container.nameOf nl sdx
190 , show (Instance.mem i)
191 , show (Instance.dsk i)
192 , show (Instance.vcpus i)
198 cmd_args <- System.getArgs
199 (opts, args) <- parseOpts cmd_args "hspace" options
201 unless (null args) $ do
202 hPutStrLn stderr "Error: this program doesn't take any arguments."
203 exitWith $ ExitFailure 1
205 let verbose = optVerbose opts
206 ispec = optISpec opts
207 shownodes = optShowNodes opts
209 (gl, fixed_nl, il, ctags) <- loadExternalData opts
211 printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
212 printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
214 let num_instances = length $ Container.elems il
216 let offline_names = optOffline opts
217 all_nodes = Container.elems fixed_nl
218 all_names = map Node.name all_nodes
219 offline_wrong = filter (`notElem` all_names) offline_names
220 offline_indices = map Node.idx $
222 Node.name n `elem` offline_names ||
223 Node.alias n `elem` offline_names)
225 req_nodes = optINodes opts
229 when (length offline_wrong > 0) $ do
230 hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
231 (commaJoin offline_wrong) :: IO ()
232 exitWith $ ExitFailure 1
234 when (req_nodes /= 1 && req_nodes /= 2) $ do
235 hPrintf stderr "Error: Invalid required nodes (%d)\n"
237 exitWith $ ExitFailure 1
239 let nm = Container.map (\n -> if Node.idx n `elem` offline_indices
240 then Node.setOffline n True
242 nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
244 csf = commonSuffix fixed_nl il
246 when (length csf > 0 && verbose > 1) $
247 hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
249 when (isJust shownodes) $
251 hPutStrLn stderr "Initial cluster status:"
252 hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes)
254 let ini_cv = Cluster.compCV nl
255 ini_stats = Cluster.totalResources nl
258 hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
259 ini_cv (Cluster.printStats nl)
261 printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
262 printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
263 printKeys $ printStats PInitial ini_stats
265 let bad_nodes = fst $ Cluster.computeBadItems nl il
266 stop_allocation = length bad_nodes > 0
267 result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [])
270 let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
271 (rspecCpu spx) "running" [] (-1) (-1)
272 exitifbad val = (case val of
274 hPrintf stderr "Failure: %s\n" s :: IO ()
275 exitWith $ ExitFailure 1
279 let reqinst = iofspec ispec
281 -- Run the tiered allocation, if enabled
283 (case optTieredSpec opts of
286 (_, trl_nl, trl_il, trl_ixes) <-
288 then return result_noalloc
289 else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec)
291 let spec_map' = Cluster.tieredSpecMap trl_ixes
293 when (verbose > 1) $ do
294 hPutStrLn stderr "Tiered allocation map"
295 hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
296 formatTable (map (printInstance trl_nl) (reverse trl_ixes))
297 [False, False, False, True, True, True]
299 when (isJust shownodes) $ do
301 hPutStrLn stderr "Tiered allocation status:"
302 hPutStrLn stderr $ Cluster.printNodes trl_nl (fromJust shownodes)
304 when (isJust $ optSaveCluster opts) $
306 let out_path = (fromJust $ optSaveCluster opts) <.> "tiered"
307 adata = serializeCluster gl trl_nl trl_il ctags
308 writeFile out_path adata
309 hPrintf stderr "The cluster state after tiered allocation\
310 \ has been written to file '%s'\n"
312 printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
313 printKeys [("TSPEC", intercalate " " spec_map')]
314 printAllocationStats m_cpu nl trl_nl)
316 -- Run the standard (avg-mode) allocation
318 (ereason, fin_nl, fin_il, ixes) <-
320 then return result_noalloc
321 else exitifbad (Cluster.iterateAlloc nl il reqinst req_nodes [])
323 let allocs = length ixes
324 fin_ixes = reverse ixes
325 sreason = reverse $ sortBy (comparing snd) ereason
327 when (verbose > 1) $ do
328 hPutStrLn stderr "Instance map"
329 hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
330 formatTable (map (printInstance fin_nl) fin_ixes)
331 [False, False, False, True, True, True]
332 when (isJust shownodes) $
335 hPutStrLn stderr "Final cluster status:"
336 hPutStrLn stderr $ Cluster.printNodes fin_nl (fromJust shownodes)
338 when (isJust $ optSaveCluster opts) $
340 let out_path = (fromJust $ optSaveCluster opts) <.> "alloc"
341 adata = serializeCluster gl fin_nl fin_il ctags
342 writeFile out_path adata
343 hPrintf stderr "The cluster state after standard allocation\
344 \ has been written to file '%s'\n"
347 printResults fin_nl num_instances allocs sreason