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

   1 {-| Cluster space sizing
   2
   3 -}
   4
   5 {-
   6
   7 Copyright (C) 2009, 2010 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.Maybe (isJust, fromJust)
  31 import Data.Ord (comparing)
  32 import Monad
  33 import System (exitWith, ExitCode(..))
  34 import System.FilePath
  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.Text (serializeCluster)
  50
  51 -- | Options list and functions
  52 options :: [OptType]
  53 options =
  54     [ oPrintNodes
  55     , oDataFile
  56     , oNodeSim
  57     , oRapiMaster
  58     , oLuxiSocket
  59     , oVerbose
  60     , oQuiet
  61     , oOfflineNode
  62     , oIMem
  63     , oIDisk
  64     , oIVcpus
  65     , oINodes
  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 formatRSpec :: Double -> String -> RSpec -> [(String, String)]
 157 formatRSpec m_cpu s r =
 158     [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
 159     , ("KM_" ++ s ++ "_NPU", show $ fromIntegral (rspecCpu r) / m_cpu)
 160     , ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
 161     , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
 162     ]
 163
 164 printAllocationStats :: Double -> Node.List -> Node.List -> IO ()
 165 printAllocationStats m_cpu ini_nl fin_nl = do
 166   let ini_stats = Cluster.totalResources ini_nl
 167       fin_stats = Cluster.totalResources fin_nl
 168       (rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
 169   printKeys $ formatRSpec m_cpu  "USED" rini
 170   printKeys $ formatRSpec m_cpu "POOL"ralo
 171   printKeys $ formatRSpec m_cpu "UNAV" runa
 172
 173 -- | Ensure a value is quoted if needed
 174 ensureQuoted :: String -> String
 175 ensureQuoted v = if not (all (\c -> (isAlphaNum c || c == '.')) v)
 176                  then '\'':v ++ "'"
 177                  else v
 178
 179 -- | Format a list of key\/values as a shell fragment
 180 printKeys :: [(String, String)] -> IO ()
 181 printKeys = mapM_ (\(k, v) ->
 182                    printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
 183
 184 printInstance :: Node.List -> Instance.Instance -> [String]
 185 printInstance nl i = [ Instance.name i
 186                      , Container.nameOf nl $ Instance.pNode i
 187                      , let sdx = Instance.sNode i
 188                        in if sdx == Node.noSecondary then ""
 189                           else Container.nameOf nl sdx
 190                      , show (Instance.mem i)
 191                      , show (Instance.dsk i)
 192                      , show (Instance.vcpus i)
 193                      ]
 194
 195 -- | Main function.
 196 main :: IO ()
 197 main = do
 198   cmd_args <- System.getArgs
 199   (opts, args) <- parseOpts cmd_args "hspace" options
 200
 201   unless (null args) $ do
 202          hPutStrLn stderr "Error: this program doesn't take any arguments."
 203          exitWith $ ExitFailure 1
 204
 205   let verbose = optVerbose opts
 206       ispec = optISpec opts
 207       shownodes = optShowNodes opts
 208
 209   (gl, fixed_nl, il, ctags) <- loadExternalData opts
 210
 211   printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
 212   printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
 213
 214   let num_instances = length $ Container.elems il
 215
 216   let offline_names = optOffline opts
 217       all_nodes = Container.elems fixed_nl
 218       all_names = map Node.name all_nodes
 219       offline_wrong = filter (`notElem` all_names) offline_names
 220       offline_indices = map Node.idx $
 221                         filter (\n ->
 222                                  Node.name n `elem` offline_names ||
 223                                  Node.alias n `elem` offline_names)
 224                                all_nodes
 225       req_nodes = optINodes opts
 226       m_cpu = optMcpu opts
 227       m_dsk = optMdsk opts
 228
 229   when (length offline_wrong > 0) $ do
 230          hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
 231                      (commaJoin offline_wrong) :: IO ()
 232          exitWith $ ExitFailure 1
 233
 234   when (req_nodes /= 1 && req_nodes /= 2) $ do
 235          hPrintf stderr "Error: Invalid required nodes (%d)\n"
 236                                             req_nodes :: IO ()
 237          exitWith $ ExitFailure 1
 238
 239   let nm = Container.map (\n -> if Node.idx n `elem` offline_indices
 240                                 then Node.setOffline n True
 241                                 else n) fixed_nl
 242       nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
 243            nm
 244       csf = commonSuffix fixed_nl il
 245
 246   when (length csf > 0 && verbose > 1) $
 247        hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
 248
 249   when (isJust shownodes) $
 250        do
 251          hPutStrLn stderr "Initial cluster status:"
 252          hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes)
 253
 254   let ini_cv = Cluster.compCV nl
 255       ini_stats = Cluster.totalResources nl
 256
 257   when (verbose > 2) $
 258          hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
 259                  ini_cv (Cluster.printStats nl)
 260
 261   printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
 262   printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
 263   printKeys $ printStats PInitial ini_stats
 264
 265   let bad_nodes = fst $ Cluster.computeBadItems nl il
 266       stop_allocation = length bad_nodes > 0
 267       result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [])
 268
 269   -- utility functions
 270   let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
 271                     (rspecCpu spx) "running" [] (-1) (-1)
 272       exitifbad val = (case val of
 273                          Bad s -> do
 274                            hPrintf stderr "Failure: %s\n" s :: IO ()
 275                            exitWith $ ExitFailure 1
 276                          Ok x -> return x)
 277
 278
 279   let reqinst = iofspec ispec
 280
 281   -- Run the tiered allocation, if enabled
 282
 283   (case optTieredSpec opts of
 284      Nothing -> return ()
 285      Just tspec -> do
 286        (_, trl_nl, trl_il, trl_ixes) <-
 287            if stop_allocation
 288            then return result_noalloc
 289            else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec)
 290                                   req_nodes [])
 291        let spec_map' = Cluster.tieredSpecMap trl_ixes
 292
 293        when (verbose > 1) $ do
 294          hPutStrLn stderr "Tiered allocation map"
 295          hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
 296                  formatTable (map (printInstance trl_nl) (reverse trl_ixes))
 297                                  [False, False, False, True, True, True]
 298
 299        when (isJust shownodes) $ do
 300          hPutStrLn stderr ""
 301          hPutStrLn stderr "Tiered allocation status:"
 302          hPutStrLn stderr $ Cluster.printNodes trl_nl (fromJust shownodes)
 303
 304        when (isJust $ optSaveCluster opts) $
 305             do
 306               let out_path = (fromJust $ optSaveCluster opts) <.> "tiered"
 307                   adata = serializeCluster gl trl_nl trl_il ctags
 308               writeFile out_path adata
 309               hPrintf stderr "The cluster state after tiered allocation\
 310                              \ has been written to file '%s'\n"
 311                              out_path
 312        printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
 313        printKeys [("TSPEC", intercalate " " spec_map')]
 314        printAllocationStats m_cpu nl trl_nl)
 315
 316   -- Run the standard (avg-mode) allocation
 317
 318   (ereason, fin_nl, fin_il, ixes) <-
 319       if stop_allocation
 320       then return result_noalloc
 321       else exitifbad (Cluster.iterateAlloc nl il reqinst req_nodes [])
 322
 323   let allocs = length ixes
 324       fin_ixes = reverse ixes
 325       sreason = reverse $ sortBy (comparing snd) ereason
 326
 327   when (verbose > 1) $ do
 328          hPutStrLn stderr "Instance map"
 329          hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
 330                  formatTable (map (printInstance fin_nl) fin_ixes)
 331                                  [False, False, False, True, True, True]
 332   when (isJust shownodes) $
 333        do
 334          hPutStrLn stderr ""
 335          hPutStrLn stderr "Final cluster status:"
 336          hPutStrLn stderr $ Cluster.printNodes fin_nl (fromJust shownodes)
 337
 338   when (isJust $ optSaveCluster opts) $
 339        do
 340          let out_path = (fromJust $ optSaveCluster opts) <.> "alloc"
 341              adata = serializeCluster gl fin_nl fin_il ctags
 342          writeFile out_path adata
 343          hPrintf stderr "The cluster state after standard allocation\
 344                         \ has been written to file '%s'\n"
 345                  out_path
 346
 347   printResults fin_nl num_instances allocs sreason