simpler more generic processTranscript'
This allows using functions that generate CreateProcess and passing the result to processTranscript', which is more flexible, and also simpler than the old interface. This commit was sponsored by Riku Voipio.
This commit is contained in:
parent
f07af03018
commit
113b10cdc9
3 changed files with 15 additions and 17 deletions
|
@ -379,7 +379,7 @@ sshAuthTranscript sshinput opts input = case inputAuthMethod sshinput of
|
|||
geti f = maybe "" T.unpack (f sshinput)
|
||||
|
||||
go extraopts environ = processTranscript'
|
||||
(askPass environ) "ssh" (extraopts ++ opts)
|
||||
(askPass environ (proc "ssh" (extraopts ++ opts)))
|
||||
-- Always provide stdin, even when empty.
|
||||
(Just (fromMaybe "" input))
|
||||
|
||||
|
|
|
@ -127,7 +127,7 @@ getOutput c ps environ = do
|
|||
putStrLn $ unwords [c, show ps]
|
||||
systemenviron <- getEnvironment
|
||||
let environ' = fromMaybe [] environ ++ systemenviron
|
||||
out@(_, ok) <- processTranscript' (\p -> p { Utility.Process.env = Just environ' }) c ps Nothing
|
||||
out@(_, ok) <- processTranscript' ((proc c ps) { Utility.Process.env = Just environ' }) Nothing
|
||||
putStrLn $ unwords [c, "finished", show ok]
|
||||
return out
|
||||
|
||||
|
|
|
@ -174,22 +174,21 @@ createBackgroundProcess p a = a =<< createProcess p
|
|||
-- returns a transcript combining its stdout and stderr, and
|
||||
-- whether it succeeded or failed.
|
||||
processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
|
||||
processTranscript = processTranscript' id
|
||||
processTranscript cmd opts = processTranscript' (proc cmd opts)
|
||||
|
||||
processTranscript' :: (CreateProcess -> CreateProcess) -> String -> [String] -> Maybe String -> IO (String, Bool)
|
||||
processTranscript' modproc cmd opts input = do
|
||||
processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool)
|
||||
processTranscript' cp input = do
|
||||
#ifndef mingw32_HOST_OS
|
||||
{- This implementation interleves stdout and stderr in exactly the order
|
||||
- the process writes them. -}
|
||||
(readf, writef) <- System.Posix.IO.createPipe
|
||||
readh <- System.Posix.IO.fdToHandle readf
|
||||
writeh <- System.Posix.IO.fdToHandle writef
|
||||
p@(_, _, _, pid) <- createProcess $ modproc $
|
||||
(proc cmd opts)
|
||||
{ std_in = if isJust input then CreatePipe else Inherit
|
||||
, std_out = UseHandle writeh
|
||||
, std_err = UseHandle writeh
|
||||
}
|
||||
p@(_, _, _, pid) <- createProcess $ cp
|
||||
{ std_in = if isJust input then CreatePipe else Inherit
|
||||
, std_out = UseHandle writeh
|
||||
, std_err = UseHandle writeh
|
||||
}
|
||||
hClose writeh
|
||||
|
||||
get <- mkreader readh
|
||||
|
@ -200,12 +199,11 @@ processTranscript' modproc cmd opts input = do
|
|||
return (transcript, ok)
|
||||
#else
|
||||
{- This implementation for Windows puts stderr after stdout. -}
|
||||
p@(_, _, _, pid) <- createProcess $ modproc $
|
||||
(proc cmd opts)
|
||||
{ std_in = if isJust input then CreatePipe else Inherit
|
||||
, std_out = CreatePipe
|
||||
, std_err = CreatePipe
|
||||
}
|
||||
p@(_, _, _, pid) <- createProcess $ cp
|
||||
{ std_in = if isJust input then CreatePipe else Inherit
|
||||
, std_out = CreatePipe
|
||||
, std_err = CreatePipe
|
||||
}
|
||||
|
||||
getout <- mkreader (stdoutHandle p)
|
||||
geterr <- mkreader (stderrHandle p)
|
||||
|
|
Loading…
Reference in a new issue