also serialize ssh password prompting when json or quiet output is enable

2 files changed, 19 insertions, 15 deletions

diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index e0cc4a0fe..c53802941 100644
--- a/Annex/Ssh.hs
+++ b/Annex/Ssh.hs
@@ -34,7 +34,7 @@ import Annex.Path
 import Utility.Env
 import Utility.FileSystemEncoding
 import Types.CleanupActions
-import Types.Messages
+import Types.Concurrency
 import Git.Env
 import Git.Ssh
 #ifndef mingw32_HOST_OS
@@ -191,13 +191,16 @@ prepSocket socketfile gc sshparams = do
 	liftIO $ createDirectoryIfMissing True $ parentDir socketfile
 	let socketlock = socket2lock socketfile
 
-	prompt $ \s -> when (concurrentOutputEnabled s) $ do
-		-- If the LockCache already has the socketlock in it,
-		-- the connection has already been started. Otherwise,
-		-- get the connection started now.
-		whenM (isNothing <$> fromLockCache socketlock) $
-			void $ liftIO $ boolSystem "ssh" $
-				sshparams ++ startSshConnection gc
+	prompt $ \c -> case c of
+		Concurrent {} -> do
+			-- If the LockCache already has the socketlock in it,
+			-- the connection has already been started. Otherwise,
+			-- get the connection started now.
+			whenM (isNothing <$> fromLockCache socketlock) $
+				void $ liftIO $ boolSystem "ssh" $
+					sshparams ++ startSshConnection gc
+		NonConcurrent -> return ()
+	
 	lockFileCached socketlock
 
 -- Parameters to get ssh connected to the remote host,
diff --git a/Messages.hs b/Messages.hs
index f3c44aebf..83ea91dbc 100644
--- a/Messages.hs
+++ b/Messages.hs
@@ -54,6 +54,7 @@ import Common
 import Types
 import Types.Messages
 import Types.ActionItem
+import Types.Concurrency
 import Messages.Internal
 import qualified Messages.JSON as JSON
 import qualified Annex
@@ -226,10 +227,10 @@ implicitMessage = whenM (implicitMessages <$> Annex.getState Annex.output)
  - that the action is the only thing using the console, and can eg prompt
  - the user.
  -}
-prompt :: (MessageState -> Annex a) -> Annex a
-prompt a = withMessageState $ \s ->
-	if concurrentOutputEnabled s
-		then 
-			let l = promptLock s
-			in bracketIO (takeMVar l) (putMVar l) (const (a s))
-		else a s
+prompt :: (Concurrency -> Annex a) -> Annex a
+prompt a = go =<< Annex.getState Annex.concurrency
+  where
+	go NonConcurrent = a NonConcurrent
+	go c@(Concurrent {}) = withMessageState $ \s -> do
+		let l = promptLock s
+		bracketIO (takeMVar l) (putMVar l) (const (a c))