From 58301e40d26155176bba75d4e2478b7d76bb6f74 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 24 May 2024 14:52:22 -0400
Subject: [PATCH] sync with special remotes with an annex:: url

Check explicitly for an annex:: url, not just any url. While no built-in
special remotes set an url, except ones that can be synced with, it
seems possible that some external special remote sets an url for its own
use, but did not expect it to be used by git-annex sync et al.

The assistant also syncs with them.
---
 Assistant/DaemonStatus.hs      |  2 +-
 Command/Sync.hs                |  4 ++--
 Remote.hs                      | 12 +++++++++++-
 Remote/List.hs                 |  6 +++++-
 Types/GitConfig.hs             |  7 +++++++
 doc/todo/git-remote-annex.mdwn |  2 --
 6 files changed, 26 insertions(+), 7 deletions(-)

diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs
index 9be4558761..68edd95c47 100644
--- a/Assistant/DaemonStatus.hs
+++ b/Assistant/DaemonStatus.hs
@@ -64,7 +64,7 @@ calcSyncRemotes = do
 
 	return $ \dstatus -> dstatus
 		{ syncRemotes = syncable
-		, syncGitRemotes = filter (Remote.gitSyncableRemoteType . Remote.remotetype) syncable
+		, syncGitRemotes = filter Remote.gitSyncableRemote syncable
 		, syncDataRemotes = dataremotes
 		, exportRemotes = exportremotes
 		, downloadRemotes = contentremotes
diff --git a/Command/Sync.hs b/Command/Sync.hs
index 96742257ac..62b557ccc7 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -267,8 +267,8 @@ seek' o = startConcurrency transferStages $ do
 
 	remotes <- syncRemotes (syncWith o)
 	warnSyncContentTransition o remotes
-	-- Remotes that are git repositories, not (necessarily) special remotes.
-	let gitremotes = filter (Remote.gitSyncableRemoteType . Remote.remotetype) remotes
+	-- Remotes that git can push to and pull from.
+	let gitremotes = filter Remote.gitSyncableRemote remotes
 	-- Remotes that contain annex object content.
 	contentremotes <- filter (\r -> Remote.uuid r /= NoUUID)
 		<$> filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) remotes
diff --git a/Remote.hs b/Remote.hs
index dbbca32a5e..501f010b2e 100644
--- a/Remote.hs
+++ b/Remote.hs
@@ -26,7 +26,6 @@ module Remote (
 	remoteTypes,
 	remoteList,
 	remoteList',
-	gitSyncableRemoteType,
 	remoteMap,
 	remoteMap',
 	uuidDescriptions,
@@ -61,6 +60,8 @@ module Remote (
 	claimingUrl,
 	claimingUrl',
 	isExportSupported,
+	gitSyncableRemote,
+	gitSyncableRemoteType,
 ) where
 
 import Data.Ord
@@ -445,3 +446,12 @@ claimingUrl' remotefilter url = do
 	fromMaybe web <$> firstM checkclaim (filter remotefilter rs)
   where
 	checkclaim = maybe (pure False) (`id` url) . claimUrl
+
+{- Is this a remote of a type we can sync with, or a special remote
+ - with an annex:: url configured? -}
+gitSyncableRemote :: Remote -> Bool
+gitSyncableRemote r
+	| gitSyncableRemoteType (remotetype r) = True
+	| otherwise = case remoteUrl (gitconfig r) of
+		Just u | "annex::" `isPrefixOf` u -> True
+		_ -> False
diff --git a/Remote/List.hs b/Remote/List.hs
index e884a25a3b..e25d09b957 100644
--- a/Remote/List.hs
+++ b/Remote/List.hs
@@ -109,7 +109,11 @@ updateRemote remote = do
 			Remote.Git.configRead False r
 		| otherwise = return r
 
-{- Checks if a remote is syncable using git. -}
+{- Types of remotes that are always syncable using git.
+ -
+ - This does not include special remotes that may or may not have an
+ - annex:: url that allows using git-remote-annex with them.
+ -}
 gitSyncableRemoteType :: RemoteType -> Bool
 gitSyncableRemoteType t = t `elem`
 	[ Remote.Git.remote
diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index 3ba46eb5c1..e1090a1121 100644
--- a/Types/GitConfig.hs
+++ b/Types/GitConfig.hs
@@ -374,6 +374,7 @@ data RemoteGitConfig = RemoteGitConfig
 	, remoteAnnexAllowUnverifiedDownloads :: Bool
 	, remoteAnnexConfigUUID :: Maybe UUID
 	, remoteAnnexAllowEncryptedGitRepo :: Bool
+	, remoteUrl :: Maybe String
 
 	{- These settings are specific to particular types of remotes
 	 - including special remotes. -}
@@ -480,6 +481,12 @@ extractRemoteGitConfig r remotename = do
 		, remoteAnnexExternalType = notempty $ getmaybe "externaltype"
 		, remoteAnnexAllowEncryptedGitRepo = 
 			getbool "allow-encrypted-gitrepo" False
+		, remoteUrl = 
+			case Git.Config.getMaybe (remoteConfig remotename "url") r of
+				Just (ConfigValue b)
+					| B.null b -> Nothing
+					| otherwise -> Just (decodeBS b)
+				_ -> Nothing
 		}
   where
 	getbool k d = fromMaybe d $ getmaybebool k
diff --git a/doc/todo/git-remote-annex.mdwn b/doc/todo/git-remote-annex.mdwn
index 96959773be..d4c77a7974 100644
--- a/doc/todo/git-remote-annex.mdwn
+++ b/doc/todo/git-remote-annex.mdwn
@@ -10,8 +10,6 @@ will be available to users who don't use datalad.
 
 This is implememented and working. Remaining todo list for it:
 
-* git-annex sync doesn't pull/push to these remotes, and should.
-
 * Cloning from an annex:: url with importtree=yes doesn't work
   (with or without exporttree=yes). This is because the ContentIdentifier
   db is not populated. It should be possible to work around this.