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

   1 {-| Solver for N+1 cluster errors
   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 Monad
  31 import System
  32 import System.IO
  33 import System.Console.GetOpt
  34 import qualified System
  35
  36 import Text.Printf (printf)
  37
  38 import qualified Ganeti.HTools.Container as Container
  39 import qualified Ganeti.HTools.Instance as Instance
  40 import qualified Ganeti.HTools.Node as Node
  41 import qualified Ganeti.HTools.Cluster as Cluster
  42 import qualified Ganeti.HTools.CLI as CLI
  43
  44 -- | Command line options structure.
  45 data Options = Options
  46     { optShowNodes   :: Bool
  47     , optShowCmds    :: Bool
  48     , optNodef       :: FilePath
  49     , optNodeSet     :: Bool     -- ^ The nodes have been set by options
  50     , optInstf       :: FilePath -- ^ Path to the instances file
  51     , optInstSet     :: Bool     -- ^ The insts have been set by options
  52     , optMinDepth    :: Int
  53     , optMaxRemovals :: Int
  54     , optMinDelta    :: Int
  55     , optMaxDelta    :: Int
  56     , optMaster      :: String
  57     , optShowVer     :: Bool     -- ^ Just show the program version
  58     , optShowHelp    :: Bool     -- ^ Just show the help
  59     } deriving Show
  60
  61 instance CLI.CLIOptions Options where
  62     showVersion = optShowVer
  63     showHelp    = optShowHelp
  64
  65 instance CLI.EToolOptions Options where
  66     nodeFile   = optNodef
  67     nodeSet    = optNodeSet
  68     instFile   = optInstf
  69     instSet    = optInstSet
  70     masterName = optMaster
  71     silent _   = False
  72
  73 -- | Default values for the command line options.
  74 defaultOptions :: Options
  75 defaultOptions    = Options
  76  { optShowNodes   = False
  77  , optShowCmds    = False
  78  , optNodef       = "nodes"
  79  , optNodeSet     = False
  80  , optInstf       = "instances"
  81  , optInstSet     = False
  82  , optMinDepth    = 1
  83  , optMaxRemovals = -1
  84  , optMinDelta    = 0
  85  , optMaxDelta    = -1
  86  , optMaster      = ""
  87  , optShowVer     = False
  88  , optShowHelp    = False
  89  }
  90
  91 {- | Start computing the solution at the given depth and recurse until
  92 we find a valid solution or we exceed the maximum depth.
  93
  94 -}
  95 iterateDepth :: Node.List
  96              -> [Instance.Instance]
  97              -> Int
  98              -> Int
  99              -> Int
 100              -> Int
 101              -> IO (Maybe Cluster.Solution)
 102 iterateDepth nl bad_instances depth max_removals min_delta max_delta =
 103     let
 104         max_depth = length bad_instances
 105         sol = Cluster.computeSolution nl bad_instances depth
 106               max_removals min_delta max_delta
 107     in
 108       do
 109         printf "%d " depth
 110         hFlush stdout
 111         case sol `seq` sol of
 112           Nothing ->
 113               if depth > max_depth then
 114                   return Nothing
 115               else
 116                   iterateDepth nl bad_instances (depth + 1)
 117                                max_removals min_delta max_delta
 118           _ -> return sol
 119
 120 -- | Options list and functions
 121 options :: [OptDescr (Options -> Options)]
 122 options =
 123     [ Option ['p']     ["print-nodes"]
 124       (NoArg (\ opts -> opts { optShowNodes = True }))
 125       "print the final node list"
 126     , Option ['C']     ["print-commands"]
 127       (NoArg (\ opts -> opts { optShowCmds = True }))
 128       "print the ganeti command list for reaching the solution"
 129     , Option ['n']     ["nodes"]
 130       (ReqArg (\ f opts -> opts { optNodef = f, optNodeSet = True }) "FILE")
 131       "the node list FILE"
 132     , Option ['i']     ["instances"]
 133       (ReqArg (\ f opts -> opts { optInstf =  f, optInstSet = True }) "FILE")
 134       "the instance list FILE"
 135     , Option ['d']     ["depth"]
 136       (ReqArg (\ i opts -> opts { optMinDepth =  (read i)::Int }) "D")
 137       "start computing the solution at depth D"
 138     , Option ['r']     ["max-removals"]
 139       (ReqArg (\ i opts -> opts { optMaxRemovals =  (read i)::Int }) "R")
 140       "do not process more than R removal sets (useful for high depths)"
 141     , Option ['L']     ["max-delta"]
 142       (ReqArg (\ i opts -> opts { optMaxDelta =  (read i)::Int }) "L")
 143       "refuse solutions with delta higher than L"
 144     , Option ['l']     ["min-delta"]
 145       (ReqArg (\ i opts -> opts { optMinDelta =  (read i)::Int }) "L")
 146       "return once a solution with delta L or lower has been found"
 147     , Option ['m']     ["master"]
 148       (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
 149       "collect data via RAPI at the given ADDRESS"
 150     , Option ['V']     ["version"]
 151       (NoArg (\ opts -> opts { optShowVer = True}))
 152       "show the version of the program"
 153     , Option ['h']     ["help"]
 154       (NoArg (\ opts -> opts { optShowHelp = True}))
 155       "show help"
 156     ]
 157
 158 -- | Main function.
 159 main :: IO ()
 160 main = do
 161   cmd_args <- System.getArgs
 162   (opts, args) <- CLI.parseOpts cmd_args "hn1" options
 163                   defaultOptions
 164
 165   unless (null args) $ do
 166          hPutStrLn stderr "Error: this program doesn't take any arguments."
 167          exitWith $ ExitFailure 1
 168
 169   (nl, il, csf) <- CLI.loadExternalData opts
 170
 171   printf "Loaded %d nodes, %d instances\n"
 172              (Container.size nl)
 173              (Container.size il)
 174
 175   when (length csf > 0) $ do
 176          printf "Note: Stripping common suffix of '%s' from names\n" csf
 177
 178   let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
 179       min_depth = optMinDepth opts
 180
 181   printf "Initial check done: %d bad nodes, %d bad instances.\n"
 182              (length bad_nodes) (length bad_instances)
 183
 184   when (null bad_instances) $ do
 185          putStrLn "Happy time! Cluster is fine, no need to burn CPU."
 186          exitWith ExitSuccess
 187
 188   when (length bad_instances < min_depth) $ do
 189          printf "Error: depth %d is higher than the number of bad instances.\n"
 190                 min_depth
 191          exitWith $ ExitFailure 2
 192
 193   let ini_cv = Cluster.compCV nl
 194   printf "Initial coefficients: overall %.8f, %s\n"
 195          ini_cv (Cluster.printStats nl)
 196
 197   putStr "Computing solution: depth "
 198   hFlush stdout
 199
 200   result <- iterateDepth nl bad_instances min_depth (optMaxRemovals opts)
 201             (optMinDelta opts) (optMaxDelta opts)
 202   let (min_d, solution) =
 203           case result of
 204             Just (Cluster.Solution a b) -> (a, reverse b)
 205             Nothing -> (-1, [])
 206   when (min_d == -1) $ do
 207          putStrLn "failed. Try to run with higher depth."
 208          exitWith $ ExitFailure 1
 209
 210   printf "found.\n"
 211
 212   let
 213       ns = Cluster.applySolution nl il solution
 214       fin_cv = Cluster.compCV ns
 215
 216   printf "Final coefficients:   overall %.8f, %s\n"
 217          fin_cv
 218          (Cluster.printStats ns)
 219
 220   printf "Solution (delta=%d):\n" $! min_d
 221   let (sol_strs, cmd_strs) = Cluster.printSolution ns il solution
 222   putStr $ unlines $ sol_strs
 223   when (optShowCmds opts) $
 224        do
 225          putStrLn ""
 226          putStrLn "Commands to run to reach the above solution:"
 227          putStr . Cluster.formatCmds . reverse $ cmd_strs
 228
 229   when (optShowNodes opts) $
 230        do
 231          let (orig_mem, orig_disk) = Cluster.totalResources nl
 232              (final_mem, final_disk) = Cluster.totalResources ns
 233          putStrLn ""
 234          putStrLn "Final cluster status:"
 235          putStrLn $ Cluster.printNodes ns
 236          printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
 237          printf "Final:    mem=%d disk=%d\n" final_mem final_disk