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
55
Annex/Ssh.hs
55
Annex/Ssh.hs
|
@ -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
|
||||
|
||||
|
|
|
@ -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)
|
||||
]
|
||||
|
|
|
@ -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." ]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
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.
|
||||
* 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
|
||||
|
||||
|
|
|
@ -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]]
|
||||
|
|
Loading…
Reference in a new issue