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 :: 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 -- | Efficiency generic function.
 109 effFn :: (Cluster.CStats -> Integer)
 110       -> (Cluster.CStats -> Double)
 111       -> Cluster.CStats -> Double
 112 effFn fi ft cs = fromIntegral (fi cs) / ft cs
 113
 114 -- | Memory efficiency.
 115 memEff :: Cluster.CStats -> Double
 116 memEff = effFn Cluster.csImem Cluster.csTmem
 117
 118 -- | Disk efficiency.
 119 dskEff :: Cluster.CStats -> Double
 120 dskEff = effFn Cluster.csIdsk Cluster.csTdsk
 121
 122 -- | Cpu efficiency.
 123 cpuEff :: Cluster.CStats -> Double
 124 cpuEff = effFn Cluster.csIcpu (fromIntegral . Cluster.csVcpu)
 125
 126 -- | Holds data for converting a 'Cluster.CStats' structure into
 127 -- detailed statistics.
 128 statsData :: [(String, Cluster.CStats -> String)]
 129 statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
 130             , ("INST_CNT", printf "%d" . Cluster.csNinst)
 131             , ("MEM_FREE", printf "%d" . Cluster.csFmem)
 132             , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
 133             , ("MEM_RESVD",
 134                \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
 135             , ("MEM_INST", printf "%d" . Cluster.csImem)
 136             , ("MEM_OVERHEAD",
 137                \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
 138             , ("MEM_EFF", printf "%.8f" . memEff)
 139             , ("DSK_FREE", printf "%d" . Cluster.csFdsk)
 140             , ("DSK_AVAIL", printf "%d". Cluster.csAdsk)
 141             , ("DSK_RESVD",
 142                \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
 143             , ("DSK_INST", printf "%d" . Cluster.csIdsk)
 144             , ("DSK_EFF", printf "%.8f" . dskEff)
 145             , ("CPU_INST", printf "%d" . Cluster.csIcpu)
 146             , ("CPU_EFF", printf "%.8f" . cpuEff)
 147             , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
 148             , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
 149             ]
 150
 151 -- | List holding 'RSpec' formatting information.
 152 specData :: [(String, RSpec -> String)]
 153 specData = [ ("MEM", printf "%d" . rspecMem)
 154            , ("DSK", printf "%d" . rspecDsk)
 155            , ("CPU", printf "%d" . rspecCpu)
 156            ]
 157
 158 -- | List holding 'Cluster.CStats' formatting information.
 159 clusterData :: [(String, Cluster.CStats -> String)]
 160 clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
 161               , ("DSK", printf "%.0f" . Cluster.csTdsk)
 162               , ("CPU", printf "%.0f" . Cluster.csTcpu)
 163               , ("VCPU", printf "%d" . Cluster.csVcpu)
 164               ]
 165
 166 -- | Function to print stats for a given phase.
 167 printStats :: Phase -> Cluster.CStats -> [(String, String)]
 168 printStats ph cs =
 169   map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
 170   where kind = case ph of
 171                  PInitial -> "INI"
 172                  PFinal -> "FIN"
 173                  PTiered -> "TRL"
 174
 175 -- | Print failure reason and scores
 176 printFRScores :: Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
 177 printFRScores ini_nl fin_nl sreason = do
 178   printf "  - most likely failure reason: %s\n" $ failureReason sreason::IO ()
 179   printClusterScores ini_nl fin_nl
 180   printClusterEff (Cluster.totalResources fin_nl)
 181
 182 -- | Print final stats and related metrics.
 183 printResults :: Bool -> Node.List -> Node.List -> Int -> Int
 184              -> [(FailMode, Int)] -> IO ()
 185 printResults True _ fin_nl num_instances allocs sreason = do
 186   let fin_stats = Cluster.totalResources fin_nl
 187       fin_instances = num_instances + allocs
 188
 189   exitWhen (num_instances + allocs /= Cluster.csNinst fin_stats) $
 190            printf "internal inconsistency, allocated (%d)\
 191                   \ != counted (%d)\n" (num_instances + allocs)
 192            (Cluster.csNinst fin_stats)
 193
 194   printKeysHTS $ printStats PFinal fin_stats
 195   printKeysHTS [ ("ALLOC_USAGE", printf "%.8f"
 196                                    ((fromIntegral num_instances::Double) /
 197                                    fromIntegral fin_instances))
 198                , ("ALLOC_INSTANCES", printf "%d" allocs)
 199                , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
 200                ]
 201   printKeysHTS $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
 202                                   printf "%d" y)) sreason
 203
 204 printResults False ini_nl fin_nl _ allocs sreason = do
 205   putStrLn "Normal (fixed-size) allocation results:"
 206   printf "  - %3d instances allocated\n" allocs :: IO ()
 207   printFRScores ini_nl fin_nl sreason
 208
 209 -- | Prints the final @OK@ marker in machine readable output.
 210 printFinalHTS :: Bool -> IO ()
 211 printFinalHTS = printFinal htsPrefix
 212
 213 -- | Compute the tiered spec counts from a list of allocated
 214 -- instances.
 215 tieredSpecMap :: [Instance.Instance]
 216               -> [(RSpec, Int)]
 217 tieredSpecMap trl_ixes =
 218   let fin_trl_ixes = reverse trl_ixes
 219       ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
 220       spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
 221                  ix_byspec
 222   in spec_map
 223
 224 -- | Formats a spec map to strings.
 225 formatSpecMap :: [(RSpec, Int)] -> [String]
 226 formatSpecMap =
 227   map (\(spec, cnt) -> printf "%d,%d,%d=%d" (rspecMem spec)
 228                        (rspecDsk spec) (rspecCpu spec) cnt)
 229
 230 -- | Formats \"key-metrics\" values.
 231 formatRSpec :: String -> AllocInfo -> [(String, String)]
 232 formatRSpec s r =
 233   [ ("KM_" ++ s ++ "_CPU", show $ allocInfoVCpus r)
 234   , ("KM_" ++ s ++ "_NPU", show $ allocInfoNCpus r)
 235   , ("KM_" ++ s ++ "_MEM", show $ allocInfoMem r)
 236   , ("KM_" ++ s ++ "_DSK", show $ allocInfoDisk r)
 237   ]
 238
 239 -- | Shows allocations stats.
 240 printAllocationStats :: Node.List -> Node.List -> IO ()
 241 printAllocationStats ini_nl fin_nl = do
 242   let ini_stats = Cluster.totalResources ini_nl
 243       fin_stats = Cluster.totalResources fin_nl
 244       (rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
 245   printKeysHTS $ formatRSpec "USED" rini
 246   printKeysHTS $ formatRSpec "POOL" ralo
 247   printKeysHTS $ formatRSpec "UNAV" runa
 248
 249 -- | Format a list of key\/values as a shell fragment.
 250 printKeysHTS :: [(String, String)] -> IO ()
 251 printKeysHTS = printKeys htsPrefix
 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   printKeysHTS $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
 287   printKeysHTS [("CLUSTER_NODES", printf "%d" node_count)]
 288   printKeysHTS $ 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   printKeysHTS $ map (\(a, fn) -> (prefix ++ "_" ++ a, fn ispec)) specData
 301   printKeysHTS [ (prefix ++ "_RQN", printf "%d" req_nodes) ]
 302   printKeysHTS [ (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)]
 315             -> Node.List -> Node.List -> [(FailMode, Int)] -> IO ()
 316 printTiered True spec_map nl trl_nl _ = do
 317   printKeysHTS $ printStats PTiered (Cluster.totalResources trl_nl)
 318   printKeysHTS [("TSPEC", unwords (formatSpecMap spec_map))]
 319   printAllocationStats nl trl_nl
 320
 321 printTiered False spec_map ini_nl fin_nl sreason = do
 322   _ <- printf "Tiered allocation results:\n"
 323   if null spec_map
 324     then putStrLn "  - no instances allocated"
 325     else mapM_ (\(ispec, cnt) ->
 326                   printf "  - %3d instances of spec %s\n" cnt
 327                            (formatResources ispec specData)) spec_map
 328   printFRScores ini_nl fin_nl sreason
 329
 330 -- | Displays the initial/final cluster scores.
 331 printClusterScores :: Node.List -> Node.List -> IO ()
 332 printClusterScores ini_nl fin_nl = do
 333   printf "  - initial cluster score: %.8f\n" $ Cluster.compCV ini_nl::IO ()
 334   printf "  -   final cluster score: %.8f\n" $ Cluster.compCV fin_nl
 335
 336 -- | Displays the cluster efficiency.
 337 printClusterEff :: Cluster.CStats -> IO ()
 338 printClusterEff cs =
 339   mapM_ (\(s, fn) ->
 340            printf "  - %s usage efficiency: %5.2f%%\n" s (fn cs * 100))
 341           [("memory", memEff),
 342            ("  disk", dskEff),
 343            ("  vcpu", cpuEff)]
 344
 345 -- | Computes the most likely failure reason.
 346 failureReason :: [(FailMode, Int)] -> String
 347 failureReason = show . fst . head
 348
 349 -- | Sorts the failure reasons.
 350 sortReasons :: [(FailMode, Int)] -> [(FailMode, Int)]
 351 sortReasons = reverse . sortBy (comparing snd)
 352
 353 -- | Runs an allocation algorithm and saves cluster state.
 354 runAllocation :: ClusterData                -- ^ Cluster data
 355               -> Maybe Cluster.AllocResult  -- ^ Optional stop-allocation
 356               -> Result Cluster.AllocResult -- ^ Allocation result
 357               -> RSpec                      -- ^ Requested instance spec
 358               -> DiskTemplate               -- ^ Requested disk template
 359               -> SpecType                   -- ^ Allocation type
 360               -> Options                    -- ^ CLI options
 361               -> IO (FailStats, Node.List, Int, [(RSpec, Int)])
 362 runAllocation cdata stop_allocation actual_result spec dt mode opts = do
 363   (reasons, new_nl, new_il, new_ixes, _) <-
 364       case stop_allocation of
 365         Just result_noalloc -> return result_noalloc
 366         Nothing -> exitIfBad "failure during allocation" actual_result
 367
 368   let name = head . words . specDescription $ mode
 369       descr = name ++ " allocation"
 370       ldescr = "after " ++ map toLower descr
 371
 372   printISpec (optMachineReadable opts) spec mode dt
 373
 374   printAllocationMap (optVerbose opts) descr new_nl new_ixes
 375
 376   maybePrintNodes (optShowNodes opts) descr (Cluster.printNodes new_nl)
 377
 378   maybeSaveData (optSaveCluster opts) (map toLower name) ldescr
 379                     (cdata { cdNodes = new_nl, cdInstances = new_il})
 380
 381   return (sortReasons reasons, new_nl, length new_ixes, tieredSpecMap new_ixes)
 382
 383 -- | Create an instance from a given spec.
 384 instFromSpec :: RSpec -> DiskTemplate -> Int -> Instance.Instance
 385 instFromSpec spx =
 386   Instance.create "new" (rspecMem spx) (rspecDsk spx)
 387     (rspecCpu spx) Running [] True (-1) (-1)
 388
 389 -- | Main function.
 390 main :: Options -> [String] -> IO ()
 391 main opts args = do
 392   exitUnless (null args) "This program doesn't take any arguments."
 393
 394   let verbose = optVerbose opts
 395       machine_r = optMachineReadable opts
 396
 397   orig_cdata@(ClusterData gl fixed_nl il _ ipol) <- loadExternalData opts
 398   nl <- setNodeStatus opts fixed_nl
 399
 400   cluster_disk_template <-
 401     case iPolicyDiskTemplates ipol of
 402       first_templ:_ -> return first_templ
 403       _ -> exitErr "null list of disk templates received from cluster"
 404
 405   let num_instances = Container.size il
 406       all_nodes = Container.elems fixed_nl
 407       cdata = orig_cdata { cdNodes = fixed_nl }
 408       disk_template = fromMaybe cluster_disk_template (optDiskTemplate opts)
 409       req_nodes = Instance.requiredNodes disk_template
 410       csf = commonSuffix fixed_nl il
 411       su = fromMaybe (iSpecSpindleUse $ iPolicyStdSpec ipol)
 412                      (optSpindleUse opts)
 413
 414   when (not (null csf) && verbose > 1) $
 415        hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
 416
 417   maybePrintNodes (optShowNodes opts) "Initial cluster" (Cluster.printNodes nl)
 418
 419   when (verbose > 2) $
 420          hPrintf stderr "Initial coefficients: overall %.8f\n%s"
 421                  (Cluster.compCV nl) (Cluster.printStats "  " nl)
 422
 423   printCluster machine_r (Cluster.totalResources nl) (length all_nodes)
 424
 425   let stop_allocation = case Cluster.computeBadItems nl il of
 426                           ([], _) -> Nothing
 427                           _ -> Just ([(FailN1, 1)]::FailStats, nl, il, [], [])
 428       alloclimit = if optMaxLength opts == -1
 429                    then Nothing
 430                    else Just (optMaxLength opts)
 431
 432   allocnodes <- exitIfBad "failure during allocation" $
 433                 Cluster.genAllocNodes gl nl req_nodes True
 434
 435   -- Run the tiered allocation
 436
 437   let tspec = fromMaybe (rspecFromISpec (iPolicyMaxSpec ipol))
 438               (optTieredSpec opts)
 439
 440   (treason, trl_nl, _, spec_map) <-
 441     runAllocation cdata stop_allocation
 442        (Cluster.tieredAlloc nl il alloclimit
 443         (instFromSpec tspec disk_template su) allocnodes [] [])
 444        tspec disk_template SpecTiered opts
 445
 446   printTiered machine_r spec_map nl trl_nl treason
 447
 448   -- Run the standard (avg-mode) allocation
 449
 450   let ispec = fromMaybe (rspecFromISpec (iPolicyStdSpec ipol))
 451               (optStdSpec opts)
 452
 453   (sreason, fin_nl, allocs, _) <-
 454       runAllocation cdata stop_allocation
 455             (Cluster.iterateAlloc nl il alloclimit
 456              (instFromSpec ispec disk_template su) allocnodes [] [])
 457             ispec disk_template SpecNormal opts
 458
 459   printResults machine_r nl fin_nl num_instances allocs sreason
 460
 461   -- Print final result
 462
 463   printFinalHTS machine_r