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

This commit is contained in:
Joey Hess 2017-05-13 13:13:13 -04:00
parent 1a0390e418
commit 2c6cfbe503
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 19 additions and 15 deletions

View file

@ -34,7 +34,7 @@ import Annex.Path
import Utility.Env import Utility.Env
import Utility.FileSystemEncoding import Utility.FileSystemEncoding
import Types.CleanupActions import Types.CleanupActions
import Types.Messages import Types.Concurrency
import Git.Env import Git.Env
import Git.Ssh import Git.Ssh
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
@ -191,13 +191,16 @@ prepSocket socketfile gc sshparams = do
liftIO $ createDirectoryIfMissing True $ parentDir socketfile liftIO $ createDirectoryIfMissing True $ parentDir socketfile
let socketlock = socket2lock socketfile let socketlock = socket2lock socketfile
prompt $ \s -> when (concurrentOutputEnabled s) $ do prompt $ \c -> case c of
Concurrent {} -> do
-- If the LockCache already has the socketlock in it, -- If the LockCache already has the socketlock in it,
-- the connection has already been started. Otherwise, -- the connection has already been started. Otherwise,
-- get the connection started now. -- get the connection started now.
whenM (isNothing <$> fromLockCache socketlock) $ whenM (isNothing <$> fromLockCache socketlock) $
void $ liftIO $ boolSystem "ssh" $ void $ liftIO $ boolSystem "ssh" $
sshparams ++ startSshConnection gc sshparams ++ startSshConnection gc
NonConcurrent -> return ()
lockFileCached socketlock lockFileCached socketlock
-- Parameters to get ssh connected to the remote host, -- Parameters to get ssh connected to the remote host,

View file

@ -54,6 +54,7 @@ import Common
import Types import Types
import Types.Messages import Types.Messages
import Types.ActionItem import Types.ActionItem
import Types.Concurrency
import Messages.Internal import Messages.Internal
import qualified Messages.JSON as JSON import qualified Messages.JSON as JSON
import qualified Annex 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 - that the action is the only thing using the console, and can eg prompt
- the user. - the user.
-} -}
prompt :: (MessageState -> Annex a) -> Annex a prompt :: (Concurrency -> Annex a) -> Annex a
prompt a = withMessageState $ \s -> prompt a = go =<< Annex.getState Annex.concurrency
if concurrentOutputEnabled s where
then go NonConcurrent = a NonConcurrent
go c@(Concurrent {}) = withMessageState $ \s -> do
let l = promptLock s let l = promptLock s
in bracketIO (takeMVar l) (putMVar l) (const (a s)) bracketIO (takeMVar l) (putMVar l) (const (a c))
else a s