1 {-| Cluster rebalancer.
7 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
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.
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.
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
26 module Ganeti.HTools.Program.Hbal
33 import Control.Concurrent (threadDelay)
34 import Control.Exception (bracket)
37 import Data.Maybe (isJust, isNothing, fromJust)
41 import System.Posix.Process
42 import System.Posix.Signals
44 import Text.Printf (printf, hPrintf)
46 import qualified Ganeti.HTools.Container as Container
47 import qualified Ganeti.HTools.Cluster as Cluster
48 import qualified Ganeti.HTools.Group as Group
49 import qualified Ganeti.HTools.Node as Node
50 import qualified Ganeti.HTools.Instance as Instance
52 import Ganeti.BasicTypes
55 import Ganeti.HTools.CLI
56 import Ganeti.HTools.ExtLoader
57 import Ganeti.HTools.Types
58 import Ganeti.HTools.Loader
61 import qualified Ganeti.Luxi as L
64 -- | Options list and functions.
95 -- | The list of arguments supported by the program.
96 arguments :: [ArgCompletion]
99 {- | Start computing the solution at the given depth and recurse until
100 we find a valid solution or we exceed the maximum depth.
103 iterateDepth :: Bool -- ^ Whether to print moves
104 -> Cluster.Table -- ^ The starting table
105 -> Int -- ^ Remaining length
106 -> Bool -- ^ Allow disk moves
107 -> Bool -- ^ Allow instance moves
108 -> Int -- ^ Max node name len
109 -> Int -- ^ Max instance name len
110 -> [MoveJob] -- ^ Current command list
111 -> Score -- ^ Score at which to stop
112 -> Score -- ^ Min gain limit
113 -> Score -- ^ Min score gain
114 -> Bool -- ^ Enable evacuation mode
115 -> IO (Cluster.Table, [MoveJob]) -- ^ The resulting table
117 iterateDepth printmove ini_tbl max_rounds disk_moves inst_moves nmlen imlen
118 cmd_strs min_score mg_limit min_gain evac_mode =
119 let Cluster.Table ini_nl ini_il _ _ = ini_tbl
120 allowed_next = Cluster.doNextBalance ini_tbl max_rounds min_score
121 m_fin_tbl = if allowed_next
122 then Cluster.tryBalance ini_tbl disk_moves inst_moves
123 evac_mode mg_limit min_gain
128 let (Cluster.Table _ _ _ fin_plc) = fin_tbl
129 fin_plc_len = length fin_plc
130 cur_plc@(idx, _, _, move, _) = head fin_plc
131 (sol_line, cmds) = Cluster.printSolutionLine ini_nl ini_il
132 nmlen imlen cur_plc fin_plc_len
133 afn = Cluster.involvedNodes ini_il cur_plc
134 upd_cmd_strs = (afn, idx, move, cmds):cmd_strs
138 iterateDepth printmove fin_tbl max_rounds disk_moves inst_moves
139 nmlen imlen upd_cmd_strs min_score
140 mg_limit min_gain evac_mode
141 Nothing -> return (ini_tbl, cmd_strs)
143 -- | Displays the cluster stats.
144 printStats :: Node.List -> Node.List -> IO ()
145 printStats ini_nl fin_nl = do
146 let ini_cs = Cluster.totalResources ini_nl
147 fin_cs = Cluster.totalResources fin_nl
148 printf "Original: mem=%d disk=%d\n"
149 (Cluster.csFmem ini_cs) (Cluster.csFdsk ini_cs) :: IO ()
150 printf "Final: mem=%d disk=%d\n"
151 (Cluster.csFmem fin_cs) (Cluster.csFdsk fin_cs)
153 -- | Saves the rebalance commands to a text file.
154 saveBalanceCommands :: Options -> String -> IO ()
155 saveBalanceCommands opts cmd_data = do
156 let out_path = fromJust $ optShowCmds opts
159 then printf "Commands to run to reach the above solution:\n%s"
160 (unlines . map (" " ++) .
161 filter (/= " check") .
164 writeFile out_path (shTemplate ++ cmd_data)
165 printf "The commands have been written to file '%s'\n" out_path
167 -- | Polls a set of jobs at a fixed interval until all are finished
168 -- one way or another.
169 waitForJobs :: L.Client -> [L.JobId] -> IO (Result [JobStatus])
170 waitForJobs client jids = do
171 sts <- L.queryJobsStatus client jids
173 Bad e -> return . Bad $ "Checking job status: " ++ formatError e
174 Ok s -> if any (<= JOB_STATUS_RUNNING) s
176 -- TODO: replace hardcoded value with a better thing
177 threadDelay (1000000 * 15)
178 waitForJobs client jids
181 -- | Check that a set of job statuses is all success.
182 checkJobsStatus :: [JobStatus] -> Bool
183 checkJobsStatus = all (== JOB_STATUS_SUCCESS)
185 -- | Wrapper over execJobSet checking for early termination.
186 execWrapper :: String -> Node.List
187 -> Instance.List -> IORef Int -> [JobSet] -> IO Bool
188 execWrapper _ _ _ _ [] = return True
189 execWrapper master nl il cref alljss = do
190 cancel <- readIORef cref
193 hPrintf stderr "Exiting early due to user request, %d\
194 \ jobset(s) remaining." (length alljss)::IO ()
196 else execJobSet master nl il cref alljss
198 -- | Execute an entire jobset.
199 execJobSet :: String -> Node.List
200 -> Instance.List -> IORef Int -> [JobSet] -> IO Bool
201 execJobSet _ _ _ _ [] = return True
202 execJobSet master nl il cref (js:jss) = do
203 -- map from jobset (htools list of positions) to [[opcodes]]
204 let jobs = map (\(_, idx, move, _) ->
205 Cluster.iMoveToJob nl il idx move) js
206 let descr = map (\(_, idx, _, _) -> Container.nameOf il idx) js
207 putStrLn $ "Executing jobset for instances " ++ commaJoin descr
208 jrs <- bracket (L.getClient master) L.closeClient
210 jids <- L.submitManyJobs client jobs
212 Bad e -> return . Bad $ "Job submission error: " ++ formatError e
214 putStrLn $ "Got job IDs " ++ commaJoin (map show x)
221 Ok x -> if checkJobsStatus x
222 then execWrapper master nl il cref jss
224 hPutStrLn stderr $ "Not all jobs completed successfully: " ++
226 hPutStrLn stderr "Aborting."
229 -- | Executes the jobs, if possible and desired.
230 maybeExecJobs :: Options
236 maybeExecJobs opts ord_plc fin_nl il cmd_jobs =
237 if optExecJobs opts && not (null ord_plc)
238 then (case optLuxi opts of
240 hPutStrLn stderr "Execution of commands possible only on LUXI"
242 Just master -> runJobSet master fin_nl il cmd_jobs)
245 -- | Signal handler for graceful termination.
246 hangleSigInt :: IORef Int -> IO ()
247 hangleSigInt cref = do
249 putStrLn ("Cancel request registered, will exit at" ++
250 " the end of the current job set...")
252 -- | Signal handler for immediate termination.
253 hangleSigTerm :: IORef Int -> IO ()
254 hangleSigTerm cref = do
255 -- update the cref to 2, just for consistency
257 putStrLn "Double cancel request, exiting now..."
258 exitImmediately $ ExitFailure 2
260 -- | Runs a job set with handling of signals.
261 runJobSet :: String -> Node.List -> Instance.List -> [JobSet] -> IO Bool
262 runJobSet master fin_nl il cmd_jobs = do
264 mapM_ (\(hnd, sig) -> installHandler sig (Catch (hnd cref)) Nothing)
265 [(hangleSigTerm, softwareTermination), (hangleSigInt, keyboardSignal)]
266 execWrapper master fin_nl il cref cmd_jobs
268 -- | Select the target node group.
269 selectGroup :: Options -> Group.List -> Node.List -> Instance.List
270 -> IO (String, (Node.List, Instance.List))
271 selectGroup opts gl nlf ilf = do
272 let ngroups = Cluster.splitCluster nlf ilf
273 when (length ngroups > 1 && isNothing (optGroup opts)) $ do
274 hPutStrLn stderr "Found multiple node groups:"
275 mapM_ (hPutStrLn stderr . (" " ++) . Group.name .
276 flip Container.find gl . fst) ngroups
279 case optGroup opts of
281 let (gidx, cdata) = head ngroups
282 grp = Container.find gidx gl
283 return (Group.name grp, cdata)
284 Just g -> case Container.findByName gl g of
286 hPutStrLn stderr $ "Node group " ++ g ++
287 " not found. Node group list is:"
288 mapM_ (hPutStrLn stderr . (" " ++) . Group.name ) (Container.elems gl)
291 case lookup (Group.idx grp) ngroups of
293 -- This will only happen if there are no nodes assigned
295 return (Group.name grp, (Container.empty, Container.empty))
296 Just cdata -> return (Group.name grp, cdata)
298 -- | Do a few checks on the cluster data.
299 checkCluster :: Int -> Node.List -> Instance.List -> IO ()
300 checkCluster verbose nl il = do
301 -- nothing to do on an empty cluster
302 when (Container.null il) $ do
303 printf "Cluster is empty, exiting.\n"::IO ()
306 -- hbal doesn't currently handle split clusters
307 let split_insts = Cluster.findSplitInstances nl il
308 unless (null split_insts || verbose <= 1) $ do
309 hPutStrLn stderr "Found instances belonging to multiple node groups:"
310 mapM_ (\i -> hPutStrLn stderr $ " " ++ Instance.name i) split_insts
311 hPutStrLn stderr "These instances will not be moved."
313 printf "Loaded %d nodes, %d instances\n"
315 (Container.size il)::IO ()
317 let csf = commonSuffix nl il
318 when (not (null csf) && verbose > 1) $
319 printf "Note: Stripping common suffix of '%s' from names\n" csf
321 -- | Do a few checks on the selected group data.
322 checkGroup :: Int -> String -> Node.List -> Instance.List -> IO ()
323 checkGroup verbose gname nl il = do
324 printf "Group size %d nodes, %d instances\n"
326 (Container.size il)::IO ()
328 putStrLn $ "Selected node group: " ++ gname
330 let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
331 unless (verbose == 0) $ printf
332 "Initial check done: %d bad nodes, %d bad instances.\n"
333 (length bad_nodes) (length bad_instances)
335 unless (null bad_nodes) $
336 putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
337 \that the cluster will end N+1 happy."
339 -- | Check that we actually need to rebalance.
340 checkNeedRebalance :: Options -> Score -> IO ()
341 checkNeedRebalance opts ini_cv = do
342 let min_cv = optMinScore opts
343 when (ini_cv < min_cv) $ do
344 printf "Cluster is already well balanced (initial score %.6g,\n\
345 \minimum score %.6g).\nNothing to do, exiting\n"
346 ini_cv min_cv:: IO ()
350 main :: Options -> [String] -> IO ()
352 unless (null args) $ exitErr "This program doesn't take any arguments."
354 let verbose = optVerbose opts
355 shownodes = optShowNodes opts
356 showinsts = optShowInsts opts
358 ini_cdata@(ClusterData gl fixed_nl ilf ctags ipol) <- loadExternalData opts
360 when (verbose > 1) $ do
361 putStrLn $ "Loaded cluster tags: " ++ intercalate "," ctags
362 putStrLn $ "Loaded cluster ipolicy: " ++ show ipol
364 nlf <- setNodeStatus opts fixed_nl
365 checkCluster verbose nlf ilf
367 maybeSaveData (optSaveCluster opts) "original" "before balancing" ini_cdata
369 (gname, (nl, il)) <- selectGroup opts gl nlf ilf
371 checkGroup verbose gname nl il
373 maybePrintInsts showinsts "Initial" (Cluster.printInsts nl il)
375 maybePrintNodes shownodes "Initial cluster" (Cluster.printNodes nl)
377 let ini_cv = Cluster.compCV nl
378 ini_tbl = Cluster.Table nl il ini_cv []
379 min_cv = optMinScore opts
381 checkNeedRebalance opts ini_cv
384 then printf "Initial coefficients: overall %.8f\n%s"
385 ini_cv (Cluster.printStats " " nl)::IO ()
386 else printf "Initial score: %.8f\n" ini_cv
388 putStrLn "Trying to minimize the CV..."
389 let imlen = maximum . map (length . Instance.alias) $ Container.elems il
390 nmlen = maximum . map (length . Node.alias) $ Container.elems nl
392 (fin_tbl, cmd_strs) <- iterateDepth True ini_tbl (optMaxLength opts)
395 nmlen imlen [] min_cv
396 (optMinGainLim opts) (optMinGain opts)
398 let (Cluster.Table fin_nl fin_il fin_cv fin_plc) = fin_tbl
399 ord_plc = reverse fin_plc
401 _ | null fin_plc -> printf "No solution found\n"
403 printf "Final coefficients: overall %.8f\n%s"
404 fin_cv (Cluster.printStats " " fin_nl)
406 printf "Cluster score improved from %.8f to %.8f\n"
407 ini_cv fin_cv ::String
411 unless (verbose == 0) $
412 printf "Solution length=%d\n" (length ord_plc)
414 let cmd_jobs = Cluster.splitJobs cmd_strs
416 when (isJust $ optShowCmds opts) .
417 saveBalanceCommands opts $ Cluster.formatCmds cmd_jobs
419 maybeSaveData (optSaveCluster opts) "balanced" "after balancing"
420 ini_cdata { cdNodes = fin_nl, cdInstances = fin_il }
422 maybePrintInsts showinsts "Final" (Cluster.printInsts fin_nl fin_il)
424 maybePrintNodes shownodes "Final cluster" (Cluster.printNodes fin_nl)
426 when (verbose > 3) $ printStats nl fin_nl
428 eval <- maybeExecJobs opts ord_plc fin_nl il cmd_jobs
429 unless eval (exitWith (ExitFailure 1))