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

   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