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

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