diff options
| -rw-r--r-- | Assistant/Ssh.hs | 30 | ||||
| -rw-r--r-- | debian/changelog | 1 |
2 files changed, 31 insertions, 0 deletions
diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index 7a93a2fa9..a62319096 100644 --- a/Assistant/Ssh.hs +++ b/Assistant/Ssh.hs @@ -198,6 +198,36 @@ setupSshKeyPair sshkeypair sshdata = do 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 + - 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 [] + where + go c [] = reverse c + go c (l:[]) + | all (`isInfixOf` l) indicators = go (fixedline l:l:c) [] + | otherwise = go (l:c) [] + go c (l:next:rest) + | all (`isInfixOf` l) indicators && not ("IdentitiesOnly" `isInfixOf` next) = + go (fixedline l:l:c) (next:rest) + | otherwise = go (l:c) (next:rest) + indicators = ["IdentityFile", "key.git-annex"] + fixedline tmpl = takeWhile isSpace tmpl ++ "IdentitiesOnly yes" + {- 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/debian/changelog b/debian/changelog index d7752f51c..479216165 100644 --- a/debian/changelog +++ b/debian/changelog @@ -15,6 +15,7 @@ git-annex (4.20130724) UNRELEASED; urgency=low on a host, set IdentitiesOnly to prevent the ssh-agent from forcing use of a different ssh key. That could result in unncessary password prompts, or prevent git-annex-shell from being run on the remote host. + * webapp: Improve handling of remotes whose setup has stalled. * Add status message to XMPP presence tag, to identify to others that the client is a git-annex client. Closes: #717652 * webapp: When creating a repository on a removable drive, set |