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
|
{- 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
]
| otherwise -> ret c [gitps]
Nothing -> do
gs <- getEnv gitSshEnv
case gs of
Just c -> ret c [gitps]
Nothing -> return Nothing
where
-- git passes exactly these parameters
gitps = map Param $ case mp of
Nothing -> [host, cmd]
Just p -> [host, "-p", show p, cmd]
ret c ll = return $ Just (c, concat ll)
|
