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