Statistics
| Branch: | Tag: | Revision:

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

History | View | Annotate | Download (17 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
instFromSpec :: RSpec -> DiskTemplate -> Int -> Instance.Instance
394
instFromSpec spx =
395
  Instance.create "new" (rspecMem spx) (rspecDsk spx)
396
    (rspecCpu spx) Running [] True (-1) (-1)
397

    
398
-- | Main function.
399
main :: Options -> [String] -> IO ()
400
main opts args = do
401
  exitUnless (null args) "This program doesn't take any arguments."
402

    
403
  let verbose = optVerbose opts
404
      machine_r = optMachineReadable opts
405

    
406
  orig_cdata@(ClusterData gl fixed_nl il _ ipol) <- loadExternalData opts
407
  nl <- setNodeStatus opts fixed_nl
408

    
409
  cluster_disk_template <-
410
    case iPolicyDiskTemplates ipol of
411
      first_templ:_ -> return first_templ
412
      _ -> exitErr "null list of disk templates received from cluster"
413

    
414
  let num_instances = Container.size il
415
      all_nodes = Container.elems fixed_nl
416
      cdata = orig_cdata { cdNodes = fixed_nl }
417
      disk_template = fromMaybe cluster_disk_template (optDiskTemplate opts)
418
      req_nodes = Instance.requiredNodes disk_template
419
      csf = commonSuffix fixed_nl il
420
      su = fromMaybe (iSpecSpindleUse $ iPolicyStdSpec ipol)
421
                     (optSpindleUse opts)
422

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

    
426
  maybePrintNodes (optShowNodes opts) "Initial cluster" (Cluster.printNodes nl)
427

    
428
  when (verbose > 2) $
429
         hPrintf stderr "Initial coefficients: overall %.8f\n%s"
430
                 (Cluster.compCV nl) (Cluster.printStats "  " nl)
431

    
432
  printCluster machine_r (Cluster.totalResources nl) (length all_nodes)
433

    
434
  let stop_allocation = case Cluster.computeBadItems nl il of
435
                          ([], _) -> Nothing
436
                          _ -> Just ([(FailN1, 1)]::FailStats, nl, il, [], [])
437
      alloclimit = if optMaxLength opts == -1
438
                   then Nothing
439
                   else Just (optMaxLength opts)
440

    
441
  allocnodes <- exitIfBad "failure during allocation" $
442
                Cluster.genAllocNodes gl nl req_nodes True
443

    
444
  -- Run the tiered allocation
445

    
446
  let tspec = fromMaybe (rspecFromISpec (iPolicyMaxSpec ipol))
447
              (optTieredSpec opts)
448

    
449
  (treason, trl_nl, _, spec_map) <-
450
    runAllocation cdata stop_allocation
451
       (Cluster.tieredAlloc nl il alloclimit
452
        (instFromSpec tspec disk_template su) allocnodes [] [])
453
       tspec disk_template SpecTiered opts
454

    
455
  printTiered machine_r spec_map nl trl_nl treason
456

    
457
  -- Run the standard (avg-mode) allocation
458

    
459
  let ispec = fromMaybe (rspecFromISpec (iPolicyStdSpec ipol))
460
              (optStdSpec opts)
461

    
462
  (sreason, fin_nl, allocs, _) <-
463
      runAllocation cdata stop_allocation
464
            (Cluster.iterateAlloc nl il alloclimit
465
             (instFromSpec ispec disk_template su) allocnodes [] [])
466
            ispec disk_template SpecNormal opts
467

    
468
  printResults machine_r nl fin_nl num_instances allocs sreason
469

    
470
  -- Print final result
471

    
472
  printFinalHTS machine_r