Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / HTools / Program / Hspace.hs @ dd77da99

History | View | Annotate | Download (16.6 kB)

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 :: [OptType]
57
options =
58
  [ oPrintNodes
59
  , oDataFile
60
  , oDiskTemplate
61
  , oSpindleUse
62
  , oNodeSim
63
  , oRapiMaster
64
  , oLuxiSocket
65
  , oIAllocSrc
66
  , oVerbose
67
  , oQuiet
68
  , oOfflineNode
69
  , oMachineReadable
70
  , oMaxCpu
71
  , oMaxSolLength
72
  , oMinDisk
73
  , oStdSpec
74
  , oTieredSpec
75
  , oSaveCluster
76
  ]
77

    
78
-- | The list of arguments supported by the program.
79
arguments :: [ArgCompletion]
80
arguments = []
81

    
82
-- | The allocation phase we're in (initial, after tiered allocs, or
83
-- after regular allocation).
84
data Phase = PInitial
85
           | PFinal
86
           | PTiered
87

    
88
-- | The kind of instance spec we print.
89
data SpecType = SpecNormal
90
              | SpecTiered
91

    
92
-- | Prefix for machine readable names
93
htsPrefix :: String
94
htsPrefix = "HTS"
95

    
96
-- | What we prefix a spec with.
97
specPrefix :: SpecType -> String
98
specPrefix SpecNormal = "SPEC"
99
specPrefix SpecTiered = "TSPEC_INI"
100

    
101
-- | The description of a spec.
102
specDescription :: SpecType -> String
103
specDescription SpecNormal = "Standard (fixed-size)"
104
specDescription SpecTiered = "Tiered (initial size)"
105

    
106
-- | Efficiency generic function.
107
effFn :: (Cluster.CStats -> Integer)
108
      -> (Cluster.CStats -> Double)
109
      -> Cluster.CStats -> Double
110
effFn fi ft cs = fromIntegral (fi cs) / ft cs
111

    
112
-- | Memory efficiency.
113
memEff :: Cluster.CStats -> Double
114
memEff = effFn Cluster.csImem Cluster.csTmem
115

    
116
-- | Disk efficiency.
117
dskEff :: Cluster.CStats -> Double
118
dskEff = effFn Cluster.csIdsk Cluster.csTdsk
119

    
120
-- | Cpu efficiency.
121
cpuEff :: Cluster.CStats -> Double
122
cpuEff = effFn Cluster.csIcpu (fromIntegral . Cluster.csVcpu)
123

    
124
-- | Holds data for converting a 'Cluster.CStats' structure into
125
-- detailed statistics.
126
statsData :: [(String, Cluster.CStats -> String)]
127
statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
128
            , ("INST_CNT", printf "%d" . Cluster.csNinst)
129
            , ("MEM_FREE", printf "%d" . Cluster.csFmem)
130
            , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
131
            , ("MEM_RESVD",
132
               \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
133
            , ("MEM_INST", printf "%d" . Cluster.csImem)
134
            , ("MEM_OVERHEAD",
135
               \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
136
            , ("MEM_EFF", printf "%.8f" . memEff)
137
            , ("DSK_FREE", printf "%d" . Cluster.csFdsk)
138
            , ("DSK_AVAIL", printf "%d". Cluster.csAdsk)
139
            , ("DSK_RESVD",
140
               \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
141
            , ("DSK_INST", printf "%d" . Cluster.csIdsk)
142
            , ("DSK_EFF", printf "%.8f" . dskEff)
143
            , ("CPU_INST", printf "%d" . Cluster.csIcpu)
144
            , ("CPU_EFF", printf "%.8f" . cpuEff)
145
            , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
146
            , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
147
            ]
148

    
149
-- | List holding 'RSpec' formatting information.
150
specData :: [(String, RSpec -> String)]
151
specData = [ ("MEM", printf "%d" . rspecMem)
152
           , ("DSK", printf "%d" . rspecDsk)
153
           , ("CPU", printf "%d" . rspecCpu)
154
           ]
155

    
156
-- | List holding 'Cluster.CStats' formatting information.
157
clusterData :: [(String, Cluster.CStats -> String)]
158
clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
159
              , ("DSK", printf "%.0f" . Cluster.csTdsk)
160
              , ("CPU", printf "%.0f" . Cluster.csTcpu)
161
              , ("VCPU", printf "%d" . Cluster.csVcpu)
162
              ]
163

    
164
-- | Function to print stats for a given phase.
165
printStats :: Phase -> Cluster.CStats -> [(String, String)]
166
printStats ph cs =
167
  map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
168
  where kind = case ph of
169
                 PInitial -> "INI"
170
                 PFinal -> "FIN"
171
                 PTiered -> "TRL"
172

    
173
-- | Print failure reason and scores
174
printFRScores :: Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
175
printFRScores ini_nl fin_nl sreason = do
176
  printf "  - most likely failure reason: %s\n" $ failureReason sreason::IO ()
177
  printClusterScores ini_nl fin_nl
178
  printClusterEff (Cluster.totalResources fin_nl)
179

    
180
-- | Print final stats and related metrics.
181
printResults :: Bool -> Node.List -> Node.List -> Int -> Int
182
             -> [(FailMode, Int)] -> IO ()
183
printResults True _ fin_nl num_instances allocs sreason = do
184
  let fin_stats = Cluster.totalResources fin_nl
185
      fin_instances = num_instances + allocs
186

    
187
  exitWhen (num_instances + allocs /= Cluster.csNinst fin_stats) $
188
           printf "internal inconsistency, allocated (%d)\
189
                  \ != counted (%d)\n" (num_instances + allocs)
190
           (Cluster.csNinst fin_stats)
191

    
192
  printKeysHTS $ printStats PFinal fin_stats
193
  printKeysHTS [ ("ALLOC_USAGE", printf "%.8f"
194
                                   ((fromIntegral num_instances::Double) /
195
                                   fromIntegral fin_instances))
196
               , ("ALLOC_INSTANCES", printf "%d" allocs)
197
               , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
198
               ]
199
  printKeysHTS $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
200
                                  printf "%d" y)) sreason
