The ssh-options git config is now used by gcrypt, rsync, and ddar special remotes that use ssh as a transport.

Annex/Ssh.hs

@@ -1,6 +1,6 @@
 {- git-annex ssh interface, with connection caching
  -
- - Copyright 2012-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2015 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -8,7 +8,7 @@
 {-# LANGUAGE CPP #-}
 
 module Annex.Ssh (
-	sshCachingOptions,
+	sshOptions,
 	sshCacheDir,
 	sshReadPort,
 	forceSshCleanup,
@@ -41,20 +41,26 @@ import Utility.LockFile
 #endif
 
 {- Generates parameters to ssh to a given host (or user@host) on a given
- - port, with connection caching. -}
-sshCachingOptions :: (String, Maybe Integer) -> [CommandParam] -> Annex [CommandParam]
-sshCachingOptions (host, port) opts = go =<< sshInfo (host, port)
+ - port. This includes connection caching parameters, and any ssh-options. -}
+sshOptions :: (String, Maybe Integer) -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam]
+sshOptions (host, port) gc opts = go =<< sshCachingInfo (host, port)
   where
 	go (Nothing, params) = ret params
 	go (Just socketfile, params) = do
 		prepSocket socketfile
 		ret params
-	ret ps = return $ ps ++ opts ++ portParams port ++ [Param "-T"]
+	ret ps = return $ concat
+		[ ps
+		, map Param (remoteAnnexSshOptions gc)
+		, opts
+		, portParams port
+		, [Param "-T"]
+		]
 
 {- Returns a filename to use for a ssh connection caching socket, and
  - parameters to enable ssh connection caching. -}
-sshInfo :: (String, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam])
-sshInfo (host, port) = go =<< sshCacheDir
+sshCachingInfo :: (String, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam])
+sshCachingInfo (host, port) = go =<< sshCacheDir
   where
 	go Nothing = return (Nothing, [])
 	go (Just dir) = do
@@ -256,7 +262,7 @@ sshCachingTo remote g
 	| otherwise = case Git.Url.hostuser remote of
 		Nothing -> uncached
 		Just host -> do
-			(msockfile, _) <- sshInfo (host, Git.Url.port remote)
+			(msockfile, _) <- sshCachingInfo (host, Git.Url.port remote)
 			case msockfile of
 				Nothing -> return g
 				Just sockfile -> do

Remote/Ddar.hs

@@ -23,7 +23,10 @@ import Remote.Helper.Special
 import Annex.Ssh
 import Annex.UUID
 
-type DdarRepo = String
+data DdarRepo = DdarRepo
+	{ ddarRepoConfig :: RemoteGitConfig
+	, ddarRepoLocation :: String
+	}
 
 remote :: RemoteType
 remote = RemoteType {
@@ -62,18 +65,18 @@ gen r u c gc = do
 		, config = c
 		, repo = r
 		, gitconfig = gc
-		, localpath = if ddarLocal ddarrepo && not (null ddarrepo)
-			then Just ddarrepo
+		, localpath = if ddarLocal ddarrepo && not (null $ ddarRepoLocation ddarrepo)
+			then Just $ ddarRepoLocation ddarrepo
 			else Nothing
 		, remotetype = remote
 		, availability = if ddarLocal ddarrepo then LocallyAvailable else GloballyAvailable
 		, readonly = False
 		, mkUnavailable = return Nothing
-		, getInfo = return [("repo", ddarrepo)]
+		, getInfo = return [("repo", ddarRepoLocation ddarrepo)]
 		, claimUrl = Nothing
 		, checkUrl = Nothing
 		}
