1{- GIT_SSH and GIT_SSH_COMMAND support
2 -
3 - Copyright 2017 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8module Git.Ssh (module Git.Ssh, module Utility.SshHost) where
9
10import Common
11import Utility.Env
12import Utility.SshHost
13
14import Data.Char
15
16gitSshEnv :: String
17gitSshEnv = "GIT_SSH"
18
19gitSshCommandEnv :: String
20gitSshCommandEnv = "GIT_SSH_COMMAND"
21
22gitSshEnvSet :: IO Bool
23gitSshEnvSet = anyM (isJust <$$> getEnv) [gitSshEnv, gitSshCommandEnv]
24
25type SshPort = Integer
26
27-- Command to run on the remote host. It is run by the shell
28-- there, so any necessary shell escaping of parameters in it should
29-- already be done.
30type SshCommand = String
31
32-- | Checks for GIT_SSH and GIT_SSH_COMMAND and if set, returns
33-- a command and parameters to run to ssh.
34gitSsh :: SshHost -> Maybe SshPort -> SshCommand -> IO (Maybe (FilePath, [CommandParam]))
35gitSsh host mp cmd = gitSsh' host mp cmd []
36
37gitSsh' :: SshHost -> Maybe SshPort -> SshCommand -> [CommandParam] -> IO (Maybe (FilePath, [CommandParam]))
38gitSsh' host mp cmd extrasshparams = do
39	gsc <- getEnv gitSshCommandEnv
40	case gsc of
41		Just c
42			-- git only runs the command with the shell
43			-- when it contains spaces; otherwise it's
44			-- treated the same as GIT_SSH
45			| any isSpace c -> ret "sh"
46				[ Param "-c"
47				, Param (shellcmd c sshps)
48				]
49			| otherwise -> ret c sshps
50		Nothing -> do
51			gs <- getEnv gitSshEnv
52			case gs of
53				Just c -> ret c sshps
54				Nothing -> return Nothing
55 where
56	ret c l = return $ Just (c, l)
57
58	-- Git passes exactly these parameters to the ssh command.
59	gitps = map Param $ case mp of
60		Nothing -> [fromSshHost host, cmd]
61		Just p -> [fromSshHost host, "-p", show p, cmd]
62
63	-- Passing any extra parameters to the ssh command may
64	-- break some commands.
65	sshps = extrasshparams ++ gitps
66
67	-- The shell command to run with sh -c is constructed
68	-- this way, rather than using "$@" because there could be some
69	-- unwanted parameters passed to the command, and this way they
70	-- are ignored. For example, when Utility.Rsync.rsyncShell is
71	-- used, rsync adds some parameters after the command.
72	shellcmd c ps = c ++ " " ++ unwords (map shellEscape (toCommand ps))
73