+ (if fin_cv == 0 then 1 else ini_cv / fin_cv)
+
+-- | Polls a set of jobs at a fixed interval until all are finished
+-- one way or another
+waitForJobs :: L.Client -> [String] -> IO (Result [JobStatus])
+waitForJobs client jids = do
+ sts <- L.queryJobsStatus client jids
+ case sts of
+ Bad x -> return $ Bad x
+ Ok s -> if any (<= JOB_STATUS_RUNNING) s
+ then do
+ -- TODO: replace hardcoded value with a better thing
+ threadDelay (1000000 * 15)
+ waitForJobs client jids
+ else return $ Ok s
+
+-- | Check that a set of job statuses is all success
+checkJobsStatus :: [JobStatus] -> Bool
+checkJobsStatus = all (== JOB_STATUS_SUCCESS)
+
+-- | Execute an entire jobset
+execJobSet :: String -> Node.List
+ -> Instance.List -> IORef Int -> [JobSet] -> IO ()
+execJobSet _ _ _ _ [] = return ()
+execJobSet master nl il cref alljss@(js:jss) = do
+ -- map from jobset (htools list of positions) to [[opcodes]]
+ cancel <- readIORef cref
+ when (cancel > 0) $ do
+ putStrLn ("Exiting early due to user request, " ++ show (length alljss) ++
+ " jobset(s) remaining.")
+ exitWith $ ExitFailure 1
+
+ let jobs = map (\(_, idx, move, _) ->
+ Cluster.iMoveToJob nl il idx move) js
+ 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
+ jids <- L.submitManyJobs client jobs
+ case jids of
+ Bad x -> return $ Bad x
+ Ok x -> do
+ putStrLn $ "Got job IDs " ++ commaJoin x
+ waitForJobs client x
+ )
+ (case jrs of
+ Bad x -> do
+ hPutStrLn stderr $ "Cannot compute job status, aborting: " ++ show x
+ return ()
+ Ok x -> if checkJobsStatus x
+ then execJobSet master nl il cref jss
+ else do
+ hPutStrLn stderr $ "Not all jobs completed successfully: " ++
+ show x
+ hPutStrLn stderr "Aborting.")
+
+-- | Signal handler for graceful termination
+hangleSigInt :: IORef Int -> IO ()
+hangleSigInt cref = do
+ writeIORef cref 1
+ putStrLn ("Cancel request registered, will exit at" ++
+ " the end of the current job set...")
+
+-- | Signal handler for immediate termination
+hangleSigTerm :: IORef Int -> IO ()
+hangleSigTerm cref = do
+ -- update the cref to 2, just for consistency
+ writeIORef cref 2
+ putStrLn "Double cancel request, exiting now..."
+ exitImmediately $ ExitFailure 2
+
+runJobSet :: String -> Node.List -> Instance.List -> [JobSet] -> IO ()
+runJobSet master fin_nl il cmd_jobs = do
+ cref <- newIORef 0
+ mapM_ (\(hnd, sig) -> installHandler sig (Catch (hnd cref)) Nothing)
+ [(hangleSigTerm, softwareTermination), (hangleSigInt, keyboardSignal)]
+ execJobSet master fin_nl il cref cmd_jobs