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.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,

View file

@ -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))