This commit is contained in:
Joey Hess 2014-05-14 17:28:58 -04:00
parent 74f937cc55
commit a66c942645
2 changed files with 13 additions and 24 deletions

View file

@ -334,7 +334,7 @@ showSshErr msg = sshConfigurator $
- is no controlling terminal. On Unix, that is set up when the assistant
- starts, by calling createSession. On Windows, all of stdin, stdout, and
- stderr must be disconnected from the terminal. This is accomplished
- by always providing an empty input string on stdin.
- by always providing input on stdin.
-}
sshAuthTranscript :: SshInput -> [String] -> (Maybe String) -> Assistant (String, Bool)
sshAuthTranscript sshinput opts input = case inputAuthMethod sshinput of

View file

@ -167,10 +167,10 @@ processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
processTranscript cmd opts input = processTranscript' cmd opts Nothing input
processTranscript' :: String -> [String] -> Maybe [(String, String)] -> (Maybe String) -> IO (String, Bool)
processTranscript' cmd opts environ input = do
#ifndef mingw32_HOST_OS
{- This implementation interleves stdout and stderr in exactly the order
- the process writes them. -}
processTranscript' cmd opts environ input = do
(readf, writef) <- createPipe
readh <- fdToHandle readf
writeh <- fdToHandle writef
@ -184,24 +184,13 @@ processTranscript' cmd opts environ input = do
hClose writeh
get <- mkreader readh
-- now write and flush any input
case input of
Just s -> do
let inh = stdinHandle p
unless (null s) $ do
hPutStr inh s
hFlush inh
hClose inh
Nothing -> return ()
writeinput input p
transcript <- get
ok <- checkSuccessProcess pid
return (transcript, ok)
#else
{- This implementation for Windows puts stderr after stdout. -}
processTranscript' cmd opts environ input = do
p@(_, _, _, pid) <- createProcess $
(proc cmd opts)
{ std_in = if isJust input then CreatePipe else Inherit
@ -212,17 +201,9 @@ processTranscript' cmd opts environ input = do
getout <- mkreader (stdoutHandle p)
geterr <- mkreader (stderrHandle p)
case input of
Just s -> do
let inh = stdinHandle p
unless (null s) $ do
hPutStr inh s
hFlush inh
hClose inh
Nothing -> return ()
writeinput input p
transcript <- (++) <$> getout <*> geterr
ok <- checkSuccessProcess pid
return (transcript, ok)
#endif
@ -237,6 +218,14 @@ processTranscript' cmd opts environ input = do
takeMVar v
return s
writeinput (Just s) p = do
let inh = stdinHandle p
unless (null s) $ do
hPutStr inh s
hFlush inh
hClose inh
writeinput Nothing _ = return ()
{- Runs a CreateProcessRunner, on a CreateProcess structure, that
- is adjusted to pipe only from/to a single StdHandle, and passes
- the resulting Handle to an action. -}