Hspace.hs 16.5 KB
Newer Older
Iustin Pop's avatar
Iustin Pop committed
1 2 3 4 5 6
{-| Cluster space sizing

-}

{-

Iustin Pop's avatar
Iustin Pop committed
7
Copyright (C) 2009, 2010, 2011 Google Inc.
Iustin Pop's avatar
Iustin Pop committed
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.

-}

26
module Ganeti.HTools.Program.Hspace (main) where
Iustin Pop's avatar
Iustin Pop committed
27

Iustin Pop's avatar
Iustin Pop committed
28
import Control.Monad
Iustin Pop's avatar
Iustin Pop committed
29
import Data.Char (toUpper, isAlphaNum, toLower)
30
import Data.Function (on)
Iustin Pop's avatar
Iustin Pop committed
31
import Data.List
32
import Data.Ord (comparing)
Iustin Pop's avatar
Iustin Pop committed
33
import System (exitWith, ExitCode(..))
Iustin Pop's avatar
Iustin Pop committed
34 35 36
import System.IO
import qualified System

37
import Text.Printf (printf, hPrintf)
Iustin Pop's avatar
Iustin Pop committed
38 39 40 41 42 43 44

import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Node as Node
import qualified Ganeti.HTools.Instance as Instance

import Ganeti.HTools.Utils
45
import Ganeti.HTools.Types
46
import Ganeti.HTools.CLI
47
import Ganeti.HTools.ExtLoader
48
import Ganeti.HTools.Loader
Iustin Pop's avatar
Iustin Pop committed
49

Iustin Pop's avatar
Iustin Pop committed
50
-- | Options list and functions.
51
options :: [OptType]
Iustin Pop's avatar
Iustin Pop committed
52
options =
53
    [ oPrintNodes
54
    , oDataFile
55
    , oDiskTemplate
56
    , oNodeSim
57 58 59 60 61 62 63 64
    , oRapiMaster
    , oLuxiSocket
    , oVerbose
    , oQuiet
    , oOfflineNode
    , oIMem
    , oIDisk
    , oIVcpus
65
    , oMachineReadable
66
    , oMaxCpu
Iustin Pop's avatar
Iustin Pop committed
67
    , oMaxSolLength
68
    , oMinDisk
69
    , oTieredSpec
70
    , oSaveCluster
71 72
    , oShowVer
    , oShowHelp
Iustin Pop's avatar
Iustin Pop committed
73 74
    ]

75 76 77 78 79
-- | The allocation phase we're in (initial, after tiered allocs, or
-- after regular allocation).
data Phase = PInitial
           | PFinal
           | PTiered
80

81 82 83 84 85 86 87 88 89 90 91
-- | The kind of instance spec we print.
data SpecType = SpecNormal
              | SpecTiered

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

-- | The description of a spec.
specDescription :: SpecType -> String
Iustin Pop's avatar
Iustin Pop committed
92
specDescription SpecNormal = "Standard (fixed-size)"
93 94 95 96 97
specDescription SpecTiered = "Tiered (initial size)"

-- | Efficiency generic function.
effFn :: (Cluster.CStats -> Integer)
      -> (Cluster.CStats -> Double)
Iustin Pop's avatar
Iustin Pop committed
98
      -> Cluster.CStats -> Double
99 100 101 102 103 104 105 106 107 108 109 110 111 112
effFn fi ft cs = fromIntegral (fi cs) / ft cs

-- | Memory efficiency.
memEff :: Cluster.CStats -> Double
memEff = effFn Cluster.csImem Cluster.csTmem

-- | Disk efficiency.
dskEff :: Cluster.CStats -> Double
dskEff = effFn Cluster.csIdsk Cluster.csTdsk

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

Iustin Pop's avatar
Iustin Pop committed
113 114
-- | Holds data for converting a 'Cluster.CStats' structure into
-- detailed statictics.
115
statsData :: [(String, Cluster.CStats -> String)]
116 117 118 119
statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
            , ("INST_CNT", printf "%d" . Cluster.csNinst)
            , ("MEM_FREE", printf "%d" . Cluster.csFmem)
            , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
