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   , oIMem
  63   , oIDisk
  64   , oIVcpus
  65   , oMachineReadable
  66   , oMaxCpu
  67   , oMaxSolLength
  68   , oMinDisk
  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 :: Double -> String -> RSpec -> [(String, String)]
 225 formatRSpec m_cpu s r =
 226   [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
 227   , ("KM_" ++ s ++ "_NPU", show $ fromIntegral (rspecCpu r) / m_cpu)
 228   , ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
 229   , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
 230   ]
 231
 232 -- | Shows allocations stats.
 233 printAllocationStats :: Double -> Node.List -> Node.List -> IO ()
 234 printAllocationStats m_cpu 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 m_cpu  "USED" rini
 239   printKeys $ formatRSpec m_cpu "POOL"ralo
 240   printKeys $ formatRSpec m_cpu "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)] -> Double
 315             -> Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
 316 printTiered True spec_map m_cpu nl trl_nl _ = do
 317   printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
 318   printKeys [("TSPEC", unwords (formatSpecMap spec_map))]
 319   printAllocationStats m_cpu nl trl_nl
 320
 321 printTiered False spec_map _ ini_nl fin_nl sreason = do
 322   _ <- printf "Tiered allocation results:\n"
 323   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 -- | Aborts the program if we get a bad value.
 352 exitIfBad :: Result a -> IO a
 353 exitIfBad (Bad s) =
 354   hPrintf stderr "Failure: %s\n" s >> exitWith (ExitFailure 1)
 355 exitIfBad (Ok v) = return v
 356
 357 -- | Runs an allocation algorithm and saves cluster state.
 358 runAllocation :: ClusterData                -- ^ Cluster data
 359               -> Maybe Cluster.AllocResult  -- ^ Optional stop-allocation
 360               -> Result Cluster.AllocResult -- ^ Allocation result
 361               -> RSpec                      -- ^ Requested instance spec
 362               -> SpecType                   -- ^ Allocation type
 363               -> Options                    -- ^ CLI options
 364               -> IO (FailStats, Node.List, Int, [(RSpec, Int)])
 365 runAllocation cdata stop_allocation actual_result spec mode opts = do
 366   (reasons, new_nl, new_il, new_ixes, _) <-
 367       case stop_allocation of
 368         Just result_noalloc -> return result_noalloc
 369         Nothing -> exitIfBad actual_result
 370
 371   let name = head . words . specDescription $ mode
 372       descr = name ++ " allocation"
 373       ldescr = "after " ++ map toLower descr
 374
 375   printISpec (optMachineReadable opts) spec mode (optDiskTemplate opts)
 376
 377   printAllocationMap (optVerbose opts) descr new_nl new_ixes
 378
 379   maybePrintNodes (optShowNodes opts) descr (Cluster.printNodes new_nl)
 380
 381   maybeSaveData (optSaveCluster opts) (map toLower name) ldescr
 382                     (cdata { cdNodes = new_nl, cdInstances = new_il})
 383
 384   return (sortReasons reasons, new_nl, length new_ixes, tieredSpecMap new_ixes)
 385
 386 -- | Main function.
 387 main :: IO ()
 388 main = do
 389   cmd_args <- getArgs
 390   (opts, args) <- parseOpts cmd_args "hspace" options
 391
 392   unless (null args) $ do
 393          hPutStrLn stderr "Error: this program doesn't take any arguments."
 394          exitWith $ ExitFailure 1
 395
 396   let verbose = optVerbose opts
 397       ispec = optISpec opts
 398       disk_template = optDiskTemplate opts
 399       req_nodes = Instance.requiredNodes disk_template
 400       machine_r = optMachineReadable opts
 401
 402   (ClusterData gl fixed_nl il ctags) <- loadExternalData opts
 403   nl <- setNodeStatus opts fixed_nl
 404
 405   let num_instances = Container.size il
 406       all_nodes = Container.elems fixed_nl
 407       cdata = ClusterData gl nl il ctags
 408       csf = commonSuffix fixed_nl il
 409
 410   when (not (null csf) && verbose > 1) $
 411        hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
 412
 413   maybePrintNodes (optShowNodes opts) "Initial cluster" (Cluster.printNodes nl)
 414
 415   when (verbose > 2) $
 416          hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
 417                  (Cluster.compCV nl) (Cluster.printStats nl)
 418
 419   printCluster machine_r (Cluster.totalResources nl) (length all_nodes)
 420
 421   let stop_allocation = case Cluster.computeBadItems nl il of
 422                           ([], _) -> Nothing
 423                           _ -> Just ([(FailN1, 1)]::FailStats, nl, il, [], [])
 424       alloclimit = if optMaxLength opts == -1
 425                    then Nothing
 426                    else Just (optMaxLength opts)
 427
 428   -- utility functions
 429   let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
 430                     (rspecCpu spx) Running [] True (-1) (-1) disk_template
 431
 432   allocnodes <- exitIfBad $ Cluster.genAllocNodes gl nl req_nodes True
 433
 434   -- Run the tiered allocation, if enabled
 435
 436   case optTieredSpec opts of
 437     Nothing -> return ()
 438     Just tspec -> do
 439          (treason, trl_nl, _, spec_map) <-
 440            runAllocation cdata stop_allocation
 441              (Cluster.tieredAlloc nl il alloclimit (iofspec tspec)
 442                      allocnodes [] []) tspec SpecTiered opts
 443
 444          printTiered machine_r spec_map (optMcpu opts) nl trl_nl treason
 445
 446   -- Run the standard (avg-mode) allocation
 447
 448   (sreason, fin_nl, allocs, _) <-
 449       runAllocation cdata stop_allocation
 450             (Cluster.iterateAlloc nl il alloclimit (iofspec ispec)
 451              allocnodes [] []) ispec SpecNormal opts
 452
 453   printResults machine_r nl fin_nl num_instances allocs sreason
 454
 455   printFinal machine_r