import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Cluster as Cluster
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Cluster as Cluster
-> [MoveJob] -- ^ Current command list
-> Bool -- ^ Whether to be silent
-> Score -- ^ Score at which to stop
-> [MoveJob] -- ^ Current command list
-> Bool -- ^ Whether to be silent
-> Score -- ^ Score at which to stop
-> IO (Cluster.Table, [MoveJob]) -- ^ The resulting table
-- and commands
iterateDepth ini_tbl max_rounds disk_moves nmlen imlen
-> IO (Cluster.Table, [MoveJob]) -- ^ The resulting table
-- and commands
iterateDepth ini_tbl max_rounds disk_moves nmlen imlen
- m_fin_tbl = Cluster.tryBalance ini_tbl max_rounds disk_moves min_score
+ allowed_next = Cluster.doNextBalance ini_tbl max_rounds min_score
+ m_fin_tbl = if allowed_next
+ then Cluster.tryBalance ini_tbl disk_moves evac_mode
+ else Nothing
Nothing -> return (ini_tbl, cmd_strs)
-- | Formats the solution for the oneline display
Nothing -> return (ini_tbl, cmd_strs)
-- | Formats the solution for the oneline display
-- | Polls a set of jobs at a fixed interval until all are finished
-- one way or another
waitForJobs :: L.Client -> [String] -> IO (Result [JobStatus])
-- | Polls a set of jobs at a fixed interval until all are finished
-- one way or another
waitForJobs :: L.Client -> [String] -> IO (Result [JobStatus])
-- map from jobset (htools list of positions) to [[opcodes]]
let jobs = map (\(_, idx, move, _) ->
-- map from jobset (htools list of positions) to [[opcodes]]
let jobs = map (\(_, idx, move, _) ->
let descr = map (\(_, idx, _, _) -> Container.nameOf il idx) js
putStrLn $ "Executing jobset for instances " ++ commaJoin descr
jrs <- bracket (L.getClient master) L.closeClient
(\client -> do
let descr = map (\(_, idx, _, _) -> Container.nameOf il idx) js
putStrLn $ "Executing jobset for instances " ++ commaJoin descr
jrs <- bracket (L.getClient master) L.closeClient
(\client -> do
hPutStrLn stderr $ "Cannot compute job status, aborting: " ++ show x
return ()
Ok x -> if checkJobsStatus x
hPutStrLn stderr $ "Cannot compute job status, aborting: " ++ show x
return ()
Ok x -> if checkJobsStatus x
- all_names = map Node.name all_nodes
- offline_wrong = filter (flip notElem all_names) offline_names
+ all_names = concatMap allNames all_nodes
+ offline_wrong = filter (`notElem` all_names) offline_names
when (Container.size il == 0) $ do
(if oneline then putStrLn $ formatOneline 0 0 0
else printf "Cluster is empty, exiting.\n")
when (Container.size il == 0) $ do
(if oneline then putStrLn $ formatOneline 0 0 0
else printf "Cluster is empty, exiting.\n")
- let imlen = Container.maxNameLen il
- nmlen = Container.maxNameLen nl
+ let imlen = maximum . map (length . Instance.alias) $ Container.elems il
+ nmlen = maximum . map (length . Node.alias) $ Container.elems nl
let (Cluster.Table fin_nl fin_il fin_cv fin_plc) = fin_tbl
ord_plc = reverse fin_plc
sol_msg = if null fin_plc
let (Cluster.Table fin_nl fin_il fin_cv fin_plc) = fin_tbl
ord_plc = reverse fin_plc
sol_msg = if null fin_plc