From 26d4eaa4e02b480803d5adf7af60e056eb39e777 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 27 Jul 2015 11:03:58 -0400
Subject: [PATCH] use mangled hostname for gitlab repo when using a dedicated
 git-annex ssh key

---
 Assistant/Ssh.hs                      |  9 +++++++--
 Assistant/WebApp/Configurators/Ssh.hs | 13 ++++++++-----
 2 files changed, 15 insertions(+), 7 deletions(-)

diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs
index cd29d50364..80fb5c19a9 100644
--- a/Assistant/Ssh.hs
+++ b/Assistant/Ssh.hs
@@ -325,11 +325,16 @@ setSshConfig sshdata config = do
 				(settings ++ config)
 		setSshConfigMode configfile
 
-	return $ sshdata { sshHostName = T.pack mangledhost }
+	return $ sshdata
+		{ sshHostName = T.pack mangledhost
+		, sshRepoUrl = replace orighost mangledhost
+			<$> sshRepoUrl sshdata
+		}
   where
+	orighost = T.unpack $ sshHostName sshdata
 	mangledhost = mangleSshHostName sshdata
 	settings =
-		[ ("Hostname", T.unpack $ sshHostName sshdata)
+		[ ("Hostname", orighost)
 		, ("Port", show $ sshPort sshdata)
 		]
 
diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs
index 54f94f07b3..7239e21f95 100644
--- a/Assistant/WebApp/Configurators/Ssh.hs
+++ b/Assistant/WebApp/Configurators/Ssh.hs
@@ -708,17 +708,20 @@ parseGitLabUrl (GitLabUrl t) =
 testGitLabUrl :: GitLabUrl -> Annex (ServerStatus, Maybe SshData, UUID)
 testGitLabUrl glu = case parseGitLabUrl glu of
 	Nothing -> return (UnusableServer badGitLabUrl, Nothing, NoUUID)
-	Just sshdata -> do
+	Just sshdata -> 
+		checkor sshdata $ do
+			(sshdata', keypair) <- liftIO $ setupSshKeyPair sshdata
+			checkor sshdata' $ 
+				return (ServerNeedsPubKey (sshPubKey keypair), Just sshdata', NoUUID)
+  where
+	checkor sshdata ora = do
 		u <- probeuuid sshdata
 		if u /= NoUUID
 			then return (UsableServer (sshCapabilities sshdata), Just sshdata, u)
 			else ifM (verifysshworks sshdata)
 				( return (UsableServer (sshCapabilities sshdata), Just sshdata, NoUUID)
-				, do
-					(sshdata', keypair) <- liftIO $ setupSshKeyPair sshdata
-					return (ServerNeedsPubKey (sshPubKey keypair), Just sshdata', NoUUID)
+				, ora
 				)
-  where
 	probeuuid sshdata = do
 		r <- inRepo $ Git.Construct.fromRemoteLocation (fromJust $ sshRepoUrl sshdata)
 		getUncachedUUID . either (const r) fst <$>