Fix retrieval of content from borg repos accessed over ssh

It was making the borgrepo path absolute.. even when it was a ssh
repository.

Made BorgRepo a newtype, to guard against accidentially treating it like a
FilePath.

Sponsored-by: Graham Spencer on Patreon

CHANGELOG

@@ -5,6 +5,7 @@ git-annex (8.20210715) UNRELEASED; urgency=medium
   * Fix a bug that prevented getting content from a repository that
     started out as a bare repository, or had annex.crippledfilesystem
     set, and was converted to a non-bare repository.
+  * Fix retrieval of content from borg repos accessed over ssh.
 
  -- Joey Hess <id@joeyh.name>  Wed, 14 Jul 2021 14:26:36 -0400
 

Remote/Borg.hs

@@ -39,7 +39,7 @@ import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 import qualified System.FilePath.ByteString as P
 
-type BorgRepo = String
+newtype BorgRepo = BorgRepo { locBorgRepo :: String }
 
 type BorgArchiveName = S.ByteString
 
@@ -109,9 +109,7 @@ gen r u rc gc rs = do
 		, config = c
 		, getRepo = return r
 		, gitconfig = gc
-		, localpath = if borgLocal borgrepo && not (null borgrepo)
+		, localpath = borgRepoLocalPath borgrepo
-			then Just borgrepo
-			else Nothing
 		, remotetype = remote
 		, availability = if borgLocal borgrepo then LocallyAvailable else GloballyAvailable
 		, readonly = False
@@ -122,13 +120,16 @@ gen r u rc gc rs = do
 		, untrustworthy = maybe True not $
 			getRemoteConfigValue appendonlyField c
 		, mkUnavailable = return Nothing
-		, getInfo = return [("repo", borgrepo)]
+		, getInfo = return [("repo", locBorgRepo borgrepo)]
 		, claimUrl = Nothing
 		, checkUrl = Nothing
 		, remoteStateHandle = rs
 		}
   where
-	borgrepo = fromMaybe (giveup "missing borgrepo") $ remoteAnnexBorgRepo gc
+	borgrepo = maybe
+		(giveup "missing borgrepo")
+		BorgRepo
+		(remoteAnnexBorgRepo gc)
 
 borgSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
 borgSetup _ mu _ c _gc = do
@@ -145,15 +146,26 @@ borgSetup _ mu _ c _gc = do
 	return (c, u)
 
 borgLocal :: BorgRepo -> Bool
-borgLocal = notElem ':'
+borgLocal (BorgRepo r) = notElem ':' r
 
 borgArchive :: BorgRepo -> BorgArchiveName -> String
-borgArchive r n = r ++ "::" ++ decodeBS' n
+borgArchive (BorgRepo r) n = r ++ "::" ++ decodeBS' n
+
+absBorgRepo :: BorgRepo -> IO BorgRepo
+absBorgRepo r@(BorgRepo p)
+	| borgLocal r = BorgRepo . fromRawFilePath
+		<$> absPath (toRawFilePath p)
+	| otherwise = return r
+
+borgRepoLocalPath :: BorgRepo -> Maybe FilePath
+borgRepoLocalPath r@(BorgRepo p)
+	| borgLocal r && not (null p) = Just p
+	| otherwise = Nothing
 
 listImportableContentsM :: UUID -> BorgRepo -> ParsedRemoteConfig -> Annex (Maybe (ImportableContents (ContentIdentifier, ByteSize)))
 listImportableContentsM u borgrepo c = prompt $ do
 	imported <- getImported u
-	ls <- withborglist borgrepo Nothing formatarchivelist $ \as ->
+	ls <- withborglist (locBorgRepo borgrepo) Nothing formatarchivelist $ \as ->
 		forM (filter (not . S.null) as) $ \archivename ->
 			case M.lookup archivename imported of
 				Just getfast -> return $ Left (archivename, getfast)
@@ -329,14 +341,14 @@ checkPresentExportWithContentIdentifierM borgrepo _ loc _ = prompt $ liftIO $ do
 			[ Param "list"
 			, Param "--format"
 			, Param "1"
-			, Param borgrepo
+			, Param (locBorgRepo borgrepo)
 			]
 		(Nothing, Nothing, Nothing, pid) <- withNullHandle $ \nullh ->
 			createProcess $ p
 				{ std_out = UseHandle nullh }
 		ifM (checkSuccessProcess pid)
 			( return False -- repo exists, content not in it
-			, giveup $ "Unable to access borg repository " ++ borgrepo
+			, giveup $ "Unable to access borg repository " ++ locBorgRepo borgrepo
 			)
 
 retrieveExportWithContentIdentifierM :: BorgRepo -> ImportLocation -> ContentIdentifier -> FilePath -> Annex Key -> MeterUpdate -> Annex Key
@@ -345,7 +357,7 @@ retrieveExportWithContentIdentifierM borgrepo loc _ dest mkk _ = do
 	prompt $ withOtherTmp $ \othertmp -> liftIO $ do
 		-- borgrepo could be relative, and borg has to be run
 		-- in the temp directory to get it to write there
-		absborgrepo <- fromRawFilePath <$> absPath (toRawFilePath borgrepo)
+		absborgrepo <- absBorgRepo borgrepo
 		let p = proc "borg" $ toCommand
 			[ Param "extract"
 			, Param (borgArchive absborgrepo archivename)

doc/bugs/content_retrieval_from_borg_remote_fails_over_ssh.mdwn

@@ -71,3 +71,5 @@ NOTE: I tried several variations of the ssh url syntax, but they all resulted in
 ### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders)
 
 Definitely. I love git-annex. I LOVE it. It has no equal and is the secret to my productivity, not to mention peace of mind in this epoch. Much, much respect.
+
+> [[fixed|done]] --[[Joey]]

doc/bugs/content_retrieval_from_borg_remote_fails_over_ssh/comment_1_050cb1054a9d1cc7b2e6722757c41784._comment

@@ -0,0 +1,15 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2021-07-15T16:20:33Z"
+ content="""
+Thanks for a good repo recipe. I only needed to add a "borg init
+$BORG_REPO -e none" to see the bug.
+
+The bug is because it had to make the path to the borg repo absolute,
+since it's running borg inside a temp directory. And the case of a ssh
+location was not considered when doing that.
+
+Fixed and cleaned up the BorgRepo data type to avoid this kind of dumb
+mistake in the future. ;-)
+"""]]