assistant: Set StrictHostKeyChecking yes when creating ssh remotes, and add it to the configuration for any ssh remotes previously created by the assistant. This avoids repeated prompts by ssh if the host key changes, instead syncing with such a remote will fail. Closes: #732602

1 files changed, 27 insertions, 21 deletions

diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs
index 1dc982ba6..d69c29254 100644
--- a/Assistant/Ssh.hs
+++ b/Assistant/Ssh.hs
@@ -9,10 +9,10 @@ module Assistant.Ssh where
 
 import Common.Annex
 import Utility.Tmp
-import Utility.UserInfo
 import Utility.Shell
 import Utility.Rsync
 import Utility.FileMode
+import Utility.SshConfig
 import Git.Remote
 
 import Data.Text (Text)
@@ -54,11 +54,6 @@ type SshPubKey = String
 sshOpt :: String -> String -> String
 sshOpt k v = concat ["-o", k, "=", v]
 
-sshDir :: IO FilePath
-sshDir = do
-	home <- myHomeDir
-	return $ home </> ".ssh"
-
 {- user@host or host -}
 genSshHost :: Text -> Maybe Text -> String
 genSshHost host user = maybe "" (\v -> T.unpack v ++ "@") user ++ T.unpack host
@@ -228,6 +223,10 @@ genSshKeyPair = withTmpDir "git-annex-keygen" $ \dir -> do
  -
  - Similarly, IdentitiesOnly is set in the ssh config to prevent the
  - ssh-agent from forcing use of a different key.
+ -
+ - Force strict host key checking to avoid repeated prompts
+ - when git-annex and git try to access the remote, if its
+ - host key has changed.
  -}
 setupSshKeyPair :: SshKeyPair -> SshData -> IO SshData
 setupSshKeyPair sshkeypair sshdata = do
@@ -242,29 +241,22 @@ setupSshKeyPair sshkeypair sshdata = do
 	setSshConfig sshdata
 		[ ("IdentityFile", "~/.ssh/" ++ sshprivkeyfile)
 		, ("IdentitiesOnly", "yes")
+		, ("StrictHostKeyChecking", "yes")
 		]
   where
 	sshprivkeyfile = "git-annex" </> "key." ++ mangleSshHostName sshdata
 	sshpubkeyfile = sshprivkeyfile ++ ".pub"
 
 {- Fixes git-annex ssh key pairs configured in .ssh/config 
- - by old versions to set IdentitiesOnly. -}
-fixSshKeyPair :: IO ()
-fixSshKeyPair = do
-	sshdir <- sshDir
-	let configfile = sshdir </> "config"
-	whenM (doesFileExist configfile) $ do
-		ls <- lines <$> readFileStrict configfile
-		let ls' = fixSshKeyPair' ls
-		when (ls /= ls') $
-			viaTmp writeFile configfile $ unlines ls'
-
-{- Strategy: Search for IdentityFile lines in for files with key.git-annex
+ - by old versions to set IdentitiesOnly.
+ -
+ - Strategy: Search for IdentityFile lines with key.git-annex
  - in their names. These are for git-annex ssh key pairs.
  - Add the IdentitiesOnly line immediately after them, if not already
- - present. -}
-fixSshKeyPair' :: [String] -> [String]
-fixSshKeyPair' = go []
+ - present.
+ -}
+fixSshKeyPairIdentitiesOnly :: IO ()
+fixSshKeyPairIdentitiesOnly = changeUserSshConfig $ unlines . go [] . lines
   where
   	go c [] = reverse c
 	go c (l:[])
@@ -277,6 +269,20 @@ fixSshKeyPair' = go []
   	indicators = ["IdentityFile", "key.git-annex"]
 	fixedline tmpl = takeWhile isSpace tmpl ++ "IdentitiesOnly yes"
 
+{- Add StrictHostKeyChecking to any ssh config stanzas that were written
+ - by git-annex. -}
+fixUpSshRemotes :: IO ()
+fixUpSshRemotes = modifyUserSshConfig (map go)
+  where
+	go c@(HostConfig h _)
+		| "git-annex-" `isPrefixOf` h = fixupconfig c
+		| otherwise = c
+	go other = other
+
+	fixupconfig c = case findHostConfigKey c "StrictHostKeyChecking" of
+		Nothing -> addToHostConfig c "StrictHostKeyChecking" "yes"
+		Just _ -> c
+
 {- Setups up a ssh config with a mangled hostname.
  - Returns a modified SshData containing the mangled hostname. -}
 setSshConfig :: SshData -> [(String, String)] -> IO SshData