From 3a6e0d12153b0be57f1012b5d92d660fcc85d55c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 20 Dec 2013 20:58:36 -0400 Subject: [PATCH] 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 | 2 +- Assistant/Ssh.hs | 48 ++++---- Assistant/Threads/SanityChecker.hs | 4 + Assistant/WebApp/Configurators/Edit.hs | 2 +- Utility/SshConfig.hs | 125 +++++++++++++++++++++ debian/changelog | 4 + doc/bugs/Endless_SSH_password_prompts.mdwn | 19 ++++ 7 files changed, 181 insertions(+), 23 deletions(-) create mode 100644 Utility/SshConfig.hs diff --git a/Assistant/Install.hs b/Assistant/Install.hs index bb8053ffa4..2b6297b1ff 100644 --- a/Assistant/Install.hs +++ b/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 diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index 1dc982ba63..d69c292543 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 diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index 2e6a287595..446ade54f1 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/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 diff --git a/Assistant/WebApp/Configurators/Edit.hs b/Assistant/WebApp/Configurators/Edit.hs index a8ceeb5e03..59824de79c 100644 --- a/Assistant/WebApp/Configurators/Edit.hs +++ b/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) diff --git a/Utility/SshConfig.hs b/Utility/SshConfig.hs new file mode 100644 index 0000000000..b7068f48df --- /dev/null +++ b/Utility/SshConfig.hs @@ -0,0 +1,125 @@ +{- ssh config file parsing and modification + - + - Copyright 2013 Joey Hess + - + - 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" diff --git a/debian/changelog b/debian/changelog index afdc51038b..04dd79fe01 100644 --- a/debian/changelog +++ b/debian/changelog @@ -13,6 +13,10 @@ git-annex (5.20131214) UNRELEASED; urgency=low * assistant: Always batch changes found in startup scan. * assistant: Fix OSX-specific bug that caused the startup scan to try to follow symlinks to other directories, and add their contents to the annex. + * 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 -- Joey Hess Sun, 15 Dec 2013 13:32:49 -0400 diff --git a/doc/bugs/Endless_SSH_password_prompts.mdwn b/doc/bugs/Endless_SSH_password_prompts.mdwn index 26def613f3..fad730a1b4 100644 --- a/doc/bugs/Endless_SSH_password_prompts.mdwn +++ b/doc/bugs/Endless_SSH_password_prompts.mdwn @@ -13,3 +13,22 @@ I don't understand why this is happening. ### What version of git-annex are you using? On what operating system? 1 Nov 2013 Linux tarball on Ubuntu Raring 13.04 + +> [[fixed|done]]; assistant now sets `StrictHostKeyChecking yes` +> when creating ssh remotes. It also fixes up any ssh remotes it already +> created to have that setting (unless StrictHostKeyChecking is already +> being set). +> +> So, when the host key changes, syncing with the remote will now fail, +> rather than letting ssh prompt for the y/n response. In the local +> pairing case, this is completely right, when on a different lan +> and it tries to communicate with the wrong host there. OTOH, if the ssh +> key of a ssh server has really changed, the assistant does not currently +> help dealing with that. +> +> Any ssh remotes not set up by the assistant are left as-is, so this +> could still happen if the ssh host key of such a ssh remote changes. +> I'll assume that if someone can set up their ssh remotes at the command +> line, they can also read the dialog box ssh pops up, ignore the +> misleading "passphrase request" in the title, and see that it's actually +> prompting about a host key change. --[[Joey]]