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, 125 insertions, 0 deletions

diff --git a/Utility/SshConfig.hs b/Utility/SshConfig.hs
new file mode 100644
index 000000000..b7068f48d
--- /dev/null
+++ b/Utility/SshConfig.hs
@@ -0,0 +1,125 @@
+{- ssh config file parsing and modification
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.SshConfig where
+
+import Common
+import Utility.UserInfo
+import Utility.Tmp
+
+import Data.Char
+import Data.Ord
+import Data.Either
+
+data SshConfig
+	= GlobalConfig SshSetting
+	| HostConfig Host [Either Comment SshSetting]
+	| CommentLine Comment
+	deriving (Show)
+
+data Comment = Comment Indent String
+	deriving (Show)
+
+data SshSetting = SshSetting Indent Key Value
+	deriving (Show)
+
+type Indent = String
+type Host = String
+type Key = String
+type Value = String
+
+{- Parses ~/.ssh/config. Comments and indentation are preserved.
+ -
+ - Note that there is no parse failure. If a line cannot be parsed, it will
+ - be taken to be a SshSetting that contains the whole line as the key,
+ - and has no value. -}
+parseSshConfig :: String -> [SshConfig]
+parseSshConfig = go [] . lines
+  where
+	go c [] = reverse c
+	go c (l:ls)
+		| iscomment l = collect $ CommentLine $ mkcomment l
+		| otherwise = case splitline l of
+			(indent, k, v)
+				| isHost k -> hoststanza v c [] ls
+				| otherwise -> collect $ GlobalConfig $ SshSetting indent k v
+	  where
+		collect v = go (v:c) ls
+
+	hoststanza host c hc [] = go (HostConfig host (reverse hc):c) []
+	hoststanza host c hc (l:ls)
+		| iscomment l = hoststanza host c ((Left $ mkcomment l):hc) ls
+		| otherwise = case splitline l of
+			(indent, k, v)
+			 	| isHost k -> hoststanza v
+					(HostConfig host (reverse hc):c) [] ls
+				| otherwise -> hoststanza host c
+					((Right $ SshSetting indent k v):hc) ls
+
+	iscomment l = all isSpace l || "#" `isPrefixOf` (dropWhile isSpace l)
+
+	splitline l = (indent, k, v)
+	  where
+		(indent, rest) = span isSpace l
+		(k, v) = separate isSpace rest
+	
+	mkcomment l = Comment indent c
+	  where
+		(indent, c) = span isSpace l
+
+	isHost v = map toLower v == "host"
+	
+genSshConfig :: [SshConfig] -> String
+genSshConfig = unlines . concatMap gen
+  where
+	gen (CommentLine c) = [comment c]
+	gen (GlobalConfig s) = [setting s]
+	gen (HostConfig h cs) = ("Host " ++ h) : map (either comment setting) cs
+
+	setting (SshSetting indent k v) = indent ++ k ++ " " ++ v
+	comment (Comment indent c) = indent ++ c
+
+findHostConfigKey :: SshConfig -> Key -> Maybe Value
+findHostConfigKey (HostConfig _ cs) wantk = go (rights cs) (map toLower wantk)
+  where
+  	go [] _ = Nothing
+	go ((SshSetting _ k v):rest) wantk'
+		| map toLower k == wantk' = Just v
+		| otherwise = go rest wantk'
+findHostConfigKey _ _ = Nothing
+
+{- Adds a particular Key and Value to a HostConfig. -}
+addToHostConfig :: SshConfig -> Key -> Value -> SshConfig
+addToHostConfig (HostConfig host cs) k v = 
+	HostConfig host $ Right (SshSetting indent k v) : cs
+  where
+ 	{- The indent is taken from any existing SshSetting
+	 - in the HostConfig (largest indent wins). -}
+	indent = fromMaybe "\t" $ headMaybe $ reverse $
+		sortBy (comparing length) $ map getindent cs
+	getindent (Right (SshSetting i _ _)) = i
+	getindent (Left (Comment i _)) = i
+addToHostConfig other _ _ = other
+
+modifyUserSshConfig :: ([SshConfig] -> [SshConfig]) -> IO ()
+modifyUserSshConfig modifier = changeUserSshConfig $ 
+	genSshConfig . modifier . parseSshConfig
+
+changeUserSshConfig :: (String -> String) -> IO ()
+changeUserSshConfig modifier = do
+	sshdir <- sshDir
+	let configfile = sshdir </> "config"
+	whenM (doesFileExist configfile) $ do
+		c <- readFileStrict configfile
+		let c' = modifier c
+		when (c /= c') $
+			viaTmp writeFile configfile c'
+
+sshDir :: IO FilePath
+sshDir = do
+	home <- myHomeDir
+	return $ home </> ".ssh"