120
            , ("MEM_RESVD",
121 122
               \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
            , ("MEM_INST", printf "%d" . Cluster.csImem)
123
            , ("MEM_OVERHEAD",
124
               \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
125
            , ("MEM_EFF", printf "%.8f" . memEff)
126
            , ("DSK_FREE", printf "%d" . Cluster.csFdsk)
127
            , ("DSK_AVAIL", printf "%d". Cluster.csAdsk)
128
            , ("DSK_RESVD",
129 130
               \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
            , ("DSK_INST", printf "%d" . Cluster.csIdsk)
131
            , ("DSK_EFF", printf "%.8f" . dskEff)
132
            , ("CPU_INST", printf "%d" . Cluster.csIcpu)
133
            , ("CPU_EFF", printf "%.8f" . cpuEff)
134 135
            , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
            , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
136 137
            ]

Iustin Pop's avatar
Iustin Pop committed
138
-- | List holding 'RSpec' formatting information.
139 140 141 142
specData :: [(String, RSpec -> String)]
specData = [ ("MEM", printf "%d" . rspecMem)
           , ("DSK", printf "%d" . rspecDsk)
           , ("CPU", printf "%d" . rspecCpu)
143 144
           ]

Iustin Pop's avatar
Iustin Pop committed
145
-- | List holding 'Cluster.CStats' formatting information.
146
clusterData :: [(String, Cluster.CStats -> String)]
147 148 149
clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
              , ("DSK", printf "%.0f" . Cluster.csTdsk)
              , ("CPU", printf "%.0f" . Cluster.csTcpu)
Iustin Pop's avatar
Iustin Pop committed
150
              , ("VCPU", printf "%d" . Cluster.csVcpu)
151 152
              ]

Iustin Pop's avatar
Iustin Pop committed
153
-- | Function to print stats for a given phase.
154 155 156 157 158 159
printStats :: Phase -> Cluster.CStats -> [(String, String)]
printStats ph cs =
  map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
  where kind = case ph of
                 PInitial -> "INI"
                 PFinal -> "FIN"
160
                 PTiered -> "TRL"
Iustin Pop's avatar
Iustin Pop committed
161

162 163 164 165
-- | Print final stats and related metrics.
printResults :: Bool -> Node.List -> Node.List -> Int -> Int
             -> [(FailMode, Int)] -> IO ()
printResults True _ fin_nl num_instances allocs sreason = do
166 167 168
  let fin_stats = Cluster.totalResources fin_nl
      fin_instances = num_instances + allocs

169
  when (num_instances + allocs /= Cluster.csNinst fin_stats) $
170 171 172
       do
         hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
                        \ != counted (%d)\n" (num_instances + allocs)
Iustin Pop's avatar
Iustin Pop committed
173
                                 (Cluster.csNinst fin_stats) :: IO ()
174 175
         exitWith $ ExitFailure 1

176 177 178 179
  printKeys $ printStats PFinal fin_stats
  printKeys [ ("ALLOC_USAGE", printf "%.8f"
                                ((fromIntegral num_instances::Double) /
                                 fromIntegral fin_instances))
180
            , ("ALLOC_INSTANCES", printf "%d" allocs)
181 182 183 184
            , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
            ]
  printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
                               printf "%d" y)) sreason
185 186 187 188 189 190 191 192 193 194 195

printResults False ini_nl fin_nl _ allocs sreason = do
  putStrLn "Normal (fixed-size) allocation results:"
  printf "  - %3d instances allocated\n" allocs :: IO ()
  printf "  - most likely failure reason: %s\n" $ failureReason sreason::IO ()
  printClusterScores ini_nl fin_nl
  printClusterEff (Cluster.totalResources fin_nl)

-- | Prints the final @OK@ marker in machine readable output.
printFinal :: Bool -> IO ()
printFinal True =
196 197 198
  -- this should be the final entry
  printKeys [("OK", "1")]

199 200
printFinal False = return ()

201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217
-- | Compute the tiered spec counts from a list of allocated
-- instances.
tieredSpecMap :: [Instance.Instance]
              -> [(RSpec, Int)]
tieredSpecMap trl_ixes =
    let fin_trl_ixes = reverse trl_ixes
        ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
        spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
                   ix_byspec
    in spec_map

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

Iustin Pop's avatar
Iustin Pop committed
218
-- | Formats \"key-metrics\" values.
219 220
formatRSpec :: Double -> String -> RSpec -> [(String, String)]
formatRSpec m_cpu s r =
Iustin Pop's avatar
Iustin Pop committed
221
    [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
222
    , ("KM_" ++ s ++ "_NPU", show $ fromIntegral (rspecCpu r) / m_cpu)
Iustin Pop's avatar
Iustin Pop committed
223 224 225 226
    , ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
    , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
    ]

