Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / HTools / Program / Hspace.hs @ 2d6bdcc5

History | View | Annotate | Download (17 kB)

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