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