add LISTCONFIGS to external special remote protocol

Special remote programs that use GETCONFIG/SETCONFIG are recommended to implement it. The description is not yet used, but will be useful later when adding a way to make initremote list all accepted configs. configParser now takes a RemoteConfig parameter. Normally, that's not needed, because configParser returns a parter, it does not parse it itself. But, it's needed to look at externaltype and work out what external remote program to run for LISTCONFIGS. Note that, while externalUUID is changed to a Maybe UUID, checkExportSupported used to use NoUUID. The code that now checks for Nothing used to behave in some undefined way if the external program made requests that triggered it. Also, note that in externalSetup, once it generates external, it parses the RemoteConfig strictly. That generates a ParsedRemoteConfig, which is thrown away. The reason it's ok to throw that away, is that, if the strict parse succeeded, the result must be the same as the earlier, lenient parse. initremote of an external special remote now runs the program three times. First for LISTCONFIGS, then EXPORTSUPPORTED, and again LISTCONFIGS+INITREMOTE. It would not be hard to eliminate at least one of those, and it should be possible to only run the program once.
2020-01-17 15:30:14 -04:00 · 2020-01-17 15:30:14 -04:00 · 99cb3e75f1
commit 99cb3e75f1
parent 1ce722d86f
20 changed files with 158 additions and 76 deletions
--- a/Assistant/DaemonStatus.hs
+++ b/Assistant/DaemonStatus.hs
@ -19,7 +19,6 @@ import Logs.Trust
 import Utility.TimeStamp
 import qualified Remote
 import qualified Types.Remote as Remote
-import Config
 import Config.DynamicConfig
 import Annex.SpecialRemote.Config

--- a/Assistant/WebApp/Configurators/AWS.hs
+++ b/Assistant/WebApp/Configurators/AWS.hs
@ -171,7 +171,7 @@ getEnableS3R uuid = do
 	isia <- case M.lookup uuid m of
 		Just c -> liftAnnex $ do
 			pc <- either mempty id . parseRemoteConfig c
-				<$> Remote.configParser S3.remote
+				<$> Remote.configParser S3.remote c
 			return $ S3.configIA pc
 		Nothing -> return False
 	if isia
--- a/Assistant/WebApp/Configurators/Edit.hs
+++ b/Assistant/WebApp/Configurators/Edit.hs
@ -257,7 +257,7 @@ getRepoInfo (Just r) c = case fromProposedAccepted <$> M.lookup typeField c of
 	Just "S3" -> do
 #ifdef WITH_S3
 		pc <- liftAnnex $ either mempty id . parseRemoteConfig c
-			<$> Remote.configParser S3.remote
+			<$> Remote.configParser S3.remote c
 		if S3.configIA pc
 			then IA.getRepoInfo c
 			else AWS.getRepoInfo c
--- a/Assistant/WebApp/Configurators/WebDAV.hs
+++ b/Assistant/WebApp/Configurators/WebDAV.hs
@ -63,7 +63,7 @@ postEnableWebDAVR uuid = do
 	mcreds <- liftAnnex $ do
 		dummycfg <- liftIO dummyRemoteGitConfig
 		pc <- either mempty id . parseRemoteConfig c
-			<$> configParser WebDAV.remote
+			<$> configParser WebDAV.remote c
 		getRemoteCredPairFor "webdav" pc dummycfg (WebDAV.davCreds uuid)
 	case mcreds of
 		Just creds -> webDAVConfigurator $ liftH $
--- a/2
+++ b/2
@ -10,6 +10,8 @@ git-annex (7.20191231) UNRELEASED; urgency=medium
    foo=yes is expected
  * initremote, enableremote: Reject unknown parameters provided to these
    commands.
+  * Added LISTCONFIGS to external special remote protocol. Special remote
+    programs that use GETCONFIG/SETCONFIG are recommended to implement it.

 -- Joey Hess <id@joeyh.name>  Wed, 01 Jan 2020 12:51:40 -0400

--- a/Remote/External.hs
+++ b/Remote/External.hs
@ -43,27 +43,19 @@ import Control.Concurrent.STM
 import Control.Concurrent.Async
 import System.Log.Logger (debugM)
 import qualified Data.Map as M
+import qualified Data.Set as S

 remote :: RemoteType
