propigate ssh-options everywhere ssh caching is used

* sync: Use the ssh-options git config when doing git pull and push.
* remotedaemon: Use the ssh-options git config.

Note that the rename env var means that if a new git-annex calls an old one
for git-annex ssh, or a new calls an old, nothing much will go wrong;
just ssh caching won't happen.
This commit is contained in:
Joey Hess 2015-02-12 16:12:32 -04:00
parent 3f5c9ddc05
commit 15107d2c5a
8 changed files with 53 additions and 33 deletions

View file

@ -12,10 +12,10 @@ module Annex.Ssh (
sshCacheDir, sshCacheDir,
sshReadPort, sshReadPort,
forceSshCleanup, forceSshCleanup,
sshCachingEnv, sshOptionsEnv,
sshCachingTo, sshOptionsTo,
inRepoWithSshCachingTo, inRepoWithSshOptionsTo,
runSshCaching, runSshOptions,
sshAskPassEnv, sshAskPassEnv,
runSshAskPass runSshAskPass
) where ) where
@ -233,31 +233,38 @@ sshReadPort params = (port, reverse args)
| otherwise = aux (p,q:ps) rest | otherwise = aux (p,q:ps) rest
readPort p = fmap fst $ listToMaybe $ reads p readPort p = fmap fst $ listToMaybe $ reads p
{- When this env var is set, git-annex runs ssh with parameters {- When this env var is set, git-annex runs ssh with the specified
- to use the socket file that the env var contains. - options. (The options are separated by newlines.)
- -
- This is a workaround for GIT_SSH not being able to contain - This is a workaround for GIT_SSH not being able to contain
- additional parameters to pass to ssh. -} - additional parameters to pass to ssh. -}
sshCachingEnv :: String sshOptionsEnv :: String
sshCachingEnv = "GIT_ANNEX_SSHCACHING" sshOptionsEnv = "GIT_ANNEX_SSHOPTION"
toSshOptionsEnv :: [CommandParam] -> String
toSshOptionsEnv = unlines . toCommand
fromSshOptionsEnv :: String -> [CommandParam]
fromSshOptionsEnv = map Param . lines
{- Enables ssh caching for git push/pull to a particular {- Enables ssh caching for git push/pull to a particular
- remote git repo. (Can safely be used on non-ssh remotes.) - remote git repo. (Can safely be used on non-ssh remotes.)
- -
- Also propigates any configured ssh-options.
-
- Like inRepo, the action is run with the local git repo. - Like inRepo, the action is run with the local git repo.
- But here it's a modified version, with gitEnv to set GIT_SSH=git-annex, - But here it's a modified version, with gitEnv to set GIT_SSH=git-annex,
- and sshCachingEnv set so that git-annex will know what socket - and sshOptionsEnv set so that git-annex will know what socket
- file to use. -} - file to use. -}
inRepoWithSshCachingTo :: Git.Repo -> (Git.Repo -> IO a) -> Annex a inRepoWithSshOptionsTo :: Git.Repo -> RemoteGitConfig -> (Git.Repo -> IO a) -> Annex a
inRepoWithSshCachingTo remote a = inRepoWithSshOptionsTo remote gc a =
liftIO . a =<< sshCachingTo remote =<< gitRepo liftIO . a =<< sshOptionsTo remote gc =<< gitRepo
{- To make any git commands be run with ssh caching enabled, {- To make any git commands be run with ssh caching enabled,
- alters the local Git.Repo's gitEnv to set GIT_SSH=git-annex, - and configured ssh-options alters the local Git.Repo's gitEnv
- and set sshCachingEnv so that git-annex will know what socket - to set GIT_SSH=git-annex, and sets sshOptionsEnv. -}
- file to use. -} sshOptionsTo :: Git.Repo -> RemoteGitConfig -> Git.Repo -> Annex Git.Repo
sshCachingTo :: Git.Repo -> Git.Repo -> Annex Git.Repo sshOptionsTo remote gc g
sshCachingTo remote g
| not (Git.repoIsUrl remote) || Git.repoIsHttp remote = uncached | not (Git.repoIsUrl remote) || Git.repoIsHttp remote = uncached
| otherwise = case Git.Url.hostuser remote of | otherwise = case Git.Url.hostuser remote of
Nothing -> uncached Nothing -> uncached
@ -268,15 +275,19 @@ sshCachingTo remote g
Just sockfile -> do Just sockfile -> do
command <- liftIO readProgramFile command <- liftIO readProgramFile
prepSocket sockfile prepSocket sockfile
let val = toSshOptionsEnv $ concat
[ sshConnectionCachingParams sockfile
, map Param (remoteAnnexSshOptions gc)
]
liftIO $ do liftIO $ do
g' <- addGitEnv g sshCachingEnv sockfile g' <- addGitEnv g sshOptionsEnv val
addGitEnv g' "GIT_SSH" command addGitEnv g' "GIT_SSH" command
where where
uncached = return g uncached = return g
runSshCaching :: [String] -> FilePath -> IO () runSshOptions :: [String] -> String -> IO ()
runSshCaching args sockfile = do runSshOptions args s = do
let args' = toCommand (sshConnectionCachingParams sockfile) ++ args let args' = toCommand (fromSshOptionsEnv s) ++ args
let p = proc "ssh" args' let p = proc "ssh" args'
exitWith =<< waitForProcess . processHandle =<< createProcess p exitWith =<< waitForProcess . processHandle =<< createProcess p

