Better ssh connection warmup when using -J for concurrency.

Avoids ugly messages when forced ssh command is not git-annex-shell.

This commit was sponsored by Ole-Morten Duesund on Patreon.
This commit is contained in:
Joey Hess 2018-03-07 17:25:42 -04:00
parent 460ab8a181
commit 3dd43df9c2
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 60 additions and 40 deletions

View file

@ -1,6 +1,6 @@
{- Process transcript
-
- Copyright 2012-2015 Joey Hess <id@joeyh.name>
- Copyright 2012-2018 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
@ -13,6 +13,7 @@ module Utility.Process.Transcript where
import Utility.Process
import System.IO
import System.Exit
import Control.Concurrent
import qualified Control.Exception as E
import Control.Monad
@ -24,14 +25,19 @@ import Control.Applicative
import Data.Maybe
import Prelude
-- | Runs a process, optionally feeding it some input, and
-- returns a transcript combining its stdout and stderr, and
-- whether it succeeded or failed.
-- | Runs a process and returns a transcript combining its stdout and
-- stderr, and whether it succeeded or failed.
processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
processTranscript cmd opts = processTranscript' (proc cmd opts)
-- | Also feeds the process some input.
processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool)
processTranscript' cp input = do
(t, c) <- processTranscript'' cp input
return (t, c == ExitSuccess)
processTranscript'' :: CreateProcess -> Maybe String -> IO (String, ExitCode)
processTranscript'' cp input = do
#ifndef mingw32_HOST_OS
{- This implementation interleves stdout and stderr in exactly the order
- the process writes them. -}
@ -48,9 +54,6 @@ processTranscript' cp input = do
get <- mkreader readh
writeinput input p
transcript <- get
ok <- checkSuccessProcess pid
return (transcript, ok)
#else
{- This implementation for Windows puts stderr after stdout. -}
p@(_, _, _, pid) <- createProcess $ cp
@ -63,10 +66,9 @@ processTranscript' cp input = do
geterr <- mkreader (stderrHandle p)
writeinput input p
transcript <- (++) <$> getout <*> geterr
ok <- checkSuccessProcess pid
return (transcript, ok)
#endif
code <- waitForProcess pid
return (transcript, code)
where
mkreader h = do
s <- hGetContents h