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

This commit is contained in:
Joey Hess 2013-12-01 14:53:15 -04:00
parent 3c6be8cd6e
commit 4882a611e5
6 changed files with 42 additions and 31 deletions

View file

@ -50,8 +50,9 @@ bundledPrograms = catMaybes
, Just "gunzip" , Just "gunzip"
, Just "tar" , Just "tar"
#endif #endif
-- nice and ionice are not included in the bundle; we rely on the -- nice, ionice, and nocache are not included in the bundle;
-- system's own version, which may better match its kernel -- we rely on the system's own version, which may better match
-- its kernel, and avoid using them if not available.
] ]
where where
ifset True s = Just s ifset True s = Just s

View file

@ -37,17 +37,16 @@ data FsckResults = FsckFoundMissing MissingObjects | FsckFailed
-} -}
findBroken :: Bool -> Repo -> IO FsckResults findBroken :: Bool -> Repo -> IO FsckResults
findBroken batchmode r = do 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 (output, fsckok) <- processTranscript command' (toCommand params') Nothing
let objs = findShas output let objs = findShas output
badobjs <- findMissing objs r badobjs <- findMissing objs r
if S.null badobjs && not fsckok if S.null badobjs && not fsckok
then return FsckFailed then return FsckFailed
else return $ FsckFoundMissing badobjs else return $ FsckFoundMissing badobjs
where
(command, params) = ("git", fsckParams r)
(command', params')
| batchmode = toBatchCommand (command, params)
| otherwise = (command, params)
foundBroken :: FsckResults -> Bool foundBroken :: FsckResults -> Bool
foundBroken FsckFailed = True foundBroken FsckFailed = True

View file

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

2
debian/changelog vendored
View file

@ -2,6 +2,8 @@ git-annex (5.20131131) UNRELEASED; urgency=low
* Avoid using git commit in direct mode, since in some situations * Avoid using git commit in direct mode, since in some situations
it will read the full contents of files in the tree. 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 -- Joey Hess <joeyh@debian.org> Sun, 01 Dec 2013 13:57:58 -0400

9
debian/control vendored
View file

@ -73,7 +73,14 @@ Depends: ${misc:Depends}, ${shlibs:Depends},
wget, wget,
curl, curl,
openssh-client (>= 1:5.6p1) 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 Suggests: graphviz, bup, libnss-mdns
Description: manage files with git, without checking their contents into git Description: manage files with git, without checking their contents into git
git-annex allows managing files with git, without checking the file git-annex allows managing files with git, without checking the file

View file

@ -65,6 +65,8 @@ quite a lot.
(optional; recommended for watch mode) (optional; recommended for watch mode)
* [gcrypt](https://github.com/joeyh/git-remote-gcrypt) * [gcrypt](https://github.com/joeyh/git-remote-gcrypt)
(optional) (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/) * 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) (optional; recommended for the assistant to support pairing well)
* [ikiwiki](http://ikiwiki.info) (optional; used to build the docs) * [ikiwiki](http://ikiwiki.info) (optional; used to build the docs)