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,
sshReadPort,
forceSshCleanup,
sshCachingEnv,
sshCachingTo,
inRepoWithSshCachingTo,
runSshCaching,
sshOptionsEnv,
sshOptionsTo,
inRepoWithSshOptionsTo,
runSshOptions,
sshAskPassEnv,
runSshAskPass
) where
@ -233,31 +233,38 @@ sshReadPort params = (port, reverse args)
| otherwise = aux (p,q:ps) rest
readPort p = fmap fst $ listToMaybe $ reads p
{- When this env var is set, git-annex runs ssh with parameters
- to use the socket file that the env var contains.
{- When this env var is set, git-annex runs ssh with the specified
- options. (The options are separated by newlines.)
-
- This is a workaround for GIT_SSH not being able to contain
- additional parameters to pass to ssh. -}
sshCachingEnv :: String
sshCachingEnv = "GIT_ANNEX_SSHCACHING"
sshOptionsEnv :: String
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
- 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.
- 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. -}
inRepoWithSshCachingTo :: Git.Repo -> (Git.Repo -> IO a) -> Annex a
inRepoWithSshCachingTo remote a =
liftIO . a =<< sshCachingTo remote =<< gitRepo
inRepoWithSshOptionsTo :: Git.Repo -> RemoteGitConfig -> (Git.Repo -> IO a) -> Annex a
inRepoWithSshOptionsTo remote gc a =
liftIO . a =<< sshOptionsTo remote gc =<< gitRepo
{- 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 set sshCachingEnv so that git-annex will know what socket
- file to use. -}
sshCachingTo :: Git.Repo -> Git.Repo -> Annex Git.Repo
sshCachingTo remote g
{- To make any git commands be run with ssh caching enabled,
- and configured ssh-options alters the local Git.Repo's gitEnv
- to set GIT_SSH=git-annex, and sets sshOptionsEnv. -}
sshOptionsTo :: Git.Repo -> RemoteGitConfig -> Git.Repo -> Annex Git.Repo
sshOptionsTo remote gc g
| not (Git.repoIsUrl remote) || Git.repoIsHttp remote = uncached
| otherwise = case Git.Url.hostuser remote of
Nothing -> uncached
@ -268,15 +275,19 @@ sshCachingTo remote g
Just sockfile -> do
command <- liftIO readProgramFile
prepSocket sockfile
let val = toSshOptionsEnv $ concat
[ sshConnectionCachingParams sockfile
, map Param (remoteAnnexSshOptions gc)
]
liftIO $ do
g' <- addGitEnv g sshCachingEnv sockfile
g' <- addGitEnv g sshOptionsEnv val
addGitEnv g' "GIT_SSH" command
where
uncached = return g
runSshCaching :: [String] -> FilePath -> IO ()
runSshCaching args sockfile = do
let args' = toCommand (sshConnectionCachingParams sockfile) ++ args
runSshOptions :: [String] -> String -> IO ()
runSshOptions args s = do
let args' = toCommand (fromSshOptionsEnv s) ++ args
let p = proc "ssh" args'
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 ((v, a):rest) = maybe (go rest) a =<< getEnv v
envmodes =
[ (sshCachingEnv, runSshCaching args)
[ (sshOptionsEnv, runSshOptions args)
, (sshAskPassEnv, runSshAskPass)
]

View file

@ -234,8 +234,9 @@ pullRemote remote branch = do
stopUnless fetch $
next $ mergeRemote remote branch
where
fetch = inRepoWithSshCachingTo (Remote.repo remote) $ Git.Command.runBool
[Param "fetch", Param $ Remote.name remote]
fetch = inRepoWithSshOptionsTo (Remote.repo remote) (Remote.gitconfig remote) $
Git.Command.runBool
[Param "fetch", Param $ Remote.name remote]
{- The remote probably has both a master and a synced/master branch.
- Which to merge from? Well, the master has whatever latest changes
@ -270,7 +271,7 @@ pushRemote remote (Just branch) = go =<< needpush
showStart "push" (Remote.name remote)
next $ next $ do
showOutput
ok <- inRepoWithSshCachingTo (Remote.repo remote) $
ok <- inRepoWithSshOptionsTo (Remote.repo remote) (Remote.gitconfig remote) $
pushBranch remote branch
unless ok $ do
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
Git.Url u -> case M.lookup (uriScheme u) remoteTransports of
Just transport
| remoteAnnexSync (extractRemoteGitConfig r (Git.repoDescribe r)) -> do
| remoteAnnexSync gc -> do
ichan <- newTChanIO :: IO (TChan Consumed)
return $ Just
( r
, (transport r (RemoteURI u) h ichan ochan, ichan)
, (transport (RemoteRepo r gc) (RemoteURI u) h ichan ochan, ichan)
)
_ -> return Nothing
_ -> return Nothing
where
gc = extractRemoteGitConfig r (Git.repoDescribe r)
genTransportHandle :: IO TransportHandle
genTransportHandle = do

View file

@ -22,13 +22,13 @@ import Control.Concurrent.STM
import Control.Concurrent.Async
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
g' <- liftAnnex h $ sshCachingTo r g
transport' r url (TransportHandle g' s) ichan ochan
g' <- liftAnnex h $ sshOptionsTo r gc g
transport' rr url (TransportHandle g' s) ichan ochan
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" [] []
case v of

View file

@ -14,6 +14,7 @@ import Common
import qualified Annex
import qualified Git.Types as Git
import qualified Utility.SimpleProtocol as Proto
import Types.GitConfig
import Network.URI
import Control.Concurrent
@ -27,7 +28,7 @@ newtype RemoteURI = RemoteURI URI
-- from a Chan, and emits others to another Chan.
type Transport = RemoteRepo -> RemoteURI -> TransportHandle -> TChan Consumed -> TChan Emitted -> IO ()
type RemoteRepo = Git.Repo
data RemoteRepo = RemoteRepo Git.Repo RemoteGitConfig
type LocalRepo = Git.Repo
-- 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.
* The ssh-options git config is now used by gcrypt, rsync, and ddar
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

View file

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