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