code.grnet.gr Git - ganeti-local/blob - hspace.hs

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