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 :: String -> RSpec -> [(String, String)]
 158 formatRSpec s r =
 159     [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
 160     , ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
 161     , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
 162     ]
 163
 164 printAllocationStats :: Node.List -> Node.List -> IO ()
 165 printAllocationStats 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 "USED" rini
 170   printKeys $ formatRSpec "POOL" ralo
 171   printKeys $ formatRSpec "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   (fixed_nl, il, _) <- 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 fin_trl_ixes = reverse trl_ixes
 292            ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
 293            spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
 294                       ix_byspec::[(RSpec, Int)]
 295            spec_map' = map (\(spec, cnt) ->
 296                                 printf "%d,%d,%d=%d" (rspecMem spec)
 297                                        (rspecDsk spec) (rspecCpu spec) cnt)
 298                        spec_map::[String]
 299
 300        when (verbose > 1) $ do
 301          hPutStrLn stderr "Tiered allocation map"
 302          hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
 303                  formatTable (map (printInstance trl_nl) fin_trl_ixes)
 304                                  [False, False, False, True, True, True]
 305
 306        when (isJust shownodes) $ do
 307          hPutStrLn stderr ""
 308          hPutStrLn stderr "Tiered allocation status:"
 309          hPutStrLn stderr $ Cluster.printNodes trl_nl (fromJust shownodes)
 310
 311        when (isJust $ optSaveCluster opts) $
 312             do
 313               let out_path = (fromJust $ optSaveCluster opts) <.> "tiered"
 314                   adata = serializeCluster trl_nl trl_il
 315               writeFile out_path adata
 316               hPrintf stderr "The cluster state after tiered allocation\
 317                              \ has been written to file '%s'\n"
 318                              out_path
 319        printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
 320        printKeys [("TSPEC", intercalate " " spec_map')]
 321        printAllocationStats nl trl_nl)
 322
 323   -- Run the standard (avg-mode) allocation
 324
 325   (ereason, fin_nl, fin_il, ixes) <-
 326       if stop_allocation
 327       then return result_noalloc
 328       else exitifbad (Cluster.iterateAlloc nl il reqinst req_nodes [])
 329
 330   let allocs = length ixes
 331       fin_ixes = reverse ixes
 332       sreason = reverse $ sortBy (comparing snd) ereason
 333
 334   when (verbose > 1) $ do
 335          hPutStrLn stderr "Instance map"
 336          hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
 337                  formatTable (map (printInstance fin_nl) fin_ixes)
 338                                  [False, False, False, True, True, True]
 339   when (isJust shownodes) $
 340        do
 341          hPutStrLn stderr ""
 342          hPutStrLn stderr "Final cluster status:"
 343          hPutStrLn stderr $ Cluster.printNodes fin_nl (fromJust shownodes)
 344
 345   when (isJust $ optSaveCluster opts) $
 346        do
 347          let out_path = (fromJust $ optSaveCluster opts) <.> "alloc"
 348              adata = serializeCluster fin_nl fin_il
 349          writeFile out_path adata
 350          hPrintf stderr "The cluster state after standard allocation\
 351                         \ has been written to file '%s'\n"
 352                  out_path
 353
 354   printResults fin_nl num_instances allocs sreason