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

This commit is contained in:
Joey Hess 2013-12-20 20:58:36 -04:00
parent 1a20ec4079
commit 3a6e0d1215
7 changed files with 181 additions and 23 deletions

125
Utility/SshConfig.hs Normal file
View file

@ -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"