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)
  30 import Data.Function (on)
  31 import Data.List
  32 import Data.Maybe (isJust, fromJust)
  33 import Data.Ord (comparing)
  34 import System (exitWith, ExitCode(..))
  35 import System.IO
  36 import qualified System
  37
  38 import Text.Printf (printf, hPrintf)
  39
  40 import qualified Ganeti.HTools.Container as Container
  41 import qualified Ganeti.HTools.Cluster as Cluster
  42 import qualified Ganeti.HTools.Node as Node
  43 import qualified Ganeti.HTools.Instance as Instance
  44
  45 import Ganeti.HTools.Utils
  46 import Ganeti.HTools.Types
  47 import Ganeti.HTools.CLI
  48 import Ganeti.HTools.ExtLoader
  49 import Ganeti.HTools.Loader (ClusterData(..))
  50
  51 -- | Options list and functions
  52 options :: [OptType]
  53 options =
  54     [ oPrintNodes
  55     , oDataFile
  56     , oDiskTemplate
  57     , oNodeSim
  58     , oRapiMaster
  59     , oLuxiSocket
  60     , oVerbose
  61     , oQuiet
  62     , oOfflineNode
  63     , oIMem
  64     , oIDisk
  65     , oIVcpus
  66     , oMaxCpu
  67     , oMinDisk
  68     , oTieredSpec
  69     , oSaveCluster
  70     , oShowVer
  71     , oShowHelp
  72     ]
  73
  74 -- | The allocation phase we're in (initial, after tiered allocs, or
  75 -- after regular allocation).
  76 data Phase = PInitial
  77            | PFinal
  78            | PTiered
  79
  80 statsData :: [(String, Cluster.CStats -> String)]
  81 statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
  82             , ("INST_CNT", printf "%d" . Cluster.csNinst)
  83             , ("MEM_FREE", printf "%d" . Cluster.csFmem)
  84             , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
  85             , ("MEM_RESVD",
  86                \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
  87             , ("MEM_INST", printf "%d" . Cluster.csImem)
  88             , ("MEM_OVERHEAD",
  89                \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
  90             , ("MEM_EFF",
  91                \cs -> printf "%.8f" (fromIntegral (Cluster.csImem cs) /
  92                                      Cluster.csTmem cs))
  93             , ("DSK_FREE", printf "%d" . Cluster.csFdsk)
  94             , ("DSK_AVAIL", printf "%d". Cluster.csAdsk)
  95             , ("DSK_RESVD",
  96                \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
  97             , ("DSK_INST", printf "%d" . Cluster.csIdsk)
  98             , ("DSK_EFF",
  99                \cs -> printf "%.8f" (fromIntegral (Cluster.csIdsk cs) /
 100                                     Cluster.csTdsk cs))
 101             , ("CPU_INST", printf "%d" . Cluster.csIcpu)
 102             , ("CPU_EFF",
 103                \cs -> printf "%.8f" (fromIntegral (Cluster.csIcpu cs) /
 104                                      Cluster.csTcpu cs))
 105             , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
 106             , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
 107             ]
 108
 109 specData :: [(String, RSpec -> String)]
 110 specData = [ ("MEM", printf "%d" . rspecMem)
 111            , ("DSK", printf "%d" . rspecDsk)
 112            , ("CPU", printf "%d" . rspecCpu)
 113            ]
 114
 115 clusterData :: [(String, Cluster.CStats -> String)]
 116 clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
 117               , ("DSK", printf "%.0f" . Cluster.csTdsk)
 118               , ("CPU", printf "%.0f" . Cluster.csTcpu)
 119               , ("VCPU", printf "%d" . Cluster.csVcpu)
 120               ]
 121
 122 -- | Function to print stats for a given phase
 123 printStats :: Phase -> Cluster.CStats -> [(String, String)]
 124 printStats ph cs =
 125   map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
 126   where kind = case ph of
 127                  PInitial -> "INI"
 128                  PFinal -> "FIN"
 129                  PTiered -> "TRL"
 130
 131 -- | Print final stats and related metrics
 132 printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()
 133 printResults fin_nl num_instances allocs sreason = do
 134   let fin_stats = Cluster.totalResources fin_nl
 135       fin_instances = num_instances + allocs
 136
 137   when (num_instances + allocs /= Cluster.csNinst fin_stats) $
 138        do
 139          hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
 140                         \ != counted (%d)\n" (num_instances + allocs)
 141                                  (Cluster.csNinst fin_stats) :: IO ()
 142          exitWith $ ExitFailure 1
 143
 144   printKeys $ printStats PFinal fin_stats
 145   printKeys [ ("ALLOC_USAGE", printf "%.8f"
 146                                 ((fromIntegral num_instances::Double) /
 147                                  fromIntegral fin_instances))
 148             , ("ALLOC_INSTANCES", printf "%d" allocs)
 149             , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
 150             ]
 151   printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
 152                                printf "%d" y)) sreason
 153   -- this should be the final entry
 154   printKeys [("OK", "1")]
 155
 156 -- | Compute the tiered spec counts from a list of allocated
 157 -- instances.
 158 tieredSpecMap :: [Instance.Instance]
 159               -> [(RSpec, Int)]
 160 tieredSpecMap trl_ixes =
 161     let fin_trl_ixes = reverse trl_ixes
 162         ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
 163         spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
 164                    ix_byspec
 165     in spec_map
 166
 167 -- | Formats a spec map to strings.
 168 formatSpecMap :: [(RSpec, Int)] -> [String]
 169 formatSpecMap =
 170     map (\(spec, cnt) -> printf "%d,%d,%d=%d" (rspecMem spec)
 171                          (rspecDsk spec) (rspecCpu spec) cnt)
 172
 173 formatRSpec :: Double -> String -> RSpec -> [(String, String)]
 174 formatRSpec m_cpu s r =
 175     [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
 176     , ("KM_" ++ s ++ "_NPU", show $ fromIntegral (rspecCpu r) / m_cpu)
 177     , ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
 178     , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
 179     ]
 180
 181 printAllocationStats :: Double -> Node.List -> Node.List -> IO ()
 182 printAllocationStats m_cpu ini_nl fin_nl = do
 183   let ini_stats = Cluster.totalResources ini_nl
 184       fin_stats = Cluster.totalResources fin_nl
 185       (rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
 186   printKeys $ formatRSpec m_cpu  "USED" rini
 187   printKeys $ formatRSpec m_cpu "POOL"ralo
 188   printKeys $ formatRSpec m_cpu "UNAV" runa
 189
 190 -- | Ensure a value is quoted if needed
 191 ensureQuoted :: String -> String
 192 ensureQuoted v = if not (all (\c -> isAlphaNum c || c == '.') v)
 193                  then '\'':v ++ "'"
 194                  else v
 195
 196 -- | Format a list of key\/values as a shell fragment
 197 printKeys :: [(String, String)] -> IO ()
 198 printKeys = mapM_ (\(k, v) ->
 199                    printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
 200
 201 printInstance :: Node.List -> Instance.Instance -> [String]
 202 printInstance nl i = [ Instance.name i
 203                      , Container.nameOf nl $ Instance.pNode i
 204                      , let sdx = Instance.sNode i
 205                        in if sdx == Node.noSecondary then ""
 206                           else Container.nameOf nl sdx
 207                      , show (Instance.mem i)
 208                      , show (Instance.dsk i)
 209                      , show (Instance.vcpus i)
 210                      ]
 211
 212 -- | Optionally print the allocation map
 213 printAllocationMap :: Int -> String
 214                    -> Node.List -> [Instance.Instance] -> IO ()
 215 printAllocationMap verbose msg nl ixes =
 216   when (verbose > 1) $ do
 217     hPutStrLn stderr msg
 218     hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
 219             formatTable (map (printInstance nl) (reverse ixes))
 220                         -- This is the numberic-or-not field
 221                         -- specification; the first three fields are
 222                         -- strings, whereas the rest are numeric
 223                        [False, False, False, True, True, True]
 224
 225 -- | Main function.
 226 main :: IO ()
 227 main = do
 228   cmd_args <- System.getArgs
 229   (opts, args) <- parseOpts cmd_args "hspace" options
 230
 231   unless (null args) $ do
 232          hPutStrLn stderr "Error: this program doesn't take any arguments."
 233          exitWith $ ExitFailure 1
 234
 235   let verbose = optVerbose opts
 236       ispec = optISpec opts
 237       shownodes = optShowNodes opts
 238       disk_template = optDiskTemplate opts
 239       req_nodes = Instance.requiredNodes disk_template
 240
 241   (ClusterData gl fixed_nl il ctags) <- loadExternalData opts
 242
 243   printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
 244   printKeys [ ("SPEC_RQN", printf "%d" req_nodes) ]
 245   printKeys [ ("SPEC_DISK_TEMPLATE", dtToString disk_template) ]
 246
 247   let num_instances = length $ Container.elems il
 248
 249   let offline_names = optOffline opts
 250       all_nodes = Container.elems fixed_nl
 251       all_names = map Node.name all_nodes
 252       offline_wrong = filter (`notElem` all_names) offline_names
 253       offline_indices = map Node.idx $
 254                         filter (\n ->
 255                                  Node.name n `elem` offline_names ||
 256                                  Node.alias n `elem` offline_names)
 257                                all_nodes
 258       m_cpu = optMcpu opts
 259       m_dsk = optMdsk opts
 260
 261   when (length offline_wrong > 0) $ do
 262          hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
 263                      (commaJoin offline_wrong) :: IO ()
 264          exitWith $ ExitFailure 1
 265
 266   when (req_nodes /= 1 && req_nodes /= 2) $ do
 267          hPrintf stderr "Error: Invalid required nodes (%d)\n"
 268                                             req_nodes :: IO ()
 269          exitWith $ ExitFailure 1
 270
 271   let nm = Container.map (\n -> if Node.idx n `elem` offline_indices
 272                                 then Node.setOffline n True
 273                                 else n) fixed_nl
 274       nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
 275            nm
 276       csf = commonSuffix fixed_nl il
 277
 278   when (length csf > 0 && verbose > 1) $
 279        hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
 280
 281   when (isJust shownodes) $
 282        do
 283          hPutStrLn stderr "Initial cluster status:"
 284          hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes)
 285
 286   let ini_cv = Cluster.compCV nl
 287       ini_stats = Cluster.totalResources nl
 288
 289   when (verbose > 2) $
 290          hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
 291                  ini_cv (Cluster.printStats nl)
 292
 293   printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
 294   printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
 295   printKeys $ printStats PInitial ini_stats
 296
 297   let bad_nodes = fst $ Cluster.computeBadItems nl il
 298       stop_allocation = length bad_nodes > 0
 299       result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [], [])
 300
 301   -- utility functions
 302   let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
 303                     (rspecCpu spx) "running" [] True (-1) (-1) disk_template
 304       exitifbad val = (case val of
 305                          Bad s -> do
 306                            hPrintf stderr "Failure: %s\n" s :: IO ()
 307                            exitWith $ ExitFailure 1
 308                          Ok x -> return x)
 309
 310
 311   let reqinst = iofspec ispec
 312
 313   allocnodes <- exitifbad $ Cluster.genAllocNodes gl nl req_nodes True
 314
 315   -- Run the tiered allocation, if enabled
 316
 317   (case optTieredSpec opts of
 318      Nothing -> return ()
 319      Just tspec -> do
 320        (_, trl_nl, trl_il, trl_ixes, _) <-
 321            if stop_allocation
 322            then return result_noalloc
 323            else exitifbad (Cluster.tieredAlloc nl il Nothing (iofspec tspec)
 324                                   allocnodes [] [])
 325        let spec_map' = tieredSpecMap trl_ixes
 326
 327        printAllocationMap verbose "Tiered allocation map" trl_nl trl_ixes
 328
 329        maybePrintNodes shownodes "Tiered allocation"
 330                            (Cluster.printNodes trl_nl)
 331
 332        maybeSaveData (optSaveCluster opts) "tiered" "after tiered allocation"
 333                      (ClusterData gl trl_nl trl_il ctags)
 334
 335        printKeys $ map (\(a, fn) -> ("TSPEC_INI_" ++ a, fn tspec)) specData
 336        printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
 337        printKeys [("TSPEC", intercalate " " (formatSpecMap spec_map'))]
 338        printAllocationStats m_cpu nl trl_nl)
 339
 340   -- Run the standard (avg-mode) allocation
 341
 342   (ereason, fin_nl, fin_il, ixes, _) <-
 343       if stop_allocation
 344       then return result_noalloc
 345       else exitifbad (Cluster.iterateAlloc nl il Nothing
 346                       reqinst allocnodes [] [])
 347
 348   let allocs = length ixes
 349       sreason = reverse $ sortBy (comparing snd) ereason
 350
 351   printAllocationMap verbose "Standard allocation map" fin_nl ixes
 352
 353   maybePrintNodes shownodes "Standard allocation" (Cluster.printNodes fin_nl)
 354
 355   maybeSaveData (optSaveCluster opts) "alloc" "after standard allocation"
 356        (ClusterData gl fin_nl fin_il ctags)
 357
 358   printResults fin_nl num_instances allocs sreason