X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/446d8827ab570f6d0b8a52a5ee397102f5de488b..844eff86e3fded35282073a3060dbc66f4e4b16f:/hbal.hs diff --git a/hbal.hs b/hbal.hs index 5db69d3..daf3c9e 100644 --- a/hbal.hs +++ b/hbal.hs @@ -2,6 +2,27 @@ -} +{- + +Copyright (C) 2009 Google Inc. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +02110-1301, USA. + +-} + module Main (main) where import Data.List @@ -19,12 +40,8 @@ import qualified Ganeti.HTools.Container as Container import qualified Ganeti.HTools.Cluster as Cluster import qualified Ganeti.HTools.Node as Node import qualified Ganeti.HTools.CLI as CLI -import qualified Ganeti.HTools.Rapi as Rapi -import qualified Ganeti.HTools.Text as Text -import qualified Ganeti.HTools.Loader as Loader import Ganeti.HTools.Utils -import Ganeti.HTools.Types -- | Command line options structure. data Options = Options @@ -48,6 +65,14 @@ instance CLI.CLIOptions Options where showVersion = optShowVer showHelp = optShowHelp +instance CLI.EToolOptions Options where + nodeFile = optNodef + nodeSet = optNodeSet + instFile = optInstf + instSet = optInstSet + masterName = optMaster + silent a = (optVerbose a) == 0 + -- | Default values for the command line options. defaultOptions :: Options defaultOptions = Options @@ -121,8 +146,6 @@ we find a valid solution or we exceed the maximum depth. -} iterateDepth :: Cluster.Table -- ^ The starting table -> Int -- ^ Remaining length - -> Cluster.NameList -- ^ Node idx to name list - -> Cluster.NameList -- ^ Inst idx to name list -> Int -- ^ Max node name len -> Int -- ^ Max instance name len -> [[String]] -- ^ Current command list @@ -130,7 +153,7 @@ iterateDepth :: Cluster.Table -- ^ The starting table -> Cluster.Score -- ^ Score at which to stop -> IO (Cluster.Table, [[String]]) -- ^ The resulting table and -- commands -iterateDepth ini_tbl max_rounds ktn kti nmlen imlen +iterateDepth ini_tbl max_rounds nmlen imlen cmd_strs oneline min_score = let Cluster.Table ini_nl ini_il ini_cv ini_plc = ini_tbl all_inst = Container.elems ini_il @@ -144,7 +167,7 @@ iterateDepth ini_tbl max_rounds ktn kti nmlen imlen in do let - (sol_line, cmds) = Cluster.printSolutionLine ini_il ktn kti + (sol_line, cmds) = Cluster.printSolutionLine ini_nl ini_il nmlen imlen (head fin_plc) fin_plc_len upd_cmd_strs = cmds:cmd_strs unless (oneline || fin_plc_len == ini_plc_len) $ do @@ -152,7 +175,7 @@ iterateDepth ini_tbl max_rounds ktn kti nmlen imlen hFlush stdout (if fin_cv < ini_cv then -- this round made success, try deeper if allowed_next && fin_cv > min_score - then iterateDepth fin_tbl max_rounds ktn kti + then iterateDepth fin_tbl max_rounds nmlen imlen upd_cmd_strs oneline min_score -- don't go deeper, but return the better solution else return (fin_tbl, upd_cmd_strs) @@ -175,38 +198,18 @@ main = do hPutStrLn stderr "Error: this program doesn't take any arguments." exitWith $ ExitFailure 1 - (env_node, env_inst) <- CLI.parseEnv () - let nodef = if optNodeSet opts then optNodef opts - else env_node - instf = if optInstSet opts then optInstf opts - else env_inst - oneline = optOneline opts + let oneline = optOneline opts verbose = optVerbose opts - input_data <- - case optMaster opts of - "" -> Text.loadData nodef instf - host -> Rapi.loadData host - - let ldresult = input_data >>= Loader.mergeData - - (loaded_nl, il, csf, ktn, kti) <- - (case ldresult of - Ok x -> return x - Bad s -> do - printf "Error: failed to load data. Details:\n%s\n" s - exitWith $ ExitFailure 1 - ) - let (fix_msgs, fixed_nl) = Loader.checkData loaded_nl il ktn kti - - unless (null fix_msgs || verbose == 0) $ do - putStrLn "Warning: cluster has inconsistent data:" - putStrLn . unlines . map (\s -> printf " - %s" s) $ fix_msgs + + (fixed_nl, il, csf) <- CLI.loadExternalData opts let offline_names = optOffline opts - all_names = snd . unzip $ ktn + all_nodes = Container.elems fixed_nl + all_names = map Node.name all_nodes offline_wrong = filter (\n -> not $ elem n all_names) offline_names - offline_indices = fst . unzip . - filter (\(_, n) -> elem n offline_names) $ ktn + offline_indices = map Node.idx $ + filter (\n -> elem (Node.name n) offline_names) + all_nodes when (length offline_wrong > 0) $ do printf "Wrong node name(s) set as offline: %s\n" @@ -218,13 +221,10 @@ main = do else n) fixed_nl when (Container.size il == 0) $ do - (if oneline then - putStrLn $ formatOneline 0 0 0 - else - printf "Cluster is empty, exiting.\n") + (if oneline then putStrLn $ formatOneline 0 0 0 + else printf "Cluster is empty, exiting.\n") exitWith ExitSuccess - unless oneline $ printf "Loaded %d nodes, %d instances\n" (Container.size nl) (Container.size il) @@ -244,7 +244,7 @@ main = do when (optShowNodes opts) $ do putStrLn "Initial cluster status:" - putStrLn $ Cluster.printNodes ktn nl + putStrLn $ Cluster.printNodes nl let ini_cv = Cluster.compCV nl ini_tbl = Cluster.Table nl il ini_cv [] @@ -265,22 +265,21 @@ main = do printf "Initial score: %.8f\n" ini_cv) unless oneline $ putStrLn "Trying to minimize the CV..." - let mlen_fn = maximum . (map length) . snd . unzip - imlen = mlen_fn kti - nmlen = mlen_fn ktn + let imlen = Container.maxNameLen il + nmlen = Container.maxNameLen nl (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts) - ktn kti nmlen imlen [] oneline min_cv + nmlen imlen [] oneline min_cv let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl ord_plc = reverse fin_plc - sol_msg = if null fin_plc - then printf "No solution found\n" - else (if verbose > 2 - then printf "Final coefficients: overall %.8f, %s\n" - fin_cv (Cluster.printStats fin_nl) - else printf "Cluster score improved from %.8f to %.8f\n" - ini_cv fin_cv - ) + sol_msg = (if null fin_plc + then printf "No solution found\n" + else (if verbose > 2 + then printf "Final coefficients: overall %.8f, %s\n" + fin_cv (Cluster.printStats fin_nl) + else printf "Cluster score improved from %.8f to %.8f\n" + ini_cv fin_cv + ))::String unless oneline $ putStr sol_msg @@ -308,7 +307,7 @@ main = do (final_mem, final_disk) = Cluster.totalResources fin_nl putStrLn "" putStrLn "Final cluster status:" - putStrLn $ Cluster.printNodes ktn fin_nl + putStrLn $ Cluster.printNodes fin_nl when (verbose > 3) $ do printf "Original: mem=%d disk=%d\n" orig_mem orig_disk