Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / HTools / Program / Hspace.hs @ 53822ec4

History | View | Annotate | Download (17.9 kB)

1
{-| Cluster space sizing
2

    
3
-}
4

    
5
{-
6

    
7
Copyright (C) 2009, 2010, 2011, 2012, 2013 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
-- | The \"name\" of a 'SpecType'.
109
specName :: SpecType -> String
110
specName SpecNormal = "Standard"
111
specName SpecTiered = "Tiered"
112

    
113
-- | Efficiency generic function.
114
effFn :: (Cluster.CStats -> Integer)
115
      -> (Cluster.CStats -> Double)
116
      -> Cluster.CStats -> Double
117
effFn fi ft cs = fromIntegral (fi cs) / ft cs
118

    
119
-- | Memory efficiency.
120
memEff :: Cluster.CStats -> Double
121
memEff = effFn Cluster.csImem Cluster.csTmem
122

    
123
-- | Disk efficiency.
124
dskEff :: Cluster.CStats -> Double
125
dskEff = effFn Cluster.csIdsk Cluster.csTdsk
126

    
127
-- | Cpu efficiency.
128
cpuEff :: Cluster.CStats -> Double
129
cpuEff = effFn Cluster.csIcpu (fromIntegral . Cluster.csVcpu)
130

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

    
156
-- | List holding 'RSpec' formatting information.
157
specData :: [(String, RSpec -> String)]
158
specData = [ ("MEM", printf "%d" . rspecMem)
159
           , ("DSK", printf "%d" . rspecDsk)
160
           , ("CPU", printf "%d" . rspecCpu)
161
           ]
162

    
163
-- | List holding 'Cluster.CStats' formatting information.
164
clusterData :: [(String, Cluster.CStats -> String)]
165
clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
166
              , ("DSK", printf "%.0f" . Cluster.csTdsk)
167
              , ("CPU", printf "%.0f" . Cluster.csTcpu)
168
              , ("VCPU", printf "%d" . Cluster.csVcpu)
169
              ]
170

    
171
-- | Function to print stats for a given phase.
172
printStats :: Phase -> Cluster.CStats -> [(String, String)]
173
printStats ph cs =
174
  map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
175
  where kind = case ph of
176
                 PInitial -> "INI"
177
                 PFinal -> "FIN"
178
                 PTiered -> "TRL"
179

    
180
-- | Print failure reason and scores
181
printFRScores :: Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
182
printFRScores ini_nl fin_nl sreason = do
183
  printf "  - most likely failure reason: %s\n" $ failureReason sreason::IO ()
184
  printClusterScores ini_nl fin_nl
185
  printClusterEff (Cluster.totalResources fin_nl)
186

    
187
-- | Print final stats and related metrics.
188
printResults :: Bool -> Node.List -> Node.List -> Int -> Int
189
             -> [(FailMode, Int)] -> IO ()
190
printResults True _ fin_nl num_instances allocs sreason = do
191
  let fin_stats = Cluster.totalResources fin_nl
192
      fin_instances = num_instances + allocs
193

    
194
  exitWhen (num_instances + allocs /= Cluster.csNinst fin_stats) $
195
           printf "internal inconsistency, allocated (%d)\
196
                  \ != counted (%d)\n" (num_instances + allocs)
197
           (Cluster.csNinst fin_stats)
198

    
199
  main_reason <- exitIfEmpty "Internal error, no failure reasons?!" sreason
200

    
201
  printKeysHTS $ printStats PFinal fin_stats
202
  printKeysHTS [ ("ALLOC_USAGE", printf "%.8f"
203
                                   ((fromIntegral num_instances::Double) /
204
                                   fromIntegral fin_instances))
205
               , ("ALLOC_INSTANCES", printf "%d" allocs)
206
               , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ main_reason)
207
               ]
208
  printKeysHTS $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
209
                                  printf "%d" y)) sreason
210

    
211
printResults False ini_nl fin_nl _ allocs sreason = do
212
  putStrLn "Normal (fixed-size) allocation results:"
213
  printf "  - %3d instances allocated\n" allocs :: IO ()
214
  printFRScores ini_nl fin_nl sreason
