summaryrefslogtreecommitdiff
path: root/Utility/Batch.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-10-11 16:03:18 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-10-11 16:03:18 -0400
commita8728440dec6213c1e9e5347175effca30c1118e (patch)
tree6f9d3a2be0ff606912ad8571fbca286e9899b434 /Utility/Batch.hs
parent388d27825323091f317ed380e3105f88df3f66cb (diff)
add remote fsck interface
Currently only implemented for local git remotes. May try to add support to git-annex-shell for ssh remotes later. Could concevably also be supported by some special remote, although that seems unlikely. Cronner user this when available, and when not falls back to fsck --fast --from remote git annex fsck --from does not itself use this interface. To do so, I would need to pass --fast and all other options that influence fsck on to the git annex fsck that it runs inside the remote. And that seems like a lot of work for a result that would be no better than cd remote; git annex fsck This may need to be revisited if git-annex-shell gets support, since it may be the case that the user cannot ssh to the server to run git-annex fsck there, but can run git-annex-shell there. This commit was sponsored by Damien Diederen.
Diffstat (limited to 'Utility/Batch.hs')
-rw-r--r--Utility/Batch.hs28
1 files changed, 28 insertions, 0 deletions
diff --git a/Utility/Batch.hs b/Utility/Batch.hs
index c3c34bf27..561a406b2 100644
--- a/Utility/Batch.hs
+++ b/Utility/Batch.hs
@@ -9,10 +9,14 @@
module Utility.Batch where
+import Common
+import qualified Build.SysConfig
+
#if defined(linux_HOST_OS) || defined(__ANDROID__)
import Control.Concurrent.Async
import System.Posix.Process
#endif
+import qualified Control.Exception as E
{- Runs an operation, at batch priority.
-
@@ -38,3 +42,27 @@ batch a = a
maxNice :: Int
maxNice = 19
+
+{- Runs a command in a way that's suitable for batch jobs.
+ - 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. -}
+batchCommand :: String -> [CommandParam] -> IO Bool
+batchCommand command params = do
+ (_, _, _, pid) <- createProcess $ proc "sh"
+ [ "-c"
+ , "exec " ++ nicedcommand
+ ]
+ 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
+ where
+ commandline = unwords $ map shellEscape $ command : toCommand params
+ nicedcommand
+ | Build.SysConfig.nice = "nice " ++ commandline
+ | otherwise = commandline