e213ef310f
* Fix minor FD leak in journal code. Closes: #754608 * direct: Fix handling of case where a work tree subdirectory cannot be written to due to permissions. * migrate: Avoid re-checksumming when migrating from hashE to hash backend. * uninit: Avoid failing final removal in some direct mode repositories due to file modes. * S3: Deal with AWS ACL configurations that do not allow creating or checking the location of a bucket, but only reading and writing content to it. * resolvemerge: New plumbing command that runs the automatic merge conflict resolver. * Deal with change in git 2.0 that made indirect mode merge conflict resolution leave behind old files. * sync: Fix git sync with local git remotes even when they don't have an annex.uuid set. (The assistant already did so.) * Set gcrypt-publish-participants when setting up a gcrypt repository, to avoid unncessary passphrase prompts. This is a security/usability tradeoff. To avoid exposing the gpg key ids who can decrypt the repository, users can unset gcrypt-publish-participants. * Install nautilus hooks even when ~/.local/share/nautilus/ does not yet exist, since it is not automatically created for Gnome 3 users. * Windows: Move .vbs files out of git\bin, to avoid that being in the PATH, which caused some weird breakage. (Thanks, divB) * Windows: Fix locking issue that prevented the webapp starting (since 5.20140707). # imported from the archive
96 lines
2.9 KiB
Haskell
96 lines
2.9 KiB
Haskell
{- Running a long or expensive batch operation niced.
|
|
-
|
|
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- License: BSD-2-clause
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Utility.Batch where
|
|
|
|
import Common
|
|
|
|
#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.
|
|
-
|
|
- This is done by running it in a bound thread, which on Linux can be set
|
|
- to have a different nice level than the rest of the program. Note that
|
|
- due to running in a bound thread, some operations may be more expensive
|
|
- to perform. Also note that if the action calls forkIO or forkOS itself,
|
|
- that will make a new thread that does not have the batch priority.
|
|
-
|
|
- POSIX threads do not support separate nice levels, so on other operating
|
|
- systems, the action is simply ran.
|
|
-}
|
|
batch :: IO a -> IO a
|
|
#if defined(linux_HOST_OS) || defined(__ANDROID__)
|
|
batch a = wait =<< batchthread
|
|
where
|
|
batchthread = asyncBound $ do
|
|
setProcessPriority 0 maxNice
|
|
a
|
|
#else
|
|
batch a = a
|
|
#endif
|
|
|
|
maxNice :: Int
|
|
maxNice = 19
|
|
|
|
{- Makes a command be run by whichever of nice, ionice, and nocache
|
|
- are available in the path. -}
|
|
type BatchCommandMaker = (String, [CommandParam]) -> (String, [CommandParam])
|
|
|
|
getBatchCommandMaker :: IO BatchCommandMaker
|
|
getBatchCommandMaker = do
|
|
#ifndef mingw32_HOST_OS
|
|
nicers <- filterM (inPath . fst)
|
|
[ ("nice", [])
|
|
#ifndef __ANDROID__
|
|
-- Android's ionice does not allow specifying a command,
|
|
-- so don't use it.
|
|
, ("ionice", ["-c3"])
|
|
#endif
|
|
, ("nocache", [])
|
|
]
|
|
return $ \(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
|
|
return id
|
|
#endif
|
|
|
|
toBatchCommand :: (String, [CommandParam]) -> IO (String, [CommandParam])
|
|
toBatchCommand v = do
|
|
batchmaker <- getBatchCommandMaker
|
|
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. -}
|
|
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
|
|
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
|