Support GIT_SSH and GIT_SSH_COMMAND

They are handled close the same as they are by git. However, unlike git,
git-annex sometimes needs to pass the -n parameter when using these.

So, this has the potential for breaking some setup, and perhaps there ought
to be a ANNEX_USE_GIT_SSH=1 needed to use these. But I'd rather avoid that
if possible, so let's see if anyone complains.

Almost all places where "ssh" was run have been changed to support the env
vars. Anything still calling sshOptions does not support them. In
particular, rsync special remotes don't. Seems that annex-rsync-transport
already gives sufficient control there.

(Fixed in passing: Remote.Helper.Ssh.toRepo used to extract
remoteAnnexSshOptions and pass them to sshOptions, which was redundant
since sshOptions also extracts those.)

This commit was sponsored by Jeff Goeke-Smith on Patreon.

Annex/Ssh.hs

@@ -9,6 +9,8 @@
 
 module Annex.Ssh (
 	ConsumeStdin(..),
+	SshCommand,
+	sshCommand,
 	sshOptions,
 	sshCacheDir,
 	sshReadPort,
@@ -37,6 +39,7 @@ import Utility.Env
 import Utility.FileSystemEncoding
 import Types.CleanupActions
 import Git.Env
+import Git.Ssh
 #ifndef mingw32_HOST_OS
 import Annex.Perms
 import Annex.LockPool
@@ -47,8 +50,22 @@ import Annex.LockPool
  - not be allowed to consume the process's stdin. -}
 data ConsumeStdin = ConsumeStdin | NoConsumeStdin
 
+{- Generates a command to ssh to a given host (or user@host) on a given
+ - port. This includes connection caching parameters, and any ssh-options.
+ - If GIT_SSH or GIT_SSH_COMMAND is set, they are used instead. -}
+sshCommand :: ConsumeStdin -> (SshHost, Maybe SshPort) -> RemoteGitConfig -> SshCommand -> Annex (FilePath, [CommandParam])
+sshCommand cs (host, port) gc remotecmd =
+	go =<< liftIO (gitSsh host port remotecmd)
+  where
+	go (Just (c, ps)) = return (c, consumeStdinParams cs ++ ps)
+	go Nothing = do
+		ps <- sshOptions cs (host, port) gc []
+		return ("ssh", Param host:ps++[Param remotecmd])
+
 {- Generates parameters to ssh to a given host (or user@host) on a given
- - port. This includes connection caching parameters, and any ssh-options. -}
+ - port. This includes connection caching parameters, and any
+ - ssh-options. Note that the host to ssh to and the command to run
+ - are not included in the returned options. -}
 sshOptions :: ConsumeStdin -> (String, Maybe Integer) -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam]
 sshOptions cs (host, port) gc opts = go =<< sshCachingInfo (host, port)
   where
@@ -61,12 +78,14 @@ sshOptions cs (host, port) gc opts = go =<< sshCachingInfo (host, port)
 		, map Param (remoteAnnexSshOptions gc)
 		, opts
 		, portParams port
-		, case cs of
-			ConsumeStdin -> []
-			NoConsumeStdin -> [Param "-n"]
+		, consumeStdinParams cs
 		, [Param "-T"]
 		]
 
+consumeStdinParams :: ConsumeStdin -> [CommandParam]
+consumeStdinParams ConsumeStdin = []
+consumeStdinParams NoConsumeStdin = [Param "-n"]
+
 {- Returns a filename to use for a ssh connection caching socket, and
  - parameters to enable ssh connection caching. -}
 sshCachingInfo :: (String, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam])
@@ -285,19 +304,24 @@ inRepoWithSshOptionsTo remote gc a =
 {- 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 set sshOptionsEnv when running git
- - commands. -}
+ - commands.
+ -
+ - If GIT_SSH or GIT_SSH_COMMAND are set, this has no effect. -}
 sshOptionsTo :: Git.Repo -> RemoteGitConfig -> Git.Repo -> Annex Git.Repo
 sshOptionsTo remote gc localr
 	| not (Git.repoIsUrl remote) || Git.repoIsHttp remote = unchanged
 	| otherwise = case Git.Url.hostuser remote of
 		Nothing -> unchanged
