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:
parent
3f5c9ddc05
commit
15107d2c5a
8 changed files with 53 additions and 33 deletions
53
Annex/Ssh.hs
53
Annex/Ssh.hs
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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)
|
||||||
]
|
]
|
||||||
|
|
|
@ -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." ]
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
2
debian/changelog
vendored
|
@ -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
|
||||||
|
|
||||||
|
|
|
@ -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]]
|
||||||
|
|
Loading…
Reference in a new issue