-remote = RemoteType
+remote = specialRemoteType $ RemoteType
 	{ typename = "external"
 	, enumerate = const (findSpecialRemotes "externaltype")
 	, generate = gen
-	, configParser = pure remoteConfigParser
+	, configParser = remoteConfigParser
 	, setup = externalSetup
 	, exportSupported = checkExportSupported
 	, importSupported = importUnsupported
 	}

-remoteConfigParser :: RemoteConfigParser
-remoteConfigParser = RemoteConfigParser
-	{ remoteConfigFieldParsers =
-		[ optionalStringParser externaltypeField
-		, trueFalseParser readonlyField False
-		]
-	, remoteConfigRestPassthrough = const True
-	}
-
 externaltypeField :: RemoteConfigField
 externaltypeField = Accepted "externaltype"

@ -87,7 +79,7 @@ gen r u c gc rs
 			exportUnsupported
 			exportUnsupported
 	| otherwise = do
-		external <- newExternal externaltype u c gc (Just rs)
+		external <- newExternal externaltype (Just u) c (Just gc) (Just rs)
 		Annex.addCleanup (RemoteCleanup u) $ stopExternal external
 		cst <- getCost external r gc
 		avail <- getAvailability external r gc
@ -170,7 +162,7 @@ gen r u c gc rs
 externalSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
 externalSetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu
