Skip to content
Snippets Groups Projects
Commit 42afc235 authored by Dato Simó's avatar Dato Simó
Browse files

Hbal.hs: use Result (), not Bool, as return value for exec*


Previously, functions in Hbal.hs related to execution of jobsets were
returning only IO Bool, and printing any errors they found directly to
stderr on their own.

I'm going to be moving some of these functions to a library module in
future commits, and it makes sense that they won't print to stderr, but
rather return an error condition. To make diffs more readable, I change the
return value in Hbal.hs itself, so that the next commit deals only with the
move. It's now `main` that prints any Bad result to stderr.

Signed-off-by: default avatarDato Simó <dato@google.com>
Reviewed-by: default avatarIustin Pop <iustin@google.com>
parent 3b23f238
No related branches found
No related tags found
No related merge requests found
......@@ -41,7 +41,7 @@ import System.IO
import System.Posix.Process
import System.Posix.Signals
import Text.Printf (printf, hPrintf)
import Text.Printf (printf)
import qualified Ganeti.HTools.Container as Container
import qualified Ganeti.HTools.Cluster as Cluster
......@@ -194,21 +194,19 @@ checkJobsStatus = all (== JOB_STATUS_SUCCESS)
-- | Wrapper over execJobSet checking for early termination via an IORef.
execCancelWrapper :: String -> Node.List
-> Instance.List -> IORef Int -> [JobSet] -> IO Bool
execCancelWrapper _ _ _ _ [] = return True
-> Instance.List -> IORef Int -> [JobSet] -> IO (Result ())
execCancelWrapper _ _ _ _ [] = return $ Ok ()
execCancelWrapper master nl il cref alljss = do
cancel <- readIORef cref
if cancel > 0
then do
hPrintf stderr "Exiting early due to user request, %d\
\ jobset(s) remaining." (length alljss)::IO ()
return True
then return . Bad $ "Exiting early due to user request, " ++
show (length alljss) ++ " jobset(s) remaining."
else execJobSet master nl il cref alljss
-- | Execute an entire jobset.
execJobSet :: String -> Node.List
-> Instance.List -> IORef Int -> [JobSet] -> IO Bool
execJobSet _ _ _ _ [] = return True
-> Instance.List -> IORef Int -> [JobSet] -> IO (Result ())
execJobSet _ _ _ _ [] = return $ Ok ()
execJobSet master nl il cref (js:jss) = do
-- map from jobset (htools list of positions) to [[opcodes]]
let jobs = map (\(_, idx, move, _) ->
......@@ -227,16 +225,12 @@ execJobSet master nl il cref (js:jss) = do
waitForJobs client x
)
case jrs of
Bad x -> do
hPutStrLn stderr x
return False
Bad x -> return $ Bad x
Ok x -> if checkJobsStatus x
then execCancelWrapper master nl il cref jss
else do
hPutStrLn stderr $ "Not all jobs completed successfully: " ++
show x
hPutStrLn stderr "Aborting."
return False
else return . Bad . unlines $ [
"Not all jobs completed successfully: " ++ show x,
"Aborting."]
-- | Executes the jobs, if possible and desired.
maybeExecJobs :: Options
......@@ -244,15 +238,14 @@ maybeExecJobs :: Options
-> Node.List
-> Instance.List
-> [JobSet]
-> IO Bool
-> IO (Result ())
maybeExecJobs opts ord_plc fin_nl il cmd_jobs =
if optExecJobs opts && not (null ord_plc)
then (case optLuxi opts of
Nothing -> do
hPutStrLn stderr "Execution of commands possible only on LUXI"
return False
Nothing -> return $
Bad "Execution of commands possible only on LUXI"
Just master -> execWithCancel master fin_nl il cmd_jobs)
else return True
else return $ Ok ()
-- | Signal handler for graceful termination.
handleSigInt :: IORef Int -> IO ()
......@@ -271,7 +264,8 @@ handleSigTerm cref = do
-- | Prepares to run a set of jobsets with handling of signals and early
-- termination.
execWithCancel :: String -> Node.List -> Instance.List -> [JobSet] -> IO Bool
execWithCancel :: String -> Node.List -> Instance.List -> [JobSet]
-> IO (Result ())
execWithCancel master fin_nl il cmd_jobs = do
cref <- newIORef 0
mapM_ (\(hnd, sig) -> installHandler sig (Catch (hnd cref)) Nothing)
......@@ -438,5 +432,4 @@ main opts args = do
when (verbose > 3) $ printStats nl fin_nl
eval <- maybeExecJobs opts ord_plc fin_nl il cmd_jobs
unless eval (exitWith (ExitFailure 1))
exitIfBad "hbal" =<< maybeExecJobs opts ord_plc fin_nl il cmd_jobs
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment