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.

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 <id@joeyh.name>
+ - Copyright 2010-2017 Joey Hess <id@joeyh.name>
  -
  - 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 <https://github.com/feuerbach/ansi-terminal/issues/7>
 
 --[[Joey]]
+
+> [[fixed|done]] using option #3. --[[Joey]]