webapp: Improve handling of remotes whose setup has stalled.

This includes recovery from the ssh-agent problem that led to many reporting
http://git-annex.branchable.com/bugs/Internal_Server_Error:_Unknown_UUID/
(Including fixing up .ssh/config to set IdentitiesOnly.)

Remotes that have no known uuid are now displayed in the webapp as
"unfinished". There's a link to check their status, and if the remote
has been set annex-ignore, a retry button can be used to unset that and
try again to set up the remote.

As this bug has shown, the process of adding a ssh remote has some failure
modes that are not really ideal. It would certianly be better if, when
setting up a ssh remote it would detect if it's failed to get the UUID,
and handle that in the remote setup process, rather than waiting until
later and handling it this way.

However, that's hard to do, particularly for local pairing, since the
PairListener runs as a background thread. The best it could do is pop up an
alert if there's a problem. This solution is not much different.

Also, this solution handles cases where the user has gotten their repo into
a mess manually and let's the assistant help with cleaning it up.

This commit was sponsored by Chia Shee Liang. Thanks!

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