d1b62c34de3fdd64d9983980e1d9e5c25a50f5ab
[ganeti-github.git] / src / Ganeti / HTools / Program / Hspace.hs
1 {-| Cluster space sizing
2
3 -}
4
5 {-
6
7 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
8
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.
13
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.
18
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
22 02110-1301, USA.
23
24 -}
25
26 module Ganeti.HTools.Program.Hspace
27 (main
28 , options
29 , arguments
30 ) where
31
32 import Control.Monad
33 import Data.Char (toUpper, toLower)
34 import Data.Function (on)
35 import Data.List
36 import Data.Maybe (fromMaybe)
37 import Data.Ord (comparing)
38 import System.IO
39
40 import Text.Printf (printf, hPrintf)
41
42 import qualified Ganeti.HTools.Container as Container
43 import qualified Ganeti.HTools.Cluster as Cluster
44 import qualified Ganeti.HTools.Node as Node
45 import qualified Ganeti.HTools.Instance as Instance
46
47 import Ganeti.BasicTypes
48 import Ganeti.Common
49 import Ganeti.HTools.Types
50 import Ganeti.HTools.CLI
51 import Ganeti.HTools.ExtLoader
52 import Ganeti.HTools.Loader
53 import Ganeti.Utils
54
55 -- | Options list and functions.
56 options :: IO [OptType]
57 options = do
58 luxi <- oLuxiSocket
59 return
60 [ oPrintNodes
61 , oDataFile
62 , oDiskTemplate
63 , oSpindleUse
64 , oNodeSim
65 , oRapiMaster
66 , luxi
67 , oIAllocSrc
68 , oVerbose
69 , oQuiet
70 , oOfflineNode
71 , oMachineReadable
72 , oMaxCpu
73 , oMaxSolLength
74 , oMinDisk
75 , oStdSpec
76 , oTieredSpec
77 , oSaveCluster
78 ]
79
80 -- | The list of arguments supported by the program.
81 arguments :: [ArgCompletion]
82 arguments = []
83
84 -- | The allocation phase we're in (initial, after tiered allocs, or
85 -- after regular allocation).
86 data Phase = PInitial
87 | PFinal
88 | PTiered
89
90 -- | The kind of instance spec we print.
91 data SpecType = SpecNormal
92 | SpecTiered
93
94 -- | Prefix for machine readable names
95 htsPrefix :: String
96 htsPrefix = "HTS"
97
98 -- | What we prefix a spec with.
99 specPrefix :: SpecType -> String
100 specPrefix SpecNormal = "SPEC"
101 specPrefix SpecTiered = "TSPEC_INI"
102
103 -- | The description of a spec.
104 specDescription :: SpecType -> String
105 specDescription SpecNormal = "Standard (fixed-size)"
106 specDescription SpecTiered = "Tiered (initial size)"
107
108 -- | Efficiency generic function.
109 effFn :: (Cluster.CStats -> Integer)
110 -> (Cluster.CStats -> Double)
111 -> Cluster.CStats -> Double
112 effFn fi ft cs = fromIntegral (fi cs) / ft cs
113
114 -- | Memory efficiency.
115 memEff :: Cluster.CStats -> Double
116 memEff = effFn Cluster.csImem Cluster.csTmem
117
118 -- | Disk efficiency.
119 dskEff :: Cluster.CStats -> Double
120 dskEff = effFn Cluster.csIdsk Cluster.csTdsk
121
122 -- | Cpu efficiency.
123 cpuEff :: Cluster.CStats -> Double
124 cpuEff = effFn Cluster.csIcpu (fromIntegral . Cluster.csVcpu)
125
126 -- | Holds data for converting a 'Cluster.CStats' structure into
127 -- detailed statistics.
128 statsData :: [(String, Cluster.CStats -> String)]
129 statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
130 , ("INST_CNT", printf "%d" . Cluster.csNinst)
131 , ("MEM_FREE", printf "%d" . Cluster.csFmem)
132 , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
133 , ("MEM_RESVD",
134 \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
135 , ("MEM_INST", printf "%d" . Cluster.csImem)
136 , ("MEM_OVERHEAD",
137 \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
138 , ("MEM_EFF", printf "%.8f" . memEff)
139 , ("DSK_FREE", printf "%d" . Cluster.csFdsk)
140 , ("DSK_AVAIL", printf "%d". Cluster.csAdsk)
141 , ("DSK_RESVD",
142 \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
143 , ("DSK_INST", printf "%d" . Cluster.csIdsk)
144 , ("DSK_EFF", printf "%.8f" . dskEff)
145 , ("CPU_INST", printf "%d" . Cluster.csIcpu)
146 , ("CPU_EFF", printf "%.8f" . cpuEff)
147 , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
148 , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
149 ]
150
151 -- | List holding 'RSpec' formatting information.
152 specData :: [(String, RSpec -> String)]
153 specData = [ ("MEM", printf "%d" . rspecMem)
154 , ("DSK", printf "%d" . rspecDsk)
155 , ("CPU", printf "%d" . rspecCpu)
156 ]
157
158 -- | List holding 'Cluster.CStats' formatting information.
159 clusterData :: [(String, Cluster.CStats -> String)]
160 clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
161 , ("DSK", printf "%.0f" . Cluster.csTdsk)
162 , ("CPU", printf "%.0f" . Cluster.csTcpu)
163 , ("VCPU", printf "%d" . Cluster.csVcpu)
164 ]
165
166 -- | Function to print stats for a given phase.
167 printStats :: Phase -> Cluster.CStats -> [(String, String)]
168 printStats ph cs =
169 map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
170 where kind = case ph of
171 PInitial -> "INI"
172 PFinal -> "FIN"
173 PTiered -> "TRL"
174
175 -- | Print failure reason and scores
176 printFRScores :: Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
177 printFRScores ini_nl fin_nl sreason = do
178 printf " - most likely failure reason: %s\n" $ failureReason sreason::IO ()
179 printClusterScores ini_nl fin_nl
180 printClusterEff (Cluster.totalResources fin_nl)
181
182 -- | Print final stats and related metrics.
183 printResults :: Bool -> Node.List -> Node.List -> Int -> Int
184 -> [(FailMode, Int)] -> IO ()
185 printResults True _ fin_nl num_instances allocs sreason = do
186 let fin_stats = Cluster.totalResources fin_nl
187 fin_instances = num_instances + allocs
188
189 exitWhen (num_instances + allocs /= Cluster.csNinst fin_stats) $
190 printf "internal inconsistency, allocated (%d)\
191 \ != counted (%d)\n" (num_instances + allocs)
192 (Cluster.csNinst fin_stats)
193
194 printKeysHTS $ printStats PFinal fin_stats
195 printKeysHTS [ ("ALLOC_USAGE", printf "%.8f"
196 ((fromIntegral num_instances::Double) /
197 fromIntegral fin_instances))
198 , ("ALLOC_INSTANCES", printf "%d" allocs)
199 , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
200 ]
201 printKeysHTS $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
202 printf "%d" y)) sreason
203
204 printResults False ini_nl fin_nl _ allocs sreason = do
205 putStrLn "Normal (fixed-size) allocation results:"
206 printf " - %3d instances allocated\n" allocs :: IO ()
207 printFRScores ini_nl fin_nl sreason
208
209 -- | Prints the final @OK@ marker in machine readable output.
210 printFinalHTS :: Bool -> IO ()
211 printFinalHTS = printFinal htsPrefix
212
213 -- | Compute the tiered spec counts from a list of allocated
214 -- instances.
215 tieredSpecMap :: [Instance.Instance]
216 -> [(RSpec, Int)]
217 tieredSpecMap trl_ixes =
218 let fin_trl_ixes = reverse trl_ixes
219 ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
220 spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
221 ix_byspec
222 in spec_map
223
224 -- | Formats a spec map to strings.
225 formatSpecMap :: [(RSpec, Int)] -> [String]
226 formatSpecMap =
227 map (\(spec, cnt) -> printf "%d,%d,%d=%d" (rspecMem spec)
228 (rspecDsk spec) (rspecCpu spec) cnt)
229
230 -- | Formats \"key-metrics\" values.
231 formatRSpec :: String -> AllocInfo -> [(String, String)]
232 formatRSpec s r =
233 [ ("KM_" ++ s ++ "_CPU", show $ allocInfoVCpus r)
234 , ("KM_" ++ s ++ "_NPU", show $ allocInfoNCpus r)
235 , ("KM_" ++ s ++ "_MEM", show $ allocInfoMem r)
236 , ("KM_" ++ s ++ "_DSK", show $ allocInfoDisk r)
237 ]
238
239 -- | Shows allocations stats.
240 printAllocationStats :: Node.List -> Node.List -> IO ()
241 printAllocationStats ini_nl fin_nl = do
242 let ini_stats = Cluster.totalResources ini_nl
243 fin_stats = Cluster.totalResources fin_nl
244 (rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
245 printKeysHTS $ formatRSpec "USED" rini
246 printKeysHTS $ formatRSpec "POOL" ralo
247 printKeysHTS $ formatRSpec "UNAV" runa
248
249 -- | Format a list of key\/values as a shell fragment.
250 printKeysHTS :: [(String, String)] -> IO ()
251 printKeysHTS = printKeys htsPrefix
252
253 -- | Converts instance data to a list of strings.
254 printInstance :: Node.List -> Instance.Instance -> [String]
255 printInstance nl i = [ Instance.name i
256 , Container.nameOf nl $ Instance.pNode i
257 , let sdx = Instance.sNode i
258 in if sdx == Node.noSecondary then ""
259 else Container.nameOf nl sdx
260 , show (Instance.mem i)
261 , show (Instance.dsk i)
262 , show (Instance.vcpus i)
263 ]
264
265 -- | Optionally print the allocation map.
266 printAllocationMap :: Int -> String
267 -> Node.List -> [Instance.Instance] -> IO ()
268 printAllocationMap verbose msg nl ixes =
269 when (verbose > 1) $ do
270 hPutStrLn stderr (msg ++ " map")
271 hPutStr stderr . unlines . map ((:) ' ' . unwords) $
272 formatTable (map (printInstance nl) (reverse ixes))
273 -- This is the numberic-or-not field
274 -- specification; the first three fields are
275 -- strings, whereas the rest are numeric
276 [False, False, False, True, True, True]
277
278 -- | Formats nicely a list of resources.
279 formatResources :: a -> [(String, a->String)] -> String
280 formatResources res =
281 intercalate ", " . map (\(a, fn) -> a ++ " " ++ fn res)
282
283 -- | Print the cluster resources.
284 printCluster :: Bool -> Cluster.CStats -> Int -> IO ()
285 printCluster True ini_stats node_count = do
286 printKeysHTS $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
287 printKeysHTS [("CLUSTER_NODES", printf "%d" node_count)]
288 printKeysHTS $ printStats PInitial ini_stats
289
290 printCluster False ini_stats node_count = do
291 printf "The cluster has %d nodes and the following resources:\n %s.\n"
292 node_count (formatResources ini_stats clusterData)::IO ()
293 printf "There are %s initial instances on the cluster.\n"
294 (if inst_count > 0 then show inst_count else "no" )
295 where inst_count = Cluster.csNinst ini_stats
296
297 -- | Prints the normal instance spec.
298 printISpec :: Bool -> RSpec -> SpecType -> DiskTemplate -> IO ()
299 printISpec True ispec spec disk_template = do
300 printKeysHTS $ map (\(a, fn) -> (prefix ++ "_" ++ a, fn ispec)) specData
301 printKeysHTS [ (prefix ++ "_RQN", printf "%d" req_nodes) ]
302 printKeysHTS [ (prefix ++ "_DISK_TEMPLATE",
303 diskTemplateToRaw disk_template) ]
304 where req_nodes = Instance.requiredNodes disk_template
305 prefix = specPrefix spec
306
307 printISpec False ispec spec disk_template =
308 printf "%s instance spec is:\n %s, using disk\
309 \ template '%s'.\n"
310 (specDescription spec)
311 (formatResources ispec specData) (diskTemplateToRaw disk_template)
312
313 -- | Prints the tiered results.
314 printTiered :: Bool -> [(RSpec, Int)]
315 -> Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
316 printTiered True spec_map nl trl_nl _ = do
317 printKeysHTS $ printStats PTiered (Cluster.totalResources trl_nl)
318 printKeysHTS [("TSPEC", unwords (formatSpecMap spec_map))]
319 printAllocationStats nl trl_nl
320
321 printTiered False spec_map ini_nl fin_nl sreason = do
322 _ <- printf "Tiered allocation results:\n"
323 if null spec_map
324 then putStrLn " - no instances allocated"
325 else mapM_ (\(ispec, cnt) ->
326 printf " - %3d instances of spec %s\n" cnt
327 (formatResources ispec specData)) spec_map
328 printFRScores ini_nl fin_nl sreason
329
330 -- | Displays the initial/final cluster scores.
331 printClusterScores :: Node.List -> Node.List -> IO ()
332 printClusterScores ini_nl fin_nl = do
333 printf " - initial cluster score: %.8f\n" $ Cluster.compCV ini_nl::IO ()
334 printf " - final cluster score: %.8f\n" $ Cluster.compCV fin_nl
335
336 -- | Displays the cluster efficiency.
337 printClusterEff :: Cluster.CStats -> IO ()
338 printClusterEff cs =
339 mapM_ (\(s, fn) ->
340 printf " - %s usage efficiency: %5.2f%%\n" s (fn cs * 100))
341 [("memory", memEff),
342 (" disk", dskEff),
343 (" vcpu", cpuEff)]
344
345 -- | Computes the most likely failure reason.
346 failureReason :: [(FailMode, Int)] -> String
347 failureReason = show . fst . head
348
349 -- | Sorts the failure reasons.
350 sortReasons :: [(FailMode, Int)] -> [(FailMode, Int)]
351 sortReasons = reverse . sortBy (comparing snd)
352
353 -- | Runs an allocation algorithm and saves cluster state.
354 runAllocation :: ClusterData -- ^ Cluster data
355 -> Maybe Cluster.AllocResult -- ^ Optional stop-allocation
356 -> Result Cluster.AllocResult -- ^ Allocation result
357 -> RSpec -- ^ Requested instance spec
358 -> DiskTemplate -- ^ Requested disk template
359 -> SpecType -- ^ Allocation type
360 -> Options -- ^ CLI options
361 -> IO (FailStats, Node.List, Int, [(RSpec, Int)])
362 runAllocation cdata stop_allocation actual_result spec dt mode opts = do
363 (reasons, new_nl, new_il, new_ixes, _) <-
364 case stop_allocation of
365 Just result_noalloc -> return result_noalloc
366 Nothing -> exitIfBad "failure during allocation" actual_result
367
368 let name = head . words . specDescription $ mode
369 descr = name ++ " allocation"
370 ldescr = "after " ++ map toLower descr
371
372 printISpec (optMachineReadable opts) spec mode dt
373
374 printAllocationMap (optVerbose opts) descr new_nl new_ixes
375
376 maybePrintNodes (optShowNodes opts) descr (Cluster.printNodes new_nl)
377
378 maybeSaveData (optSaveCluster opts) (map toLower name) ldescr
379 (cdata { cdNodes = new_nl, cdInstances = new_il})
380
381 return (sortReasons reasons, new_nl, length new_ixes, tieredSpecMap new_ixes)
382
383 -- | Create an instance from a given spec.
384 instFromSpec :: RSpec -> DiskTemplate -> Int -> Instance.Instance
385 instFromSpec spx =
386 Instance.create "new" (rspecMem spx) (rspecDsk spx)
387 (rspecCpu spx) Running [] True (-1) (-1)
388
389 -- | Main function.
390 main :: Options -> [String] -> IO ()
391 main opts args = do
392 exitUnless (null args) "This program doesn't take any arguments."
393
394 let verbose = optVerbose opts
395 machine_r = optMachineReadable opts
396
397 orig_cdata@(ClusterData gl fixed_nl il _ ipol) <- loadExternalData opts
398 nl <- setNodeStatus opts fixed_nl
399
400 cluster_disk_template <-
401 case iPolicyDiskTemplates ipol of
402 first_templ:_ -> return first_templ
403 _ -> exitErr "null list of disk templates received from cluster"
404
405 let num_instances = Container.size il
406 all_nodes = Container.elems fixed_nl
407 cdata = orig_cdata { cdNodes = fixed_nl }
408 disk_template = fromMaybe cluster_disk_template (optDiskTemplate opts)
409 req_nodes = Instance.requiredNodes disk_template
410 csf = commonSuffix fixed_nl il
411 su = fromMaybe (iSpecSpindleUse $ iPolicyStdSpec ipol)
412 (optSpindleUse opts)
413
414 when (not (null csf) && verbose > 1) $
415 hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
416
417 maybePrintNodes (optShowNodes opts) "Initial cluster" (Cluster.printNodes nl)
418
419 when (verbose > 2) $
420 hPrintf stderr "Initial coefficients: overall %.8f\n%s"
421 (Cluster.compCV nl) (Cluster.printStats " " nl)
422
423 printCluster machine_r (Cluster.totalResources nl) (length all_nodes)
424
425 let stop_allocation = case Cluster.computeBadItems nl il of
426 ([], _) -> Nothing
427 _ -> Just ([(FailN1, 1)]::FailStats, nl, il, [], [])
428 alloclimit = if optMaxLength opts == -1
429 then Nothing
430 else Just (optMaxLength opts)
431
432 allocnodes <- exitIfBad "failure during allocation" $
433 Cluster.genAllocNodes gl nl req_nodes True
434
435 -- Run the tiered allocation
436
437 let tspec = fromMaybe (rspecFromISpec (iPolicyMaxSpec ipol))
438 (optTieredSpec opts)
439
440 (treason, trl_nl, _, spec_map) <-
441 runAllocation cdata stop_allocation
442 (Cluster.tieredAlloc nl il alloclimit
443 (instFromSpec tspec disk_template su) allocnodes [] [])
444 tspec disk_template SpecTiered opts
445
446 printTiered machine_r spec_map nl trl_nl treason
447
448 -- Run the standard (avg-mode) allocation
449
450 let ispec = fromMaybe (rspecFromISpec (iPolicyStdSpec ipol))
451 (optStdSpec opts)
452
453 (sreason, fin_nl, allocs, _) <-
454 runAllocation cdata stop_allocation
455 (Cluster.iterateAlloc nl il alloclimit
456 (instFromSpec ispec disk_template su) allocnodes [] [])
457 ispec disk_template SpecNormal opts
458
459 printResults machine_r nl fin_nl num_instances allocs sreason
460
461 -- Print final result
462
463 printFinalHTS machine_r