201

    
202
printResults False ini_nl fin_nl _ allocs sreason = do
203
  putStrLn "Normal (fixed-size) allocation results:"
204
  printf "  - %3d instances allocated\n" allocs :: IO ()
205
  printFRScores ini_nl fin_nl sreason
206

    
207
-- | Prints the final @OK@ marker in machine readable output.
208
printFinalHTS :: Bool -> IO ()
209
printFinalHTS = printFinal htsPrefix
210

    
211
-- | Compute the tiered spec counts from a list of allocated
212
-- instances.
213
tieredSpecMap :: [Instance.Instance]
214
              -> [(RSpec, Int)]
215
tieredSpecMap trl_ixes =
216
  let fin_trl_ixes = reverse trl_ixes
217
      ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
218
      spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
219
                 ix_byspec
220
  in spec_map
221

    
222
-- | Formats a spec map to strings.
223
formatSpecMap :: [(RSpec, Int)] -> [String]
224
formatSpecMap =
225
  map (\(spec, cnt) -> printf "%d,%d,%d=%d" (rspecMem spec)
226
                       (rspecDsk spec) (rspecCpu spec) cnt)
227

    
228
-- | Formats \"key-metrics\" values.
229
formatRSpec :: String -> AllocInfo -> [(String, String)]
230
formatRSpec s r =
231
  [ ("KM_" ++ s ++ "_CPU", show $ allocInfoVCpus r)
232
  , ("KM_" ++ s ++ "_NPU", show $ allocInfoNCpus r)
233
  , ("KM_" ++ s ++ "_MEM", show $ allocInfoMem r)
234
  , ("KM_" ++ s ++ "_DSK", show $ allocInfoDisk r)
235
  ]
236

    
237
-- | Shows allocations stats.
238
printAllocationStats :: Node.List -> Node.List -> IO ()
239
printAllocationStats ini_nl fin_nl = do
240
  let ini_stats = Cluster.totalResources ini_nl
241
      fin_stats = Cluster.totalResources fin_nl
