diff options
| -rw-r--r-- | Assistant/Install.hs | 2 | ||||
| -rw-r--r-- | Assistant/Ssh.hs | 48 | ||||
| -rw-r--r-- | Assistant/Threads/SanityChecker.hs | 4 | ||||
| -rw-r--r-- | Utility/SshConfig.hs | 125 | ||||
| -rw-r--r-- | debian/changelog | 4 | ||||
| -rw-r--r-- | doc/bugs/Endless_SSH_password_prompts.mdwn | 19 |
6 files changed, 180 insertions, 22 deletions
diff --git a/Assistant/Install.hs b/Assistant/Install.hs index bb8053ffa..2b6297b1f 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 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 diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index 2e6a28759..446ade54f 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/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" diff --git a/debian/changelog b/debian/changelog index afdc51038..04dd79fe0 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 <joeyh@debian.org> 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 26def613f..fad730a1b 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]] |