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)
  29 import Data.List
  30 import Data.Function
  31 import Monad
  32 import System
  33 import System.IO
  34 import qualified System
  35
  36 import Text.Printf (printf, hPrintf)
  37
  38 import qualified Ganeti.HTools.Container as Container
  39 import qualified Ganeti.HTools.Cluster as Cluster
  40 import qualified Ganeti.HTools.Node as Node
  41 import qualified Ganeti.HTools.Instance as Instance
  42
  43 import Ganeti.HTools.Utils
  44 import Ganeti.HTools.Types
  45 import Ganeti.HTools.CLI
  46 import Ganeti.HTools.ExtLoader
  47
  48 -- | Options list and functions
  49 options :: [OptType]
  50 options =
  51     [ oPrintNodes
  52     , oNodeFile
  53     , oInstFile
  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 data Phase = PInitial | PFinal
  72
  73 statsData :: [(String, Cluster.CStats -> String)]
  74 statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
  75             , ("INST_CNT", printf "%d" . Cluster.csNinst)
  76             , ("MEM_FREE", printf "%d" . Cluster.csFmem)
  77             , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
  78             , ("MEM_RESVD",
  79                \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
  80             , ("MEM_INST", printf "%d" . Cluster.csImem)
  81             , ("MEM_OVERHEAD",
  82                \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
  83             , ("MEM_EFF",
  84                \cs -> printf "%.8f" (fromIntegral (Cluster.csImem cs) /
  85                                      Cluster.csTmem cs))
  86             , ("DSK_FREE", printf "%d" . Cluster.csFdsk)
  87             , ("DSK_AVAIL", printf "%d ". Cluster.csAdsk)
  88             , ("DSK_RESVD",
  89                \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
  90             , ("DSK_INST", printf "%d" . Cluster.csIdsk)
  91             , ("DSK_EFF",
  92                \cs -> printf "%.8f" (fromIntegral (Cluster.csIdsk cs) /
  93                                     Cluster.csTdsk cs))
  94             , ("CPU_INST", printf "%d" . Cluster.csIcpu)
  95             , ("CPU_EFF",
  96                \cs -> printf "%.8f" (fromIntegral (Cluster.csIcpu cs) /
  97                                      Cluster.csTcpu cs))
  98             , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
  99             , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
 100             ]
 101
 102 specData :: [(String, RSpec -> String)]
 103 specData = [ ("MEM", printf "%d" . rspecMem)
 104            , ("DSK", printf "%d" . rspecDsk)
 105            , ("CPU", printf "%d" . rspecCpu)
 106            ]
 107
 108 clusterData :: [(String, Cluster.CStats -> String)]
 109 clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
 110               , ("DSK", printf "%.0f" . Cluster.csTdsk)
 111               , ("CPU", printf "%.0f" . Cluster.csTcpu)
 112               ]
 113
 114 -- | Recursively place instances on the cluster until we're out of space
 115 iterateDepth :: Node.List
 116              -> Instance.List
 117              -> Instance.Instance
 118              -> Int
 119              -> [Instance.Instance]
 120              -> Result (FailStats, Node.List, [Instance.Instance])
 121 iterateDepth nl il newinst nreq ixes =
 122       let depth = length ixes
 123           newname = printf "new-%d" depth::String
 124           newidx = length (Container.elems il) + depth
 125           newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
 126       in case Cluster.tryAlloc nl il newi2 nreq of
 127            Bad s -> Bad s
 128            Ok (errs, _, sols3) ->
 129                case sols3 of
 130                  Nothing -> Ok (Cluster.collapseFailures errs, nl, ixes)
 131                  Just (_, (xnl, xi, _)) ->
 132                      iterateDepth xnl il newinst nreq $! (xi:ixes)
 133
 134 -- | Function to print stats for a given phase
 135 printStats :: Phase -> Cluster.CStats -> [(String, String)]
 136 printStats ph cs =
 137   map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
 138   where kind = case ph of
 139                  PInitial -> "INI"
 140                  PFinal -> "FIN"
 141
 142 -- | Print final stats and related metrics
 143 printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()
 144 printResults fin_nl num_instances allocs sreason = do
 145   let fin_stats = Cluster.totalResources fin_nl
 146       fin_instances = num_instances + allocs
 147
 148   when (num_instances + allocs /= Cluster.csNinst fin_stats) $
 149        do
 150          hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
 151                         \ != counted (%d)\n" (num_instances + allocs)
 152                                  (Cluster.csNinst fin_stats)
 153          exitWith $ ExitFailure 1
 154
 155   printKeys $ printStats PFinal fin_stats
 156   printKeys [ ("ALLOC_USAGE", printf "%.8f"
 157                                 ((fromIntegral num_instances::Double) /
 158                                  fromIntegral fin_instances))
 159             , ("ALLOC_INSTANCES", printf "%d" allocs)
 160             , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
 161             ]
 162   printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
 163                                printf "%d" y)) sreason
 164   -- this should be the final entry
 165   printKeys [("OK", "1")]
 166
 167 -- | Format a list of key/values as a shell fragment
 168 printKeys :: [(String, String)] -> IO ()
 169 printKeys = mapM_ (\(k, v) -> printf "HTS_%s=%s\n" (map toUpper k) v)
 170
 171 printInstance :: Node.List -> Instance.Instance -> [String]
 172 printInstance nl i = [ Instance.name i
 173                      , (Container.nameOf nl $ Instance.pNode i)
 174                      , (let sdx = Instance.sNode i
 175                         in if sdx == Node.noSecondary then ""
 176                            else Container.nameOf nl sdx)
 177                      , show (Instance.mem i)
 178                      , show (Instance.dsk i)
 179                      , show (Instance.vcpus i)
 180                      ]
 181
 182 -- | Main function.
 183 main :: IO ()
 184 main = do
 185   cmd_args <- System.getArgs
 186   (opts, args) <- parseOpts cmd_args "hspace" options
 187
 188   unless (null args) $ do
 189          hPutStrLn stderr "Error: this program doesn't take any arguments."
 190          exitWith $ ExitFailure 1
 191
 192   let verbose = optVerbose opts
 193       ispec = optISpec opts
 194
 195   (fixed_nl, il, csf) <- loadExternalData opts
 196
 197   printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
 198   printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
 199
 200   let num_instances = length $ Container.elems il
 201
 202   let offline_names = optOffline opts
 203       all_nodes = Container.elems fixed_nl
 204       all_names = map Node.name all_nodes
 205       offline_wrong = filter (flip notElem all_names) offline_names
 206       offline_indices = map Node.idx $
 207                         filter (\n -> elem (Node.name n) offline_names)
 208                                all_nodes
 209       req_nodes = optINodes opts
 210       m_cpu = optMcpu opts
 211       m_dsk = optMdsk opts
 212
 213   when (length offline_wrong > 0) $ do
 214          hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
 215                      (commaJoin offline_wrong)
 216          exitWith $ ExitFailure 1
 217
 218   when (req_nodes /= 1 && req_nodes /= 2) $ do
 219          hPrintf stderr "Error: Invalid required nodes (%d)\n" req_nodes
 220          exitWith $ ExitFailure 1
 221
 222   let nm = Container.map (\n -> if elem (Node.idx n) offline_indices
 223                                 then Node.setOffline n True
 224                                 else n) fixed_nl
 225       nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
 226            nm
 227
 228   when (length csf > 0 && verbose > 1) $
 229        hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
 230
 231   when (optShowNodes opts) $
 232        do
 233          hPutStrLn stderr "Initial cluster status:"
 234          hPutStrLn stderr $ Cluster.printNodes nl
 235
 236   let ini_cv = Cluster.compCV nl
 237       ini_stats = Cluster.totalResources nl
 238
 239   when (verbose > 2) $
 240          hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
 241                  ini_cv (Cluster.printStats nl)
 242
 243   printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
 244   printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
 245   printKeys $ printStats PInitial ini_stats
 246
 247   let bad_nodes = fst $ Cluster.computeBadItems nl il
 248   when (length bad_nodes > 0) $ do
 249          -- This is failn1 case, so we print the same final stats and
 250          -- exit early
 251          printResults nl num_instances 0 [(FailN1, 1)]
 252          exitWith ExitSuccess
 253
 254   let reqinst = Instance.create "new" (rspecMem ispec) (rspecDsk ispec)
 255                 (rspecCpu ispec) "ADMIN_down" (-1) (-1)
 256
 257   let result = iterateDepth nl il reqinst req_nodes []
 258   (ereason, fin_nl, ixes) <- (case result of
 259                                 Bad s -> do
 260                                   hPrintf stderr "Failure: %s\n" s
 261                                   exitWith $ ExitFailure 1
 262                                 Ok x -> return x)
 263   let allocs = length ixes
 264       fin_ixes = reverse ixes
 265       sreason = reverse $ sortBy (compare `on` snd) ereason
 266
 267   when (verbose > 1) $ do
 268          hPutStrLn stderr "Instance map"
 269          hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
 270                  formatTable (map (printInstance fin_nl) fin_ixes)
 271                                  [False, False, False, True, True, True]
 272   when (optShowNodes opts) $
 273        do
 274          hPutStrLn stderr ""
 275          hPutStrLn stderr "Final cluster status:"
 276          hPutStrLn stderr $ Cluster.printNodes fin_nl
 277
 278   printResults fin_nl num_instances allocs sreason