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