-		Just host -> do
-			(msockfile, _) <- sshCachingInfo (host, Git.Url.port remote)
-			case msockfile of
-				Nothing -> use []
-				Just sockfile -> do
-					prepSocket sockfile
-					use (sshConnectionCachingParams sockfile)
+		Just host -> ifM (liftIO gitSshEnvSet)
+			( unchanged
+			, do
+				(msockfile, _) <- sshCachingInfo (host, Git.Url.port remote)
+				case msockfile of
+					Nothing -> use []
+					Just sockfile -> do
+						prepSocket sockfile
+						use (sshConnectionCachingParams sockfile)
+			)
   where
 	unchanged = return localr
 
@@ -313,7 +337,7 @@ sshOptionsTo remote gc localr
 				liftIO $ do
 					localr' <- addGitEnv localr sshOptionsEnv
 						(toSshOptionsEnv sshopts)
-					addGitEnv localr' "GIT_SSH" command
+					addGitEnv localr' gitSshEnv command
 
 runSshOptions :: [String] -> String -> IO ()
 runSshOptions args s = do

CHANGELOG

@@ -21,6 +21,9 @@ git-annex (6.20170301.2) UNRELEASED; urgency=medium
     where "merging" messages were included in the output of configlist
     (and perhaps other commands) and caused a "Failed to get annex.uuid
     configuration" error.
+  * Support GIT_SSH and GIT_SSH_COMMAND, which are handled close the same
+    as they are by git. However, unlike git, git-annex sometimes needs to
+    pass the -n parameter when using these.
 
  -- Joey Hess <id@joeyh.name>  Thu, 02 Mar 2017 12:51:40 -0400
 

Command/Map.hs

@@ -224,10 +224,10 @@ tryScan r
 		(pipedconfig, return Nothing) "configlist" [] []
 	manualconfiglist = do
 		gc <- Annex.getRemoteGitConfig r
-		sshparams <- Ssh.toRepo NoConsumeStdin r gc [Param sshcmd]
-		liftIO $ pipedconfig "ssh" sshparams
+		(sshcmd, sshparams) <- Ssh.toRepo NoConsumeStdin r gc remotecmd
+		liftIO $ pipedconfig sshcmd sshparams
 	  where
-		sshcmd = "sh -c " ++ shellEscape
+		remotecmd = "sh -c " ++ shellEscape
 			(cddir ++ " && " ++ "git config --null --list")
 		dir = Git.repoPath r
 		cddir

Git/Ssh.hs

