diff options
author | Joey Hess <joey@kitenet.net> | 2012-08-24 20:50:39 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-08-24 20:50:39 -0400 |
commit | c9b3b8829dc3f106583fb933808179ec02773790 (patch) | |
tree | d2b27b5d8ee40c74be33c83807761c5eb5cea584 /Utility | |
parent | 8de7699f3905f5a3feb88cd6297f982f3666a201 (diff) |
thread safe git-annex index file use
Diffstat (limited to 'Utility')
-rw-r--r-- | Utility/Process.hs | 71 |
1 files changed, 47 insertions, 24 deletions
diff --git a/Utility/Process.hs b/Utility/Process.hs index 5c29bbdfb..e5de96ae9 100644 --- a/Utility/Process.hs +++ b/Utility/Process.hs @@ -12,7 +12,9 @@ module Utility.Process ( module X, CreateProcess, StdHandle(..), + readProcess, readProcessEnv, + writeReadProcessEnv, forceSuccessProcess, checkSuccessProcess, createProcessSuccess, @@ -22,8 +24,6 @@ module Utility.Process ( withBothHandles, createProcess, runInteractiveProcess, - writeReadProcess, - readProcess ) where import qualified System.Process @@ -32,6 +32,9 @@ import System.Process hiding (createProcess, runInteractiveProcess, readProcess) import System.Exit import System.IO import System.Log.Logger +import Control.Concurrent +import qualified Control.Exception as E +import Control.Monad import Utility.Misc @@ -40,8 +43,11 @@ type CreateProcessRunner = forall a. CreateProcess -> ((Maybe Handle, Maybe Hand data StdHandle = StdinHandle | StdoutHandle | StderrHandle deriving (Eq) -{- Like readProcess, but allows specifying the environment, and does - - not mess with stdin. -} +{- Normally, when reading from a process, it does not need to be fed any + - standard input. -} +readProcess :: FilePath -> [String] -> IO String +readProcess cmd args = readProcessEnv cmd args Nothing + readProcessEnv :: FilePath -> [String] -> Maybe [(String, String)] -> IO String readProcessEnv cmd args environ = withHandle StdoutHandle createProcessSuccess p $ \h -> do @@ -54,6 +60,43 @@ readProcessEnv cmd args environ = , env = environ } +{- Writes stdout to a process, returns its output, and also allows specifying + - the environment. -} +writeReadProcessEnv + :: FilePath + -> [String] + -> Maybe [(String, String)] + -> String + -> IO String +writeReadProcessEnv cmd args environ input = do + (Just inh, Just outh, _, pid) <- createProcess p + + -- fork off a thread to start consuming the output + output <- hGetContents outh + outMVar <- newEmptyMVar + _ <- forkIO $ E.evaluate (length output) >> putMVar outMVar () + + -- now write and flush any input + when (not (null input)) $ do hPutStr inh input; hFlush inh + hClose inh -- done with stdin + + -- wait on the output + takeMVar outMVar + hClose outh + + -- wait on the process + forceSuccessProcess p pid + + return output + + where + p = (proc cmd args) + { std_in = CreatePipe + , std_out = CreatePipe + , std_err = Inherit + , env = environ + } + {- Waits for a ProcessHandle, and throws an exception if the process - did not exit successfully. -} forceSuccessProcess :: CreateProcess -> ProcessHandle -> IO () @@ -192,23 +235,3 @@ runInteractiveProcess f args c e = do , std_err = CreatePipe } System.Process.runInteractiveProcess f args c e - -{- I think this is a more descriptive name than System.Process.readProcess. -} -writeReadProcess - :: FilePath - -> [String] - -> String - -> IO String -writeReadProcess f args input = do - debugProcess $ (proc f args) { std_out = CreatePipe, std_in = CreatePipe } - System.Process.readProcess f args input - -{- Normally, when reading from a process, it does not need to be fed any - - input. -} -readProcess - :: FilePath - -> [String] - -> IO String -readProcess f args = do - debugProcess $ (proc f args) { std_out = CreatePipe } - System.Process.readProcess f args [] |