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.

1 files changed, 18 insertions, 8 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.