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

   1 {-| Cluster rebalancer
   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.List
  29 import Data.Function
  30 import Data.Maybe (isJust, fromJust)
  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
  42 import Ganeti.HTools.CLI
  43 import Ganeti.HTools.Utils
  44
  45 -- | Options list and functions
  46 options :: [OptType]
  47 options =
  48     [ oPrintNodes
  49     , oPrintCommands
  50     , oOneline
  51     , oNodeFile
  52     , oInstFile
  53     , oRapiMaster
  54     , oLuxiSocket
  55     , oMaxSolLength
  56     , oVerbose
  57     , oQuiet
  58     , oOfflineNode
  59     , oMinScore
  60     , oMaxCpu
  61     , oMinDisk
  62     , oDiskMoves
  63     , oShowVer
  64     , oShowHelp
  65     ]
  66
  67 {- | Start computing the solution at the given depth and recurse until
  68 we find a valid solution or we exceed the maximum depth.
  69
  70 -}
  71 iterateDepth :: Cluster.Table    -- ^ The starting table
  72              -> Int              -- ^ Remaining length
  73              -> Bool             -- ^ Allow disk moves
  74              -> Int              -- ^ Max node name len
  75              -> Int              -- ^ Max instance name len
  76              -> [[String]]       -- ^ Current command list
  77              -> Bool             -- ^ Whether to be silent
  78              -> Cluster.Score    -- ^ Score at which to stop
  79              -> IO (Cluster.Table, [[String]]) -- ^ The resulting table and
  80                                                -- commands
  81 iterateDepth ini_tbl max_rounds disk_moves nmlen imlen
  82              cmd_strs oneline min_score =
  83     let Cluster.Table ini_nl ini_il ini_cv ini_plc = ini_tbl
  84         all_inst = Container.elems ini_il
  85         node_idx = map Node.idx . filter (not . Node.offline) $
  86                    Container.elems ini_nl
  87         fin_tbl = Cluster.checkMove node_idx disk_moves ini_tbl all_inst
  88         (Cluster.Table _ _ fin_cv fin_plc) = fin_tbl
  89         ini_plc_len = length ini_plc
  90         fin_plc_len = length fin_plc
  91         allowed_next = (max_rounds < 0 || length fin_plc < max_rounds)
  92     in
  93       do
  94         let
  95             (sol_line, cmds) = Cluster.printSolutionLine ini_nl ini_il
  96                                nmlen imlen (head fin_plc) fin_plc_len
  97             upd_cmd_strs = cmds:cmd_strs
  98         unless (oneline || fin_plc_len == ini_plc_len) $ do
  99           putStrLn sol_line
 100           hFlush stdout
 101         (if fin_cv < ini_cv then -- this round made success, try deeper
 102              if allowed_next && fin_cv > min_score
 103              then iterateDepth fin_tbl max_rounds disk_moves
 104                   nmlen imlen upd_cmd_strs oneline min_score
 105              -- don't go deeper, but return the better solution
 106              else return (fin_tbl, upd_cmd_strs)
 107          else
 108              return (ini_tbl, cmd_strs))
 109
 110 -- | Formats the solution for the oneline display
 111 formatOneline :: Double -> Int -> Double -> String
 112 formatOneline ini_cv plc_len fin_cv =
 113     printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv
 114                (if fin_cv == 0 then 1 else ini_cv / fin_cv)
 115
 116 -- | Main function.
 117 main :: IO ()
 118 main = do
 119   cmd_args <- System.getArgs
 120   (opts, args) <- parseOpts cmd_args "hbal" options
 121
 122   unless (null args) $ do
 123          hPutStrLn stderr "Error: this program doesn't take any arguments."
 124          exitWith $ ExitFailure 1
 125
 126   let oneline = optOneline opts
 127       verbose = optVerbose opts
 128
 129   (fixed_nl, il, csf) <- loadExternalData opts
 130
 131   let offline_names = optOffline opts
 132       all_nodes = Container.elems fixed_nl
 133       all_names = map Node.name all_nodes
 134       offline_wrong = filter (flip notElem all_names) offline_names
 135       offline_indices = map Node.idx $
 136                         filter (\n -> elem (Node.name n) offline_names)
 137                                all_nodes
 138       m_cpu = optMcpu opts
 139       m_dsk = optMdsk opts
 140
 141   when (length offline_wrong > 0) $ do
 142          hPrintf stderr "Wrong node name(s) set as offline: %s\n"
 143                      (commaJoin offline_wrong)
 144          exitWith $ ExitFailure 1
 145
 146   let nm = Container.map (\n -> if elem (Node.idx n) offline_indices
 147                                 then Node.setOffline n True
 148                                 else n) fixed_nl
 149       nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
 150            nm
 151
 152   when (Container.size il == 0) $ do
 153          (if oneline then putStrLn $ formatOneline 0 0 0
 154           else printf "Cluster is empty, exiting.\n")
 155          exitWith ExitSuccess
 156
 157   unless oneline $ printf "Loaded %d nodes, %d instances\n"
 158              (Container.size nl)
 159              (Container.size il)
 160
 161   when (length csf > 0 && not oneline && verbose > 1) $
 162        printf "Note: Stripping common suffix of '%s' from names\n" csf
 163
 164   let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
 165   unless (oneline || verbose == 0) $ printf
 166              "Initial check done: %d bad nodes, %d bad instances.\n"
 167              (length bad_nodes) (length bad_instances)
 168
 169   when (length bad_nodes > 0) $
 170          putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
 171                   \that the cluster will end N+1 happy."
 172
 173   when (optShowNodes opts) $
 174        do
 175          putStrLn "Initial cluster status:"
 176          putStrLn $ Cluster.printNodes nl
 177
 178   let ini_cv = Cluster.compCV nl
 179       ini_tbl = Cluster.Table nl il ini_cv []
 180       min_cv = optMinScore opts
 181
 182   when (ini_cv < min_cv) $ do
 183          (if oneline then
 184               putStrLn $ formatOneline ini_cv 0 ini_cv
 185           else printf "Cluster is already well balanced (initial score %.6g,\n\
 186                       \minimum score %.6g).\nNothing to do, exiting\n"
 187                       ini_cv min_cv)
 188          exitWith ExitSuccess
 189
 190   unless oneline (if verbose > 2 then
 191                       printf "Initial coefficients: overall %.8f, %s\n"
 192                       ini_cv (Cluster.printStats nl)
 193                   else
 194                       printf "Initial score: %.8f\n" ini_cv)
 195
 196   unless oneline $ putStrLn "Trying to minimize the CV..."
 197   let imlen = Container.maxNameLen il
 198       nmlen = Container.maxNameLen nl
 199
 200   (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
 201                          (optDiskMoves opts)
 202                          nmlen imlen [] oneline min_cv
 203   let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl
 204       ord_plc = reverse fin_plc
 205       sol_msg = if null fin_plc
 206                 then printf "No solution found\n"
 207                 else if verbose > 2
 208                      then printf "Final coefficients:   overall %.8f, %s\n"
 209                           fin_cv (Cluster.printStats fin_nl)
 210                      else printf "Cluster score improved from %.8f to %.8f\n"
 211                           ini_cv fin_cv
 212                               ::String
 213
 214   unless oneline $ putStr sol_msg
 215
 216   unless (oneline || verbose == 0) $
 217          printf "Solution length=%d\n" (length ord_plc)
 218
 219   let cmd_data = Cluster.formatCmds . reverse $ cmd_strs
 220
 221   when (isJust $ optShowCmds opts) $
 222        do
 223          let out_path = fromJust $ optShowCmds opts
 224          putStrLn ""
 225          (if out_path == "-" then
 226               printf "Commands to run to reach the above solution:\n%s"
 227                      (unlines . map ("  " ++) .
 228                       filter (/= "check") .
 229                       lines $ cmd_data)
 230           else do
 231             writeFile out_path (shTemplate ++ cmd_data)
 232             printf "The commands have been written to file '%s'\n" out_path)
 233
 234   when (optShowNodes opts) $
 235        do
 236          let ini_cs = Cluster.totalResources nl
 237              fin_cs = Cluster.totalResources fin_nl
 238          putStrLn ""
 239          putStrLn "Final cluster status:"
 240          putStrLn $ Cluster.printNodes fin_nl
 241          when (verbose > 3) $
 242               do
 243                 printf "Original: mem=%d disk=%d\n"
 244                        (Cluster.cs_fmem ini_cs) (Cluster.cs_fdsk ini_cs)
 245                 printf "Final:    mem=%d disk=%d\n"
 246                        (Cluster.cs_fmem fin_cs) (Cluster.cs_fdsk fin_cs)
 247   when oneline $
 248          putStrLn $ formatOneline ini_cv (length ord_plc) fin_cv