Ssh password prompting improved when using -J

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.

This also fixes a race in prepSocket's stale ssh connection stopping
when run with -J. It was possible for one thread to start a cached ssh
connection, and another thread to immediately stop it, resulting in excess
connections being made.

This commit was supported by the NSF-funded DataLad project.
This commit is contained in:
Joey Hess 2017-05-11 17:33:18 -04:00
parent 782c30b8a4
commit 6992fe133b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
8 changed files with 104 additions and 36 deletions

View file

@ -124,6 +124,7 @@ data AnnexState = AnnexState
, groupmap :: Maybe GroupMap
, ciphers :: M.Map StorableCipher Cipher
, lockcache :: LockCache
, sshstalecleaned :: MVar ()
, flags :: M.Map String Bool
, fields :: M.Map String String
, cleanup :: M.Map CleanupAction (Annex ())
@ -145,6 +146,8 @@ data AnnexState = AnnexState
newState :: GitConfig -> Git.Repo -> IO AnnexState
newState c r = do
emptyactiveremotes <- newMVar M.empty
o <- newMessageState
sc <- newMVar ()
return $ AnnexState
{ repo = r
, repoadjustment = return
@ -152,7 +155,7 @@ newState c r = do
, backend = Nothing
, remotes = []
, remoteannexstate = M.empty
, output = def
, output = o
, concurrency = NonConcurrent
, force = False
, fast = False
@ -175,6 +178,7 @@ newState c r = do
, groupmap = Nothing
, ciphers = M.empty
, lockcache = M.empty
, sshstalecleaned = sc
, flags = M.empty
, fields = M.empty
, cleanup = M.empty

View file

@ -11,6 +11,7 @@ module Annex.LockFile (
lockFileCached,
unlockFile,
getLockCache,
fromLockCache,
withExclusiveLock,
tryExclusiveLock,
) where

View file

@ -23,10 +23,6 @@ module Annex.Ssh (
runSshAskPass
) where
import qualified Data.Map as M
import Data.Hash.MD5
import System.Exit
import Annex.Common
import Annex.LockFile
import qualified Build.SysConfig as SysConfig
@ -38,6 +34,7 @@ import Annex.Path
import Utility.Env
import Utility.FileSystemEncoding
import Types.CleanupActions
import Types.Messages
import Git.Env
import Git.Ssh
#ifndef mingw32_HOST_OS
@ -45,6 +42,9 @@ import Annex.Perms
import Annex.LockPool
#endif
import Data.Hash.MD5
import Control.Concurrent
{- Some ssh commands are fed stdin on a pipe and so should be allowed to
- consume it. But ssh commands that are not piped stdin should generally
- not be allowed to consume the process's stdin. -}
@ -71,16 +71,18 @@ sshCommand cs (host, port) gc remotecmd = ifM (liftIO safe_GIT_SSH)
sshOptions :: ConsumeStdin -> (String, Maybe Integer) -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam]
sshOptions cs (host, port) gc opts = go =<< sshCachingInfo (host, port)
where
go (Nothing, params) = ret params
go (Nothing, params) = return $ mkparams cs params
go (Just socketfile, params) = do
prepSocket socketfile
ret params
ret ps = return $ concat
prepSocket socketfile gc
(Param host : mkparams NoConsumeStdin params)
return $ mkparams cs params
mkparams cs' ps = concat
[ ps
, map Param (remoteAnnexSshOptions gc)
, opts
, portParams port
, consumeStdinParams cs
, consumeStdinParams cs'
, [Param "-T"]
]
@ -159,20 +161,51 @@ portParams Nothing = []
portParams (Just port) = [Param "-p", Param $ show port]
{- Prepare to use a socket file for ssh connection caching.
- Locks a lock file to prevent other git-annex processes from
- stopping the ssh multiplexer on this socket. -}
prepSocket :: FilePath -> Annex ()
prepSocket socketfile = do
-- If the lock pool is empty, this is the first ssh of this
-- run. There could be stale ssh connections hanging around
-
- When concurrency is enabled, this blocks until a ssh connection
- has been made to the host. So, any password prompting by ssh will
- happen in this call, and only one ssh process will prompt at a time.
-
- Locks the socket lock file to prevent other git-annex processes from
- stopping the ssh multiplexer on this socket.
-}
prepSocket :: FilePath -> RemoteGitConfig -> [CommandParam] -> Annex ()
prepSocket socketfile gc sshparams = do
-- There could be stale ssh connections hanging around
-- from a previous git-annex run that was interrupted.
whenM (not . any isLock . M.keys <$> getLockCache)
-- This must run only once, before we have made any ssh connection.
whenM (isJust <$> (liftIO . tryTakeMVar =<< Annex.getState Annex.sshstalecleaned)) $
sshCleanup
-- Cleanup at end of this run.
-- Cleanup at shutdown.
Annex.addCleanup SshCachingCleanup sshCleanup
liftIO $ createDirectoryIfMissing True $ parentDir socketfile
lockFileCached $ socket2lock socketfile
let socketlock = socket2lock socketfile
prompt $ \s -> when (concurrentOutputEnabled s) $
-- 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
lockFileCached socketlock
-- Parameters to get ssh connected to the remote host,
-- by asking it to run a no-op command.
--
-- Could simply run "true", but the remote host may only
-- allow git-annex-shell to run. So, run git-annex-shell inannex
-- with the path to the remote repository and no other parameters,
-- which is a no-op supported by all versions of git-annex-shell.
startSshConnection :: RemoteGitConfig -> [CommandParam]
startSshConnection gc =
[ Param "git-annex-shell"
, Param "inannex"
, File $ Git.repoPath $ gitConfigRepo $
remoteGitConfig gc
]
{- Find ssh socket files.
-
@ -324,12 +357,20 @@ sshOptionsTo remote gc localr
Just host -> ifM (liftIO $ safe_GIT_SSH <&&> gitSshEnvSet)
( unchanged
, do
(msockfile, _) <- sshCachingInfo (host, Git.Url.port remote)
let port = Git.Url.port remote
(msockfile, cacheparams) <- sshCachingInfo (host, port)
case msockfile of
Nothing -> use []
Just sockfile -> do
prepSocket sockfile
use (sshConnectionCachingParams sockfile)
prepSocket sockfile gc $
Param host : concat
[ cacheparams
, map Param (remoteAnnexSshOptions gc)
, portParams port
, consumeStdinParams NoConsumeStdin
, [Param "-T"]
]
use cacheparams
)
where
unchanged = return localr

View file

@ -1,3 +1,12 @@
git-annex (6.20170511) UNRELEASED; urgency=medium
* Ssh password prompting improved when using -J for concurrency.
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.
-- Joey Hess <id@joeyh.name> Thu, 11 May 2017 15:16:23 -0400
git-annex (6.20170510) unstable; urgency=medium
* When a http remote does not expose an annex.uuid config, only warn

View file

@ -1,6 +1,6 @@
{- git-annex output messages
-
- 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.
-}
@ -41,12 +41,14 @@ module Messages (
outputMessage,
implicitMessage,
withMessageState,
prompt,
) where
import System.Log.Logger
import System.Log.Formatter
import System.Log.Handler (setFormatter)
import System.Log.Handler.Simple
import Control.Concurrent
import Common
import Types
@ -219,3 +221,15 @@ commandProgressDisabled = withMessageState $ \s -> return $
- output. -}
implicitMessage :: Annex () -> Annex ()
implicitMessage = whenM (implicitMessages <$> Annex.getState Annex.output)
{- Prevents any concurrent console access while running an action, so
- that the action is the only thing using the console, and can eg prompt
- the user.
-}
prompt :: (MessageState -> Annex a) -> Annex a
prompt a = withMessageState $ \s ->
if concurrentOutputEnabled s
then
let l = promptLock s
in bracketIO (takeMVar l) (putMVar l) (const (a s))
else a s

