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 data Phase = PInitial | PFinal
73 statsData :: [(String, Cluster.CStats -> String)]
74 statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
75 , ("INST_CNT", printf "%d" . Cluster.csNinst)
76 , ("MEM_FREE", printf "%d" . Cluster.csFmem)
77 , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
79 \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
80 , ("MEM_INST", printf "%d" . Cluster.csImem)
82 \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
84 \cs -> printf "%.8f" (fromIntegral (Cluster.csImem cs) /
86 , ("DSK_FREE", printf "%d" . Cluster.csFdsk)
87 , ("DSK_AVAIL", printf "%d ". Cluster.csAdsk)
89 \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
90 , ("DSK_INST", printf "%d" . Cluster.csIdsk)
92 \cs -> printf "%.8f" (fromIntegral (Cluster.csIdsk cs) /
94 , ("CPU_INST", printf "%d" . Cluster.csIcpu)
96 \cs -> printf "%.8f" (fromIntegral (Cluster.csIcpu cs) /
98 , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
99 , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
102 specData :: [(String, RSpec -> String)]
103 specData = [ ("MEM", printf "%d" . rspecMem)
104 , ("DSK", printf "%d" . rspecDsk)
105 , ("CPU", printf "%d" . rspecCpu)
108 clusterData :: [(String, Cluster.CStats -> String)]
109 clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
110 , ("DSK", printf "%.0f" . Cluster.csTdsk)
111 , ("CPU", printf "%.0f" . Cluster.csTcpu)
114 -- | Recursively place instances on the cluster until we're out of space
115 iterateDepth :: Node.List
119 -> [Instance.Instance]
120 -> Result (FailStats, Node.List, [Instance.Instance])
121 iterateDepth nl il newinst nreq ixes =
122 let depth = length ixes
123 newname = printf "new-%d" depth::String
124 newidx = length (Container.elems il) + depth
125 newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
126 in case Cluster.tryAlloc nl il newi2 nreq of
128 Ok (errs, _, sols3) ->
130 Nothing -> Ok (Cluster.collapseFailures errs, nl, ixes)
131 Just (_, (xnl, xi, _)) ->
132 iterateDepth xnl il newinst nreq $! (xi:ixes)
134 -- | Function to print stats for a given phase
135 printStats :: Phase -> Cluster.CStats -> [(String, String)]
137 map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
138 where kind = case ph of
142 -- | Print final stats and related metrics
143 printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()
144 printResults fin_nl num_instances allocs sreason = do
145 let fin_stats = Cluster.totalResources fin_nl
146 fin_instances = num_instances + allocs
148 when (num_instances + allocs /= Cluster.csNinst fin_stats) $
150 hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
151 \ != counted (%d)\n" (num_instances + allocs)
152 (Cluster.csNinst fin_stats)
153 exitWith $ ExitFailure 1
155 printKeys $ printStats PFinal fin_stats
156 printKeys [ ("ALLOC_USAGE", printf "%.8f"
157 ((fromIntegral num_instances::Double) /
158 fromIntegral fin_instances))
159 , ("ALLOC_INSTANCES", printf "%d" allocs)
160 , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
162 printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
163 printf "%d" y)) sreason
164 -- this should be the final entry
165 printKeys [("OK", "1")]
167 -- | Format a list of key/values as a shell fragment
168 printKeys :: [(String, String)] -> IO ()
169 printKeys = mapM_ (\(k, v) -> printf "HTS_%s=%s\n" (map toUpper k) v)
171 printInstance :: Node.List -> Instance.Instance -> [String]
172 printInstance nl i = [ Instance.name i
173 , (Container.nameOf nl $ Instance.pNode i)
174 , (let sdx = Instance.sNode i
175 in if sdx == Node.noSecondary then ""
176 else Container.nameOf nl sdx)
177 , show (Instance.mem i)
178 , show (Instance.dsk i)
179 , show (Instance.vcpus i)
185 cmd_args <- System.getArgs
186 (opts, args) <- parseOpts cmd_args "hspace" options
188 unless (null args) $ do
189 hPutStrLn stderr "Error: this program doesn't take any arguments."
190 exitWith $ ExitFailure 1
192 let verbose = optVerbose opts
193 ispec = optISpec opts
195 (fixed_nl, il, csf) <- loadExternalData opts
197 printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
198 printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
200 let num_instances = length $ Container.elems il
202 let offline_names = optOffline opts
203 all_nodes = Container.elems fixed_nl
204 all_names = map Node.name all_nodes
205 offline_wrong = filter (flip notElem all_names) offline_names
206 offline_indices = map Node.idx $
207 filter (\n -> elem (Node.name n) offline_names)
209 req_nodes = optINodes opts
213 when (length offline_wrong > 0) $ do
214 hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
215 (commaJoin offline_wrong)
216 exitWith $ ExitFailure 1
218 when (req_nodes /= 1 && req_nodes /= 2) $ do
219 hPrintf stderr "Error: Invalid required nodes (%d)\n" req_nodes
220 exitWith $ ExitFailure 1
222 let nm = Container.map (\n -> if elem (Node.idx n) offline_indices
223 then Node.setOffline n True
225 nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
228 when (length csf > 0 && verbose > 1) $
229 hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
231 when (optShowNodes opts) $
233 hPutStrLn stderr "Initial cluster status:"
234 hPutStrLn stderr $ Cluster.printNodes nl
236 let ini_cv = Cluster.compCV nl
237 ini_stats = Cluster.totalResources nl
240 hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
241 ini_cv (Cluster.printStats nl)
243 printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
244 printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
245 printKeys $ printStats PInitial ini_stats
247 let bad_nodes = fst $ Cluster.computeBadItems nl il
248 when (length bad_nodes > 0) $ do
249 -- This is failn1 case, so we print the same final stats and
251 printResults nl num_instances 0 [(FailN1, 1)]
254 let reqinst = Instance.create "new" (rspecMem ispec) (rspecDsk ispec)
255 (rspecCpu ispec) "ADMIN_down" (-1) (-1)
257 let result = iterateDepth nl il reqinst req_nodes []
258 (ereason, fin_nl, ixes) <- (case result of
260 hPrintf stderr "Failure: %s\n" s
261 exitWith $ ExitFailure 1
263 let allocs = length ixes
264 fin_ixes = reverse ixes
265 sreason = reverse $ sortBy (compare `on` snd) ereason
267 when (verbose > 1) $ do
268 hPutStrLn stderr "Instance map"
269 hPutStr stderr . unlines . map ((:) ' ' . intercalate " ") $
270 formatTable (map (printInstance fin_nl) fin_ixes)
271 [False, False, False, True, True, True]
272 when (optShowNodes opts) $
275 hPutStrLn stderr "Final cluster status:"
276 hPutStrLn stderr $ Cluster.printNodes fin_nl
278 printResults fin_nl num_instances allocs sreason