From 23f83c876b0644b24e46f8cc1a782e2f558bf329 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 13 May 2017 13:13:13 -0400 Subject: also serialize ssh password prompting when json or quiet output is enable --- Annex/Ssh.hs | 19 +++++++++++-------- Messages.hs | 15 ++++++++------- 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)) -- cgit v1.2.3