From 3bdf2d2052f3a194b3f72500ca71867fb22e1315 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sun, 1 Dec 2013 15:14:13 -0400
Subject: merge from git-annex

Note that the batchCommand stuff is not used in git-repair, so
configure does not need to check for nice, ionice, and nocache,
nor are they dependend on.
---
 Utility/Batch.hs | 43 +++++++++++++++++++------------------------
 1 file changed, 19 insertions(+), 24 deletions(-)

(limited to 'Utility')

diff --git a/Utility/Batch.hs b/Utility/Batch.hs
index 035a2eb..958801e 100644
--- a/Utility/Batch.hs
+++ b/Utility/Batch.hs
@@ -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,38 @@ 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' =
-		[ Param "-c"
-		, Param $ "exec " ++ nicedcommand
+	nicers <- filterM (inPath . fst)
+		[ ("nice", [])
+		, ("ionice", ["-c3"])
+		, ("nocache", [])
 		]
+	let (command', params') = case nicers of
+		[] -> (command, params)
+		(first:rest) -> (fst first, map Param (snd first ++ concatMap (\p -> fst p : snd p) rest ++ [command]) ++ 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 +84,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'
-
-- 
cgit v1.2.3