summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-08-24 20:50:39 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-08-24 20:50:39 -0400
commitc9b3b8829dc3f106583fb933808179ec02773790 (patch)
treed2b27b5d8ee40c74be33c83807761c5eb5cea584 /Utility
parent8de7699f3905f5a3feb88cd6297f982f3666a201 (diff)
thread safe git-annex index file use
Diffstat (limited to 'Utility')
-rw-r--r--Utility/Process.hs71
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 []