1 {-| Solver for N+1 cluster errors
5 module Main (main) where
9 import Data.Maybe (isJust, fromJust, fromMaybe)
13 import System.Console.GetOpt
14 import qualified System
16 import Text.Printf (printf)
18 import qualified Ganeti.HTools.Container as Container
19 import qualified Ganeti.HTools.Cluster as Cluster
20 import qualified Ganeti.HTools.Node as Node
21 import qualified Ganeti.HTools.CLI as CLI
22 import Ganeti.HTools.IAlloc
23 import Ganeti.HTools.Utils
24 import Ganeti.HTools.Types
26 -- | Command line options structure.
27 data Options = Options
28 { optShowNodes :: Bool -- ^ Whether to show node status
29 , optShowCmds :: Maybe FilePath -- ^ Whether to show the command list
30 , optOneline :: Bool -- ^ Switch output to a single line
31 , optNodef :: FilePath -- ^ Path to the nodes file
32 , optNodeSet :: Bool -- ^ The nodes have been set by options
33 , optInstf :: FilePath -- ^ Path to the instances file
34 , optInstSet :: Bool -- ^ The insts have been set by options
35 , optMaxLength :: Int -- ^ Stop after this many steps
36 , optMaster :: String -- ^ Collect data from RAPI
37 , optVerbose :: Int -- ^ Verbosity level
38 , optOffline :: [String] -- ^ Names of offline nodes
39 , optMinScore :: Cluster.Score -- ^ The minimum score we aim for
40 , optShowVer :: Bool -- ^ Just show the program version
41 , optShowHelp :: Bool -- ^ Just show the help
44 instance CLI.CLIOptions Options where
45 showVersion = optShowVer
46 showHelp = optShowHelp
48 -- | Default values for the command line options.
49 defaultOptions :: Options
50 defaultOptions = Options
51 { optShowNodes = False
52 , optShowCmds = Nothing
56 , optInstf = "instances"
67 -- | Options list and functions
68 options :: [OptDescr (Options -> Options)]
70 [ Option ['p'] ["print-nodes"]
71 (NoArg (\ opts -> opts { optShowNodes = True }))
72 "print the final node list"
73 , Option ['C'] ["print-commands"]
74 (OptArg ((\ f opts -> opts { optShowCmds = Just f }) . fromMaybe "-")
76 "print the ganeti command list for reaching the solution,\
77 \if an argument is passed then write the commands to a file named\
79 , Option ['o'] ["oneline"]
80 (NoArg (\ opts -> opts { optOneline = True }))
81 "print the ganeti command list for reaching the solution"
82 , Option ['n'] ["nodes"]
83 (ReqArg (\ f opts -> opts { optNodef = f, optNodeSet = True }) "FILE")
85 , Option ['i'] ["instances"]
86 (ReqArg (\ f opts -> opts { optInstf = f, optInstSet = True }) "FILE")
87 "the instance list FILE"
88 , Option ['m'] ["master"]
89 (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
90 "collect data via RAPI at the given ADDRESS"
91 , Option ['l'] ["max-length"]
92 (ReqArg (\ i opts -> opts { optMaxLength = (read i)::Int }) "N")
93 "cap the solution at this many moves (useful for very unbalanced \
95 , Option ['v'] ["verbose"]
96 (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 }))
97 "increase the verbosity level"
98 , Option ['q'] ["quiet"]
99 (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) - 1 }))
100 "decrease the verbosity level"
101 , Option ['O'] ["offline"]
102 (ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE")
103 " set node as offline"
104 , Option ['e'] ["min-score"]
105 (ReqArg (\ e opts -> opts { optMinScore = read e }) "EPSILON")
106 " mininum score to aim for"
107 , Option ['V'] ["version"]
108 (NoArg (\ opts -> opts { optShowVer = True}))
109 "show the version of the program"
110 , Option ['h'] ["help"]
111 (NoArg (\ opts -> opts { optShowHelp = True}))
115 {- | Start computing the solution at the given depth and recurse until
116 we find a valid solution or we exceed the maximum depth.
119 iterateDepth :: Cluster.Table -- ^ The starting table
120 -> Int -- ^ Remaining length
121 -> Cluster.NameList -- ^ Node idx to name list
122 -> Cluster.NameList -- ^ Inst idx to name list
123 -> Int -- ^ Max node name len
124 -> Int -- ^ Max instance name len
125 -> [[String]] -- ^ Current command list
126 -> Bool -- ^ Wheter to be silent
127 -> Cluster.Score -- ^ Score at which to stop
128 -> IO (Cluster.Table, [[String]]) -- ^ The resulting table and
130 iterateDepth ini_tbl max_rounds ktn kti nmlen imlen
131 cmd_strs oneline min_score =
132 let Cluster.Table ini_nl ini_il ini_cv ini_plc = ini_tbl
133 all_inst = Container.elems ini_il
134 node_idx = map Node.idx . filter (not . Node.offline) $
135 Container.elems ini_nl
136 fin_tbl = Cluster.checkMove node_idx ini_tbl all_inst
137 (Cluster.Table _ _ fin_cv fin_plc) = fin_tbl
138 ini_plc_len = length ini_plc
139 fin_plc_len = length fin_plc
140 allowed_next = (max_rounds < 0 || length fin_plc < max_rounds)
144 (sol_line, cmds) = Cluster.printSolutionLine ini_il ktn
145 nmlen imlen (head fin_plc) fin_plc_len
146 upd_cmd_strs = cmds:cmd_strs
147 unless (oneline || fin_plc_len == ini_plc_len) $ do
150 (if fin_cv < ini_cv then -- this round made success, try deeper
151 if allowed_next && fin_cv > min_score
152 then iterateDepth fin_tbl max_rounds ktn kti
153 nmlen imlen upd_cmd_strs oneline min_score
154 -- don't go deeper, but return the better solution
155 else return (fin_tbl, upd_cmd_strs)
157 return (ini_tbl, cmd_strs))
159 -- | Formats the solution for the oneline display
160 formatOneline :: Double -> Int -> Double -> String
161 formatOneline ini_cv plc_len fin_cv =
162 printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv
163 (if fin_cv == 0 then 1 else (ini_cv / fin_cv))
168 cmd_args <- System.getArgs
169 (opts, args) <- CLI.parseOpts cmd_args "hail" options
172 when (null args) $ do
173 hPutStrLn stderr "Error: this program needs an input file."
174 exitWith $ ExitFailure 1
176 let input_file = head args
177 input_data <- readFile input_file
179 request <- case (parseData input_data) of
181 putStrLn $ "Error: " ++ err
182 exitWith $ ExitFailure 1
185 putStrLn $ show request
188 (loaded_nl, il, csf, ktn, kti) <- liftM2 Cluster.loadData node_data inst_data
189 let (fix_msgs, fixed_nl) = Cluster.checkData loaded_nl il ktn kti
191 unless (null fix_msgs || verbose == 0) $ do
192 putStrLn "Warning: cluster has inconsistent data:"
193 putStrLn . unlines . map (\s -> printf " - %s" s) $ fix_msgs
195 let offline_names = optOffline opts
196 all_names = snd . unzip $ ktn
197 offline_wrong = filter (\n -> not $ elem n all_names) offline_names
198 offline_indices = fst . unzip .
199 filter (\(_, n) -> elem n offline_names) $ ktn
201 when (length offline_wrong > 0) $ do
202 printf "Wrong node name(s) set as offline: %s\n"
203 (commaJoin offline_wrong)
204 exitWith $ ExitFailure 1
206 let nl = Container.map (\n -> if elem (Node.idx n) offline_indices
207 then Node.setOffline n True
210 when (Container.size il == 0) $ do
212 putStrLn $ formatOneline 0 0 0
214 printf "Cluster is empty, exiting.\n")
218 unless oneline $ printf "Loaded %d nodes, %d instances\n"
222 when (length csf > 0 && not oneline && verbose > 1) $ do
223 printf "Note: Stripping common suffix of '%s' from names\n" csf
225 let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
226 unless (oneline || verbose == 0) $ printf
227 "Initial check done: %d bad nodes, %d bad instances.\n"
228 (length bad_nodes) (length bad_instances)
230 when (length bad_nodes > 0) $ do
231 putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
232 \that the cluster will end N+1 happy."
234 when (optShowNodes opts) $
236 putStrLn "Initial cluster status:"
237 putStrLn $ Cluster.printNodes ktn nl
239 let ini_cv = Cluster.compCV nl
240 ini_tbl = Cluster.Table nl il ini_cv []
241 min_cv = optMinScore opts
243 when (ini_cv < min_cv) $ do
245 putStrLn $ formatOneline ini_cv 0 ini_cv
246 else printf "Cluster is already well balanced (initial score %.6g,\n\
247 \minimum score %.6g).\nNothing to do, exiting\n"
251 unless oneline (if verbose > 2 then
252 printf "Initial coefficients: overall %.8f, %s\n"
253 ini_cv (Cluster.printStats nl)
255 printf "Initial score: %.8f\n" ini_cv)
257 unless oneline $ putStrLn "Trying to minimize the CV..."
258 let mlen_fn = maximum . (map length) . snd . unzip
262 (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
263 ktn kti nmlen imlen [] oneline min_cv
264 let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl
265 ord_plc = reverse fin_plc
266 sol_msg = if null fin_plc
267 then printf "No solution found\n"
269 then printf "Final coefficients: overall %.8f, %s\n"
270 fin_cv (Cluster.printStats fin_nl)
271 else printf "Cluster score improved from %.8f to %.8f\n"
275 unless oneline $ putStr sol_msg
277 unless (oneline || verbose == 0) $
278 printf "Solution length=%d\n" (length ord_plc)
280 let cmd_data = Cluster.formatCmds . reverse $ cmd_strs
282 when (isJust $ optShowCmds opts) $
284 let out_path = fromJust $ optShowCmds opts
286 (if out_path == "-" then
287 printf "Commands to run to reach the above solution:\n%s"
288 (unlines . map (" " ++) .
289 filter (/= "check") .
292 writeFile out_path (CLI.shTemplate ++ cmd_data)
293 printf "The commands have been written to file '%s'\n" out_path)
295 when (optShowNodes opts) $
297 let (orig_mem, orig_disk) = Cluster.totalResources nl
298 (final_mem, final_disk) = Cluster.totalResources fin_nl
300 putStrLn "Final cluster status:"
301 putStrLn $ Cluster.printNodes ktn fin_nl
304 printf "Original: mem=%d disk=%d\n" orig_mem orig_disk
305 printf "Final: mem=%d disk=%d\n" final_mem final_disk
307 putStrLn $ formatOneline ini_cv (length ord_plc) fin_cv