Added GETGITREMOTENAME to extenal special remote protocol

CHANGELOG

@@ -39,6 +39,7 @@ git-annex (8.20201130) UNRELEASED; urgency=medium
   * adjust: Fix some bad behavior when unlocked files use URL keys.
   * smudge: Fix some bad behavior when git add is run on an unlocked
     and modified file that used an URL key.
+  * Added GETGITREMOTENAME to extenal special remote protocol.
 
  -- Joey Hess <id@joeyh.name>  Mon, 04 Jan 2021 12:52:41 -0400
 

Remote/External.hs

@@ -81,7 +81,8 @@ gen r u rc gc rs
 			exportUnsupported
 	| otherwise = do
 		c <- parsedRemoteConfig remote rc
-		external <- newExternal externaltype (Just u) c (Just gc) (Just rs)
+		external <- newExternal externaltype (Just u) c (Just gc)
+			(Git.remoteName r) (Just rs)
 		Annex.addCleanupAction (RemoteCleanup u) $ stopExternal external
 		cst <- getCost external r gc
 		avail <- getAvailability external r gc
@@ -184,7 +185,7 @@ externalSetup _ mu _ c gc = do
 			return c'
 		else do
 			pc' <- either giveup return $ parseRemoteConfig c' lenientRemoteConfigParser
-			external <- newExternal externaltype (Just u) pc' (Just gc) Nothing
+			external <- newExternal externaltype (Just u) pc' (Just gc) Nothing Nothing
 			-- Now that we have an external, ask it to LISTCONFIGS, 
 			-- and re-parse the RemoteConfig strictly, so we can
 			-- error out if the user provided an unexpected config.
@@ -212,7 +213,7 @@ checkExportSupported c gc = do
 	if externaltype == "readonly"
 		then return False
 		else checkExportSupported' 
-			=<< newExternal externaltype Nothing c (Just gc) Nothing
+			=<< newExternal externaltype Nothing c (Just gc) Nothing Nothing
 
 checkExportSupported' :: External -> Annex Bool
 checkExportSupported' external = go `catchNonAsync` (const (return False))
@@ -458,6 +459,10 @@ handleRequest' st external req mp responsehandler
 		Nothing -> senderror "cannot send GETUUID here"
 	handleRemoteRequest GETGITDIR = 
 		send . VALUE . fromRawFilePath =<< fromRepo Git.localGitDir
+	handleRemoteRequest GETGITREMOTENAME =
+		case externalRemoteName external of
+			Just n -> send $ VALUE n
+			Nothing -> senderror "git remote name not known"
 	handleRemoteRequest (SETWANTED expr) = case externalUUID external of
 		Just u -> preferredContentSet u expr
 		Nothing -> senderror "cannot send SETWANTED here"
@@ -896,7 +901,7 @@ remoteConfigParser c
 			(Nothing, _) -> return lenientRemoteConfigParser
 			(_, Just True) -> return lenientRemoteConfigParser
 			(Just externaltype, _) -> do
-				external <- newExternal externaltype Nothing pc Nothing Nothing
+				external <- newExternal externaltype Nothing pc Nothing Nothing Nothing
 				strictRemoteConfigParser external
   where
 	isproposed (Accepted _) = False

Remote/External/Types.hs

@@ -52,6 +52,7 @@ import Types.RemoteConfig
 import Types.Export
 import Types.Availability (Availability(..))
 import Types.Key
+import Git.Types
 import Utility.Url (URLString)
 import qualified Utility.SimpleProtocol as Proto
 
@@ -69,18 +70,20 @@ data External = External
 	, externalLastPid :: TVar PID
 	, externalDefaultConfig :: ParsedRemoteConfig
 	, externalGitConfig :: Maybe RemoteGitConfig
+	, externalRemoteName :: Maybe RemoteName 
 	, externalRemoteStateHandle :: Maybe RemoteStateHandle
 	, externalAsync :: TMVar ExternalAsync
 	}
 
-newExternal :: ExternalType -> Maybe UUID -> ParsedRemoteConfig -> Maybe RemoteGitConfig -> Maybe RemoteStateHandle -> Annex External
+newExternal :: ExternalType -> Maybe UUID -> ParsedRemoteConfig -> Maybe RemoteGitConfig -> Maybe RemoteName -> Maybe RemoteStateHandle -> Annex External
-newExternal externaltype u c gc rs = liftIO $ External
+newExternal externaltype u c gc rn rs = liftIO $ External
 	<$> pure externaltype
 	<*> pure u
 	<*> atomically (newTVar [])
 	<*> atomically (newTVar 0)
 	<*> pure c
 	<*> pure gc
