diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index cbf3231965..4f3c2effb0 100644 --- 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 diff --git a/Assistant/WebApp/Configurators/AWS.hs b/Assistant/WebApp/Configurators/AWS.hs index fd0a4b6de0..92717bfe64 100644 --- 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 diff --git a/Assistant/WebApp/Configurators/Edit.hs b/Assistant/WebApp/Configurators/Edit.hs index cbb9ccb966..93a45ef7a9 100644 --- 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 diff --git a/Assistant/WebApp/Configurators/WebDAV.hs b/Assistant/WebApp/Configurators/WebDAV.hs index 2cdcdc0f2c..37ff804557 100644 --- 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 $ diff --git a/CHANGELOG b/CHANGELOG index 04d41e91f3..84689b4e74 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -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 Wed, 01 Jan 2020 12:51:40 -0400 diff --git a/Remote/External.hs b/Remote/External.hs index 16edec7f8d..e63d78d1b9 100644 --- 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 diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index 0e2f62f219..461a4b5258 100644 --- 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 diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 497c967e0a..2a3f251c72 100644 --- 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 diff --git a/Remote/GitLFS.hs b/Remote/GitLFS.hs index 0f99ddb507..ab69cb6a5c 100644 --- 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 diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index 6fc1e6aa4c..359fa21612 100644 --- 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 () diff --git a/Remote/Helper/ExportImport.hs b/Remote/Helper/ExportImport.hs index 2db7deb14f..da58d58de1 100644 --- 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 diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs index f4e53a1fd8..7c788875a4 100644 --- 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] diff --git a/Remote/List.hs b/Remote/List.hs index 19123cf5fb..4619df6345 100644 --- 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 diff --git a/Remote/S3.hs b/Remote/S3.hs index 2c3369f03c..166f8daf5e 100644 --- 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." diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs index b5ebd5ec55..f755282228 100644 --- 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) diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs index 583a0017be..4978754c41 100644 --- 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")] diff --git a/Types/Remote.hs b/Types/Remote.hs index d56fa6fd25..12a37a618c 100644 --- 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 diff --git a/Types/RemoteConfig.hs b/Types/RemoteConfig.hs index 7b0b51ee5b..daf7f31902 100644 --- 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 } diff --git a/doc/design/external_special_remote_protocol.mdwn b/doc/design/external_special_remote_protocol.mdwn index ddaad9ae63..9b69300d8f 100644 --- 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` diff --git a/doc/special_remotes/external/example.sh b/doc/special_remotes/external/example.sh index fe1d9380ec..cfae74ae25 100755 --- 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.