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
32 import Control.Concurrent (threadDelay)
33 import Control.Exception (bracket)
36 import Data.Maybe (isJust, isNothing, fromJust)
40 import System.Posix.Process
41 import System.Posix.Signals
43 import Text.Printf (printf, hPrintf)
45 import qualified Ganeti.HTools.Container as Container
46 import qualified Ganeti.HTools.Cluster as Cluster
47 import qualified Ganeti.HTools.Group as Group
48 import qualified Ganeti.HTools.Node as Node
49 import qualified Ganeti.HTools.Instance as Instance
51 import Ganeti.HTools.CLI
52 import Ganeti.HTools.ExtLoader
53 import Ganeti.HTools.Utils
54 import Ganeti.HTools.Types
55 import Ganeti.HTools.Loader
57 import qualified Ganeti.Luxi as L
60 -- | Options list and functions.
93 {- | Start computing the solution at the given depth and recurse until
94 we find a valid solution or we exceed the maximum depth.
97 iterateDepth :: Bool -- ^ Whether to print moves
98 -> Cluster.Table -- ^ The starting table
99 -> Int -- ^ Remaining length
100 -> Bool -- ^ Allow disk moves
101 -> Bool -- ^ Allow instance moves
102 -> Int -- ^ Max node name len
103 -> Int -- ^ Max instance name len
104 -> [MoveJob] -- ^ Current command list
105 -> Score -- ^ Score at which to stop
106 -> Score -- ^ Min gain limit
107 -> Score -- ^ Min score gain
108 -> Bool -- ^ Enable evacuation mode
109 -> IO (Cluster.Table, [MoveJob]) -- ^ The resulting table
111 iterateDepth printmove ini_tbl max_rounds disk_moves inst_moves nmlen imlen
112 cmd_strs min_score mg_limit min_gain evac_mode =
113 let Cluster.Table ini_nl ini_il _ _ = ini_tbl
114 allowed_next = Cluster.doNextBalance ini_tbl max_rounds min_score
115 m_fin_tbl = if allowed_next
116 then Cluster.tryBalance ini_tbl disk_moves inst_moves
117 evac_mode mg_limit min_gain
122 let (Cluster.Table _ _ _ fin_plc) = fin_tbl
123 fin_plc_len = length fin_plc
124 cur_plc@(idx, _, _, move, _) = head fin_plc
125 (sol_line, cmds) = Cluster.printSolutionLine ini_nl ini_il
126 nmlen imlen cur_plc fin_plc_len
127 afn = Cluster.involvedNodes ini_il cur_plc
128 upd_cmd_strs = (afn, idx, move, cmds):cmd_strs
132 iterateDepth printmove fin_tbl max_rounds disk_moves inst_moves
133 nmlen imlen upd_cmd_strs min_score
134 mg_limit min_gain evac_mode
135 Nothing -> return (ini_tbl, cmd_strs)
137 -- | Displays the cluster stats.
138 printStats :: Node.List -> Node.List -> IO ()
139 printStats ini_nl fin_nl = do
140 let ini_cs = Cluster.totalResources ini_nl
141 fin_cs = Cluster.totalResources fin_nl
142 printf "Original: mem=%d disk=%d\n"
143 (Cluster.csFmem ini_cs) (Cluster.csFdsk ini_cs) :: IO ()
144 printf "Final: mem=%d disk=%d\n"
145 (Cluster.csFmem fin_cs) (Cluster.csFdsk fin_cs)
147 -- | Saves the rebalance commands to a text file.
148 saveBalanceCommands :: Options -> String -> IO ()
149 saveBalanceCommands opts cmd_data = do
150 let out_path = fromJust $ optShowCmds opts
153 then printf "Commands to run to reach the above solution:\n%s"
154 (unlines . map (" " ++) .
155 filter (/= " check") .
158 writeFile out_path (shTemplate ++ cmd_data)
159 printf "The commands have been written to file '%s'\n" out_path
161 -- | Polls a set of jobs at a fixed interval until all are finished
162 -- one way or another.
163 waitForJobs :: L.Client -> [String] -> IO (Result [JobStatus])
164 waitForJobs client jids = do
165 sts <- L.queryJobsStatus client jids
167 Bad x -> return $ Bad x
168 Ok s -> if any (<= JOB_STATUS_RUNNING) s
170 -- TODO: replace hardcoded value with a better thing
171 threadDelay (1000000 * 15)
172 waitForJobs client jids
175 -- | Check that a set of job statuses is all success.
176 checkJobsStatus :: [JobStatus] -> Bool
177 checkJobsStatus = all (== JOB_STATUS_SUCCESS)
179 -- | Wrapper over execJobSet checking for early termination.
180 execWrapper :: String -> Node.List
181 -> Instance.List -> IORef Int -> [JobSet] -> IO Bool
182 execWrapper _ _ _ _ [] = return True
183 execWrapper master nl il cref alljss = do
184 cancel <- readIORef cref
187 hPrintf stderr "Exiting early due to user request, %d\
188 \ jobset(s) remaining." (length alljss)::IO ()
190 else execJobSet master nl il cref alljss
192 -- | Execute an entire jobset.
193 execJobSet :: String -> Node.List
194 -> Instance.List -> IORef Int -> [JobSet] -> IO Bool
195 execJobSet _ _ _ _ [] = return True
196 execJobSet master nl il cref (js:jss) = do
197 -- map from jobset (htools list of positions) to [[opcodes]]
198 let jobs = map (\(_, idx, move, _) ->
199 Cluster.iMoveToJob nl il idx move) js
200 let descr = map (\(_, idx, _, _) -> Container.nameOf il idx) js
201 putStrLn $ "Executing jobset for instances " ++ commaJoin descr
202 jrs <- bracket (L.getClient master) L.closeClient
204 jids <- L.submitManyJobs client jobs
206 Bad x -> return $ Bad x
208 putStrLn $ "Got job IDs " ++ commaJoin x
213 hPutStrLn stderr $ "Cannot compute job status, aborting: " ++ show x
215 Ok x -> if checkJobsStatus x
216 then execWrapper master nl il cref jss
218 hPutStrLn stderr $ "Not all jobs completed successfully: " ++
220 hPutStrLn stderr "Aborting."
223 -- | Executes the jobs, if possible and desired.
224 maybeExecJobs :: Options
230 maybeExecJobs opts ord_plc fin_nl il cmd_jobs =
231 if optExecJobs opts && not (null ord_plc)
232 then (case optLuxi opts of
234 hPutStrLn stderr "Execution of commands possible only on LUXI"
236 Just master -> runJobSet master fin_nl il cmd_jobs)
239 -- | Signal handler for graceful termination.
240 hangleSigInt :: IORef Int -> IO ()
241 hangleSigInt cref = do
243 putStrLn ("Cancel request registered, will exit at" ++
244 " the end of the current job set...")
246 -- | Signal handler for immediate termination.
247 hangleSigTerm :: IORef Int -> IO ()
248 hangleSigTerm cref = do
249 -- update the cref to 2, just for consistency
251 putStrLn "Double cancel request, exiting now..."
252 exitImmediately $ ExitFailure 2
254 -- | Runs a job set with handling of signals.
255 runJobSet :: String -> Node.List -> Instance.List -> [JobSet] -> IO Bool
256 runJobSet master fin_nl il cmd_jobs = do
258 mapM_ (\(hnd, sig) -> installHandler sig (Catch (hnd cref)) Nothing)
259 [(hangleSigTerm, softwareTermination), (hangleSigInt, keyboardSignal)]
260 execWrapper master fin_nl il cref cmd_jobs
262 -- | Select the target node group.
263 selectGroup :: Options -> Group.List -> Node.List -> Instance.List
264 -> IO (String, (Node.List, Instance.List))
265 selectGroup opts gl nlf ilf = do
266 let ngroups = Cluster.splitCluster nlf ilf
267 when (length ngroups > 1 && isNothing (optGroup opts)) $ do
268 hPutStrLn stderr "Found multiple node groups:"
269 mapM_ (hPutStrLn stderr . (" " ++) . Group.name .
270 flip Container.find gl . fst) ngroups
271 hPutStrLn stderr "Aborting."
272 exitWith $ ExitFailure 1
274 case optGroup opts of
276 let (gidx, cdata) = head ngroups
277 grp = Container.find gidx gl
278 return (Group.name grp, cdata)
279 Just g -> case Container.findByName gl g of
281 hPutStrLn stderr $ "Node group " ++ g ++
282 " not found. Node group list is:"
283 mapM_ (hPutStrLn stderr . (" " ++) . Group.name ) (Container.elems gl)
284 hPutStrLn stderr "Aborting."
285 exitWith $ ExitFailure 1
287 case lookup (Group.idx grp) ngroups of
289 -- This will only happen if there are no nodes assigned
291 return (Group.name grp, (Container.empty, Container.empty))
292 Just cdata -> return (Group.name grp, cdata)
294 -- | Do a few checks on the cluster data.
295 checkCluster :: Int -> Node.List -> Instance.List -> IO ()
296 checkCluster verbose nl il = do
297 -- nothing to do on an empty cluster
298 when (Container.null il) $ do
299 printf "Cluster is empty, exiting.\n"::IO ()
302 -- hbal doesn't currently handle split clusters
303 let split_insts = Cluster.findSplitInstances nl il
304 unless (null split_insts || verbose <= 1) $ do
305 hPutStrLn stderr "Found instances belonging to multiple node groups:"
306 mapM_ (\i -> hPutStrLn stderr $ " " ++ Instance.name i) split_insts
307 hPutStrLn stderr "These instances will not be moved."
309 printf "Loaded %d nodes, %d instances\n"
311 (Container.size il)::IO ()
313 let csf = commonSuffix nl il
314 when (not (null csf) && verbose > 1) $
315 printf "Note: Stripping common suffix of '%s' from names\n" csf
317 -- | Do a few checks on the selected group data.
318 checkGroup :: Int -> String -> Node.List -> Instance.List -> IO ()
319 checkGroup verbose gname nl il = do
320 printf "Group size %d nodes, %d instances\n"
322 (Container.size il)::IO ()
324 putStrLn $ "Selected node group: " ++ gname
326 let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
327 unless (verbose == 0) $ printf
328 "Initial check done: %d bad nodes, %d bad instances.\n"
329 (length bad_nodes) (length bad_instances)
331 when (not (null bad_nodes)) $
332 putStrLn "Cluster is not N+1 happy, continuing but no guarantee \
333 \that the cluster will end N+1 happy."
335 -- | Check that we actually need to rebalance.
336 checkNeedRebalance :: Options -> Score -> IO ()
337 checkNeedRebalance opts ini_cv = do
338 let min_cv = optMinScore opts
339 when (ini_cv < min_cv) $ do
340 printf "Cluster is already well balanced (initial score %.6g,\n\
341 \minimum score %.6g).\nNothing to do, exiting\n"
342 ini_cv min_cv:: IO ()
346 main :: Options -> [String] -> IO ()
348 unless (null args) $ do
349 hPutStrLn stderr "Error: this program doesn't take any arguments."
350 exitWith $ ExitFailure 1
352 let verbose = optVerbose opts
353 shownodes = optShowNodes opts
354 showinsts = optShowInsts opts
356 ini_cdata@(ClusterData gl fixed_nl ilf ctags ipol) <- loadExternalData opts
358 when (verbose > 1) $ do
359 putStrLn $ "Loaded cluster tags: " ++ intercalate "," ctags
360 putStrLn $ "Loaded cluster ipolicy: " ++ show ipol
362 nlf <- setNodeStatus opts fixed_nl
363 checkCluster verbose nlf ilf
365 maybeSaveData (optSaveCluster opts) "original" "before balancing" ini_cdata
367 (gname, (nl, il)) <- selectGroup opts gl nlf ilf
369 checkGroup verbose gname nl il
371 maybePrintInsts showinsts "Initial" (Cluster.printInsts nl il)
373 maybePrintNodes shownodes "Initial cluster" (Cluster.printNodes nl)
375 let ini_cv = Cluster.compCV nl
376 ini_tbl = Cluster.Table nl il ini_cv []
377 min_cv = optMinScore opts
379 checkNeedRebalance opts ini_cv
382 then printf "Initial coefficients: overall %.8f\n%s"
383 ini_cv (Cluster.printStats " " nl)::IO ()
384 else printf "Initial score: %.8f\n" ini_cv
386 putStrLn "Trying to minimize the CV..."
387 let imlen = maximum . map (length . Instance.alias) $ Container.elems il
388 nmlen = maximum . map (length . Node.alias) $ Container.elems nl
390 (fin_tbl, cmd_strs) <- iterateDepth True ini_tbl (optMaxLength opts)
393 nmlen imlen [] min_cv
394 (optMinGainLim opts) (optMinGain opts)
396 let (Cluster.Table fin_nl fin_il fin_cv fin_plc) = fin_tbl
397 ord_plc = reverse fin_plc
399 _ | null fin_plc -> printf "No solution found\n"
401 printf "Final coefficients: overall %.8f\n%s"
402 fin_cv (Cluster.printStats " " fin_nl)
404 printf "Cluster score improved from %.8f to %.8f\n"
405 ini_cv fin_cv ::String
409 unless (verbose == 0) $
410 printf "Solution length=%d\n" (length ord_plc)
412 let cmd_jobs = Cluster.splitJobs cmd_strs
414 when (isJust $ optShowCmds opts) $
415 saveBalanceCommands opts $ Cluster.formatCmds cmd_jobs
417 maybeSaveData (optSaveCluster opts) "balanced" "after balancing"
418 ini_cdata { cdNodes = fin_nl, cdInstances = fin_il }
420 maybePrintInsts showinsts "Final" (Cluster.printInsts fin_nl fin_il)
422 maybePrintNodes shownodes "Final cluster" (Cluster.printNodes fin_nl)
424 when (verbose > 3) $ printStats nl fin_nl
426 eval <- maybeExecJobs opts ord_plc fin_nl il cmd_jobs
427 unless eval (exitWith (ExitFailure 1))