From 53263efe4b8b8ac95cf1fdaa43c0db16760e232b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 3 Jun 2020 12:59:09 -0400 Subject: [PATCH] simplify 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. --- Utility/Batch.hs | 20 +++----------------- 1 file changed, 3 insertions(+), 17 deletions(-) diff --git a/Utility/Batch.hs b/Utility/Batch.hs index 1d66881d23..7a89448810 100644 --- a/Utility/Batch.hs +++ b/Utility/Batch.hs @@ -1,6 +1,6 @@ {- Running a long or expensive batch operation niced. - - - Copyright 2013 Joey Hess + - Copyright 2013-2020 Joey Hess - - 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