From 5f2ce9e7dfd19a387b79334bb3e1c496221663aa Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 16 May 2017 15:28:06 -0400 Subject: 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. --- Annex/Ssh.hs | 26 +++++++++++++++------- CHANGELOG | 2 ++ Messages.hs | 12 ++++++---- Messages/Concurrent.hs | 24 ++++++++++++++++++-- ..._glitch_with_ssh_password_prompting_and_-J.mdwn | 2 ++ 5 files changed, 52 insertions(+), 14 deletions(-) diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index a9ff91751..50a516342 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -191,17 +191,27 @@ prepSocket socketfile gc sshparams = do liftIO $ createDirectoryIfMissing True $ parentDir socketfile let socketlock = socket2lock socketfile - 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 + c <- Annex.getState Annex.concurrency + case c of + Concurrent {} -> makeconnection socketlock NonConcurrent -> return () 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, -- by asking it to run a no-op command. diff --git a/CHANGELOG b/CHANGELOG index 3096b8020..5e816ca74 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -4,6 +4,8 @@ git-annex (6.20170511) UNRELEASED; urgency=medium 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 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. * Progress is displayed for transfers of files of unknown size. * Work around bug in git 2.13.0 involving GIT_COMMON_DIR that broke diff --git a/Messages.hs b/Messages.hs index 83ea91dbc..ff13b31ee 100644 --- a/Messages.hs +++ b/Messages.hs @@ -56,6 +56,7 @@ import Types.Messages import Types.ActionItem import Types.Concurrency import Messages.Internal +import Messages.Concurrent import qualified Messages.JSON as JSON 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 - the user. -} -prompt :: (Concurrency -> Annex a) -> Annex a +prompt :: Annex a -> Annex a prompt a = go =<< Annex.getState Annex.concurrency where - go NonConcurrent = a NonConcurrent - go c@(Concurrent {}) = withMessageState $ \s -> do + go NonConcurrent = a + go (Concurrent {}) = withMessageState $ \s -> do let l = promptLock s - bracketIO (takeMVar l) (putMVar l) (const (a c)) + bracketIO + (takeMVar l) + (putMVar l) + (const $ hideRegionsWhile a) diff --git a/Messages/Concurrent.hs b/Messages/Concurrent.hs index 41153d067..78eed3bb1 100644 --- a/Messages/Concurrent.hs +++ b/Messages/Concurrent.hs @@ -1,6 +1,6 @@ {- git-annex output messages, including concurrent output to display regions - - - Copyright 2010-2016 Joey Hess + - Copyright 2010-2017 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -10,8 +10,9 @@ module Messages.Concurrent where -import Annex +import Types import Types.Messages +import qualified Annex #ifdef WITH_CONCURRENTOUTPUT import Common @@ -136,3 +137,22 @@ concurrentOutputSupported = return True -- Windows is always unicode #else concurrentOutputSupported = return False #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 diff --git a/doc/bugs/minor_display_glitch_with_ssh_password_prompting_and_-J.mdwn b/doc/bugs/minor_display_glitch_with_ssh_password_prompting_and_-J.mdwn index 1df069466..a8e0871a1 100644 --- a/doc/bugs/minor_display_glitch_with_ssh_password_prompting_and_-J.mdwn +++ b/doc/bugs/minor_display_glitch_with_ssh_password_prompting_and_-J.mdwn @@ -47,3 +47,5 @@ Some approaches to fix it: See --[[Joey]] + +> [[fixed|done]] using option #3. --[[Joey]] -- cgit v1.2.3