View file

@ -13,7 +13,6 @@ import Types.Messages
import Messages.Concurrent
import Messages.JSON
withMessageState :: (MessageState -> Annex a) -> Annex a
withMessageState a = Annex.getState Annex.output >>= a

View file

@ -1,6 +1,6 @@
{- git-annex Messages data types
-
- Copyright 2012 Joey Hess <id@joeyh.name>
- Copyright 2012-2017 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -9,9 +9,9 @@
module Types.Messages where
import Data.Default
import qualified Data.Aeson as Aeson
import Control.Concurrent
#ifdef WITH_CONCURRENTOUTPUT
import System.Console.Regions (ConsoleRegion)
#endif
@ -32,11 +32,13 @@ data MessageState = MessageState
, consoleRegionErrFlag :: Bool
#endif
, jsonBuffer :: Maybe Aeson.Object
, promptLock :: MVar () -- left full when not prompting
}
instance Default MessageState
where
def = MessageState
newMessageState :: IO MessageState
newMessageState = do
promptlock <- newMVar ()
return $ MessageState
{ outputType = NormalOutput
, concurrentOutputEnabled = False
, sideActionBlock = NoBlock
@ -46,4 +48,5 @@ instance Default MessageState
, consoleRegionErrFlag = False
#endif
, jsonBuffer = Nothing
, promptLock = promptlock
}

View file

@ -37,9 +37,6 @@ non-concurrent uses the current, faster path.
prepSocket takes a shared
file level lock of the socket's lock file, which is used to tell when
another git-annex process is using the connection multiplexer.
So, an optimisation would be for prepSocket to try to take a non-blocking
exclusive file-level lock. If it fails, it knows some process has
already taken the shared lock, and so the multiplexer is started and no
password prompting needs to be done. So it does not need to try to start
the multiplexer in this case.
So, an optimisation would be for prepSocket to check if it's already
taken that shared lock, and then it does not need to start the multiplexer.
"""]]