code.grnet.gr Git - ganeti-local/blob - htools/Ganeti/HTools/Program/Hspace.hs

   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 (main, options) where
  27
  28 import Control.Monad
  29 import Data.Char (toUpper, isAlphaNum, toLower)
  30 import Data.Function (on)
  31 import Data.List
  32 import Data.Maybe (fromMaybe)
  33 import Data.Ord (comparing)
  34 import System.Exit
  35 import System.IO
  36
  37 import Text.Printf (printf, hPrintf)
  38
  39 import qualified Ganeti.HTools.Container as Container
  40 import qualified Ganeti.HTools.Cluster as Cluster
  41 import qualified Ganeti.HTools.Node as Node
  42 import qualified Ganeti.HTools.Instance as Instance
  43
  44 import Ganeti.HTools.Utils
  45 import Ganeti.HTools.Types
  46 import Ganeti.HTools.CLI
  47 import Ganeti.HTools.ExtLoader
  48 import Ganeti.HTools.Loader
  49
  50 -- | Options list and functions.
  51 options :: [OptType]
  52 options =
  53   [ oPrintNodes
  54   , oDataFile
  55   , oDiskTemplate
  56   , oSpindleUse
  57   , oNodeSim
  58   , oRapiMaster
  59   , oLuxiSocket
  60   , oIAllocSrc
  61   , oVerbose
  62   , oQuiet
  63   , oOfflineNode
  64   , oMachineReadable
  65   , oMaxCpu
  66   , oMaxSolLength
  67   , oMinDisk
  68   , oStdSpec
  69   , oTieredSpec
  70   , oSaveCluster
  71   , oShowVer
  72   , oShowHelp
  73   ]
  74
  75 -- | The allocation phase we're in (initial, after tiered allocs, or
  76 -- after regular allocation).
  77 data Phase = PInitial
  78            | PFinal
  79            | PTiered
  80
  81 -- | The kind of instance spec we print.
  82 data SpecType = SpecNormal
  83               | SpecTiered
  84
  85 -- | What we prefix a spec with.
  86 specPrefix :: SpecType -> String
  87 specPrefix SpecNormal = "SPEC"
  88 specPrefix SpecTiered = "TSPEC_INI"
  89
  90 -- | The description of a spec.
  91 specDescription :: SpecType -> String
  92 specDescription SpecNormal = "Standard (fixed-size)"
  93 specDescription SpecTiered = "Tiered (initial size)"
  94
  95 -- | Efficiency generic function.
  96 effFn :: (Cluster.CStats -> Integer)
  97       -> (Cluster.CStats -> Double)
  98       -> Cluster.CStats -> Double
  99 effFn fi ft cs = fromIntegral (fi cs) / ft cs
 100
 101 -- | Memory efficiency.
 102 memEff :: Cluster.CStats -> Double
 103 memEff = effFn Cluster.csImem Cluster.csTmem
 104
 105 -- | Disk efficiency.
 106 dskEff :: Cluster.CStats -> Double
 107 dskEff = effFn Cluster.csIdsk Cluster.csTdsk
 108
 109 -- | Cpu efficiency.
 110 cpuEff :: Cluster.CStats -> Double
 111 cpuEff = effFn Cluster.csIcpu (fromIntegral . Cluster.csVcpu)
 112
 113 -- | Holds data for converting a 'Cluster.CStats' structure into
 114 -- detailed statictics.
 115 statsData :: [(String, Cluster.CStats -> String)]
 116 statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
 117             , ("INST_CNT", printf "%d" . Cluster.csNinst)
 118             , ("MEM_FREE", printf "%d" . Cluster.csFmem)
 119             , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
 120             , ("MEM_RESVD",
 121                \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
 122             , ("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                \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
 130             , ("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             , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
 135             , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
 136             ]
 137
 138 -- | List holding 'RSpec' formatting information.
 139 specData :: [(String, RSpec -> String)]
 140 specData = [ ("MEM", printf "%d" . rspecMem)
 141            , ("DSK", printf "%d" . rspecDsk)
 142            , ("CPU", printf "%d" . rspecCpu)
 143            ]
 144
 145 -- | List holding 'Cluster.CStats' formatting information.
 146 clusterData :: [(String, Cluster.CStats -> String)]
 147 clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
 148               , ("DSK", printf "%.0f" . Cluster.csTdsk)
 149               , ("CPU", printf "%.0f" . Cluster.csTcpu)
 150               , ("VCPU", printf "%d" . Cluster.csVcpu)
 151               ]
 152
 153 -- | Function to print stats for a given phase.
 154 printStats :: Phase -> Cluster.CStats -> [(String, String)]
 155 printStats ph cs =
 156   map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
 157   where kind = case ph of
 158                  PInitial -> "INI"
 159                  PFinal -> "FIN"
 160                  PTiered -> "TRL"
 161
 162 -- | Print failure reason and scores
 163 printFRScores :: Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
 164 printFRScores ini_nl fin_nl sreason = do
 165   printf "  - most likely failure reason: %s\n" $ failureReason sreason::IO ()
 166   printClusterScores ini_nl fin_nl
 167   printClusterEff (Cluster.totalResources fin_nl)
 168
 169 -- | Print final stats and related metrics.
 170 printResults :: Bool -> Node.List -> Node.List -> Int -> Int
 171              -> [(FailMode, Int)] -> IO ()
 172 printResults True _ fin_nl num_instances allocs sreason = do
 173   let fin_stats = Cluster.totalResources fin_nl
 174       fin_instances = num_instances + allocs
 175
 176   when (num_instances + allocs /= Cluster.csNinst fin_stats) $
 177        do
 178          hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
 179                         \ != counted (%d)\n" (num_instances + allocs)
 180                                  (Cluster.csNinst fin_stats) :: IO ()
 181          exitWith $ ExitFailure 1
 182
 183   printKeys $ printStats PFinal fin_stats
 184   printKeys [ ("ALLOC_USAGE", printf "%.8f"
 185                                 ((fromIntegral num_instances::Double) /
 186                                  fromIntegral fin_instances))
 187             , ("ALLOC_INSTANCES", printf "%d" allocs)
 188             , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
 189             ]
 190   printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
 191                                printf "%d" y)) sreason
 192
 193 printResults False ini_nl fin_nl _ allocs sreason = do
 194   putStrLn "Normal (fixed-size) allocation results:"
 195   printf "  - %3d instances allocated\n" allocs :: IO ()
 196   printFRScores ini_nl fin_nl sreason
 197
 198 -- | Prints the final @OK@ marker in machine readable output.
 199 printFinal :: Bool -> IO ()
 200 printFinal True =
 201   -- this should be the final entry
 202   printKeys [("OK", "1")]
 203
 204 printFinal False = return ()
 205
 206 -- | Compute the tiered spec counts from a list of allocated
 207 -- instances.
 208 tieredSpecMap :: [Instance.Instance]
 209               -> [(RSpec, Int)]
 210 tieredSpecMap trl_ixes =
 211   let fin_trl_ixes = reverse trl_ixes
 212       ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
 213       spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
 214                  ix_byspec
 215   in spec_map
 216
 217 -- | Formats a spec map to strings.
 218 formatSpecMap :: [(RSpec, Int)] -> [String]
 219 formatSpecMap =
 220   map (\(spec, cnt) -> printf "%d,%d,%d=%d" (rspecMem spec)
 221                        (rspecDsk spec) (rspecCpu spec) cnt)
 222
 223 -- | Formats \"key-metrics\" values.
 224 formatRSpec :: String -> AllocInfo -> [(String, String)]
 225 formatRSpec s r =
 226   [ ("KM_" ++ s ++ "_CPU", show $ allocInfoVCpus r)
 227   , ("KM_" ++ s ++ "_NPU", show $ allocInfoNCpus r)
 228   , ("KM_" ++ s ++ "_MEM", show $ allocInfoMem r)
 229   , ("KM_" ++ s ++ "_DSK", show $ allocInfoDisk r)
 230   ]
 231
 232 -- | Shows allocations stats.
 233 printAllocationStats :: Node.List -> Node.List -> IO ()
 234 printAllocationStats ini_nl fin_nl = do
 235   let ini_stats = Cluster.totalResources ini_nl
 236       fin_stats = Cluster.totalResources fin_nl
 237       (rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
 238   printKeys $ formatRSpec "USED" rini
 239   printKeys $ formatRSpec "POOL" ralo
 240   printKeys $ formatRSpec "UNAV" runa
 241
 242 -- | Ensure a value is quoted if needed.
 243 ensureQuoted :: String -> String
 244 ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v)
 245                  then '\'':v ++ "'"
 246                  else v
 247
 248 -- | Format a list of key\/values as a shell fragment.
 249 printKeys :: [(String, String)] -> IO ()
 250 printKeys = mapM_ (\(k, v) ->
 251                    printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
 252
 253 -- | Converts instance data to a list of strings.
 254 printInstance :: Node.List -> Instance.Instance -> [String]
 255 printInstance nl i = [ Instance.name i
 256                      , Container.nameOf nl $ Instance.pNode i
 257                      , let sdx = Instance.sNode i
 258                        in if sdx == Node.noSecondary then ""
 259                           else Container.nameOf nl sdx
 260                      , show (Instance.mem i)
 261                      , show (Instance.dsk i)
 262                      , show (Instance.vcpus i)
 263                      ]
 264
 265 -- | Optionally print the allocation map.
 266 printAllocationMap :: Int -> String
 267                    -> Node.List -> [Instance.Instance] -> IO ()
 268 printAllocationMap verbose msg nl ixes =
 269   when (verbose > 1) $ do
 270     hPutStrLn stderr (msg ++ " map")
 271     hPutStr stderr . unlines . map ((:) ' ' .  unwords) $
 272             formatTable (map (printInstance nl) (reverse ixes))
 273                         -- This is the numberic-or-not field
 274                         -- specification; the first three fields are
 275                         -- strings, whereas the rest are numeric
 276                        [False, False, False, True, True, True]
 277
 278 -- | Formats nicely a list of resources.
 279 formatResources :: a -> [(String, a->String)] -> String
 280 formatResources res =
 281     intercalate ", " . map (\(a, fn) -> a ++ " " ++ fn res)
 282
 283 -- | Print the cluster resources.
 284 printCluster :: Bool -> Cluster.CStats -> Int -> IO ()
 285 printCluster True ini_stats node_count = do
 286   printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
 287   printKeys [("CLUSTER_NODES", printf "%d" node_count)]
 288   printKeys $ printStats PInitial ini_stats
 289
 290 printCluster False ini_stats node_count = do
 291   printf "The cluster has %d nodes and the following resources:\n  %s.\n"
 292          node_count (formatResources ini_stats clusterData)::IO ()
 293   printf "There are %s initial instances on the cluster.\n"
 294              (if inst_count > 0 then show inst_count else "no" )
 295       where inst_count = Cluster.csNinst ini_stats
 296
 297 -- | Prints the normal instance spec.
 298 printISpec :: Bool -> RSpec -> SpecType -> DiskTemplate -> IO ()
 299 printISpec True ispec spec disk_template = do
 300   printKeys $ map (\(a, fn) -> (prefix ++ "_" ++ a, fn ispec)) specData
 301   printKeys [ (prefix ++ "_RQN", printf "%d" req_nodes) ]
 302   printKeys [ (prefix ++ "_DISK_TEMPLATE",
 303                diskTemplateToRaw disk_template) ]
 304       where req_nodes = Instance.requiredNodes disk_template
 305             prefix = specPrefix spec
 306
 307 printISpec False ispec spec disk_template =
 308   printf "%s instance spec is:\n  %s, using disk\
 309          \ template '%s'.\n"
 310          (specDescription spec)
 311          (formatResources ispec specData) (diskTemplateToRaw disk_template)
 312
 313 -- | Prints the tiered results.
 314 printTiered :: Bool -> [(RSpec, Int)]
 315             -> Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
 316 printTiered True spec_map nl trl_nl _ = do
 317   printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
 318   printKeys [("TSPEC", unwords (formatSpecMap spec_map))]
 319   printAllocationStats nl trl_nl
 320
 321 printTiered False spec_map ini_nl fin_nl sreason = do
 322   _ <- printf "Tiered allocation results:\n"
 323   if null spec_map
 324     then putStrLn "  - no instances allocated"
 325     else mapM_ (\(ispec, cnt) ->
 326                   printf "  - %3d instances of spec %s\n" cnt
 327                            (formatResources ispec specData)) spec_map
 328   printFRScores ini_nl fin_nl sreason
 329
 330 -- | Displays the initial/final cluster scores.
 331 printClusterScores :: Node.List -> Node.List -> IO ()
 332 printClusterScores ini_nl fin_nl = do
 333   printf "  - initial cluster score: %.8f\n" $ Cluster.compCV ini_nl::IO ()
 334   printf "  -   final cluster score: %.8f\n" $ Cluster.compCV fin_nl
 335
 336 -- | Displays the cluster efficiency.
 337 printClusterEff :: Cluster.CStats -> IO ()
 338 printClusterEff cs =
 339   mapM_ (\(s, fn) ->
 340            printf "  - %s usage efficiency: %5.2f%%\n" s (fn cs * 100))
 341           [("memory", memEff),
 342            ("  disk", dskEff),
 343            ("  vcpu", cpuEff)]
 344
 345 -- | Computes the most likely failure reason.
 346 failureReason :: [(FailMode, Int)] -> String
 347 failureReason = show . fst . head
 348
 349 -- | Sorts the failure reasons.
 350 sortReasons :: [(FailMode, Int)] -> [(FailMode, Int)]
 351 sortReasons = reverse . sortBy (comparing snd)
 352
 353 -- | Aborts the program if we get a bad value.
 354 exitIfBad :: Result a -> IO a
 355 exitIfBad (Bad s) =
 356   hPrintf stderr "Failure: %s\n" s >> exitWith (ExitFailure 1)
 357 exitIfBad (Ok v) = return v
 358
 359 -- | Runs an allocation algorithm and saves cluster state.
 360 runAllocation :: ClusterData                -- ^ Cluster data
 361               -> Maybe Cluster.AllocResult  -- ^ Optional stop-allocation
 362               -> Result Cluster.AllocResult -- ^ Allocation result
 363               -> RSpec                      -- ^ Requested instance spec
 364               -> DiskTemplate               -- ^ Requested disk template
 365               -> SpecType                   -- ^ Allocation type
 366               -> Options                    -- ^ CLI options
 367               -> IO (FailStats, Node.List, Int, [(RSpec, Int)])
 368 runAllocation cdata stop_allocation actual_result spec dt mode opts = do
 369   (reasons, new_nl, new_il, new_ixes, _) <-
 370       case stop_allocation of
 371         Just result_noalloc -> return result_noalloc
 372         Nothing -> exitIfBad actual_result
 373
 374   let name = head . words . specDescription $ mode
 375       descr = name ++ " allocation"
 376       ldescr = "after " ++ map toLower descr
 377
 378   printISpec (optMachineReadable opts) spec mode dt
 379
 380   printAllocationMap (optVerbose opts) descr new_nl new_ixes
 381
 382   maybePrintNodes (optShowNodes opts) descr (Cluster.printNodes new_nl)
 383
 384   maybeSaveData (optSaveCluster opts) (map toLower name) ldescr
 385                     (cdata { cdNodes = new_nl, cdInstances = new_il})
 386
 387   return (sortReasons reasons, new_nl, length new_ixes, tieredSpecMap new_ixes)
 388
 389 -- | Create an instance from a given spec.
 390 instFromSpec :: RSpec -> DiskTemplate -> Int -> Instance.Instance
 391 instFromSpec spx disk_template su =
 392   Instance.create "new" (rspecMem spx) (rspecDsk spx)
 393     (rspecCpu spx) Running [] True (-1) (-1) disk_template su
 394
 395 -- | Main function.
 396 main :: Options -> [String] -> IO ()
 397 main opts args = do
 398   unless (null args) $ do
 399          hPutStrLn stderr "Error: this program doesn't take any arguments."
 400          exitWith $ ExitFailure 1
 401
 402   let verbose = optVerbose opts
 403       machine_r = optMachineReadable opts
 404
 405   orig_cdata@(ClusterData gl fixed_nl il _ ipol) <- loadExternalData opts
 406   nl <- setNodeStatus opts fixed_nl
 407
 408   cluster_disk_template <-
 409     case iPolicyDiskTemplates ipol of
 410       first_templ:_ -> return first_templ
 411       _ -> do
 412          _ <- hPutStrLn stderr $ "Error: null list of disk templates\
 413                                \ received from cluster!"
 414          exitWith $ ExitFailure 1
 415
 416   let num_instances = Container.size il
 417       all_nodes = Container.elems fixed_nl
 418       cdata = orig_cdata { cdNodes = fixed_nl }
 419       disk_template = fromMaybe cluster_disk_template (optDiskTemplate opts)
 420       req_nodes = Instance.requiredNodes disk_template
 421       csf = commonSuffix fixed_nl il
 422       su = fromMaybe (iSpecSpindleUse $ iPolicyStdSpec ipol)
 423                      (optSpindleUse opts)
 424
 425   when (not (null csf) && verbose > 1) $
 426        hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
 427
 428   maybePrintNodes (optShowNodes opts) "Initial cluster" (Cluster.printNodes nl)
 429
 430   when (verbose > 2) $
 431          hPrintf stderr "Initial coefficients: overall %.8f\n%s"
 432                  (Cluster.compCV nl) (Cluster.printStats "  " nl)
 433
 434   printCluster machine_r (Cluster.totalResources nl) (length all_nodes)
 435
 436   let stop_allocation = case Cluster.computeBadItems nl il of
 437                           ([], _) -> Nothing
 438                           _ -> Just ([(FailN1, 1)]::FailStats, nl, il, [], [])
 439       alloclimit = if optMaxLength opts == -1
 440                    then Nothing
 441                    else Just (optMaxLength opts)
 442
 443   allocnodes <- exitIfBad $ Cluster.genAllocNodes gl nl req_nodes True
 444
 445   -- Run the tiered allocation
 446
 447   let tspec = fromMaybe (rspecFromISpec (iPolicyMaxSpec ipol))
 448               (optTieredSpec opts)
 449
 450   (treason, trl_nl, _, spec_map) <-
 451     runAllocation cdata stop_allocation
 452        (Cluster.tieredAlloc nl il alloclimit
 453         (instFromSpec tspec disk_template su) allocnodes [] [])
 454        tspec disk_template SpecTiered opts
 455
 456   printTiered machine_r spec_map nl trl_nl treason
 457
 458   -- Run the standard (avg-mode) allocation
 459
 460   let ispec = fromMaybe (rspecFromISpec (iPolicyStdSpec ipol))
 461               (optStdSpec opts)
 462
 463   (sreason, fin_nl, allocs, _) <-
 464       runAllocation cdata stop_allocation
 465             (Cluster.iterateAlloc nl il alloclimit
 466              (instFromSpec ispec disk_template su) allocnodes [] [])
 467             ispec disk_template SpecNormal opts
 468
 469   printResults machine_r nl fin_nl num_instances allocs sreason
 470
 471   -- Print final result
 472
 473   printFinal machine_r