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

Assistant/Install.hs

@@ -11,12 +11,12 @@ module Assistant.Install where
 
 import Assistant.Common
 import Assistant.Install.AutoStart
-import Assistant.Ssh
 import Config.Files
 import Utility.FileMode
 import Utility.Shell
 import Utility.Tmp
 import Utility.Env
+import Utility.SshConfig
 
 #ifdef darwin_HOST_OS
 import Utility.OSX

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

Assistant/Threads/SanityChecker.hs

@@ -15,6 +15,7 @@ import Assistant.Common
 import Assistant.DaemonStatus
 import Assistant.Alert
 import Assistant.Repair
+import Assistant.Ssh
 import qualified Git.LsFiles
 import qualified Git.Command
 import qualified Git.Config
@@ -53,6 +54,9 @@ sanityCheckerStartupThread startupdelay = namedThreadUnchecked "SanityCheckerSta
 			modifyDaemonStatus_ $ \s -> s { forceRestage = True }
 		)
 
+	{- Fix up ssh remotes set up by past versions of the assistant. -}
+	liftIO $ fixUpSshRemotes
+
 	{- If there's a startup delay, it's done here. -}
 	liftIO $ maybe noop (threadDelaySeconds . Seconds . fromIntegral . durationSeconds) startupdelay
 

Assistant/WebApp/Configurators/Edit.hs

@@ -260,7 +260,7 @@ getUpgradeRepositoryR r = go =<< liftAnnex (repoIdRemote r)
   where
   	go Nothing = redirect DashboardR
 	go (Just rmt) = do
-		liftIO fixSshKeyPair
+		liftIO fixSshKeyPairIdentitiesOnly
 		liftAnnex $ setConfig 
 			(remoteConfig (Remote.repo rmt) "ignore")
 			(Git.Config.boolConfig False)