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:
parent
460ab8a181
commit
3dd43df9c2
5 changed files with 60 additions and 40 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue