diff options
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/Install.hs | 2 | ||||
| -rw-r--r-- | Assistant/Ssh.hs | 48 | ||||
| -rw-r--r-- | Assistant/Threads/SanityChecker.hs | 4 |
3 files changed, 32 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 |