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