View file

@ -218,6 +218,6 @@ run args = do
go [] = dispatch True args cmds gitAnnexOptions [] header Git.CurrentRepo.get go [] = dispatch True args cmds gitAnnexOptions [] header Git.CurrentRepo.get
go ((v, a):rest) = maybe (go rest) a =<< getEnv v go ((v, a):rest) = maybe (go rest) a =<< getEnv v
envmodes = envmodes =
[ (sshCachingEnv, runSshCaching args) [ (sshOptionsEnv, runSshOptions args)
, (sshAskPassEnv, runSshAskPass) , (sshAskPassEnv, runSshAskPass)
] ]

View file

@ -234,7 +234,8 @@ pullRemote remote branch = do
stopUnless fetch $ stopUnless fetch $
next $ mergeRemote remote branch next $ mergeRemote remote branch
where where
fetch = inRepoWithSshCachingTo (Remote.repo remote) $ Git.Command.runBool fetch = inRepoWithSshOptionsTo (Remote.repo remote) (Remote.gitconfig remote) $
Git.Command.runBool
[Param "fetch", Param $ Remote.name remote] [Param "fetch", Param $ Remote.name remote]
{- The remote probably has both a master and a synced/master branch. {- The remote probably has both a master and a synced/master branch.
@ -270,7 +271,7 @@ pushRemote remote (Just branch) = go =<< needpush
showStart "push" (Remote.name remote) showStart "push" (Remote.name remote)
next $ next $ do next $ next $ do
showOutput showOutput
ok <- inRepoWithSshCachingTo (Remote.repo remote) $ ok <- inRepoWithSshOptionsTo (Remote.repo remote) (Remote.gitconfig remote) $
pushBranch remote branch pushBranch remote branch
unless ok $ do unless ok $ do
warning $ unwords [ "Pushing to " ++ Remote.name remote ++ " failed." ] warning $ unwords [ "Pushing to " ++ Remote.name remote ++ " failed." ]

View file

@ -117,14 +117,16 @@ genRemoteMap h@(TransportHandle g _) ochan =
gen r = case Git.location r of gen r = case Git.location r of
Git.Url u -> case M.lookup (uriScheme u) remoteTransports of Git.Url u -> case M.lookup (uriScheme u) remoteTransports of
Just transport Just transport
| remoteAnnexSync (extractRemoteGitConfig r (Git.repoDescribe r)) -> do | remoteAnnexSync gc -> do
ichan <- newTChanIO :: IO (TChan Consumed) ichan <- newTChanIO :: IO (TChan Consumed)
return $ Just return $ Just
( r ( r
, (transport r (RemoteURI u) h ichan ochan, ichan) , (transport (RemoteRepo r gc) (RemoteURI u) h ichan ochan, ichan)
) )
_ -> return Nothing _ -> return Nothing
_ -> return Nothing _ -> return Nothing
where
gc = extractRemoteGitConfig r (Git.repoDescribe r)
genTransportHandle :: IO TransportHandle genTransportHandle :: IO TransportHandle
genTransportHandle = do genTransportHandle = do

View file

@ -22,13 +22,13 @@ import Control.Concurrent.STM
import Control.Concurrent.Async import Control.Concurrent.Async
transport :: Transport transport :: Transport
transport r url h@(TransportHandle g s) ichan ochan = do transport rr@(RemoteRepo r gc) url h@(TransportHandle g s) ichan ochan = do
-- enable ssh connection caching wherever inLocalRepo is called -- enable ssh connection caching wherever inLocalRepo is called
g' <- liftAnnex h $ sshCachingTo r g g' <- liftAnnex h $ sshOptionsTo r gc g
transport' r url (TransportHandle g' s) ichan ochan transport' rr url (TransportHandle g' s) ichan ochan
transport' :: Transport transport' :: Transport
transport' r url transporthandle ichan ochan = do transport' (RemoteRepo r _) url transporthandle ichan ochan = do
v <- liftAnnex transporthandle $ git_annex_shell r "notifychanges" [] [] v <- liftAnnex transporthandle $ git_annex_shell r "notifychanges" [] []
case v of case v of