Iustin Pop's avatar
Iustin Pop committed
227
-- | Shows allocations stats.
228 229
printAllocationStats :: Double -> Node.List -> Node.List -> IO ()
printAllocationStats m_cpu ini_nl fin_nl = do
Iustin Pop's avatar
Iustin Pop committed
230 231 232
  let ini_stats = Cluster.totalResources ini_nl
      fin_stats = Cluster.totalResources fin_nl
      (rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
233 234 235
  printKeys $ formatRSpec m_cpu  "USED" rini
  printKeys $ formatRSpec m_cpu "POOL"ralo
  printKeys $ formatRSpec m_cpu "UNAV" runa
Iustin Pop's avatar
Iustin Pop committed
236

Iustin Pop's avatar
Iustin Pop committed
237
-- | Ensure a value is quoted if needed.
238
ensureQuoted :: String -> String
Iustin Pop's avatar
Iustin Pop committed
239
ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v)
240 241 242
                 then '\'':v ++ "'"
                 else v

Iustin Pop's avatar
Iustin Pop committed
243
-- | Format a list of key\/values as a shell fragment.
244
printKeys :: [(String, String)] -> IO ()
245 246
printKeys = mapM_ (\(k, v) ->
                   printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
247

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

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

273
-- | Formats nicely a list of resources.
Iustin Pop's avatar
Iustin Pop committed
274
formatResources :: a -> [(String, a->String)] -> String
275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296
formatResources res =
    intercalate ", " . map (\(a, fn) -> a ++ " " ++ fn res)

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

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

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

Iustin Pop's avatar
Iustin Pop committed
302
printISpec False ispec spec disk_template =
303 304 305
  printf "%s instance spec is:\n  %s, using disk\
         \ template '%s'.\n"
         (specDescription spec)
306
         (formatResources ispec specData) (diskTemplateToString disk_template)
307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324

-- | Prints the tiered results.
printTiered :: Bool -> [(RSpec, Int)] -> Double
            -> Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
printTiered True spec_map m_cpu nl trl_nl _ = do
  printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
  printKeys [("TSPEC", intercalate " " (formatSpecMap spec_map))]
  printAllocationStats m_cpu nl trl_nl

printTiered False spec_map _ ini_nl fin_nl sreason = do
  _ <- printf "Tiered allocation results:\n"
  mapM_ (\(ispec, cnt) ->
             printf "  - %3d instances of spec %s\n" cnt
                        (formatResources ispec specData)) spec_map
  printf "  - most likely failure reason: %s\n" $ failureReason sreason::IO ()
  printClusterScores ini_nl fin_nl
  printClusterEff (Cluster.totalResources fin_nl)

Iustin Pop's avatar
Iustin Pop committed
325
-- | Displays the initial/final cluster scores.
326 327 328 329 330
printClusterScores :: Node.List -> Node.List -> IO ()
printClusterScores ini_nl fin_nl = do
  printf "  - initial cluster score: %.8f\n" $ Cluster.compCV ini_nl::IO ()
  printf "  -   final cluster score: %.8f\n" $ Cluster.compCV fin_nl

Iustin Pop's avatar
Iustin Pop committed
331
-- | Displays the cluster efficiency.
332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347
printClusterEff :: Cluster.CStats -> IO ()
printClusterEff cs =
    mapM_ (\(s, fn) ->
               printf "  - %s usage efficiency: %5.2f%%\n" s (fn cs * 100))
          [("memory", memEff),
           ("  disk", dskEff),
           ("  vcpu", cpuEff)]

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

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

Iustin Pop's avatar
Iustin Pop committed
348 349 350 351 352 353
-- | Aborts the program if we get a bad value.
exitIfBad :: Result a -> IO a
exitIfBad (Bad s) =
  hPrintf stderr "Failure: %s\n" s >> exitWith (ExitFailure 1)
exitIfBad (Ok v) = return v

Iustin Pop's avatar
Iustin Pop committed
354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382
-- | Runs an allocation algorithm and saves cluster state.
runAllocation :: ClusterData                -- ^ Cluster data
              -> Maybe Cluster.AllocResult  -- ^ Optional stop-allocation
              -> Result Cluster.AllocResult -- ^ Allocation result
              -> RSpec                      -- ^ Requested instance spec
              -> SpecType                   -- ^ Allocation type
              -> Options                    -- ^ CLI options
              -> IO (FailStats, Node.List, Int, [(RSpec, Int)])
runAllocation cdata stop_allocation actual_result spec mode opts = do
  (reasons, new_nl, new_il, new_ixes, _) <-
      case stop_allocation of
        Just result_noalloc -> return result_noalloc
        Nothing -> exitIfBad actual_result

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

  printISpec (optMachineReadable opts) spec mode (optDiskTemplate opts)

  printAllocationMap (optVerbose opts) descr new_nl new_ixes

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

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

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

Iustin Pop's avatar
Iustin Pop committed
383 384 385 386
-- | Main function.
main :: IO ()
main = do
  cmd_args <- System.getArgs
387
  (opts, args) <- parseOpts cmd_args "hspace" options
Iustin Pop's avatar
Iustin Pop committed
388 389 390 391 392

  unless (null args) $ do
         hPutStrLn stderr "Error: this program doesn't take any arguments."
         exitWith $ ExitFailure 1

393
  let verbose = optVerbose opts
394
      ispec = optISpec opts
395 396
      disk_template = optDiskTemplate opts
      req_nodes = Instance.requiredNodes disk_template
397
      machine_r = optMachineReadable opts
398

399
  (ClusterData gl fixed_nl il ctags) <- loadExternalData opts
Iustin Pop's avatar
Iustin Pop committed
400
  nl <- setNodeStatus opts fixed_nl
401

Iustin Pop's avatar
Iustin Pop committed
402
  let num_instances = Container.size il
Iustin Pop's avatar
Iustin Pop committed
403
      all_nodes = Container.elems fixed_nl
Iustin Pop's avatar
Iustin Pop committed
404
      cdata = ClusterData gl nl il ctags
405
      csf = commonSuffix fixed_nl il
Iustin Pop's avatar
Iustin Pop committed
406

Iustin Pop's avatar
Iustin Pop committed
407
  when (not (null csf) && verbose > 1) $
408
       hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
Iustin Pop's avatar
Iustin Pop committed
409

Iustin Pop's avatar
Iustin Pop committed
410
  maybePrintNodes (optShowNodes opts) "Initial cluster" (Cluster.printNodes nl)
Iustin Pop's avatar
Iustin Pop committed
411

Iustin Pop's avatar
Iustin Pop committed
412
  when (verbose > 2) $
413
         hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
Iustin Pop's avatar
Iustin Pop committed
414
                 (Cluster.compCV nl) (Cluster.printStats nl)
415

Iustin Pop's avatar
Iustin Pop committed
416
  printCluster machine_r (Cluster.totalResources nl) (length all_nodes)
417

Iustin Pop's avatar
Iustin Pop committed
418 419 420 421 422 423
  let stop_allocation = case Cluster.computeBadItems nl il of
                          ([], _) -> Nothing
                          _ -> Just ([(FailN1, 1)]::FailStats, nl, il, [], [])
      alloclimit = if optMaxLength opts == -1
                   then Nothing
                   else Just (optMaxLength opts)
424

425 426
  -- utility functions
  let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
427
                    (rspecCpu spx) "running" [] True (-1) (-1) disk_template
428

Iustin Pop's avatar
Iustin Pop committed
429
  allocnodes <- exitIfBad $ Cluster.genAllocNodes gl nl req_nodes True
Iustin Pop's avatar
Iustin Pop committed
430

431 432 433 434 435
  -- Run the tiered allocation, if enabled

  (case optTieredSpec opts of
     Nothing -> return ()
     Just tspec -> do
Iustin Pop's avatar
Iustin Pop committed
436 437 438 439
       (treason, trl_nl, _, spec_map) <-
           runAllocation cdata stop_allocation
                   (Cluster.tieredAlloc nl il alloclimit (iofspec tspec)
                           allocnodes [] []) tspec SpecTiered opts
440

Iustin Pop's avatar
Iustin Pop committed
441
       printTiered machine_r spec_map (optMcpu opts) nl trl_nl treason
442
       )
443 444

  -- Run the standard (avg-mode) allocation
Iustin Pop's avatar
Iustin Pop committed
445

Iustin Pop's avatar
Iustin Pop committed
446 447 448 449
  (sreason, fin_nl, allocs, _) <-
      runAllocation cdata stop_allocation
            (Cluster.iterateAlloc nl il alloclimit (iofspec ispec)
             allocnodes [] []) ispec SpecNormal opts
450

451 452 453
  printResults machine_r nl fin_nl num_instances allocs sreason

  printFinal machine_r