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!

1 files changed, 30 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