@@ -0,0 +1,68 @@
+{- GIT_SSH and GIT_SSH_COMMAND support
+ -
+ - Copyright 2017 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.Ssh where
+
+import Common
+import Utility.Env
+
+import Data.Char
+
+gitSshEnv :: String
+gitSshEnv = "GIT_SSH"
+
+gitSshCommandEnv :: String
+gitSshCommandEnv = "GIT_SSH_COMMAND"
+
+gitSshEnvSet :: IO Bool
+gitSshEnvSet = anyM (isJust <$$> getEnv) [gitSshEnv, gitSshCommandEnv]
+
+-- Either a hostname, or user@host
+type SshHost = String
+
+type SshPort = Integer
+
+-- Command to run on the remote host. It is run by the shell
+-- there, so any necessary shell escaping of parameters in it should
+-- already be done.
+type SshCommand = String
+
+-- | Checks for GIT_SSH and GIT_SSH_COMMAND and if set, returns
+-- a command and parameters to run to ssh.
+gitSsh :: SshHost -> Maybe SshPort -> SshCommand -> IO (Maybe (FilePath, [CommandParam]))
+gitSsh host mp cmd = do
+	gsc <- getEnv gitSshCommandEnv
+	case gsc of
+		Just c
+			-- git only runs the command with the shell
+			-- when it contains spaces; otherwise it's
+			-- treated the same as GIT_SSH
+			| any isSpace c -> ret "sh"
+				[ [ Param "-c"
+				  , Param (c ++ " \"$@\"")
+				  , Param c
+				  ]
+				, gitps
+				-- cmd is already shell escaped
+				-- for the remote side, but needs to be
+				-- shell-escaped once more since it's
+				-- passed through the local shell.
+				, [ Param $ shellEscape $ cmd ]
+				]
+			| otherwise -> ret c [ gitps, [Param cmd]]
+		Nothing -> do
+			gs <- getEnv gitSshEnv
+			case gs of
+				Just c -> ret c [ gitps, [Param cmd]]
+				Nothing -> return Nothing
+ where
+	-- git passes exactly these parameters, followed by another
+	-- parameter containing the remote command.
+	gitps = map Param $ case mp of
+		Nothing -> [host]
+		Just p -> [host, "-p", show p]
+	ret c ll = return $ Just (c, concat ll)

Remote/Bup.hs

@@ -212,11 +212,11 @@ storeBupUUID u buprepo = do
 	v = fromUUID u
 
 onBupRemote :: Git.Repo -> (FilePath -> [CommandParam] -> IO a) -> FilePath -> [CommandParam] -> Annex a
-onBupRemote r a command params = do
+onBupRemote r runner command params = do
 	c <- Annex.getRemoteGitConfig r
-	sshparams <- Ssh.toRepo NoConsumeStdin r c [Param $
-			"cd " ++ dir ++ " && " ++ unwords (command : toCommand params)]
-	liftIO $ a "ssh" sshparams
+	let remotecmd = "cd " ++ dir ++ " && " ++ unwords (command : toCommand params)
+	(sshcmd, sshparams) <- Ssh.toRepo NoConsumeStdin r c remotecmd
+	liftIO $ runner sshcmd sshparams
   where
 	path = Git.repoPath r
 	base = fromMaybe path (stripPrefix "/~/" path)

Remote/Ddar.hs

@@ -121,13 +121,12 @@ splitRemoteDdarRepo ddarrepo =
 ddarRemoteCall :: ConsumeStdin -> DdarRepo -> Char -> [CommandParam] -> Annex (String, [CommandParam])
 ddarRemoteCall cs ddarrepo cmd params
 	| ddarLocal ddarrepo = return ("ddar", localParams)
-	| otherwise = do
-		os <- sshOptions cs (host, Nothing) (ddarRepoConfig ddarrepo) []
-		return ("ssh", os ++ remoteParams)
+	| otherwise = sshCommand cs (host, Nothing) (ddarRepoConfig ddarrepo) remoteCommand
   where
 	(host, ddarrepo') = splitRemoteDdarRepo ddarrepo
 	localParams = Param [cmd] : Param (ddarRepoLocation ddarrepo) : params
-	remoteParams = Param host : Param "ddar" : Param [cmd] : Param ddarrepo' : params
+	remoteCommand = unwords $ map shellEscape $ toCommand $
+		[Param "ddar", Param [cmd], Param ddarrepo'] ++ params
 
 {- Specialized ddarRemoteCall that includes extraction command and flags -}
 ddarExtractRemoteCall :: ConsumeStdin -> DdarRepo -> Key -> Annex (String, [CommandParam])
@@ -159,23 +158,19 @@ ddarDirectoryExists ddarrepo
 			Left _ -> Right False
 			Right status -> Right $ isDirectory status
 	| otherwise = do
-		ps <- sshOptions NoConsumeStdin (host, Nothing)
-			(ddarRepoConfig ddarrepo) []
-		exitCode <- liftIO $ safeSystem "ssh" (ps ++ params)
+		let remotecmd = unwords $ map shellEscape
+			[ "test", "-d", ddarrepo' ]
+		(sshcmd, sshps) <- sshCommand NoConsumeStdin (host, Nothing)
+			(ddarRepoConfig ddarrepo) remotecmd
+		exitCode <- liftIO $ safeSystem sshcmd sshps
 		case exitCode of
 			ExitSuccess -> return $ Right True
 			ExitFailure 1 -> return $ Right False
-			ExitFailure code -> return $ Left $ "ssh call " ++
-				show (unwords $ toCommand params) ++
+			ExitFailure code -> return $ Left $ "ssh " ++
+				show (unwords $ toCommand sshps) ++
 				" failed with status " ++ show code
   where
 	(host, ddarrepo') = splitRemoteDdarRepo ddarrepo
-	params =
-		[ Param host
-		, Param "test"
-		, Param "-d"
-		, Param ddarrepo'
-		]
 
 {- Use "ddar t" to determine if a given key is present in a ddar archive -}
 inDdarManifest :: DdarRepo -> Key -> Annex (Either String Bool)

Remote/Helper/Ssh.hs

@@ -23,15 +23,10 @@ import Types.Remote
 import Types.Transfer
 import Config
 
-{- Generates parameters to ssh to a repository's host and run a command.
- - Caller is responsible for doing any neccessary shellEscaping of the
- - passed command. -}
-toRepo :: ConsumeStdin -> Git.Repo -> RemoteGitConfig -> [CommandParam] -> Annex [CommandParam]
-toRepo cs r gc sshcmd = do
-	let opts = map Param $ remoteAnnexSshOptions gc
+toRepo :: ConsumeStdin -> Git.Repo -> RemoteGitConfig -> SshCommand -> Annex (FilePath, [CommandParam])
+toRepo cs r gc remotecmd = do
 	let host = fromMaybe (giveup "bad ssh url") $ Git.Url.hostuser r
-	params <- sshOptions cs (host, Git.Url.port r) gc opts
-	return $ params ++ Param host : sshcmd
+	sshCommand cs (host, Git.Url.port r) gc remotecmd
 
 {- Generates parameters to run a git-annex-shell command on a remote
  - repository. -}
@@ -49,8 +44,7 @@ git_annex_shell cs r command params fields
 				: map shellEscape (toCommand shellopts) ++
 			uuidcheck u ++
 			map shellEscape (toCommand fieldopts)
-		sshparams <- toRepo cs r gc [Param sshcmd]
-		return $ Just ("ssh", sshparams)
+		Just <$> toRepo cs r gc sshcmd
 	| otherwise = return Nothing
   where
 	dir = Git.repoPath r

Remote/Rsync.hs

@@ -121,7 +121,6 @@ rsyncTransport gc url
 			"ssh":sshopts -> do
 				let (port, sshopts') = sshReadPort sshopts
 				    userhost = takeWhile (/=':') url
-				-- Connection caching
 				(Param "ssh":) <$> sshOptions ConsumeStdin
 					(userhost, port) gc
 					(map Param $ loginopt ++ sshopts')

doc/forum/GIT__95__SSH/comment_1_c2e827eeac7524845cad42671d77af95._comment

@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2017-03-17T17:26:56Z"
+ content="""
+I've added support for this now.
+
+However, since git's interface to this doesn't let any options other than
+-p be passed to the command run by this, git-annex can't either. Which
+means it can't pass options for ssh connection caching. So, I'm afraid that
+using `GIT_SSH` will slow things down somewhat. Of course, you can always
+enable ssh connection caching yourself in either the `GIT_SSH` script or
+the ssh configuration.
+"""]]

doc/git-annex.mdwn

@@ -1404,6 +1404,37 @@ specific failures.  git-annex itself should return 0 on success and 1 on
 failure, unless the `--time-limit=time` option is hit, in which case it
 returns with exit code 101.
 
+# ENVIRONMENT
+
+These environment variables are used by git-annex when set:
+
+* `GIT_WORK_TREE`, `GIT_DIR`
+
+  Handled the same as they are by git, see git(1)
+
+* `GIT_SSH`, `GIT_SSH_COMMAND`
+
+  Handled similarly to the same as described in git(1).
+  The one difference is that git-annex will sometimes pass an additional
+  "-n" parameter to these, as the first parameter, to prevent ssh from
+  reading from stdin.
+
+  Note that setting either of these environment variables prevents
+  git-annex from automatically enabling ssh connection caching
+  (see `annex.sshcaching`), so it will slow down some operations with
+  remotes over ssh. It's up to you to enable ssh connection caching
+  if you need it; see ssh's documentation.
+
+  Also, `annex.ssh-options` and `remote.<name>.annex-ssh-options`
+  won't have any effect when these envionment variables are set.
+
+  Usually it's better to configure any desired options through your
+  ~/.ssh/config file, or by setting `annex.ssh-options`.
+
+Some special remotes use additional environment variables
+for authentication etc. For example, `AWS_ACCESS_KEY_ID`
+and `GIT_ANNEX_P2P_AUTHTOKEN`. See special remote documentation.
+
 # FILES
 
 These files are used by git-annex:

git-annex.cabal

@@ -833,6 +833,7 @@ Executable git-annex
     Git.Remote.Remove
     Git.Repair
     Git.Sha
+    Git.Ssh
     Git.Status
     Git.Tree
     Git.Types