assistant: Batch jobs are now run with ionice and nocache, when those commands are available.

6 files changed, 42 insertions, 31 deletions

diff --git a/Build/BundledPrograms.hs b/Build/BundledPrograms.hs
index 3c53f06fb..e875c4e96 100644
--- a/Build/BundledPrograms.hs
+++ b/Build/BundledPrograms.hs
@@ -50,8 +50,9 @@ bundledPrograms = catMaybes
 	, Just "gunzip"
 	, Just "tar"
 #endif
-	-- nice and ionice are not included in the bundle; we rely on the
-	-- system's own version, which may better match its kernel
+	-- nice, ionice, and nocache are not included in the bundle;
+	-- we rely on the system's own version, which may better match
+	-- its kernel, and avoid using them if not available.
 	]
   where
 	ifset True s = Just s
diff --git a/Git/Fsck.hs b/Git/Fsck.hs
index 8555aa0c1..8d5b75bbd 100644
--- a/Git/Fsck.hs
+++ b/Git/Fsck.hs
@@ -37,17 +37,16 @@ data FsckResults = FsckFoundMissing MissingObjects | FsckFailed
  -}
 findBroken :: Bool -> Repo -> IO FsckResults
 findBroken batchmode r = do
+	let (command, params) = ("git", fsckParams r)
+	(command', params') <- if batchmode
+		then toBatchCommand (command, params)
+		else return (command, params)
 	(output, fsckok) <- processTranscript command' (toCommand params') Nothing
 	let objs = findShas output
 	badobjs <- findMissing objs r
 	if S.null badobjs && not fsckok
 		then return FsckFailed
 		else return $ FsckFoundMissing badobjs
-  where
-	(command, params) = ("git", fsckParams r)
-	(command', params')
-		| batchmode = toBatchCommand (command, params)
-		| otherwise = (command, params)
 
 foundBroken :: FsckResults -> Bool
 foundBroken FsckFailed = True
diff --git a/Utility/Batch.hs b/Utility/Batch.hs
index 035a2eb04..98698ac26 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,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'
-
diff --git a/debian/changelog b/debian/changelog
index 12bde5dfa..567ea8bbf 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -2,6 +2,8 @@ git-annex (5.20131131) UNRELEASED; urgency=low
 
   * Avoid using git commit in direct mode, since in some situations
     it will read the full contents of files in the tree.
+  * assistant: Batch jobs are now run with ionice and nocache, when
+    those commands are available.
 
  -- Joey Hess <joeyh@debian.org>  Sun, 01 Dec 2013 13:57:58 -0400
 
diff --git a/debian/control b/debian/control
index 6fbd2a06a..4bbeddd23 100644
--- a/debian/control
+++ b/debian/control
@@ -73,7 +73,14 @@ Depends: ${misc:Depends}, ${shlibs:Depends},
 	wget,
 	curl,
 	openssh-client (>= 1:5.6p1)
-Recommends: lsof, gnupg, bind9-host, ssh-askpass, quvi, git-remote-gcrypt (>= 0.20130908-4)
+Recommends: 
+	lsof,
+	gnupg,
+	bind9-host,
+	ssh-askpass,
+	quvi,
+	git-remote-gcrypt (>= 0.20130908-4),
+	nocache
 Suggests: graphviz, bup, libnss-mdns
 Description: manage files with git, without checking their contents into git
  git-annex allows managing files with git, without checking the file
diff --git a/doc/install/fromscratch.mdwn b/doc/install/fromscratch.mdwn
index ae9065cd0..f99d8e78e 100644
--- a/doc/install/fromscratch.mdwn
+++ b/doc/install/fromscratch.mdwn
@@ -65,6 +65,8 @@ quite a lot.
     (optional; recommended for watch mode)
   * [gcrypt](https://github.com/joeyh/git-remote-gcrypt)
     (optional)
+  * [nocache](https://github.com/Feh/nocache)
+    (optional)
   * multicast DNS support, provided on linux by [nss-mdns](http://www.0pointer.de/lennart/projects/nss-mdns/)
     (optional; recommended for the assistant to support pairing well)
   * [ikiwiki](http://ikiwiki.info) (optional; used to build the docs)