Revision d41f6558
b/src/Ganeti/HTools/Program/Hbal.hs | ||
---|---|---|
99 | 99 |
arguments :: [ArgCompletion] |
100 | 100 |
arguments = [] |
101 | 101 |
|
102 |
-- | A simple type alias for clearer signature. |
|
103 |
type Annotator = OpCode -> MetaOpCode |
|
104 |
|
|
102 | 105 |
-- | Wraps an 'OpCode' in a 'MetaOpCode' while also adding a comment |
103 | 106 |
-- about what generated the opcode. |
104 |
annotateOpCode :: OpCode -> MetaOpCode
|
|
107 |
annotateOpCode :: Annotator
|
|
105 | 108 |
annotateOpCode = |
106 | 109 |
setOpComment ("rebalancing via hbal " ++ version) . wrapOpCode |
107 | 110 |
|
... | ... | |
175 | 178 |
printf "The commands have been written to file '%s'\n" out_path |
176 | 179 |
|
177 | 180 |
-- | Wrapper over execJobSet checking for early termination via an IORef. |
178 |
execCancelWrapper :: String -> Node.List |
|
181 |
execCancelWrapper :: Annotator -> String -> Node.List
|
|
179 | 182 |
-> Instance.List -> IORef Int -> [JobSet] -> IO (Result ()) |
180 |
execCancelWrapper _ _ _ _ [] = return $ Ok () |
|
181 |
execCancelWrapper master nl il cref alljss = do |
|
183 |
execCancelWrapper _ _ _ _ _ [] = return $ Ok ()
|
|
184 |
execCancelWrapper anno master nl il cref alljss = do
|
|
182 | 185 |
cancel <- readIORef cref |
183 | 186 |
if cancel > 0 |
184 | 187 |
then return . Bad $ "Exiting early due to user request, " ++ |
185 | 188 |
show (length alljss) ++ " jobset(s) remaining." |
186 |
else execJobSet master nl il cref alljss |
|
189 |
else execJobSet anno master nl il cref alljss
|
|
187 | 190 |
|
188 | 191 |
-- | Execute an entire jobset. |
189 |
execJobSet :: String -> Node.List |
|
192 |
execJobSet :: Annotator -> String -> Node.List
|
|
190 | 193 |
-> Instance.List -> IORef Int -> [JobSet] -> IO (Result ()) |
191 |
execJobSet _ _ _ _ [] = return $ Ok () |
|
192 |
execJobSet master nl il cref (js:jss) = do |
|
194 |
execJobSet _ _ _ _ _ [] = return $ Ok ()
|
|
195 |
execJobSet anno master nl il cref (js:jss) = do
|
|
193 | 196 |
-- map from jobset (htools list of positions) to [[opcodes]] |
194 | 197 |
let jobs = map (\(_, idx, move, _) -> |
195 |
map annotateOpCode $ |
|
196 |
Cluster.iMoveToJob nl il idx move) js |
|
198 |
map anno $ Cluster.iMoveToJob nl il idx move) js |
|
197 | 199 |
descr = map (\(_, idx, _, _) -> Container.nameOf il idx) js |
198 | 200 |
logfn = putStrLn . ("Got job IDs" ++) . commaJoin . map (show . fromJobId) |
199 | 201 |
putStrLn $ "Executing jobset for instances " ++ commaJoin descr |
... | ... | |
202 | 204 |
case jrs of |
203 | 205 |
Bad x -> return $ Bad x |
204 | 206 |
Ok x -> if null failures |
205 |
then execCancelWrapper master nl il cref jss |
|
207 |
then execCancelWrapper anno master nl il cref jss
|
|
206 | 208 |
else return . Bad . unlines $ [ |
207 | 209 |
"Not all jobs completed successfully: " ++ show failures, |
208 | 210 |
"Aborting."] |
... | ... | |
219 | 221 |
maybeExecJobs opts ord_plc fin_nl il cmd_jobs = |
220 | 222 |
if optExecJobs opts && not (null ord_plc) |
221 | 223 |
then (case optLuxi opts of |
222 |
Nothing -> return $ |
|
223 |
Bad "Execution of commands possible only on LUXI" |
|
224 |
Just master -> execWithCancel master fin_nl il cmd_jobs) |
|
224 |
Nothing -> |
|
225 |
return $ Bad "Execution of commands possible only on LUXI" |
|
226 |
Just master -> |
|
227 |
execWithCancel annotateOpCode master fin_nl il cmd_jobs) |
|
225 | 228 |
else return $ Ok () |
226 | 229 |
|
227 | 230 |
-- | Signal handler for graceful termination. |
... | ... | |
241 | 244 |
|
242 | 245 |
-- | Prepares to run a set of jobsets with handling of signals and early |
243 | 246 |
-- termination. |
244 |
execWithCancel :: String -> Node.List -> Instance.List -> [JobSet] |
|
247 |
execWithCancel :: Annotator -> String -> Node.List -> Instance.List -> [JobSet]
|
|
245 | 248 |
-> IO (Result ()) |
246 |
execWithCancel master fin_nl il cmd_jobs = do |
|
249 |
execWithCancel anno master fin_nl il cmd_jobs = do
|
|
247 | 250 |
cref <- newIORef 0 |
248 | 251 |
mapM_ (\(hnd, sig) -> installHandler sig (Catch (hnd cref)) Nothing) |
249 | 252 |
[(handleSigTerm, softwareTermination), (handleSigInt, keyboardSignal)] |
250 |
execCancelWrapper master fin_nl il cref cmd_jobs |
|
253 |
execCancelWrapper anno master fin_nl il cref cmd_jobs
|
|
251 | 254 |
|
252 | 255 |
-- | Select the target node group. |
253 | 256 |
selectGroup :: Options -> Group.List -> Node.List -> Instance.List |
Also available in: Unified diff