This was a pre-withCreateProcess attempt at doing the same thing, so can
just call boolSystem now that it uses withCreateProcess.

There's a slight behavior change, since it used to wait, after an async
exception, for the command to finish, before re-throwing the exception.
Now, it rethrows the exception right away. I don't think that impact any
of the users of this.
This commit is contained in:
Joey Hess 2020-06-03 12:59:09 -04:00
parent e1fc4f7594
commit 53263efe4b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

View file

@ -1,6 +1,6 @@
{- Running a long or expensive batch operation niced.
-
- Copyright 2013 Joey Hess <id@joeyh.name>
- Copyright 2013-2020 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
@ -22,7 +22,6 @@ import Common
import Control.Concurrent.Async
import System.Posix.Process
#endif
import qualified Control.Exception as E
{- Runs an operation, at batch priority.
-
@ -75,11 +74,7 @@ toBatchCommand v = do
return $ batchmaker v
{- Runs a command in a way that's suitable for batch jobs that can be
- interrupted.
-
- 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. -}
- interrupted. -}
batchCommand :: String -> [CommandParam] -> IO Bool
batchCommand command params = batchCommandEnv command params Nothing
@ -87,13 +82,4 @@ batchCommandEnv :: String -> [CommandParam] -> Maybe [(String, String)] -> IO Bo
batchCommandEnv command params environ = do
batchmaker <- getBatchCommandMaker
let (command', params') = batchmaker (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
Right ExitSuccess -> return True
Right _ -> return False
Left asyncexception -> do
terminateProcess pid
void $ waitForProcess pid
E.throwIO asyncexception
boolSystemEnv command' params' environ