clear regions before ssh prompt

When built with concurrent-output 1.9, ssh password prompts will no longer
interfere with the -J display.

To avoid flicker, only done when ssh actually does need to prompt;
ssh is first run in batch mode and if that succeeds the connection is up
and no need to clear regions.

This commit was supported by the NSF-funded DataLad project.
This commit is contained in:
Joey Hess 2017-05-16 15:28:06 -04:00
parent 89f9be3230
commit 1d45e47e3f
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 52 additions and 14 deletions

View file

@ -191,17 +191,27 @@ prepSocket socketfile gc sshparams = do
liftIO $ createDirectoryIfMissing True $ parentDir socketfile liftIO $ createDirectoryIfMissing True $ parentDir socketfile
let socketlock = socket2lock socketfile let socketlock = socket2lock socketfile
prompt $ \c -> case c of c <- Annex.getState Annex.concurrency
Concurrent {} -> do case c of
-- If the LockCache already has the socketlock in it, Concurrent {} -> makeconnection socketlock
-- 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 () NonConcurrent -> return ()
lockFileCached socketlock lockFileCached socketlock
where
-- When the LockCache already has the socketlock in it,
-- the connection has already been started. Otherwise,
-- get the connection started now.
makeconnection socketlock =
whenM (isNothing <$> fromLockCache socketlock) $ do
let startps = sshparams ++ startSshConnection gc
-- When we can start the connection in batch mode,
-- ssh won't prompt to the console.
(_, connected) <- liftIO $ processTranscript "ssh"
(["-o", "BatchMode=true"] ++ toCommand startps)
Nothing
unless connected $
prompt $ void $ liftIO $
boolSystem "ssh" startps
-- Parameters to get ssh connected to the remote host, -- Parameters to get ssh connected to the remote host,
-- by asking it to run a no-op command. -- by asking it to run a no-op command.

View file

@ -4,6 +4,8 @@ git-annex (6.20170511) UNRELEASED; urgency=medium
When ssh connection caching is enabled (and when GIT_ANNEX_USE_GIT_SSH When ssh connection caching is enabled (and when GIT_ANNEX_USE_GIT_SSH
is not set), only one ssh password prompt will be made per host, and is not set), only one ssh password prompt will be made per host, and
only one ssh password prompt will be made at a time. only one ssh password prompt will be made at a time.
* When built with concurrent-output 1.9, ssh password prompts will no
longer interfere with the -J display.
* Removed dependency on MissingH, instead depending on the split library. * Removed dependency on MissingH, instead depending on the split library.
* Progress is displayed for transfers of files of unknown size. * Progress is displayed for transfers of files of unknown size.
* Work around bug in git 2.13.0 involving GIT_COMMON_DIR that broke * Work around bug in git 2.13.0 involving GIT_COMMON_DIR that broke

View file

@ -56,6 +56,7 @@ import Types.Messages
import Types.ActionItem import Types.ActionItem
import Types.Concurrency import Types.Concurrency
import Messages.Internal import Messages.Internal
import Messages.Concurrent
import qualified Messages.JSON as JSON import qualified Messages.JSON as JSON
import qualified Annex import qualified Annex
@ -227,10 +228,13 @@ 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 :: (Concurrency -> Annex a) -> Annex a prompt :: Annex a -> Annex a
prompt a = go =<< Annex.getState Annex.concurrency prompt a = go =<< Annex.getState Annex.concurrency
where where
go NonConcurrent = a NonConcurrent go NonConcurrent = a
go c@(Concurrent {}) = withMessageState $ \s -> do go (Concurrent {}) = withMessageState $ \s -> do
let l = promptLock s let l = promptLock s
bracketIO (takeMVar l) (putMVar l) (const (a c)) bracketIO
(takeMVar l)
(putMVar l)
(const $ hideRegionsWhile a)

View file

@ -1,6 +1,6 @@
{- git-annex output messages, including concurrent output to display regions {- git-annex output messages, including concurrent output to display regions
- -
- Copyright 2010-2016 Joey Hess <id@joeyh.name> - Copyright 2010-2017 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
@ -10,8 +10,9 @@
module Messages.Concurrent where module Messages.Concurrent where
import Annex import Types
import Types.Messages import Types.Messages
import qualified Annex
#ifdef WITH_CONCURRENTOUTPUT #ifdef WITH_CONCURRENTOUTPUT
import Common import Common
@ -136,3 +137,22 @@ concurrentOutputSupported = return True -- Windows is always unicode
#else #else
concurrentOutputSupported = return False concurrentOutputSupported = return False
#endif #endif
{- Hide any currently displayed console regions while running the action,
- so that the action can use the console itself.
- This needs a new enough version of concurrent-output; otherwise
- the regions will not be hidden, but the action still runs, garbling the
- display. -}
hideRegionsWhile :: Annex a -> Annex a
#if MIN_VERSION_concurrent_output(1,9,0)
hideRegionsWhile a = bracketIO setup cleanup go
where
setup = Regions.waitDisplayChange $ swapTMVar Regions.regionList []
cleanup = void . atomically . swapTMVar Regions.regionList
go _ = do
liftIO $ hFlush stdout
a
#else
#warning Building with concurrent-output older than 1.9.0 so expect some display glitches when password prompts occur in concurrent mode
hideRegionsWhile = id
#endif

View file

@ -47,3 +47,5 @@ Some approaches to fix it:
See <https://github.com/feuerbach/ansi-terminal/issues/7> See <https://github.com/feuerbach/ansi-terminal/issues/7>
--[[Joey]] --[[Joey]]
> [[fixed|done]] using option #3. --[[Joey]]