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