-	pc <- either giveup return $ parseRemoteConfig c remoteConfigParser
+	pc <- either giveup return $ parseRemoteConfig c lenientRemoteConfigParser
 	let externaltype = fromMaybe (giveup "Specify externaltype=") $
 		getRemoteConfigValue externaltypeField pc
 	(c', _encsetup) <- encryptionSetup c gc
@ -180,8 +172,14 @@ externalSetup _ mu _ c gc = do
 			setConfig (remoteConfig (fromJust (lookupName c)) "readonly") (boolConfig True)
 			return c'
 		_ -> do
-			pc' <- either giveup return $ parseRemoteConfig c' remoteConfigParser
-			external <- newExternal externaltype u pc' gc Nothing
+			pc' <- either giveup return $ parseRemoteConfig c' lenientRemoteConfigParser
+			external <- newExternal externaltype (Just u) pc' (Just gc) 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.
+			p <- strictRemoteConfigParser external
+			let p' = addRemoteConfigParser specialRemoteConfigParsers p
+			_ <- either giveup return $ parseRemoteConfig c' p'
 			handleRequest external INITREMOTE Nothing $ \resp -> case resp of
 				INITREMOTE_SUCCESS -> result ()
 				INITREMOTE_FAILURE errmsg -> Just $ giveup errmsg
@ -201,7 +199,7 @@ checkExportSupported c gc = do
 	let externaltype = fromMaybe (giveup "Specify externaltype=") $
 		remoteAnnexExternalType gc <|> getRemoteConfigValue externaltypeField c
 	checkExportSupported' 
-		=<< newExternal externaltype NoUUID c gc Nothing
+		=<< newExternal externaltype Nothing c (Just gc) Nothing

 checkExportSupported' :: External -> Annex Bool
 checkExportSupported' external = go `catchNonAsync` (const (return False))
@ -423,30 +421,36 @@ handleRequest' st external req mp responsehandler
 			. getRemoteConfigPassedThrough
 			<$> liftIO (atomically $ readTVar $ externalConfig st)
 		send $ VALUE value
-	handleRemoteRequest (SETCREDS setting login password) = do
-		let v = externalConfig st
-		c <- liftIO $ atomically $ readTVar v
-		let gc = externalGitConfig external
-		c' <- setRemoteCredPair' RemoteConfigValue id encryptionAlreadySetup c gc
-			(credstorage setting)
-			(Just (login, password))
-		void $ liftIO $ atomically $ swapTVar v c'
-	handleRemoteRequest (GETCREDS setting) = do
-		c <- liftIO $ atomically $ readTVar $ externalConfig st
-		let gc = externalGitConfig external
-		creds <- fromMaybe ("", "") <$> 
-			getRemoteCredPair c gc (credstorage setting)
-		send $ CREDS (fst creds) (snd creds)
-	handleRemoteRequest GETUUID = send $
-		VALUE $ fromUUID $ externalUUID external
+	handleRemoteRequest (SETCREDS setting login password) = case (externalUUID external, externalGitConfig external) of
+		(Just u, Just gc) -> do
+			let v = externalConfig st
+			c <- liftIO $ atomically $ readTVar v
+			c' <- setRemoteCredPair' RemoteConfigValue id encryptionAlreadySetup c gc
+				(credstorage setting u)
+				(Just (login, password))
+			void $ liftIO $ atomically $ swapTVar v c'
+		_ -> senderror "cannot send SETCREDS here"
+	handleRemoteRequest (GETCREDS setting) = case (externalUUID external, externalGitConfig external) of
+		(Just u, Just gc) -> do
+			c <- liftIO $ atomically $ readTVar $ externalConfig st
+			creds <- fromMaybe ("", "") <$> 
+				getRemoteCredPair c gc (credstorage setting u)
+			send $ CREDS (fst creds) (snd creds)
+		_ -> senderror "cannot send GETCREDS here"
+	handleRemoteRequest GETUUID = case externalUUID external of
+		Just u -> send $ VALUE $ fromUUID u
+		Nothing -> senderror "cannot send GETUUID here"
 	handleRemoteRequest GETGITDIR = 
 		send . VALUE . fromRawFilePath =<< fromRepo Git.localGitDir
-	handleRemoteRequest (SETWANTED expr) =
-		preferredContentSet (externalUUID external) expr
-	handleRemoteRequest GETWANTED = do
-		expr <- fromMaybe "" . M.lookup (externalUUID external)
-			<$> preferredContentMapRaw
-		send $ VALUE expr
+	handleRemoteRequest (SETWANTED expr) = case externalUUID external of
+		Just u -> preferredContentSet u expr
+		Nothing -> senderror "cannot send SETWANTED here"
+	handleRemoteRequest GETWANTED = case externalUUID external of
+		Just u -> do
+			expr <- fromMaybe "" . M.lookup u
+				<$> preferredContentMapRaw
+			send $ VALUE expr
+		Nothing -> senderror "cannot send GETWANTED here"
 	handleRemoteRequest (SETSTATE key state) =
 		case externalRemoteStateHandle external of
 			Just h -> setRemoteState h key state
@ -478,13 +482,13 @@ handleRequest' st external req mp responsehandler
 	send = sendMessage st external
 	senderror = sendMessage st external . ERROR 

-	credstorage setting = CredPairStorage
+	credstorage setting u = CredPairStorage
 		{ credPairFile = base
 		, credPairEnvironment = (base ++ "login", base ++ "password")
 		, credPairRemoteField = Accepted setting
 		}
 	  where
-		base = replace "/" "_" $ fromUUID (externalUUID external) ++ "-" ++ setting
+		base = replace "/" "_" $ fromUUID u ++ "-" ++ setting
 			
 	withurl mk uri = handleRemoteRequest $ mk $
 		setDownloader (show uri) OtherDownloader
@ -777,3 +781,48 @@ getInfoM external = (++)
 		INFOVALUE v -> Just $ return $
 			GetNextMessage $ collect ((f, v) : l)
 		_ -> Nothing
+
+{- All unknown configs are passed through in case the external program
+ - uses them. -}
+lenientRemoteConfigParser :: RemoteConfigParser
+lenientRemoteConfigParser = RemoteConfigParser
+	{ remoteConfigFieldParsers =
+		[ optionalStringParser externaltypeField
+		, trueFalseParser readonlyField False
+		]
+	, remoteConfigRestPassthrough = const True
+	}
+
+{- When the remote supports LISTCONFIGS, only accept the ones it listed.
+ - When it does not, accept all configs. -}
+strictRemoteConfigParser :: External -> Annex RemoteConfigParser
+strictRemoteConfigParser external = listConfigs external >>= \case
+	Nothing -> return lenientRemoteConfigParser
+	Just l -> do
+		let s = S.fromList (map fst l)
+		let listed f = S.member (fromProposedAccepted f) s
+		return $ lenientRemoteConfigParser
+			{ remoteConfigRestPassthrough = listed }
+
+listConfigs :: External -> Annex (Maybe [(Setting, Description)])
+listConfigs external = handleRequest external LISTCONFIGS Nothing (collect [])
+  where
+	collect l req = case req of
+		CONFIG s d -> Just $ return $
+			GetNextMessage $ collect ((s, d) : l)
+		CONFIGEND -> result (Just (reverse l))
+		UNSUPPORTED_REQUEST -> result Nothing
+		_ -> Nothing
+
+remoteConfigParser :: RemoteConfig -> Annex RemoteConfigParser
+remoteConfigParser c
+	-- No need to ask when there is no config to parse.
+	| M.null c = return lenientRemoteConfigParser
+	| otherwise = case parseRemoteConfig c lenientRemoteConfigParser of
+		Left _ -> return lenientRemoteConfigParser
+		Right pc -> case (getRemoteConfigValue externaltypeField pc, getRemoteConfigValue readonlyField pc) of
+			(Nothing, _) -> return lenientRemoteConfigParser
+			(_, Just True) -> return lenientRemoteConfigParser
+			(Just externaltype, _) -> do
+				external <- newExternal externaltype Nothing pc Nothing Nothing
+				strictRemoteConfigParser external
--- a/Remote/External/Types.hs
+++ b/Remote/External/Types.hs
@ -28,6 +28,7 @@ module Remote.External.Types (
 	AsyncMessage(..),
 	ErrorMsg,
 	Setting,
+	Description,
 	ProtocolVersion,
 	supportedProtocolVersions,
 ) where
@ -51,17 +52,17 @@ import Data.Char

 data External = External
 	{ externalType :: ExternalType
-	, externalUUID :: UUID
+	, externalUUID :: Maybe UUID
 	, externalState :: TVar [ExternalState]
 	-- ^ Contains states for external special remote processes
 	-- that are not currently in use.
 	, externalLastPid :: TVar PID
 	, externalDefaultConfig :: ParsedRemoteConfig
-	, externalGitConfig :: RemoteGitConfig
+	, externalGitConfig :: Maybe RemoteGitConfig
 	, externalRemoteStateHandle :: Maybe RemoteStateHandle
 	}

-newExternal :: ExternalType -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> Maybe RemoteStateHandle -> Annex External
+newExternal :: ExternalType -> Maybe UUID -> ParsedRemoteConfig -> Maybe RemoteGitConfig -> Maybe RemoteStateHandle -> Annex External
 newExternal externaltype u c gc rs = liftIO $ External
 	<$> pure externaltype
 	<*> pure u
@ -131,6 +132,7 @@ data Request
 	| CHECKPRESENT SafeKey
 	| REMOVE SafeKey
 	| WHEREIS SafeKey
+	| LISTCONFIGS
 	| GETINFO
 	| EXPORTSUPPORTED
 	| EXPORT ExportLocation
@ -147,6 +149,7 @@ needsPREPARE PREPARE = False
 needsPREPARE (EXTENSIONS _) = False
 needsPREPARE INITREMOTE = False
 needsPREPARE EXPORTSUPPORTED = False
+needsPREPARE LISTCONFIGS = False
 needsPREPARE _ = True

 instance Proto.Sendable Request where
@ -167,6 +170,7 @@ instance Proto.Sendable Request where
 		[ "CHECKPRESENT", Proto.serialize key ]
 	formatMessage (REMOVE key) = [ "REMOVE", Proto.serialize key ]
 	formatMessage (WHEREIS key) = [ "WHEREIS", Proto.serialize key ]
+	formatMessage LISTCONFIGS = [ "LISTCONFIGS" ]
 	formatMessage GETINFO = [ "GETINFO" ]
 	formatMessage EXPORTSUPPORTED = ["EXPORTSUPPORTED"]
 	formatMessage (EXPORT loc) = [ "EXPORT", Proto.serialize loc ]
@ -211,6 +215,8 @@ data Response
 	| CHECKURL_FAILURE ErrorMsg
 	| WHEREIS_SUCCESS String
 	| WHEREIS_FAILURE
+	| CONFIG Setting Description
+	| CONFIGEND
 	| INFOFIELD String
 	| INFOVALUE String
 	| INFOEND
@ -245,6 +251,8 @@ instance Proto.Receivable Response where
 	parseCommand "CHECKURL-FAILURE" = Proto.parse1 CHECKURL_FAILURE
 	parseCommand "WHEREIS-SUCCESS" = Just . WHEREIS_SUCCESS
 	parseCommand "WHEREIS-FAILURE" = Proto.parse0 WHEREIS_FAILURE
+	parseCommand "CONFIG" = Proto.parse2 CONFIG
+	parseCommand "CONFIGEND" = Proto.parse0 CONFIGEND
 	parseCommand "INFOFIELD" = Proto.parse1 INFOFIELD
 	parseCommand "INFOVALUE" = Proto.parse1 INFOVALUE
 	parseCommand "INFOEND" = Proto.parse0 INFOEND
@ -332,6 +340,7 @@ instance Proto.Receivable AsyncMessage where
 -- All are serializable.
 type ErrorMsg = String
 type Setting = String
+type Description = String
 type ProtocolVersion = Int
 type Size = Maybe Integer

--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@ -107,7 +107,7 @@ gen baser u c gc rs = do
 			(Just remotename, Just c') -> do
 				pc <- either giveup return
 					. parseRemoteConfig c'
-					=<< configParser remote
+					=<< configParser remote c'
 				setGcryptEncryption pc remotename
 				storeUUIDIn (remoteConfig baser "uuid") u'
 				setConfig (Git.GCrypt.remoteConfigKey "gcrypt-id" remotename) gcryptid
@ -217,7 +217,7 @@ gCryptSetup _ mu _ c gc = go $ fromProposedAccepted <$> M.lookup gitRepoField c
 				| otherwise -> error "Another remote with the same name already exists."		

 		pc <- either giveup return . parseRemoteConfig c'
-			=<< configParser remote
+			=<< configParser remote c'
 		setGcryptEncryption pc remotename

 		{- Run a git fetch and a push to the git repo in order to get
--- a/Remote/GitLFS.hs
+++ b/Remote/GitLFS.hs
@ -134,7 +134,7 @@ mySetup _ mu _ c gc = do
 	u <- maybe (liftIO genUUID) return mu

 	(c', _encsetup) <- encryptionSetup c gc
-	pc <- either giveup return . parseRemoteConfig c' =<< configParser remote
+	pc <- either giveup return . parseRemoteConfig c' =<< configParser remote c'
 	case (isEncrypted pc, Git.GCrypt.urlPrefix `isPrefixOf` url) of
 		(False, False) -> noop
 		(True, True) -> Remote.GCrypt.setGcryptEncryption pc remotename
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@ -116,7 +116,8 @@ glacierSetup' ss u mcreds c gc = do
 	(c', encsetup) <- encryptionSetup c gc
 	c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
 	let fullconfig = c'' `M.union` defaults
-	pc <- either giveup return . parseRemoteConfig fullconfig =<< configParser remote
+	pc <- either giveup return . parseRemoteConfig fullconfig
+		=<< configParser remote fullconfig
 	case ss of
 		Init -> genVault pc gc u
 		_ -> return ()
--- a/Remote/Helper/ExportImport.hs
+++ b/Remote/Helper/ExportImport.hs
@ -77,10 +77,10 @@ adjustExportImportRemoteType rt = rt
 	, configParser = configparser
 	}
  where
-	configparser = addRemoteConfigParser exportImportConfigParsers 
-		<$> configParser rt
+	configparser c = addRemoteConfigParser exportImportConfigParsers 
+		<$> configParser rt c
 	setup' st mu cp c gc = do
-		pc <- either giveup return . parseRemoteConfig c =<< configparser
+		pc <- either giveup return . parseRemoteConfig c =<< configparser c
 		let checkconfig supported configured configfield cont =
 			ifM (supported rt pc gc)
 				( case st of
@ -89,7 +89,7 @@ adjustExportImportRemoteType rt = rt
 							giveup $ "cannot enable both encryption and " ++ fromProposedAccepted configfield
 						| otherwise -> cont
 					Enable oldc -> do
-						oldpc <- either mempty id . parseRemoteConfig oldc <$> configparser
+						oldpc <- either mempty id . parseRemoteConfig oldc <$> configparser oldc
 						if configured pc /= configured oldpc
 							then giveup $ "cannot change " ++ fromProposedAccepted configfield ++ " of existing special remote"
 							else cont
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@ -30,6 +30,7 @@ module Remote.Helper.Special (
 	checkPresentDummy,
 	SpecialRemoteCfg(..),
 	specialRemoteCfg,
+	specialRemoteConfigParsers,
 	specialRemoteType,
 	specialRemote,
 	specialRemote',
@ -169,8 +170,8 @@ specialRemoteCfg c = SpecialRemoteCfg (getChunkConfig c) True
 -- Modifies a base RemoteType to support chunking and encryption configs.
 specialRemoteType :: RemoteType -> RemoteType
 specialRemoteType r = r 
-	{ configParser = addRemoteConfigParser specialRemoteConfigParsers
-		<$> configParser r
+	{ configParser = \c -> addRemoteConfigParser specialRemoteConfigParsers
+		<$> configParser r c
 	}

 specialRemoteConfigParsers :: [RemoteConfigFieldParser]
--- a/Remote/List.hs
+++ b/Remote/List.hs
@ -110,10 +110,7 @@ remoteGen m t g = do
 	let cu = fromMaybe u $ remoteAnnexConfigUUID gc
 	let rs = RemoteStateHandle cu
 	let c = fromMaybe M.empty $ M.lookup cu m
-	pc <- if null c
-		then pure mempty
-		else either (const mempty) id . parseRemoteConfig c
-			<$> configParser t
+	pc <- either (const mempty) id . parseRemoteConfig c <$> configParser t c
 	generate t g u pc gc rs >>= \case
 		Nothing -> return Nothing
 		Just r -> Just <$> adjustExportImport (adjustReadOnly (addHooks r)) rs
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@ -73,7 +73,7 @@ remote = specialRemoteType $ RemoteType
 	{ typename = "S3"
 	, enumerate = const (findSpecialRemotes "s3")
 	, generate = gen
-	, configParser = pure $ RemoteConfigParser
+	, configParser = const $ pure $ RemoteConfigParser
 		{ remoteConfigFieldParsers = 
 			[ optionalStringParser bucketField
 			, optionalStringParser hostField
@ -230,7 +230,8 @@ s3Setup' ss u mcreds c gc
 		(c', encsetup) <- encryptionSetup c gc
 		c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
 		let fullconfig = c'' `M.union` defaults
-		pc <- either giveup return . parseRemoteConfig fullconfig =<< configParser remote
+		pc <- either giveup return . parseRemoteConfig fullconfig
+			=<< configParser remote fullconfig
 		info <- extractS3Info pc
 		checkexportimportsafe pc info
 		case ss of
@ -255,7 +256,8 @@ s3Setup' ss u mcreds c gc
 			M.union c' $
 			-- special constraints on key names
 			M.insert mungekeysField (Proposed "ia") defaults
-		pc <- either giveup return . parseRemoteConfig archiveconfig =<< configParser remote
+		pc <- either giveup return . parseRemoteConfig archiveconfig
+			=<< configParser remote archiveconfig
 		info <- extractS3Info pc
 		checkexportimportsafe pc info
 		hdl <- mkS3HandleVar pc gc u
@ -1234,7 +1236,7 @@ enableBucketVersioning ss info _ _ _ = do
 		Enable oldc -> do
 			oldpc <- either (const mempty) id
 				. parseRemoteConfig oldc 
-				<$> configParser remote
+				<$> configParser remote oldc
 			oldinfo <- extractS3Info oldpc
 			when (versioning info /= versioning oldinfo) $
 				giveup "Cannot change versioning= of existing S3 remote."
--- a/Remote/Tahoe.hs
+++ b/Remote/Tahoe.hs
@ -121,7 +121,7 @@ tahoeSetup _ mu _ c _ = do
 	scs <- liftIO $ tahoeConfigure configdir
 		(fromProposedAccepted furl)
 		(fromProposedAccepted <$> (M.lookup scsField c))
-	pc <- either giveup return . parseRemoteConfig c =<< configParser remote
+	pc <- either giveup return . parseRemoteConfig c =<< configParser remote c
 	let c' = if embedCreds pc
 		then flip M.union c $ M.fromList
 			[ (furlField, furl)
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@ -123,7 +123,7 @@ webdavSetup _ mu mcreds c gc = do
 		(return . fromProposedAccepted)
 		(M.lookup urlField c)
 	(c', encsetup) <- encryptionSetup c gc
-	pc <- either giveup return . parseRemoteConfig c' =<< configParser remote
+	pc <- either giveup return . parseRemoteConfig c' =<< configParser remote c'
 	creds <- maybe (getCreds pc gc u) (return . Just) mcreds
 	testDav url creds
 	gitConfigSpecialRemote u c' [("webdav", "true")]
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@ -60,7 +60,7 @@ data RemoteTypeA a = RemoteType
 	-- generates a remote of this type
 	, generate :: Git.Repo -> UUID -> ParsedRemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> a (Maybe (RemoteA a))
 	-- parse configs of remotes of this type
-	, configParser :: a RemoteConfigParser
+	, configParser :: RemoteConfig -> a RemoteConfigParser
 	-- initializes or enables a remote
 	, setup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> a (RemoteConfig, UUID)
 	-- check if a remote of this type is able to support export
--- a/Types/RemoteConfig.hs
+++ b/Types/RemoteConfig.hs
@ -44,8 +44,8 @@ data RemoteConfigParser = RemoteConfigParser
 	, remoteConfigRestPassthrough :: RemoteConfigField -> Bool
 	}

-mkRemoteConfigParser :: Monad m => [RemoteConfigFieldParser] -> m RemoteConfigParser
-mkRemoteConfigParser l = pure (RemoteConfigParser l (const False))
+mkRemoteConfigParser :: Monad m => [RemoteConfigFieldParser] -> RemoteConfig -> m RemoteConfigParser
+mkRemoteConfigParser l _ = pure (RemoteConfigParser l (const False))

 addRemoteConfigParser :: [RemoteConfigFieldParser] -> RemoteConfigParser -> RemoteConfigParser
 addRemoteConfigParser l rpc = rpc { remoteConfigFieldParsers = remoteConfigFieldParsers rpc ++ l }
--- a/doc/design/external_special_remote_protocol.mdwn
+++ b/doc/design/external_special_remote_protocol.mdwn
@ -54,8 +54,9 @@ could have its own protocol extension details, but none are currently used.
 	EXTENSIONS 

 Next, git-annex will generally send a message telling the special
-remote to start up. (Or it might send an INITREMOTE or EXPORTSUPPORTED,
-or perhaps other things in the future, so don't hardcode this order.)
+remote to start up. (Or it might send an INITREMOTE or EXPORTSUPPORTED or
+LISTCONFIGS, or perhaps other things in the future, so don't hardcode this
+order.)

 	PREPARE

@ -116,9 +117,9 @@ The following requests *must* all be supported by the special remote.
    Indicates that INITREMOTE failed.
 * `PREPARE`  
  Tells the remote that it's time to prepare itself to be used.  
-  Only a few requests for details about the remote can come before this.
-  Those include EXTENSIONS, INITREMOTE, and EXPORTSUPPORTED, but others
-  may be added later.
+  Only a few requests for details about the remote can come before this
+  (EXTENSIONS, INITREMOTE, EXPORTSUPPORTED, and LISTCONFIGS,
+  but others may be added later).
  * `PREPARE-SUCCESS`  
    Sent as a response to PREPARE once the special remote is ready for use.
  * `PREPARE-FAILURE ErrorMsg`  
@ -173,6 +174,19 @@ the special remote can reply with `UNSUPPORTED-REQUEST`.
    Sent in response to a EXTENSIONS request, the List could be used to indicate
    protocol extensions that the special remote uses, but there are currently
    no such extensions.
+* `LISTCONFIGS`  
+  Requests the remote to return a list of settings it uses (with
+  `GETCONFIG` and `SETCONFIG`). Providing a list makes `git annex initremote`
+  work better, because it can check the user's input, and can also display
+  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 `CONFIGSEND`.
+  * `CONFIG Name Description`  
+    Indicates the name and description of a config setting. The description
+    should be reasonably short. Example:
+    "CONFIG directory store data here"
+  * `CONFIGEND`  
+    Indicates the end of the response block.
 * `GETCOST`  
  Requests the remote to return a use cost. Higher costs are more expensive.
  (See Config/Cost.hs for some standard costs.)
@ -283,6 +297,8 @@ handling a request.
  Gets one of the special remote's configuration settings, which can have
  been passed by the user when running `git annex initremote`, or
  can have been set by a previous SETCONFIG. Can be run at any time.  
+  It's recommended that special remotes that use this implement
+  LISTCONFIGS.
  (git-annex replies with VALUE followed by the value. If the setting is
  not set, the value will be empty.)
 * `SETCREDS Setting User Password`  
--- a/doc/special_remotes/external/example.sh
+++ b/doc/special_remotes/external/example.sh
@ -137,7 +137,7 @@ doremove () {
 	local loc="$2"

 	# Note that it's not a failure to remove a
-	# fike that is not present.
+	# file that is not present.
 	if [ -e "$loc" ]; then
 		if runcmd rm -f "$loc"; then
 			echo REMOVE-SUCCESS "$key"
@ -155,6 +155,12 @@ echo VERSION 1
 while read line; do
 	set -- $line
 	case "$1" in
+		LISTCONFIGS)
+			# One CONFIG line for each setting that we GETCONFIG
+			# later.
+			echo CONFIG directory store data here
+			echo CONFIGEND
+		;;
 		INITREMOTE)
 			# Do anything necessary to create resources
 			# used by the remote. Try to be idempotent.