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