assistant: Batch jobs are now run with ionice and nocache, when those commands are available.
This commit is contained in:
parent
3c6be8cd6e
commit
4882a611e5
6 changed files with 42 additions and 31 deletions
|
@ -10,9 +10,6 @@
|
|||
module Utility.Batch where
|
||||
|
||||
import Common
|
||||
#ifndef mingw32_HOST_OS
|
||||
import qualified Build.SysConfig
|
||||
#endif
|
||||
|
||||
#if defined(linux_HOST_OS) || defined(__ANDROID__)
|
||||
import Control.Concurrent.Async
|
||||
|
@ -46,36 +43,43 @@ batch a = a
|
|||
maxNice :: Int
|
||||
maxNice = 19
|
||||
|
||||
{- Converts a command to run niced. -}
|
||||
toBatchCommand :: (String, [CommandParam]) -> (String, [CommandParam])
|
||||
toBatchCommand (command, params) = (command', params')
|
||||
where
|
||||
{- Makes a command be run by whichever of nice, ionice, and nocache
|
||||
- are available in the path. -}
|
||||
toBatchCommand :: (String, [CommandParam]) -> IO (String, [CommandParam])
|
||||
toBatchCommand (command, params) = do
|
||||
#ifndef mingw32_HOST_OS
|
||||
commandline = unwords $ map shellEscape $ command : toCommand params
|
||||
nicedcommand
|
||||
| Build.SysConfig.nice = "nice " ++ commandline
|
||||
| otherwise = commandline
|
||||
command' = "sh"
|
||||
params' =
|
||||
nicers <- filterM (inPath . fst)
|
||||
[ ("nice", [])
|
||||
, ("ionice", ["-c3"])
|
||||
, ("nocache", [])
|
||||
]
|
||||
let command' = "sh"
|
||||
let params' =
|
||||
[ Param "-c"
|
||||
, Param $ "exec " ++ nicedcommand
|
||||
, Param $ unwords $
|
||||
"exec"
|
||||
: concatMap (\p -> fst p : snd p) nicers
|
||||
++ map shellEscape (command : toCommand params)
|
||||
]
|
||||
#else
|
||||
command' = command
|
||||
params' = params
|
||||
let command' = command
|
||||
let params' = params
|
||||
#endif
|
||||
return (command', params')
|
||||
|
||||
{- Runs a command in a way that's suitable for batch jobs that can be
|
||||
- interrupted.
|
||||
-
|
||||
- The command is run niced. If the calling thread receives an async
|
||||
- exception, it sends the command a SIGTERM, and after the command
|
||||
- finishes shuttting down, it re-raises the async exception. -}
|
||||
- If the calling thread receives an async exception, it sends the
|
||||
- command a SIGTERM, and after the command finishes shuttting down,
|
||||
- it re-raises the async exception. -}
|
||||
batchCommand :: String -> [CommandParam] -> IO Bool
|
||||
batchCommand command params = batchCommandEnv command params Nothing
|
||||
|
||||
batchCommandEnv :: String -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
|
||||
batchCommandEnv command params environ = do
|
||||
(command', params') <- toBatchCommand (command, params)
|
||||
let p = proc command' $ toCommand params'
|
||||
(_, _, _, pid) <- createProcess $ p { env = environ }
|
||||
r <- E.try (waitForProcess pid) :: IO (Either E.SomeException ExitCode)
|
||||
case r of
|
||||
|
@ -85,7 +89,3 @@ batchCommandEnv command params environ = do
|
|||
terminateProcess pid
|
||||
void $ waitForProcess pid
|
||||
E.throwIO asyncexception
|
||||
where
|
||||
(command', params') = toBatchCommand (command, params)
|
||||
p = proc command' $ toCommand params'
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue