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 -- | The allocation phase we're in (initial, after tiered allocs, or
  72 -- after regular allocation).
  73 data Phase = PInitial
  74            | PFinal
  75            | PTiered
  76
  77 statsData :: [(String, Cluster.CStats -> String)]
  78 statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
  79             , ("INST_CNT", printf "%d" . Cluster.csNinst)
  80             , ("MEM_FREE", printf "%d" . Cluster.csFmem)
  81             , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)
  82             , ("MEM_RESVD",
  83                \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
  84             , ("MEM_INST", printf "%d" . Cluster.csImem)
  85             , ("MEM_OVERHEAD",
  86                \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
  87             , ("MEM_EFF",
  88                \cs -> printf "%.8f" (fromIntegral (Cluster.csImem cs) /
  89                                      Cluster.csTmem cs))
  90             , ("DSK_FREE", printf "%d" . Cluster.csFdsk)
  91             , ("DSK_AVAIL", printf "%d ". Cluster.csAdsk)
  92             , ("DSK_RESVD",
  93                \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
  94             , ("DSK_INST", printf "%d" . Cluster.csIdsk)
  95             , ("DSK_EFF",
  96                \cs -> printf "%.8f" (fromIntegral (Cluster.csIdsk cs) /
  97                                     Cluster.csTdsk cs))
  98             , ("CPU_INST", printf "%d" . Cluster.csIcpu)
  99             , ("CPU_EFF",
 100                \cs -> printf "%.8f" (fromIntegral (Cluster.csIcpu cs) /
 101                                      Cluster.csTcpu cs))
 102             , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
 103             , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)
 104             ]
 105
 106 specData :: [(String, RSpec -> String)]
 107 specData = [ ("MEM", printf "%d" . rspecMem)
 108            , ("DSK", printf "%d" . rspecDsk)
 109            , ("CPU", printf "%d" . rspecCpu)
 110            ]
 111
 112 clusterData :: [(String, Cluster.CStats -> String)]
 113 clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
 114               , ("DSK", printf "%.0f" . Cluster.csTdsk)
 115               , ("CPU", printf "%.0f" . Cluster.csTcpu)
 116               ]
 117
 118 -- | Recursively place instances on the cluster until we're out of space
 119 iterateDepth :: Node.List
 120              -> Instance.List
 121              -> Instance.Instance
 122              -> Int
 123              -> [Instance.Instance]
 124              -> Result (FailStats, Node.List, [Instance.Instance])
 125 iterateDepth nl il newinst nreq ixes =
 126       let depth = length ixes
 127           newname = printf "new-%d" depth::String
 128           newidx = length (Container.elems il) + depth
 129           newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
 130       in case Cluster.tryAlloc nl il newi2 nreq of
 131            Bad s -> Bad s
 132            Ok (errs, _, sols3) ->
 133                case sols3 of
 134                  Nothing -> Ok (Cluster.collapseFailures errs, nl, ixes)
 135                  Just (_, (xnl, xi, _)) ->
 136                      iterateDepth xnl il newinst nreq $! (xi:ixes)
 137
 138 tieredAlloc :: Node.List
 139             -> Instance.List
 140             -> Instance.Instance
 141             -> Int
 142             -> [Instance.Instance]
 143             -> Result (FailStats, Node.List, [Instance.Instance])
 144 tieredAlloc nl il newinst nreq ixes =
 145     case iterateDepth nl il newinst nreq ixes of
 146       Bad s -> Bad s
 147       Ok (errs, nl', ixes') ->
 148           case Instance.shrinkByType newinst . fst . last $
 149                sortBy (compare `on` snd) errs of
 150             Bad _ -> Ok (errs, nl', ixes')
 151             Ok newinst' ->
 152                 tieredAlloc nl' il newinst' nreq ixes'
 153
 154
 155 -- | Function to print stats for a given phase
 156 printStats :: Phase -> Cluster.CStats -> [(String, String)]
 157 printStats ph cs =
 158   map (\(s, fn) -> (printf "%s_%s" kind s, fn cs)) statsData
 159   where kind = case ph of
 160                  PInitial -> "INI"
 161                  PFinal -> "FIN"
 162                  PTiered -> "TRL"
 163
 164 -- | Print final stats and related metrics
 165 printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()
 166 printResults fin_nl num_instances allocs sreason = do
 167   let fin_stats = Cluster.totalResources fin_nl
 168       fin_instances = num_instances + allocs
 169
 170   when (num_instances + allocs /= Cluster.csNinst fin_stats) $
 171        do
 172          hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
 173                         \ != counted (%d)\n" (num_instances + allocs)
 174                                  (Cluster.csNinst fin_stats)
 175          exitWith $ ExitFailure 1
 176
 177   printKeys $ printStats PFinal fin_stats
 178   printKeys [ ("ALLOC_USAGE", printf "%.8f"
 179                                 ((fromIntegral num_instances::Double) /
 180                                  fromIntegral fin_instances))
 181             , ("ALLOC_INSTANCES", printf "%d" allocs)
 182             , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
 183             ]
 184   printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
 185                                printf "%d" y)) sreason
 186   -- this should be the final entry
 187   printKeys [("OK", "1")]
 188
 189 -- | Format a list of key/values as a shell fragment
 190 printKeys :: [(String, String)] -> IO ()
 191 printKeys = mapM_ (\(k, v) -> printf "HTS_%s=%s\n" (map toUpper k) v)
 192
 193 printInstance :: Node.List -> Instance.Instance -> [String]
 194 printInstance nl i = [ Instance.name i
 195                      , (Container.nameOf nl $ Instance.pNode i)
 196                      , (let sdx = Instance.sNode i
 197                         in if sdx == Node.noSecondary then ""
 198                            else Container.nameOf nl sdx)
 199                      , show (Instance.mem i)
 200                      , show (Instance.dsk i)
 201                      , show (Instance.vcpus i)
 202                      ]
 203
 204 -- | Main function.
 205 main :: IO ()
 206 main = do
 207   cmd_args <- System.getArgs
 208   (opts, args) <- parseOpts cmd_args "hspace" options
 209
 210   unless (null args) $ do
 211          hPutStrLn stderr "Error: this program doesn't take any arguments."
 212          exitWith $ ExitFailure 1
 213
 214   let verbose = optVerbose opts
 215       ispec = optISpec opts
 216
 217   (fixed_nl, il, csf) <- loadExternalData opts
 218
 219   printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
 220   printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
 221
 222   let num_instances = length $ Container.elems il
 223
 224   let offline_names = optOffline opts
 225       all_nodes = Container.elems fixed_nl
 226       all_names = map Node.name all_nodes
 227       offline_wrong = filter (flip notElem all_names) offline_names
 228       offline_indices = map Node.idx $
 229                         filter (\n -> elem (Node.name n) offline_names)
 230                                all_nodes
 231       req_nodes = optINodes opts
 232       m_cpu = optMcpu opts
 233       m_dsk = optMdsk opts
 234
 235   when (length offline_wrong > 0) $ do
 236          hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
 237                      (commaJoin offline_wrong)
 238          exitWith $ ExitFailure 1
 239
 240   when (req_nodes /= 1 && req_nodes /= 2) $ do
 241          hPrintf stderr "Error: Invalid required nodes (%d)\n" req_nodes
 242          exitWith $ ExitFailure 1
 243
 244   let nm = Container.map (\n -> if elem (Node.idx n) offline_indices
 245                                 then Node.setOffline n True
 246                                 else n) fixed_nl
 247       nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
 248            nm
 249
 250   when (length csf > 0 && verbose > 1) $
 251        hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
 252
 253   when (optShowNodes opts) $
 254        do
 255          hPutStrLn stderr "Initial cluster status:"
 256          hPutStrLn stderr $ Cluster.printNodes nl
 257
 258   let ini_cv = Cluster.compCV nl
 259       ini_stats = Cluster.totalResources nl
 260
 261   when (verbose > 2) $
 262          hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
 263                  ini_cv (Cluster.printStats nl)
 264
 265   printKeys $ map (\(a, fn) -> ("CLUSTER_" ++ a, fn ini_stats)) clusterData
 266   printKeys [("CLUSTER_NODES", printf "%d" (length all_nodes))]
 267   printKeys $ printStats PInitial ini_stats
 268
 269   let bad_nodes = fst $ Cluster.computeBadItems nl il
 270   when (length bad_nodes > 0) $ do
 271          -- This is failn1 case, so we print the same final stats and
 272          -- exit early
 273          printResults nl num_instances 0 [(FailN1, 1)]
 274          exitWith ExitSuccess
 275
 276   -- utility functions
 277   let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
 278                     (rspecCpu spx) "ADMIN_down" (-1) (-1)
 279       exitifbad val = (case val of
 280                          Bad s -> do
 281                            hPrintf stderr "Failure: %s\n" s
 282                            exitWith $ ExitFailure 1
 283                          Ok x -> return x)
 284
 285
 286   let reqinst = iofspec ispec
 287
 288   -- Run the tiered allocation, if enabled
 289
 290   (case optTieredSpec opts of
 291      Nothing -> return ()
 292      Just tspec -> do
 293        let tresu = tieredAlloc nl il (iofspec tspec) req_nodes []
 294        (_, trl_nl, trl_ixes) <- exitifbad tresu
 295        let fin_trl_ixes = reverse trl_ixes
 296            ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
 297            spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
 298                       ix_byspec::[(RSpec, Int)]
 299            spec_map' = map (\(idx, (spec, cnt)) ->
 300                                 printf "%dx%dx%dx%d=%d" idx (rspecCpu spec)
 301                                        (rspecMem spec) (rspecDsk spec) cnt)
 302                        $ zip ([1..]::[Int]) spec_map::[String]
 303
 304        when (verbose > 1) $ do
 305          hPutStrLn stderr "Tiered allocation map"
 306          hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
 307                  formatTable (map (printInstance trl_nl) fin_trl_ixes)
 308                                  [False, False, False, True, True, True]
 309
 310        when (optShowNodes opts) $ do
 311          hPutStrLn stderr ""
 312          hPutStrLn stderr "Tiered allocation status:"
 313          hPutStrLn stderr $ Cluster.printNodes trl_nl
 314
 315        printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
 316        printKeys [("TSPEC", intercalate " " spec_map')])
 317
 318   -- Run the standard (avg-mode) allocation
 319
 320   let result = iterateDepth nl il reqinst req_nodes []
 321   (ereason, fin_nl, ixes) <- exitifbad result
 322
 323   let allocs = length ixes
 324       fin_ixes = reverse ixes
 325       sreason = reverse $ sortBy (compare `on` 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 (optShowNodes opts) $
 333        do
 334          hPutStrLn stderr ""
 335          hPutStrLn stderr "Final cluster status:"
 336          hPutStrLn stderr $ Cluster.printNodes fin_nl
 337
 338   printResults fin_nl num_instances allocs sreason