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.

1 files changed, 37 insertions, 13 deletions

diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index f01cb648c..4f2b49209 100644
--- a/Annex/Ssh.hs
+++ b/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