-	ddarrepo = fromMaybe (error "missing ddarrepo") $ remoteAnnexDdarRepo gc
+	ddarrepo = maybe (error "missing ddarrepo") (DdarRepo gc) (remoteAnnexDdarRepo gc)
 	specialcfg = (specialRemoteCfg c)
 		-- chunking would not improve ddar
 		{ chunkConfig = NoChunks
@@ -100,7 +103,7 @@ store ddarrepo = fileStorer $ \k src _p -> do
 		[ Param "c"
 		, Param "-N"
 		, Param $ key2file k
-		, Param ddarrepo
+		, Param $ ddarRepoLocation ddarrepo
 		, File src
 		]
 	liftIO $ boolSystem "ddar" params
@@ -110,25 +113,23 @@ splitRemoteDdarRepo :: DdarRepo -> (String, String)
 splitRemoteDdarRepo ddarrepo =
 	(host, ddarrepo')
   where
-	(host, remainder) = span (/= ':') ddarrepo
+	(host, remainder) = span (/= ':') (ddarRepoLocation ddarrepo)
 	ddarrepo' = drop 1 remainder
 
 {- Return the command and parameters to use for a ddar call that may need to be
  - made on a remote repository. This will call ssh if needed. -}
-
 ddarRemoteCall :: DdarRepo -> Char -> [CommandParam] -> Annex (String, [CommandParam])
 ddarRemoteCall ddarrepo cmd params
 	| ddarLocal ddarrepo = return ("ddar", localParams)
 	| otherwise = do
-		remoteCachingParams <- sshCachingOptions (host, Nothing) []
-		return ("ssh", remoteCachingParams ++ remoteParams)
+		os <- sshOptions (host, Nothing) (ddarRepoConfig ddarrepo) remoteParams
+		return ("ssh", os)
   where
 	(host, ddarrepo') = splitRemoteDdarRepo ddarrepo
-	localParams = Param [cmd] : Param ddarrepo : params
+	localParams = Param [cmd] : Param (ddarRepoLocation ddarrepo) : params
 	remoteParams = Param host : Param "ddar" : Param [cmd] : Param ddarrepo' : params
 
 {- Specialized ddarRemoteCall that includes extraction command and flags -}
-
 ddarExtractRemoteCall :: DdarRepo -> Key -> Annex (String, [CommandParam])
 ddarExtractRemoteCall ddarrepo k =
 	ddarRemoteCall ddarrepo 'x' [Param "--force-stdout", Param $ key2file k]
@@ -152,13 +153,13 @@ remove ddarrepo key = do
 ddarDirectoryExists :: DdarRepo -> Annex (Either String Bool)
 ddarDirectoryExists ddarrepo
 	| ddarLocal ddarrepo = do
-		maybeStatus <- liftIO $ tryJust (guard . isDoesNotExistError) $ getFileStatus ddarrepo
+		maybeStatus <- liftIO $ tryJust (guard . isDoesNotExistError) $ getFileStatus $ ddarRepoLocation ddarrepo
 		return $ case maybeStatus of
 			Left _ -> Right False
 			Right status -> Right $ isDirectory status
 	| otherwise = do
-		sshCachingParams <- sshCachingOptions (host, Nothing) []
-		exitCode <- liftIO $ safeSystem "ssh" $ sshCachingParams ++ params
+		ps <- sshOptions (host, Nothing) (ddarRepoConfig ddarrepo) params
+		exitCode <- liftIO $ safeSystem "ssh" ps
 		case exitCode of
 			ExitSuccess -> return $ Right True
 			ExitFailure 1 -> return $ Right False
@@ -195,4 +196,4 @@ checkKey ddarrepo key = do
 		Right False -> return False
 
 ddarLocal :: DdarRepo -> Bool
-ddarLocal = notElem ':'
+ddarLocal = notElem ':' . ddarRepoLocation

Remote/GCrypt.hs

@@ -70,7 +70,7 @@ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remot
 gen baser u c gc = do
 	-- doublecheck that cache matches underlying repo's gcrypt-id
 	-- (which might not be set), only for local repos
-	(mgcryptid, r) <- getGCryptId True baser
+	(mgcryptid, r) <- getGCryptId True baser gc
 	g <- gitRepo
 	case (mgcryptid, Git.GCrypt.remoteRepoId g (Git.remoteName baser)) of
 		(Just gcryptid, Just cachedgcryptid)
@@ -99,7 +99,7 @@ gen' :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remo
 gen' r u c gc = do
 	cst <- remoteCost gc $
 		if repoCheap r then nearlyCheapRemoteCost else expensiveRemoteCost
-	(rsynctransport, rsyncurl) <- rsyncTransportToObjects r
+	(rsynctransport, rsyncurl) <- rsyncTransportToObjects r gc
 	let rsyncopts = Remote.Rsync.genRsyncOpts c gc rsynctransport rsyncurl
 	let this = Remote 
 		{ uuid = u
@@ -139,13 +139,13 @@ gen' r u c gc = do
 			{ displayProgress = False }
 		| otherwise = specialRemoteCfg c
 
-rsyncTransportToObjects :: Git.Repo -> Annex ([CommandParam], String)
-rsyncTransportToObjects r = do
-	(rsynctransport, rsyncurl, _) <- rsyncTransport r
+rsyncTransportToObjects :: Git.Repo -> RemoteGitConfig -> Annex ([CommandParam], String)
+rsyncTransportToObjects r gc = do
+	(rsynctransport, rsyncurl, _) <- rsyncTransport r gc
 	return (rsynctransport, rsyncurl ++ "/annex/objects")
 
-rsyncTransport :: Git.Repo -> Annex ([CommandParam], String, AccessMethod)
-rsyncTransport r
+rsyncTransport :: Git.Repo -> RemoteGitConfig -> Annex ([CommandParam], String, AccessMethod)
+rsyncTransport r gc
 	| "ssh://" `isPrefixOf` loc = sshtransport $ break (== '/') $ drop (length "ssh://") loc
 	| "//:" `isInfixOf` loc = othertransport
 	| ":" `isInfixOf` loc = sshtransport $ separate (== ':') loc
@@ -156,7 +156,7 @@ rsyncTransport r
 		let rsyncpath = if "/~/" `isPrefixOf` path
 			then drop 3 path
 			else path
-		opts <- sshCachingOptions (host, Nothing) []
+		opts <- sshOptions (host, Nothing) gc []
 		return (rsyncShell $ Param "ssh" : opts, host ++ ":" ++ rsyncpath, AccessShell)
 	othertransport = return ([], loc, AccessDirect)
 
@@ -218,7 +218,7 @@ gCryptSetup mu _ c = go $ M.lookup "gitrepo" c
 setupRepo :: Git.GCrypt.GCryptId -> Git.Repo -> Annex AccessMethod
 setupRepo gcryptid r
 	| Git.repoIsUrl r = do
-		(_, _, accessmethod) <- rsyncTransport r
+		(_, _, accessmethod) <- rsyncTransport r def
 		case accessmethod of
 			AccessDirect -> rsyncsetup
 			AccessShell -> ifM gitannexshellsetup
@@ -240,7 +240,7 @@ setupRepo gcryptid r
 	 -}
 	rsyncsetup = Remote.Rsync.withRsyncScratchDir $ \tmp -> do
 		liftIO $ createDirectoryIfMissing True $ tmp </> objectDir
-		(rsynctransport, rsyncurl, _) <- rsyncTransport r
+		(rsynctransport, rsyncurl, _) <- rsyncTransport r def
 		let tmpconfig = tmp </> "config"
 		void $ liftIO $ rsync $ rsynctransport ++
 			[ Param $ rsyncurl ++ "/config"
@@ -376,7 +376,7 @@ toAccessMethod _ = AccessDirect
 
 getGCryptUUID :: Bool -> Git.Repo -> Annex (Maybe UUID)
 getGCryptUUID fast r = (genUUIDInNameSpace gCryptNameSpace <$>) . fst
-	<$> getGCryptId fast r
+	<$> getGCryptId fast r def
 
 coreGCryptId :: String
 coreGCryptId = "core.gcrypt-id"
@@ -389,22 +389,22 @@ coreGCryptId = "core.gcrypt-id"
  - tries git-annex-shell and direct rsync of the git config file.
  -
  - (Also returns a version of input repo with its config read.) -}
-getGCryptId :: Bool -> Git.Repo -> Annex (Maybe Git.GCrypt.GCryptId, Git.Repo)
-getGCryptId fast r
+getGCryptId :: Bool -> Git.Repo -> RemoteGitConfig -> Annex (Maybe Git.GCrypt.GCryptId, Git.Repo)
+getGCryptId fast r gc
 	| Git.repoIsLocal r || Git.repoIsLocalUnknown r = extract <$>
 		liftIO (catchMaybeIO $ Git.Config.read r)
 	| not fast = extract . liftM fst <$> getM (eitherToMaybe <$>)
 		[ Ssh.onRemote r (Git.Config.fromPipe r, return (Left undefined)) "configlist" [] []
-		, getConfigViaRsync r
+		, getConfigViaRsync r gc
 		]
 	| otherwise = return (Nothing, r)
   where
 	extract Nothing = (Nothing, r)
 	extract (Just r') = (Git.Config.getMaybe coreGCryptId r', r')
 
-getConfigViaRsync :: Git.Repo -> Annex (Either SomeException (Git.Repo, String))
-getConfigViaRsync r = do
-	(rsynctransport, rsyncurl, _) <- rsyncTransport r
+getConfigViaRsync :: Git.Repo -> RemoteGitConfig -> Annex (Either SomeException (Git.Repo, String))
+getConfigViaRsync r gc = do
+	(rsynctransport, rsyncurl, _) <- rsyncTransport r gc
 	liftIO $ do
 		withTmpFile "tmpconfig" $ \tmpconfig _ -> do
 			void $ rsync $ rsynctransport ++

Remote/Helper/Ssh.hs

@@ -30,7 +30,7 @@ toRepo :: Git.Repo -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam]
 toRepo r gc sshcmd = do
 	let opts = map Param $ remoteAnnexSshOptions gc
 	let host = fromMaybe (error "bad ssh url") $ Git.Url.hostuser r
-	params <- sshCachingOptions (host, Git.Url.port r) opts
+	params <- sshOptions (host, Git.Url.port r) gc opts
 	return $ params ++ Param host : sshcmd
 
 {- Generates parameters to run a git-annex-shell command on a remote

Remote/Rsync.hs

@@ -121,8 +121,8 @@ rsyncTransport gc url
 				let (port, sshopts') = sshReadPort sshopts
 				    userhost = takeWhile (/=':') url
 				-- Connection caching
-				(Param "ssh":) <$> sshCachingOptions
-					(userhost, port)
+				(Param "ssh":) <$> sshOptions
+					(userhost, port) gc
 					(map Param $ loginopt ++ sshopts')
 			"rsh":rshopts -> return $ map Param $ "rsh" :
 				loginopt ++ rshopts

Types/GitConfig.hs

@@ -15,6 +15,7 @@ module Types.GitConfig (
 import Common
 import qualified Git
 import qualified Git.Config
+import qualified Git.Construct
 import Utility.DataUnits
 import Config.Cost
 import Types.Distribution
@@ -193,3 +194,5 @@ notempty Nothing = Nothing
 notempty (Just "") = Nothing
 notempty (Just s) = Just s
 
+instance Default RemoteGitConfig where
+	def = extractRemoteGitConfig Git.Construct.fromUnknown "dummy"

debian/changelog

@@ -26,6 +26,8 @@ git-annex (5.20150206) UNRELEASED; urgency=medium
     default, since that can be surprising behavior and difficult to recover
     from. The old behavior is available by using --force.
   * 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.
 
  -- Joey Hess <id@joeyh.name>  Fri, 06 Feb 2015 13:57:08 -0400