View file

@ -14,6 +14,7 @@ import Common
import qualified Annex import qualified Annex
import qualified Git.Types as Git import qualified Git.Types as Git
import qualified Utility.SimpleProtocol as Proto import qualified Utility.SimpleProtocol as Proto
import Types.GitConfig
import Network.URI import Network.URI
import Control.Concurrent import Control.Concurrent
@ -27,7 +28,7 @@ newtype RemoteURI = RemoteURI URI
-- from a Chan, and emits others to another Chan. -- from a Chan, and emits others to another Chan.
type Transport = RemoteRepo -> RemoteURI -> TransportHandle -> TChan Consumed -> TChan Emitted -> IO () type Transport = RemoteRepo -> RemoteURI -> TransportHandle -> TChan Consumed -> TChan Emitted -> IO ()
type RemoteRepo = Git.Repo data RemoteRepo = RemoteRepo Git.Repo RemoteGitConfig
type LocalRepo = Git.Repo type LocalRepo = Git.Repo
-- All Transports share a single AnnexState MVar -- All Transports share a single AnnexState MVar

2
debian/changelog vendored
View file

@ -28,6 +28,8 @@ git-annex (5.20150206) UNRELEASED; urgency=medium
* sync, assistant: Include repository name in head branch commit message. * sync, assistant: Include repository name in head branch commit message.
* The ssh-options git config is now used by gcrypt, rsync, and ddar * The ssh-options git config is now used by gcrypt, rsync, and ddar
special remotes that use ssh as a transport. special remotes that use ssh as a transport.
* sync: Use the ssh-options git config when doing git pull and push.
* remotedaemon: Use the ssh-options git config.
-- Joey Hess <id@joeyh.name> Fri, 06 Feb 2015 13:57:08 -0400 -- Joey Hess <id@joeyh.name> Fri, 06 Feb 2015 13:57:08 -0400

View file

@ -43,3 +43,6 @@ Debian testing 5.20141125
# End of transcript or log. # End of transcript or log.
"""]] """]]
> [[fixed|done]], ssh-options is now propigated everywhere that ssh
> connection caching goes --[[Joey]]