From dfc4e641b5c14418ec1c1b45bed1325cf8cbb0c3 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 4 May 2020 15:32:06 -0400
Subject: [PATCH] repair: Improve fetching from a remote with an url in
 host:path format.

User reported git@my.gitlab.foo:username/myrepo.git didn't work with
git-repair, because it rewrites it to an url
ssh://git@my.gitlab.foo/~/username/myrepo.git
and the /~/ was not something the hosting site supported.

Since git-annex still generally needs the repo url to be well, an url, did
not change the conversion code. But in this case, we're running git fetch,
so we might as well pass it the remote name rather than the url.

Did a quick audit of repoLocation uses to see if there was anything else
like this problem elsewhere, and didn't see any. But this is not the first
time this special case in git and git-annex's attempt to de-special-case
it has caused a problem..
---
 CHANGELOG     |  1 +
 Git/Repair.hs | 32 +++++++++++++++++---------------
 2 files changed, 18 insertions(+), 15 deletions(-)

diff --git a/CHANGELOG b/CHANGELOG
index f0395a4a64..948b54d0ef 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -6,6 +6,7 @@ git-annex (8.20200502) UNRELEASED; urgency=medium
   * Also display a warning message when a remote, without a known uuid,
     is located in a directory that does not currently exist, to avoid
     silently skipping such a remote.
+  * repair: Improve fetching from a remote with an url in host:path format.
 
  -- Joey Hess <id@joeyh.name>  Mon, 04 May 2020 12:46:11 -0400
 
diff --git a/Git/Repair.hs b/Git/Repair.hs
index f7a91ca0fe..f81aa786fc 100644
--- a/Git/Repair.hs
+++ b/Git/Repair.hs
@@ -122,24 +122,26 @@ retrieveMissingObjects missing referencerepo r
 			)
 	pullremotes tmpr (rmt:rmts) fetchrefs ms
 		| not (foundBroken ms) = return ms
-		| otherwise = do
-			putStrLn $ "Trying to recover missing objects from remote " ++ repoDescribe rmt ++ "."
-			ifM (fetchfrom (repoLocation rmt) fetchrefs tmpr)
-				( do
-					void $ explodePacks tmpr
-					void $ copyObjects tmpr r
-					case ms of
-						FsckFailed -> pullremotes tmpr rmts fetchrefs ms
-						FsckFoundMissing s t -> do
-							stillmissing <- findMissing (S.toList s) r
-							pullremotes tmpr rmts fetchrefs (FsckFoundMissing stillmissing t)
-				, pullremotes tmpr rmts fetchrefs ms
-				)
-	fetchfrom fetchurl ps fetchr = runBool ps' fetchr'
+		| otherwise = case remoteName rmt of
+			Just n -> do
+				putStrLn $ "Trying to recover missing objects from remote " ++ n ++ "."
+				ifM (fetchfrom n fetchrefs tmpr)
+					( do
+						void $ explodePacks tmpr
+						void $ copyObjects tmpr r
+						case ms of
+							FsckFailed -> pullremotes tmpr rmts fetchrefs ms
+							FsckFoundMissing s t -> do
+								stillmissing <- findMissing (S.toList s) r
+								pullremotes tmpr rmts fetchrefs (FsckFoundMissing stillmissing t)
+					, pullremotes tmpr rmts fetchrefs ms
+					)
+			Nothing -> pullremotes tmpr rmts fetchrefs ms
+	fetchfrom loc ps fetchr = runBool ps' fetchr'
 	  where
 		ps' = 
 			[ Param "fetch"
-			, Param fetchurl
+			, Param loc
 			, Param "--force"
 			, Param "--update-head-ok"
 			, Param "--quiet"