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.

1 files changed, 12 insertions, 10 deletions

diff --git a/Utility/Process/Transcript.hs b/Utility/Process/Transcript.hs
index 0dbe428f7..0dbbd443a 100644
--- a/Utility/Process/Transcript.hs
+++ b/Utility/Process/Transcript.hs
@@ -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