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 -- | Recursively place instances on the cluster until we're out of space
 121 iterateDepth :: Node.List
 122              -> Instance.List
 123              -> Instance.Instance
 124              -> Int
 125              -> [Instance.Instance]
 126              -> Result (FailStats, Node.List, [Instance.Instance])
 127 iterateDepth nl il newinst nreq ixes =
 128       let depth = length ixes
 129           newname = printf "new-%d" depth::String
 130           newidx = length (Container.elems il) + depth
 131           newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
 132       in case Cluster.tryAlloc nl il newi2 nreq of
 133            Bad s -> Bad s
 134            Ok (errs, _, sols3) ->
 135                case sols3 of
 136                  [] -> Ok (Cluster.collapseFailures errs, nl, ixes)
 137                  (_, (xnl, xi, _)):[] ->
 138                      iterateDepth xnl il newinst nreq $! (xi:ixes)
 139                  _ -> Bad "Internal error: multiple solutions for single\
 140                           \ allocation"
 141
 142 tieredAlloc :: Node.List
 143             -> Instance.List
 144             -> Instance.Instance
 145             -> Int
 146             -> [Instance.Instance]
 147             -> Result (FailStats, Node.List, [Instance.Instance])
 148 tieredAlloc nl il newinst nreq ixes =
 149     case iterateDepth nl il newinst nreq ixes of
 150       Bad s -> Bad s
 151       Ok (errs, nl', ixes') ->
 152           case Instance.shrinkByType newinst . fst . last $
 153                sortBy (comparing snd) errs of
 154             Bad _ -> Ok (errs, nl', ixes')
 155             Ok newinst' ->
 156                 tieredAlloc nl' il newinst' nreq ixes'
 157
 158
 159 -- | Function to print stats for a given phase
 160 printStats :: Phase -> Cluster.CStats -> [(String, String)]
 161 printStats ph cs =
 162   map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
 163   where kind = case ph of
 164                  PInitial -> "INI"
 165                  PFinal -> "FIN"
 166                  PTiered -> "TRL"
 167
 168 -- | Print final stats and related metrics
 169 printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()
 170 printResults fin_nl num_instances allocs sreason = do
 171   let fin_stats = Cluster.totalResources fin_nl
 172       fin_instances = num_instances + allocs
 173
 174   when (num_instances + allocs /= Cluster.csNinst fin_stats) $
 175        do
 176          hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
 177                         \ != counted (%d)\n" (num_instances + allocs)
 178                                  (Cluster.csNinst fin_stats) :: IO ()
 179          exitWith $ ExitFailure 1
 180
 181   printKeys $ printStats PFinal fin_stats
 182   printKeys [ ("ALLOC_USAGE", printf "%.8f"
 183                                 ((fromIntegral num_instances::Double) /
 184                                  fromIntegral fin_instances))
 185             , ("ALLOC_INSTANCES", printf "%d" allocs)
 186             , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
 187             ]
 188   printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
 189                                printf "%d" y)) sreason
 190   -- this should be the final entry
 191   printKeys [("OK", "1")]
 192
 193 formatRSpec :: String -> RSpec -> [(String, String)]
 194 formatRSpec s r =
 195     [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
 196     , ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
 197     , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
 198     ]
 199
 200 printAllocationStats :: Node.List -> Node.List -> IO ()
 201 printAllocationStats ini_nl fin_nl = do
 202   let ini_stats = Cluster.totalResources ini_nl
 203       fin_stats = Cluster.totalResources fin_nl
 204       (rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
 205   printKeys $ formatRSpec "USED" rini
 206   printKeys $ formatRSpec "POOL" ralo
 207   printKeys $ formatRSpec "UNAV" runa
 208
 209 -- | Ensure a value is quoted if needed
 210 ensureQuoted :: String -> String
 211 ensureQuoted v = if not (all (\c -> (isAlphaNum c || c == '.')) v)
 212                  then '\'':v ++ "'"
 213                  else v
 214
 215 -- | Format a list of key/values as a shell fragment
 216 printKeys :: [(String, String)] -> IO ()
 217 printKeys = mapM_ (\(k, v) ->
 218                    printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
 219
 220 printInstance :: Node.List -> Instance.Instance -> [String]
 221 printInstance nl i = [ Instance.name i
 222                      , Container.nameOf nl $ Instance.pNode i
 223                      , let sdx = Instance.sNode i
 224                        in if sdx == Node.noSecondary then ""
 225                           else Container.nameOf nl sdx
 226                      , show (Instance.mem i)
 227                      , show (Instance.dsk i)
 228                      , show (Instance.vcpus i)
 229                      ]
 230
 231 -- | Main function.
 232 main :: IO ()
 233 main = do
 234   cmd_args <- System.getArgs
 235   (opts, args) <- parseOpts cmd_args "hspace" options
 236
 237   unless (null args) $ do
 238          hPutStrLn stderr "Error: this program doesn't take any arguments."
 239          exitWith $ ExitFailure 1
 240
 241   let verbose = optVerbose opts
 242       ispec = optISpec opts
 243       shownodes = optShowNodes opts
 244
 245   (fixed_nl, il, _, csf) <- loadExternalData opts
 246
 247   printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
 248   printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
 249
 250   let num_instances = length $ Container.elems il
 251
 252   let offline_names = optOffline opts
 253       all_nodes = Container.elems fixed_nl
 254       all_names = map Node.name all_nodes
 255       offline_wrong = filter (`notElem` all_names) offline_names
 256       offline_indices = map Node.idx $
 257                         filter (\n -> Node.name n `elem` offline_names)
 258                                all_nodes
 259       req_nodes = optINodes opts
 260       m_cpu = optMcpu opts
 261       m_dsk = optMdsk opts
 262
 263   when (length offline_wrong > 0) $ do
 264          hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
 265                      (commaJoin offline_wrong) :: IO ()
 266          exitWith $ ExitFailure 1
 267
 268   when (req_nodes /= 1 && req_nodes /= 2) $ do
 269          hPrintf stderr "Error: Invalid required nodes (%d)\n"
 270                                             req_nodes :: IO ()
 271          exitWith $ ExitFailure 1
 272
 273   let nm = Container.map (\n -> if Node.idx n `elem` offline_indices
 274                                 then Node.setOffline n True
 275                                 else n) fixed_nl
 276       nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
 277            nm
 278
 279   when (length csf > 0 && verbose > 1) $
 280        hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
 281
 282   when (isJust shownodes) $
 283        do
 284          hPutStrLn stderr "Initial cluster status:"
 285          hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes)
 286
 287   let ini_cv = Cluster.compCV nl
 288       ini_stats = Cluster.totalResources nl
 289
 290   when (verbose > 2) $
 291          hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
 292                  ini_cv (Cluster.printStats nl)
 293
 294   printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
 295   printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
 296   printKeys $ printStats PInitial ini_stats
 297
 298   let bad_nodes = fst $ Cluster.computeBadItems nl il
 299   when (length bad_nodes > 0) $ do
 300          -- This is failn1 case, so we print the same final stats and
 301          -- exit early
 302          printResults nl num_instances 0 [(FailN1, 1)]
 303          exitWith ExitSuccess
 304
 305   -- utility functions
 306   let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
 307                     (rspecCpu spx) "ADMIN_down" [] (-1) (-1)
 308       exitifbad val = (case val of
 309                          Bad s -> do
 310                            hPrintf stderr "Failure: %s\n" s :: IO ()
 311                            exitWith $ ExitFailure 1
 312                          Ok x -> return x)
 313
 314
 315   let reqinst = iofspec ispec
 316
 317   -- Run the tiered allocation, if enabled
 318
 319   (case optTieredSpec opts of
 320      Nothing -> return ()
 321      Just tspec -> do
 322        let tresu = tieredAlloc nl il (iofspec tspec) req_nodes []
 323        (_, trl_nl, trl_ixes) <- exitifbad tresu
 324        let fin_trl_ixes = reverse trl_ixes
 325            ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
 326            spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
 327                       ix_byspec::[(RSpec, Int)]
 328            spec_map' = map (\(spec, cnt) ->
 329                                 printf "%d,%d,%d=%d" (rspecMem spec)
 330                                        (rspecDsk spec) (rspecCpu spec) cnt)
 331                        spec_map::[String]
 332
 333        when (verbose > 1) $ do
 334          hPutStrLn stderr "Tiered allocation map"
 335          hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
 336                  formatTable (map (printInstance trl_nl) fin_trl_ixes)
 337                                  [False, False, False, True, True, True]
 338
 339        when (isJust shownodes) $ do
 340          hPutStrLn stderr ""
 341          hPutStrLn stderr "Tiered allocation status:"
 342          hPutStrLn stderr $ Cluster.printNodes trl_nl (fromJust shownodes)
 343
 344        printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
 345        printKeys [("TSPEC", intercalate " " spec_map')]
 346        printAllocationStats nl trl_nl)
 347
 348   -- Run the standard (avg-mode) allocation
 349
 350   let result = iterateDepth nl il reqinst req_nodes []
 351   (ereason, fin_nl, ixes) <- exitifbad result
 352
 353   let allocs = length ixes
 354       fin_ixes = reverse ixes
 355       sreason = reverse $ sortBy (comparing snd) ereason
 356
 357   when (verbose > 1) $ do
 358          hPutStrLn stderr "Instance map"
 359          hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
 360                  formatTable (map (printInstance fin_nl) fin_ixes)
 361                                  [False, False, False, True, True, True]
 362   when (isJust shownodes) $
 363        do
 364          hPutStrLn stderr ""
 365          hPutStrLn stderr "Final cluster status:"
 366          hPutStrLn stderr $ Cluster.printNodes fin_nl (fromJust shownodes)
 367
 368   printResults fin_nl num_instances allocs sreason