+	<*> pure rn
 	<*> pure rs
 	<*> atomically (newTMVar UncheckedExternalAsync)
 
@@ -102,7 +105,11 @@ newtype ExtensionList = ExtensionList { fromExtensionList :: [String] }
 	deriving (Show, Monoid, Semigroup)
 
 supportedExtensionList :: ExtensionList
-supportedExtensionList = ExtensionList ["INFO", asyncExtension]
+supportedExtensionList = ExtensionList
+	[ "INFO"
+	, "GETGITREMOTENAME"
+	, asyncExtension
+	]
 
 asyncExtension :: String
 asyncExtension = "ASYNC"
@@ -304,6 +311,7 @@ data RemoteRequest
 	| GETCREDS Setting
 	| GETUUID
 	| GETGITDIR
+	| GETGITREMOTENAME
 	| SETWANTED PreferredContentExpression
 	| GETWANTED
 	| SETSTATE Key String
@@ -328,6 +336,7 @@ instance Proto.Receivable RemoteRequest where
 	parseCommand "GETCREDS" = Proto.parse1 GETCREDS
 	parseCommand "GETUUID" = Proto.parse0 GETUUID
 	parseCommand "GETGITDIR" = Proto.parse0 GETGITDIR
+	parseCommand "GETGITREMOTENAME" = Proto.parse0 GETGITREMOTENAME
 	parseCommand "SETWANTED" = Proto.parse1 SETWANTED
 	parseCommand "GETWANTED" = Proto.parse0 GETWANTED
 	parseCommand "SETSTATE" = Proto.parse2 SETSTATE

doc/design/external_special_remote_protocol.mdwn

@@ -45,7 +45,7 @@ Recent versions of git-annex respond with a message indicating
 protocol extensions that it supports. Older versions of
 git-annex do not send this message.
 
-	EXTENSIONS INFO ASYNC
+	EXTENSIONS INFO ASYNC GETGITREMOTENAME
 
 The special remote can respond to that with its own EXTENSIONS message, listing
 any extensions it wants to use. 
@@ -182,7 +182,7 @@ the special remote can reply with `UNSUPPORTED-REQUEST`.
   a list of settings with descriptions. Note that the user is not required
   to provided all the settings listed here. A block of responses
   can be made to this, which must always end with `CONFIGEND`.  
-  (Do not include settings like "name" that are common to all external
+  (Do not include settings like "encryption" that are common to all external
   special remotes.)
   * `CONFIG Name Description`  
     Indicates the name and description of a config setting. The description
@@ -298,6 +298,8 @@ handling a request.
   to be stored in the git-annex branch, so will be available if the same
   special remote is used elsewhere. (If sent after INITREMOTE, the changed
   configuration will only be available while the remote is running.)  
+  See also `GETGITREMOTENAME` for a way to access git configuration of the
+  remote.  
   (git-annex does not send a reply to this message.)
 * `GETCONFIG Setting`  
   Gets one of the special remote's configuration settings, which can have
@@ -332,6 +334,16 @@ handling a request.
   Queries for the path to the git directory of the repository that
   is using the external special remote.
   (git-annex replies with VALUE followed by the path.)
+* `GETGITREMOTENAME`  
+  Gets the name of the git remote that represents this special remote.
+  This can be used, for example, to look up git configuration belonging
+  to that git remote. This name will often be the same as what is
+  passed to `git-annex initremote` and `enableremote`, but it is possible
+  for git remotes to be renamed, and this will provide the remote's current
+  name.  
+  (git-annex replies with VALUE followed by the name.)  
+  This message is a protocol extension; it's only safe to send it to
+  git-annex after it sent an EXTENSIONS that included GETGITREMOTENAME.
 * `SETWANTED PreferredContentExpression`  
   Can be used to set the preferred content of a repository. Normally
   this is not configured by a special remote, but it may make sense
@@ -415,6 +427,8 @@ These protocol extensions are currently supported.
   This lets multiple actions be performed at the same time by
   a single external special remote program, rather than starting multiple
   programs. See the [[async_appendix]] for details.
+* `GETGITREMOTENAME`  
+  This makes the `GETGITREMOTENAME` message available to use.
 
 ## signals
 

doc/todo/extend_external_special_remote_protocol_with_way_to_get_git_config_of_remote.mdwn

@@ -27,3 +27,6 @@ the same is a perhaps not something people want to learn about.
 The former seems conceptually simpler, but there might be things that
 `git config` could do, that providing an interface on top of it would not
 allow. The --type option is one thing that comes to mind. --[[Joey]]
+
+> [[done]] as the GETGITREMOTENAME protocol extension and message.
+> --[[Joey]]