215

    
216
-- | Prints the final @OK@ marker in machine readable output.
217
printFinalHTS :: Bool -> IO ()
218
printFinalHTS = printFinal htsPrefix
219

    
220
{-# ANN tieredSpecMap "HLint: ignore Use alternative" #-}
221
-- | Compute the tiered spec counts from a list of allocated
222
-- instances.
223
tieredSpecMap :: [Instance.Instance]
224
              -> [(RSpec, Int)]
225
tieredSpecMap trl_ixes =
226
  let fin_trl_ixes = reverse trl_ixes
227
      ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
228
      -- head is "safe" here, as groupBy returns list of non-empty lists
229
      spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
230
                 ix_byspec
231
  in spec_map
232

    
233
-- | Formats a spec map to strings.
234
formatSpecMap :: [(RSpec, Int)] -> [String]
235
formatSpecMap =
236
  map (\(spec, cnt) -> printf "%d,%d,%d=%d" (rspecMem spec)
237
                       (rspecDsk spec) (rspecCpu spec) cnt)
238

    
239
-- | Formats \"key-metrics\" values.
240
formatRSpec :: String -> AllocInfo -> [(String, String)]
241
formatRSpec s r =
242
  [ ("KM_" ++ s ++ "_CPU", show $ allocInfoVCpus r)
243
  , ("KM_" ++ s ++ "_NPU", show $ allocInfoNCpus r)
244
  , ("KM_" ++ s ++ "_MEM", show $ allocInfoMem r)
245
  , ("KM_" ++ s ++ "_DSK", show $ allocInfoDisk r)
246
  ]
247

    
248
-- | Shows allocations stats.
249
printAllocationStats :: Node.List -> Node.List -> IO ()
250
printAllocationStats ini_nl fin_nl = do
251
  let ini_stats = Cluster.totalResources ini_nl
252
      fin_stats = Cluster.totalResources fin_nl
253
      (rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
254
  printKeysHTS $ formatRSpec "USED" rini
255
  printKeysHTS $ formatRSpec "POOL" ralo
256
  printKeysHTS $ formatRSpec "UNAV" runa
257

    
258
-- | Format a list of key\/values as a shell fragment.
259
printKeysHTS :: [(String, String)] -> IO ()
260
printKeysHTS = printKeys htsPrefix
261

    
262
-- | Converts instance data to a list of strings.
263
printInstance :: Node.List -> Instance.Instance -> [String]
264
printInstance nl i = [ Instance.name i
265
                     , Container.nameOf nl $ Instance.pNode i
266
                     , let sdx = Instance.sNode i
267
                       in if sdx == Node.noSecondary then ""
268
                          else Container.nameOf nl sdx
269
                     , show (Instance.mem i)
270
                     , show (Instance.dsk i)
271
                     , show (Instance.vcpus i)
272
                     ]
273

    
274
-- | Optionally print the allocation map.
275
printAllocationMap :: Int -> String
276
                   -> Node.List -> [Instance.Instance] -> IO ()
277
printAllocationMap verbose msg nl ixes =
278
  when (verbose > 1) $ do
279
    hPutStrLn stderr (msg ++ " map")
280
    hPutStr stderr . unlines . map ((:) ' ' .  unwords) $
281
            formatTable (map (printInstance nl) (reverse ixes))
282
                        -- This is the numberic-or-not field
283
                        -- specification; the first three fields are
284
                        -- strings, whereas the rest are numeric
285
                       [False, False, False, True, True, True]
286

    
287
-- | Formats nicely a list of resources.
288
formatResources :: a -> [(String, a->String)] -> String
289
formatResources res =
290
    intercalate ", " . map (\(a, fn) -> a ++ " " ++ fn res)
291

    
292
-- | Print the cluster resources.
293
printCluster :: Bool -> Cluster.CStats -> Int -> IO ()
294
printCluster True ini_stats node_count = do
295
  printKeysHTS $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
296
  printKeysHTS [("CLUSTER_NODES", printf "%d" node_count)]
297
  printKeysHTS $ printStats PInitial ini_stats
298

    
299
printCluster False ini_stats node_count = do
300
  printf "The cluster has %d nodes and the following resources:\n  %s.\n"
301
         node_count (formatResources ini_stats clusterData)::IO ()
302
  printf "There are %s initial instances on the cluster.\n"
303
             (if inst_count > 0 then show inst_count else "no" )
304
      where inst_count = Cluster.csNinst ini_stats
305

    
306
-- | Prints the normal instance spec.
307
printISpec :: Bool -> RSpec -> SpecType -> DiskTemplate -> IO ()
308
printISpec True ispec spec disk_template = do
309
  printKeysHTS $ map (\(a, fn) -> (prefix ++ "_" ++ a, fn ispec)) specData
310
  printKeysHTS [ (prefix ++ "_RQN", printf "%d" req_nodes) ]
311
  printKeysHTS [ (prefix ++ "_DISK_TEMPLATE",
312
                  diskTemplateToRaw disk_template) ]
313
      where req_nodes = Instance.requiredNodes disk_template
314
            prefix = specPrefix spec
315

    
316
printISpec False ispec spec disk_template =
317
  printf "%s instance spec is:\n  %s, using disk\
318
         \ template '%s'.\n"
319
         (specDescription spec)
320
         (formatResources ispec specData) (diskTemplateToRaw disk_template)
321

    
322
-- | Prints the tiered results.
323
printTiered :: Bool -> [(RSpec, Int)]
324
            -> Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
325
printTiered True spec_map nl trl_nl _ = do
326
  printKeysHTS $ printStats PTiered (Cluster.totalResources trl_nl)
327
  printKeysHTS [("TSPEC", unwords (formatSpecMap spec_map))]
328
  printAllocationStats nl trl_nl
329

    
330
printTiered False spec_map ini_nl fin_nl sreason = do
331
  _ <- printf "Tiered allocation results:\n"
332
  if null spec_map
333
    then putStrLn "  - no instances allocated"
334
    else mapM_ (\(ispec, cnt) ->
335
                  printf "  - %3d instances of spec %s\n" cnt
336
                           (formatResources ispec specData)) spec_map
337
  printFRScores ini_nl fin_nl sreason
338

    
339
-- | Displays the initial/final cluster scores.
340
printClusterScores :: Node.List -> Node.List -> IO ()
341
printClusterScores ini_nl fin_nl = do
342
  printf "  - initial cluster score: %.8f\n" $ Cluster.compCV ini_nl::IO ()
343
  printf "  -   final cluster score: %.8f\n" $ Cluster.compCV fin_nl
344

    
345
-- | Displays the cluster efficiency.
346
printClusterEff :: Cluster.CStats -> IO ()
347
printClusterEff cs =
348
  mapM_ (\(s, fn) ->
349
           printf "  - %s usage efficiency: %5.2f%%\n" s (fn cs * 100))
350
          [("memory", memEff),
351
           ("  disk", dskEff),
352
           ("  vcpu", cpuEff)]
353

    
354
-- | Computes the most likely failure reason.
355
failureReason :: [(FailMode, Int)] -> String
356
failureReason = show . fst . head
357

    
358
-- | Sorts the failure reasons.
359
sortReasons :: [(FailMode, Int)] -> [(FailMode, Int)]
360
sortReasons = reverse . sortBy (comparing snd)
361

    
362
-- | Runs an allocation algorithm and saves cluster state.
363
runAllocation :: ClusterData                -- ^ Cluster data
364
              -> Maybe Cluster.AllocResult  -- ^ Optional stop-allocation
365
              -> Result Cluster.AllocResult -- ^ Allocation result
366
              -> RSpec                      -- ^ Requested instance spec
367
              -> DiskTemplate               -- ^ Requested disk template
368
              -> SpecType                   -- ^ Allocation type
369
              -> Options                    -- ^ CLI options
370
              -> IO (FailStats, Node.List, Int, [(RSpec, Int)])
371
runAllocation cdata stop_allocation actual_result spec dt mode opts = do
372
  (reasons, new_nl, new_il, new_ixes, _) <-
373
      case stop_allocation of
374
        Just result_noalloc -> return result_noalloc
375
        Nothing -> exitIfBad "failure during allocation" actual_result
376

    
377
  let name = specName mode
378
      descr = name ++ " allocation"
379
      ldescr = "after " ++ map toLower descr
380

    
381
  printISpec (optMachineReadable opts) spec mode dt
382

    
383
  printAllocationMap (optVerbose opts) descr new_nl new_ixes
384

    
385
  maybePrintNodes (optShowNodes opts) descr (Cluster.printNodes new_nl)
386

    
387
  maybeSaveData (optSaveCluster opts) (map toLower name) ldescr
388
                    (cdata { cdNodes = new_nl, cdInstances = new_il})
389

    
390
  return (sortReasons reasons, new_nl, length new_ixes, tieredSpecMap new_ixes)
391

    
392
-- | Create an instance from a given spec.
393
-- For values not implied by the resorce specification (like distribution of
394
-- of the disk space to individual disks), sensible defaults are guessed (e.g.,
395
-- having a single disk).
396
instFromSpec :: RSpec -> DiskTemplate -> Int -> Instance.Instance
397
instFromSpec spx =
398
  Instance.create "new" (rspecMem spx) (rspecDsk spx) [rspecDsk spx]
399
    (rspecCpu spx) Running [] True (-1) (-1)
400

    
401
combineTiered :: Maybe Int -> Cluster.AllocNodes -> Cluster.AllocResult ->
402
           Instance.Instance -> Result Cluster.AllocResult
403
combineTiered limit allocnodes result inst = do
404
  let (_, nl, il, ixes, cstats) = result
405
      ixes_cnt = length ixes
406
      (stop, newlimit) = case limit of
407
        Nothing -> (False, Nothing)
408
        Just n -> (n <= ixes_cnt, Just (n - ixes_cnt))
409
  if stop
410
    then return result
411
    else Cluster.tieredAlloc nl il newlimit inst allocnodes ixes cstats
412

    
413
-- | Main function.
414
main :: Options -> [String] -> IO ()
415
main opts args = do
416
  exitUnless (null args) "This program doesn't take any arguments."
417

    
418
  let verbose = optVerbose opts
419
      machine_r = optMachineReadable opts
420

    
421
  orig_cdata@(ClusterData gl fixed_nl il _ ipol) <- loadExternalData opts
422
  nl <- setNodeStatus opts fixed_nl
423

    
424
  cluster_disk_template <-
425
    case iPolicyDiskTemplates ipol of
426
      first_templ:_ -> return first_templ
427
      _ -> exitErr "null list of disk templates received from cluster"
428

    
429
  let num_instances = Container.size il
430
      all_nodes = Container.elems fixed_nl
431
      cdata = orig_cdata { cdNodes = fixed_nl }
432
      disk_template = fromMaybe cluster_disk_template (optDiskTemplate opts)
433
      req_nodes = Instance.requiredNodes disk_template
434
      csf = commonSuffix fixed_nl il
435
      su = fromMaybe (iSpecSpindleUse $ iPolicyStdSpec ipol)
436
                     (optSpindleUse opts)
437

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

    
441
  maybePrintNodes (optShowNodes opts) "Initial cluster" (Cluster.printNodes nl)
442

    
443
  when (verbose > 2) $
444
         hPrintf stderr "Initial coefficients: overall %.8f\n%s"
445
                 (Cluster.compCV nl) (Cluster.printStats "  " nl)
446

    
447
  printCluster machine_r (Cluster.totalResources nl) (length all_nodes)
448

    
449
  let stop_allocation = case Cluster.computeBadItems nl il of
450
                          ([], _) -> Nothing
451
                          _ -> Just ([(FailN1, 1)]::FailStats, nl, il, [], [])
452
      alloclimit = if optMaxLength opts == -1
453
                   then Nothing
454
                   else Just (optMaxLength opts)
455

    
456
  allocnodes <- exitIfBad "failure during allocation" $
457
                Cluster.genAllocNodes gl nl req_nodes True
458

    
459
  -- Run the tiered allocation
460

    
461
  let minmaxes = iPolicyMinMaxISpecs ipol
462
      tspecs = case optTieredSpec opts of
463
                 Nothing -> map (rspecFromISpec . minMaxISpecsMaxSpec)
464
                            minmaxes
465
                 Just t -> [t]
466
      tinsts = map (\ts -> instFromSpec ts disk_template su) tspecs
467
  tspec <- case tspecs of
468
    [] -> exitErr "Empty list of specs received from the cluster"
469
    t:_ -> return t
470

    
471
  (treason, trl_nl, _, spec_map) <-
472
    runAllocation cdata stop_allocation
473
       (foldM (combineTiered alloclimit allocnodes) ([], nl, il, [], []) tinsts)
474
       tspec disk_template SpecTiered opts
475

    
476
  printTiered machine_r spec_map nl trl_nl treason
477

    
478
  -- Run the standard (avg-mode) allocation
479

    
480
  let ispec = fromMaybe (rspecFromISpec (iPolicyStdSpec ipol))
481
              (optStdSpec opts)
482

    
483
  (sreason, fin_nl, allocs, _) <-
484
      runAllocation cdata stop_allocation
485
            (Cluster.iterateAlloc nl il alloclimit
486
             (instFromSpec ispec disk_template su) allocnodes [] [])
487
            ispec disk_template SpecNormal opts
488

    
489
  printResults machine_r nl fin_nl num_instances allocs sreason
490

    
491
  -- Print final result
492

    
493
  printFinalHTS machine_r