1 {-| Cluster space sizing
7 Copyright (C) 2009, 2010, 2011 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
29 import Data.Char (toUpper, isAlphaNum)
31 import Data.Maybe (isJust, fromJust)
32 import Data.Ord (comparing)
33 import System (exitWith, ExitCode(..))
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
48 import Ganeti.HTools.Loader (ClusterData(..))
50 -- | Options list and functions
73 -- | The allocation phase we're in (initial, after tiered allocs, or
74 -- after regular allocation).
79 statsData :: [(String, Cluster.CStats -> String)]
80 statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
81 , ("INST_CNT", printf "%d" . Cluster.csNinst)
82 , ("MEM_FREE", printf "%d" . Cluster.csFmem)
83 , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
85 \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
86 , ("MEM_INST", printf "%d" . Cluster.csImem)
88 \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
90 \cs -> printf "%.8f" (fromIntegral (Cluster.csImem cs) /
92 , ("DSK_FREE", printf "%d" . Cluster.csFdsk)
93 , ("DSK_AVAIL", printf "%d". Cluster.csAdsk)
95 \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
96 , ("DSK_INST", printf "%d" . Cluster.csIdsk)
98 \cs -> printf "%.8f" (fromIntegral (Cluster.csIdsk cs) /
100 , ("CPU_INST", printf "%d" . Cluster.csIcpu)
102 \cs -> printf "%.8f" (fromIntegral (Cluster.csIcpu cs) /
104 , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
105 , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
108 specData :: [(String, RSpec -> String)]
109 specData = [ ("MEM", printf "%d" . rspecMem)
110 , ("DSK", printf "%d" . rspecDsk)
111 , ("CPU", printf "%d" . rspecCpu)
114 clusterData :: [(String, Cluster.CStats -> String)]
115 clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
116 , ("DSK", printf "%.0f" . Cluster.csTdsk)
117 , ("CPU", printf "%.0f" . Cluster.csTcpu)
118 , ("VCPU", printf "%d" . Cluster.csVcpu)
121 -- | Function to print stats for a given phase
122 printStats :: Phase -> Cluster.CStats -> [(String, String)]
124 map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
125 where kind = case ph of
130 -- | Print final stats and related metrics
131 printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()
132 printResults fin_nl num_instances allocs sreason = do
133 let fin_stats = Cluster.totalResources fin_nl
134 fin_instances = num_instances + allocs
136 when (num_instances + allocs /= Cluster.csNinst fin_stats) $
138 hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
139 \ != counted (%d)\n" (num_instances + allocs)
140 (Cluster.csNinst fin_stats) :: IO ()
141 exitWith $ ExitFailure 1
143 printKeys $ printStats PFinal fin_stats
144 printKeys [ ("ALLOC_USAGE", printf "%.8f"
145 ((fromIntegral num_instances::Double) /
146 fromIntegral fin_instances))
147 , ("ALLOC_INSTANCES", printf "%d" allocs)
148 , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
150 printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
151 printf "%d" y)) sreason
152 -- this should be the final entry
153 printKeys [("OK", "1")]
155 formatRSpec :: Double -> String -> RSpec -> [(String, String)]
156 formatRSpec m_cpu s r =
157 [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
158 , ("KM_" ++ s ++ "_NPU", show $ fromIntegral (rspecCpu r) / m_cpu)
159 , ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
160 , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
163 printAllocationStats :: Double -> Node.List -> Node.List -> IO ()
164 printAllocationStats m_cpu ini_nl fin_nl = do
165 let ini_stats = Cluster.totalResources ini_nl
166 fin_stats = Cluster.totalResources fin_nl
167 (rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
168 printKeys $ formatRSpec m_cpu "USED" rini
169 printKeys $ formatRSpec m_cpu "POOL"ralo
170 printKeys $ formatRSpec m_cpu "UNAV" runa
172 -- | Ensure a value is quoted if needed
173 ensureQuoted :: String -> String
174 ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v)
178 -- | Format a list of key\/values as a shell fragment
179 printKeys :: [(String, String)] -> IO ()
180 printKeys = mapM_ (\(k, v) ->
181 printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
183 printInstance :: Node.List -> Instance.Instance -> [String]
184 printInstance nl i = [ Instance.name i
185 , Container.nameOf nl $ Instance.pNode i
186 , let sdx = Instance.sNode i
187 in if sdx == Node.noSecondary then ""
188 else Container.nameOf nl sdx
189 , show (Instance.mem i)
190 , show (Instance.dsk i)
191 , show (Instance.vcpus i)
194 -- | Optionally print the allocation map
195 printAllocationMap :: Int -> String
196 -> Node.List -> [Instance.Instance] -> IO ()
197 printAllocationMap verbose msg nl ixes =
198 when (verbose > 1) $ do
200 hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
201 formatTable (map (printInstance nl) (reverse ixes))
202 -- This is the numberic-or-not field
203 -- specification; the first three fields are
204 -- strings, whereas the rest are numeric
205 [False, False, False, True, True, True]
210 cmd_args <- System.getArgs
211 (opts, args) <- parseOpts cmd_args "hspace" options
213 unless (null args) $ do
214 hPutStrLn stderr "Error: this program doesn't take any arguments."
215 exitWith $ ExitFailure 1
217 let verbose = optVerbose opts
218 ispec = optISpec opts
219 shownodes = optShowNodes opts
221 (ClusterData gl fixed_nl il ctags) <- loadExternalData opts
223 printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
224 printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
226 let num_instances = length $ Container.elems il
228 let offline_names = optOffline opts
229 all_nodes = Container.elems fixed_nl
230 all_names = map Node.name all_nodes
231 offline_wrong = filter (`notElem` all_names) offline_names
232 offline_indices = map Node.idx $
234 Node.name n `elem` offline_names ||
235 Node.alias n `elem` offline_names)
237 req_nodes = optINodes opts
241 when (length offline_wrong > 0) $ do
242 hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
243 (commaJoin offline_wrong) :: IO ()
244 exitWith $ ExitFailure 1
246 when (req_nodes /= 1 && req_nodes /= 2) $ do
247 hPrintf stderr "Error: Invalid required nodes (%d)\n"
249 exitWith $ ExitFailure 1
251 let nm = Container.map (\n -> if Node.idx n `elem` offline_indices
252 then Node.setOffline n True
254 nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
256 csf = commonSuffix fixed_nl il
258 when (length csf > 0 && verbose > 1) $
259 hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
261 when (isJust shownodes) $
263 hPutStrLn stderr "Initial cluster status:"
264 hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes)
266 let ini_cv = Cluster.compCV nl
267 ini_stats = Cluster.totalResources nl
270 hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
271 ini_cv (Cluster.printStats nl)
273 printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
274 printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
275 printKeys $ printStats PInitial ini_stats
277 let bad_nodes = fst $ Cluster.computeBadItems nl il
278 stop_allocation = length bad_nodes > 0
279 result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [], [])
282 let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
283 (rspecCpu spx) "running" [] True (-1) (-1)
284 exitifbad val = (case val of
286 hPrintf stderr "Failure: %s\n" s :: IO ()
287 exitWith $ ExitFailure 1
291 let reqinst = iofspec ispec
293 allocnodes <- exitifbad $ Cluster.genAllocNodes gl nl req_nodes True
295 -- Run the tiered allocation, if enabled
297 (case optTieredSpec opts of
300 (_, trl_nl, trl_il, trl_ixes, _) <-
302 then return result_noalloc
303 else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec)
305 let spec_map' = Cluster.tieredSpecMap trl_ixes
307 printAllocationMap verbose "Tiered allocation map" trl_nl trl_ixes
309 maybePrintNodes shownodes "Tiered allocation"
310 (Cluster.printNodes trl_nl)
312 maybeSaveData (optSaveCluster opts) "tiered" "after tiered allocation"
313 (ClusterData gl trl_nl trl_il ctags)
315 printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
316 printKeys [("TSPEC", intercalate " " spec_map')]
317 printAllocationStats m_cpu nl trl_nl)
319 -- Run the standard (avg-mode) allocation
321 (ereason, fin_nl, fin_il, ixes, _) <-
323 then return result_noalloc
324 else exitifbad (Cluster.iterateAlloc nl il reqinst allocnodes [] [])
326 let allocs = length ixes
327 sreason = reverse $ sortBy (comparing snd) ereason
329 printAllocationMap verbose "Standard allocation map" fin_nl ixes
331 maybePrintNodes shownodes "Standard allocation" (Cluster.printNodes fin_nl)
333 maybeSaveData (optSaveCluster opts) "alloc" "after standard allocation"
334 (ClusterData gl fin_nl fin_il ctags)
336 printResults fin_nl num_instances allocs sreason