1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
{- 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 = gitSsh' host mp cmd []
gitSsh' :: SshHost -> Maybe SshPort -> SshCommand -> [CommandParam] -> IO (Maybe (FilePath, [CommandParam]))
gitSsh' host mp cmd extrasshparams = 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 (shellcmd c sshps)
]
| otherwise -> ret c sshps
Nothing -> do
gs <- getEnv gitSshEnv
case gs of
Just c -> ret c sshps
Nothing -> return Nothing
where
ret c l = return $ Just (c, l)
-- Git passes exactly these parameters to the ssh command.
gitps = map Param $ case mp of
Nothing -> [host, cmd]
Just p -> [host, "-p", show p, cmd]
-- Passing any extra parameters to the ssh command may
-- break some commands.
sshps = extrasshparams ++ gitps
-- The shell command to run with sh -c is constructed
-- this way, rather than using "$@" because there could be some
-- unwanted parameters passed to the command, and this way they
-- are ignored. For example, when Utility.Rsync.rsyncShell is
-- used, rsync adds some parameters after the command.
shellcmd c ps = c ++ " " ++ unwords (map shellEscape (toCommand ps))
|