242
      (rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
243
  printKeysHTS $ formatRSpec "USED" rini
244
  printKeysHTS $ formatRSpec "POOL" ralo
245
  printKeysHTS $ formatRSpec "UNAV" runa
246

    
247
-- | Format a list of key\/values as a shell fragment.
248
printKeysHTS :: [(String, String)] -> IO ()
249
printKeysHTS = printKeys htsPrefix
250

    
251
-- | Converts instance data to a list of strings.
252
printInstance :: Node.List -> Instance.Instance -> [String]
253
printInstance nl i = [ Instance.name i
254
                     , Container.nameOf nl $ Instance.pNode i
255
                     , let sdx = Instance.sNode i
256
                       in if sdx == Node.noSecondary then ""
257
                          else Container.nameOf nl sdx
258
                     , show (Instance.mem i)
259
                     , show (Instance.dsk i)
260
                     , show (Instance.vcpus i)
261
                     ]
262

    
263
-- | Optionally print the allocation map.
264
printAllocationMap :: Int -> String
265
                   -> Node.List -> [Instance.Instance] -> IO ()
266
printAllocationMap verbose msg nl ixes =
267
  when (verbose > 1) $ do
268
    hPutStrLn stderr (msg ++ " map")
269
    hPutStr stderr . unlines . map ((:) ' ' .  unwords) $
270
            formatTable (map (printInstance nl) (reverse ixes))
271
                        -- This is the numberic-or-not field
272
                        -- specification; the first three fields are
273
                        -- strings, whereas the rest are numeric
274
                       [False, False, False, True, True, True]
275

    
276
-- | Formats nicely a list of resources.
277
formatResources :: a -> [(String, a->String)] -> String
278
formatResources res =
279
    intercalate ", " . map (\(a, fn) -> a ++ " " ++ fn res)
280

    
281
-- | Print the cluster resources.
282
printCluster :: Bool -> Cluster.CStats -> Int -> IO ()
283
printCluster True ini_stats node_count = do
284
  printKeysHTS $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
285
  printKeysHTS [("CLUSTER_NODES", printf "%d" node_count)]
286
  printKeysHTS $ printStats PInitial ini_stats
287

    
288
printCluster False ini_stats node_count = do
289
  printf "The cluster has %d nodes and the following resources:\n  %s.\n"
290
         node_count (formatResources ini_stats clusterData)::IO ()
291
  printf "There are %s initial instances on the cluster.\n"
292
             (if inst_count > 0 then show inst_count else "no" )
293
      where inst_count = Cluster.csNinst ini_stats
294

    
295
-- | Prints the normal instance spec.
296
printISpec :: Bool -> RSpec -> SpecType -> DiskTemplate -> IO ()
297
printISpec True ispec spec disk_template = do
298
  printKeysHTS $ map (\(a, fn) -> (prefix ++ "_" ++ a, fn ispec)) specData
299
  printKeysHTS [ (prefix ++ "_RQN", printf "%d" req_nodes) ]
300
  printKeysHTS [ (prefix ++ "_DISK_TEMPLATE",
301
                  diskTemplateToRaw disk_template) ]
302
      where req_nodes = Instance.requiredNodes disk_template
303
            prefix = specPrefix spec
304

    
305
printISpec False ispec spec disk_template =
306
  printf "%s instance spec is:\n  %s, using disk\
307
         \ template '%s'.\n"
308
         (specDescription spec)
309
         (formatResources ispec specData) (diskTemplateToRaw disk_template)
310

    
311
-- | Prints the tiered results.
312
printTiered :: Bool -> [(RSpec, Int)]
313
            -> Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
314
printTiered True spec_map nl trl_nl _ = do
315
  printKeysHTS $ printStats PTiered (Cluster.totalResources trl_nl)
316
  printKeysHTS [("TSPEC", unwords (formatSpecMap spec_map))]
317
  printAllocationStats nl trl_nl
318

    
319
printTiered False spec_map ini_nl fin_nl sreason = do
320
  _ <- printf "Tiered allocation results:\n"
321
  if null spec_map
322
    then putStrLn "  - no instances allocated"
323
    else mapM_ (\(ispec, cnt) ->
324
                  printf "  - %3d instances of spec %s\n" cnt
325
                           (formatResources ispec specData)) spec_map
326
  printFRScores ini_nl fin_nl sreason
327

    
328
-- | Displays the initial/final cluster scores.
329
printClusterScores :: Node.List -> Node.List -> IO ()
330
printClusterScores ini_nl fin_nl = do
331
  printf "  - initial cluster score: %.8f\n" $ Cluster.compCV ini_nl::IO ()
332
  printf "  -   final cluster score: %.8f\n" $ Cluster.compCV fin_nl
333

    
334
-- | Displays the cluster efficiency.
335
printClusterEff :: Cluster.CStats -> IO ()
336
printClusterEff cs =
337
  mapM_ (\(s, fn) ->
338
           printf "  - %s usage efficiency: %5.2f%%\n" s (fn cs * 100))
339
          [("memory", memEff),
340
           ("  disk", dskEff),
341
           ("  vcpu", cpuEff)]
342

    
343
-- | Computes the most likely failure reason.
344
failureReason :: [(FailMode, Int)] -> String
345
failureReason = show . fst . head
346

    
347
-- | Sorts the failure reasons.
348
sortReasons :: [(FailMode, Int)] -> [(FailMode, Int)]
349
sortReasons = reverse . sortBy (comparing snd)
350

    
351
-- | Runs an allocation algorithm and saves cluster state.
352
runAllocation :: ClusterData                -- ^ Cluster data
353
              -> Maybe Cluster.AllocResult  -- ^ Optional stop-allocation
354
              -> Result Cluster.AllocResult -- ^ Allocation result
355
              -> RSpec                      -- ^ Requested instance spec
356
              -> DiskTemplate               -- ^ Requested disk template
357
              -> SpecType                   -- ^ Allocation type
358
              -> Options                    -- ^ CLI options
359
              -> IO (FailStats, Node.List, Int, [(RSpec, Int)])
360
runAllocation cdata stop_allocation actual_result spec dt mode opts = do
361
  (reasons, new_nl, new_il, new_ixes, _) <-
362
      case stop_allocation of
363
        Just result_noalloc -> return result_noalloc
364
        Nothing -> exitIfBad "failure during allocation" actual_result
365

    
366
  let name = head . words . specDescription $ mode
367
      descr = name ++ " allocation"
368
      ldescr = "after " ++ map toLower descr
369

    
370
  printISpec (optMachineReadable opts) spec mode dt
371

    
372
  printAllocationMap (optVerbose opts) descr new_nl new_ixes
373

    
374
  maybePrintNodes (optShowNodes opts) descr (Cluster.printNodes new_nl)
375

    
376
  maybeSaveData (optSaveCluster opts) (map toLower name) ldescr
377
                    (cdata { cdNodes = new_nl, cdInstances = new_il})
378

    
379
  return (sortReasons reasons, new_nl, length new_ixes, tieredSpecMap new_ixes)
380

    
381
-- | Create an instance from a given spec.
382
instFromSpec :: RSpec -> DiskTemplate -> Int -> Instance.Instance
383
instFromSpec spx =
384
  Instance.create "new" (rspecMem spx) (rspecDsk spx)
385
    (rspecCpu spx) Running [] True (-1) (-1)
386

    
387
-- | Main function.
388
main :: Options -> [String] -> IO ()
389
main opts args = do
390
  exitUnless (null args) "This program doesn't take any arguments."
391

    
392
  let verbose = optVerbose opts
393
      machine_r = optMachineReadable opts
394

    
395
  orig_cdata@(ClusterData gl fixed_nl il _ ipol) <- loadExternalData opts
396
  nl <- setNodeStatus opts fixed_nl
397

    
398
  cluster_disk_template <-
399
    case iPolicyDiskTemplates ipol of
400
      first_templ:_ -> return first_templ
401
      _ -> exitErr "null list of disk templates received from cluster"
402

    
403
  let num_instances = Container.size il
404
      all_nodes = Container.elems fixed_nl
405
      cdata = orig_cdata { cdNodes = fixed_nl }
406
      disk_template = fromMaybe cluster_disk_template (optDiskTemplate opts)
407
      req_nodes = Instance.requiredNodes disk_template
408
      csf = commonSuffix fixed_nl il
409
      su = fromMaybe (iSpecSpindleUse $ iPolicyStdSpec ipol)
410
                     (optSpindleUse opts)
411

    
412
  when (not (null csf) && verbose > 1) $
413
       hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
414

    
415
  maybePrintNodes (optShowNodes opts) "Initial cluster" (Cluster.printNodes nl)
416

    
417
  when (verbose > 2) $
418
         hPrintf stderr "Initial coefficients: overall %.8f\n%s"
419
                 (Cluster.compCV nl) (Cluster.printStats "  " nl)
420

    
421
  printCluster machine_r (Cluster.totalResources nl) (length all_nodes)
422

    
423
  let stop_allocation = case Cluster.computeBadItems nl il of
424
                          ([], _) -> Nothing
425
                          _ -> Just ([(FailN1, 1)]::FailStats, nl, il, [], [])
426
      alloclimit = if optMaxLength opts == -1
427
                   then Nothing
428
                   else Just (optMaxLength opts)
429

    
430
  allocnodes <- exitIfBad "failure during allocation" $
431
                Cluster.genAllocNodes gl nl req_nodes True
432

    
433
  -- Run the tiered allocation
434

    
435
  let tspec = fromMaybe (rspecFromISpec (iPolicyMaxSpec ipol))
436
              (optTieredSpec opts)
437

    
438
  (treason, trl_nl, _, spec_map) <-
439
    runAllocation cdata stop_allocation
440
       (Cluster.tieredAlloc nl il alloclimit
441
        (instFromSpec tspec disk_template su) allocnodes [] [])
442
       tspec disk_template SpecTiered opts
443

    
444
  printTiered machine_r spec_map nl trl_nl treason
445

    
446
  -- Run the standard (avg-mode) allocation
447

    
448
  let ispec = fromMaybe (rspecFromISpec (iPolicyStdSpec ipol))
449
              (optStdSpec opts)
450

    
451
  (sreason, fin_nl, allocs, _) <-
452
      runAllocation cdata stop_allocation
453
            (Cluster.iterateAlloc nl il alloclimit
454
             (instFromSpec ispec disk_template su) allocnodes [] [])
455
            ispec disk_template SpecNormal opts
456

    
457
  printResults machine_r nl fin_nl num_instances allocs sreason
458

    
459
  -- Print final result
460

    
461
  printFinalHTS machine_r