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:
parent
89f9be3230
commit
1d45e47e3f
5 changed files with 52 additions and 14 deletions
26
Annex/Ssh.hs
26
Annex/Ssh.hs
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
|
|
12
Messages.hs
12
Messages.hs
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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]]
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue