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 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) 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.Ord (comparing)
  33 import System.Exit
  34 import System.IO
  35 import System.Environment (getArgs)
  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   , oNodeSim
  57   , oRapiMaster
  58   , oLuxiSocket
  59   , oVerbose
  60   , oQuiet
  61   , oOfflineNode
  62   , oMachineReadable
  63   , oMaxCpu
  64   , oMaxSolLength
  65   , oMinDisk
  66   , oStdSpec
  67   , oTieredSpec
  68   , oSaveCluster
  69   , oShowVer
  70   , oShowHelp
  71   ]
  72
  73 -- | The allocation phase we're in (initial, after tiered allocs, or
  74 -- after regular allocation).
  75 data Phase = PInitial
  76            | PFinal
  77            | PTiered
  78
  79 -- | The kind of instance spec we print.
  80 data SpecType = SpecNormal
  81               | SpecTiered
  82
  83 -- | What we prefix a spec with.
  84 specPrefix :: SpecType -> String
  85 specPrefix SpecNormal = "SPEC"
  86 specPrefix SpecTiered = "TSPEC_INI"
  87
  88 -- | The description of a spec.
  89 specDescription :: SpecType -> String
  90 specDescription SpecNormal = "Standard (fixed-size)"
  91 specDescription SpecTiered = "Tiered (initial size)"
  92
  93 -- | Efficiency generic function.
  94 effFn :: (Cluster.CStats -> Integer)
  95       -> (Cluster.CStats -> Double)
  96       -> Cluster.CStats -> Double
  97 effFn fi ft cs = fromIntegral (fi cs) / ft cs
  98
  99 -- | Memory efficiency.
 100 memEff :: Cluster.CStats -> Double
 101 memEff = effFn Cluster.csImem Cluster.csTmem
 102
 103 -- | Disk efficiency.
 104 dskEff :: Cluster.CStats -> Double
 105 dskEff = effFn Cluster.csIdsk Cluster.csTdsk
 106
 107 -- | Cpu efficiency.
 108 cpuEff :: Cluster.CStats -> Double
 109 cpuEff = effFn Cluster.csIcpu (fromIntegral . Cluster.csVcpu)
 110
 111 -- | Holds data for converting a 'Cluster.CStats' structure into
 112 -- detailed statictics.
 113 statsData :: [(String, Cluster.CStats -> String)]
 114 statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
 115             , ("INST_CNT", printf "%d" . Cluster.csNinst)
 116             , ("MEM_FREE", printf "%d" . Cluster.csFmem)
 117             , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
 118             , ("MEM_RESVD",
 119                \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
 120             , ("MEM_INST", printf "%d" . Cluster.csImem)
 121             , ("MEM_OVERHEAD",
 122                \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
 123             , ("MEM_EFF", printf "%.8f" . memEff)
 124             , ("DSK_FREE", printf "%d" . Cluster.csFdsk)
 125             , ("DSK_AVAIL", printf "%d". Cluster.csAdsk)
 126             , ("DSK_RESVD",
 127                \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
 128             , ("DSK_INST", printf "%d" . Cluster.csIdsk)
 129             , ("DSK_EFF", printf "%.8f" . dskEff)
 130             , ("CPU_INST", printf "%d" . Cluster.csIcpu)
 131             , ("CPU_EFF", printf "%.8f" . cpuEff)
 132             , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
 133             , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
 134             ]
 135
 136 -- | List holding 'RSpec' formatting information.
 137 specData :: [(String, RSpec -> String)]
 138 specData = [ ("MEM", printf "%d" . rspecMem)
 139            , ("DSK", printf "%d" . rspecDsk)
 140            , ("CPU", printf "%d" . rspecCpu)
 141            ]
 142
 143 -- | List holding 'Cluster.CStats' formatting information.
 144 clusterData :: [(String, Cluster.CStats -> String)]
 145 clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
 146               , ("DSK", printf "%.0f" . Cluster.csTdsk)
 147               , ("CPU", printf "%.0f" . Cluster.csTcpu)
 148               , ("VCPU", printf "%d" . Cluster.csVcpu)
 149               ]
 150
 151 -- | Function to print stats for a given phase.
 152 printStats :: Phase -> Cluster.CStats -> [(String, String)]
 153 printStats ph cs =
 154   map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
 155   where kind = case ph of
 156                  PInitial -> "INI"
 157                  PFinal -> "FIN"
 158                  PTiered -> "TRL"
 159
 160 -- | Print failure reason and scores
 161 printFRScores :: Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
 162 printFRScores ini_nl fin_nl sreason = do
 163   printf "  - most likely failure reason: %s\n" $ failureReason sreason::IO ()
 164   printClusterScores ini_nl fin_nl
 165   printClusterEff (Cluster.totalResources fin_nl)
 166
 167 -- | Print final stats and related metrics.
 168 printResults :: Bool -> Node.List -> Node.List -> Int -> Int
 169              -> [(FailMode, Int)] -> IO ()
 170 printResults True _ fin_nl num_instances allocs sreason = do
 171   let fin_stats = Cluster.totalResources fin_nl
 172       fin_instances = num_instances + allocs
 173
 174   when (num_instances + allocs /= Cluster.csNinst fin_stats) $
 175        do
 176          hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
 177                         \ != counted (%d)\n" (num_instances + allocs)
 178                                  (Cluster.csNinst fin_stats) :: IO ()
 179          exitWith $ ExitFailure 1
 180
 181   printKeys $ printStats PFinal fin_stats
 182   printKeys [ ("ALLOC_USAGE", printf "%.8f"
 183                                 ((fromIntegral num_instances::Double) /
 184                                  fromIntegral fin_instances))
 185             , ("ALLOC_INSTANCES", printf "%d" allocs)
 186             , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
 187             ]
 188   printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
 189                                printf "%d" y)) sreason
 190
 191 printResults False ini_nl fin_nl _ allocs sreason = do
 192   putStrLn "Normal (fixed-size) allocation results:"
 193   printf "  - %3d instances allocated\n" allocs :: IO ()
 194   printFRScores ini_nl fin_nl sreason
 195
 196 -- | Prints the final @OK@ marker in machine readable output.
 197 printFinal :: Bool -> IO ()
 198 printFinal True =
 199   -- this should be the final entry
 200   printKeys [("OK", "1")]
 201
 202 printFinal False = return ()
 203
 204 -- | Compute the tiered spec counts from a list of allocated
 205 -- instances.
 206 tieredSpecMap :: [Instance.Instance]
 207               -> [(RSpec, Int)]
 208 tieredSpecMap trl_ixes =
 209   let fin_trl_ixes = reverse trl_ixes
 210       ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
 211       spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
 212                  ix_byspec
 213   in spec_map
 214
 215 -- | Formats a spec map to strings.
 216 formatSpecMap :: [(RSpec, Int)] -> [String]
 217 formatSpecMap =
 218   map (\(spec, cnt) -> printf "%d,%d,%d=%d" (rspecMem spec)
 219                        (rspecDsk spec) (rspecCpu spec) cnt)
 220
 221 -- | Formats \"key-metrics\" values.
 222 formatRSpec :: Double -> String -> RSpec -> [(String, String)]
 223 formatRSpec m_cpu s r =
 224   [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
 225   , ("KM_" ++ s ++ "_NPU", show $ fromIntegral (rspecCpu r) / m_cpu)
 226   , ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
 227   , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
 228   ]
 229
 230 -- | Shows allocations stats.
 231 printAllocationStats :: Double -> Node.List -> Node.List -> IO ()
 232 printAllocationStats m_cpu ini_nl fin_nl = do
 233   let ini_stats = Cluster.totalResources ini_nl
 234       fin_stats = Cluster.totalResources fin_nl
 235       (rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
 236   printKeys $ formatRSpec m_cpu  "USED" rini
 237   printKeys $ formatRSpec m_cpu "POOL"ralo
 238   printKeys $ formatRSpec m_cpu "UNAV" runa
 239
 240 -- | Ensure a value is quoted if needed.
 241 ensureQuoted :: String -> String
 242 ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v)
 243                  then '\'':v ++ "'"
 244                  else v
 245
 246 -- | Format a list of key\/values as a shell fragment.
 247 printKeys :: [(String, String)] -> IO ()
 248 printKeys = mapM_ (\(k, v) ->
 249                    printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
 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   printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
 285   printKeys [("CLUSTER_NODES", printf "%d" node_count)]
 286   printKeys $ 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   printKeys $ map (\(a, fn) -> (prefix ++ "_" ++ a, fn ispec)) specData
 299   printKeys [ (prefix ++ "_RQN", printf "%d" req_nodes) ]
 300   printKeys [ (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)] -> Double
 313             -> Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
 314 printTiered True spec_map m_cpu nl trl_nl _ = do
 315   printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
 316   printKeys [("TSPEC", unwords (formatSpecMap spec_map))]
 317   printAllocationStats m_cpu nl trl_nl
 318
 319 printTiered False spec_map _ ini_nl fin_nl sreason = do
 320   _ <- printf "Tiered allocation results:\n"
 321   mapM_ (\(ispec, cnt) ->
 322              printf "  - %3d instances of spec %s\n" cnt
 323                         (formatResources ispec specData)) spec_map
 324   printFRScores ini_nl fin_nl sreason
 325
 326 -- | Displays the initial/final cluster scores.
 327 printClusterScores :: Node.List -> Node.List -> IO ()
 328 printClusterScores ini_nl fin_nl = do
 329   printf "  - initial cluster score: %.8f\n" $ Cluster.compCV ini_nl::IO ()
 330   printf "  -   final cluster score: %.8f\n" $ Cluster.compCV fin_nl
 331
 332 -- | Displays the cluster efficiency.
 333 printClusterEff :: Cluster.CStats -> IO ()
 334 printClusterEff cs =
 335   mapM_ (\(s, fn) ->
 336            printf "  - %s usage efficiency: %5.2f%%\n" s (fn cs * 100))
 337           [("memory", memEff),
 338            ("  disk", dskEff),
 339            ("  vcpu", cpuEff)]
 340
 341 -- | Computes the most likely failure reason.
 342 failureReason :: [(FailMode, Int)] -> String
 343 failureReason = show . fst . head
 344
 345 -- | Sorts the failure reasons.
 346 sortReasons :: [(FailMode, Int)] -> [(FailMode, Int)]
 347 sortReasons = reverse . sortBy (comparing snd)
 348
 349 -- | Aborts the program if we get a bad value.
 350 exitIfBad :: Result a -> IO a
 351 exitIfBad (Bad s) =
 352   hPrintf stderr "Failure: %s\n" s >> exitWith (ExitFailure 1)
 353 exitIfBad (Ok v) = return v
 354
 355 -- | Runs an allocation algorithm and saves cluster state.
 356 runAllocation :: ClusterData                -- ^ Cluster data
 357               -> Maybe Cluster.AllocResult  -- ^ Optional stop-allocation
 358               -> Result Cluster.AllocResult -- ^ Allocation result
 359               -> RSpec                      -- ^ Requested instance spec
 360               -> SpecType                   -- ^ Allocation type
 361               -> Options                    -- ^ CLI options
 362               -> IO (FailStats, Node.List, Int, [(RSpec, Int)])
 363 runAllocation cdata stop_allocation actual_result spec mode opts = do
 364   (reasons, new_nl, new_il, new_ixes, _) <-
 365       case stop_allocation of
 366         Just result_noalloc -> return result_noalloc
 367         Nothing -> exitIfBad actual_result
 368
 369   let name = head . words . specDescription $ mode
 370       descr = name ++ " allocation"
 371       ldescr = "after " ++ map toLower descr
 372
 373   printISpec (optMachineReadable opts) spec mode (optDiskTemplate opts)
 374
 375   printAllocationMap (optVerbose opts) descr new_nl new_ixes
 376
 377   maybePrintNodes (optShowNodes opts) descr (Cluster.printNodes new_nl)
 378
 379   maybeSaveData (optSaveCluster opts) (map toLower name) ldescr
 380                     (cdata { cdNodes = new_nl, cdInstances = new_il})
 381
 382   return (sortReasons reasons, new_nl, length new_ixes, tieredSpecMap new_ixes)
 383
 384 -- | Main function.
 385 main :: IO ()
 386 main = do
 387   cmd_args <- getArgs
 388   (opts, args) <- parseOpts cmd_args "hspace" options
 389
 390   unless (null args) $ do
 391          hPutStrLn stderr "Error: this program doesn't take any arguments."
 392          exitWith $ ExitFailure 1
 393
 394   let verbose = optVerbose opts
 395       ispec = optISpec opts
 396       disk_template = optDiskTemplate opts
 397       req_nodes = Instance.requiredNodes disk_template
 398       machine_r = optMachineReadable opts
 399
 400   (ClusterData gl fixed_nl il ctags) <- loadExternalData opts
 401   nl <- setNodeStatus opts fixed_nl
 402
 403   let num_instances = Container.size il
 404       all_nodes = Container.elems fixed_nl
 405       cdata = ClusterData gl nl il ctags
 406       csf = commonSuffix fixed_nl il
 407
 408   when (not (null csf) && verbose > 1) $
 409        hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
 410
 411   maybePrintNodes (optShowNodes opts) "Initial cluster" (Cluster.printNodes nl)
 412
 413   when (verbose > 2) $
 414          hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
 415                  (Cluster.compCV nl) (Cluster.printStats nl)
 416
 417   printCluster machine_r (Cluster.totalResources nl) (length all_nodes)
 418
 419   let stop_allocation = case Cluster.computeBadItems nl il of
 420                           ([], _) -> Nothing
 421                           _ -> Just ([(FailN1, 1)]::FailStats, nl, il, [], [])
 422       alloclimit = if optMaxLength opts == -1
 423                    then Nothing
 424                    else Just (optMaxLength opts)
 425
 426   -- utility functions
 427   let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
 428                     (rspecCpu spx) Running [] True (-1) (-1) disk_template
 429
 430   allocnodes <- exitIfBad $ Cluster.genAllocNodes gl nl req_nodes True
 431
 432   -- Run the tiered allocation, if enabled
 433
 434   case optTieredSpec opts of
 435     Nothing -> return ()
 436     Just tspec -> do
 437          (treason, trl_nl, _, spec_map) <-
 438            runAllocation cdata stop_allocation
 439              (Cluster.tieredAlloc nl il alloclimit (iofspec tspec)
 440                      allocnodes [] []) tspec SpecTiered opts
 441
 442          printTiered machine_r spec_map (optMcpu opts) nl trl_nl treason
 443
 444   -- Run the standard (avg-mode) allocation
 445
 446   (sreason, fin_nl, allocs, _) <-
 447       runAllocation cdata stop_allocation
 448             (Cluster.iterateAlloc nl il alloclimit (iofspec ispec)
 449              allocnodes [] []) ispec SpecNormal opts
 450
 451   printResults machine_r nl fin_nl num_instances allocs sreason
 452
 453   printFinal machine_r