convert configParser to Annex action and add passthrough option

Needed so Remote.External can query the external program for its
configs. When the external program does not support the query,
the passthrough option will make all input fields be available.

diff --git a/Annex/SpecialRemote/Config.hs b/Annex/SpecialRemote/Config.hs
index 0ce0a4d258a84b7620a0b36af9b74b3a003ed34b..0a30d463303d63d4ef47684bcf507d8302ec65dd 100644 (file)
--- a/Annex/SpecialRemote/Config.hs
+++ b/Annex/SpecialRemote/Config.hs
@@ -93,8 +93,8 @@ importTree :: ParsedRemoteConfig -> Bool
 importTree = fromMaybe False . getRemoteConfigValue importTreeField
 
 {- Parsers for fields that are common to all special remotes. -}
-commonFieldsParser :: [RemoteConfigParser]
-commonFieldsParser =
+commonFieldParsers :: [RemoteConfigFieldParser]
+commonFieldParsers =
        [ optionalStringParser nameField
        , optionalStringParser sameasNameField
        , optionalStringParser sameasUUIDField
@@ -166,11 +166,13 @@ getRemoteConfigValue f m = case M.lookup f m of
                        ]
        Nothing -> Nothing
 
-parseRemoteConfig :: RemoteConfig -> [RemoteConfigParser] -> Either String ParsedRemoteConfig
-parseRemoteConfig c ps =
-       go [] (M.filterWithKey notaccepted c) (ps ++ commonFieldsParser)
+parseRemoteConfig :: RemoteConfig -> RemoteConfigParser -> Either String ParsedRemoteConfig
+parseRemoteConfig c rpc =
+       go [] (M.filterWithKey notaccepted c) (remoteConfigFieldParsers rpc ++ commonFieldParsers)
   where
        go l c' []
+               | remoteConfigRestPassthrough rpc = Right $ M.fromList $
+                       l ++ map (uncurry passthrough) (M.toList c')
                | M.null c' = Right (M.fromList l)
                | otherwise = Left $ "Unexpected fields: " ++
                        unwords (map fromProposedAccepted (M.keys c'))
@@ -179,19 +181,22 @@ parseRemoteConfig c ps =
                case v of
                        Just v' -> go ((f,v'):l) (M.delete f c') rest
                        Nothing -> go l (M.delete f c') rest
+       
+       passthrough f v = (f, RemoteConfigValue (fromProposedAccepted v))
+
        notaccepted (Proposed _) _ = True
        notaccepted (Accepted _) _ = False
 
-optionalStringParser :: RemoteConfigField -> RemoteConfigParser
+optionalStringParser :: RemoteConfigField -> RemoteConfigFieldParser
 optionalStringParser f = (f, p)
   where
        p (Just v) _c = Right (Just (RemoteConfigValue (fromProposedAccepted v)))
        p Nothing _c = Right Nothing
 
-yesNoParser :: RemoteConfigField -> Bool -> RemoteConfigParser
+yesNoParser :: RemoteConfigField -> Bool -> RemoteConfigFieldParser
 yesNoParser = genParser yesNo "yes or no"
 
-trueFalseParser :: RemoteConfigField -> Bool -> RemoteConfigParser
+trueFalseParser :: RemoteConfigField -> Bool -> RemoteConfigFieldParser
 trueFalseParser = genParser Git.Config.isTrueFalse "true or false"
 
 genParser
@@ -200,7 +205,7 @@ genParser
        -> String -- ^ description of the value
        -> RemoteConfigField
        -> t -- ^ fallback value
-       -> RemoteConfigParser
+       -> RemoteConfigFieldParser
 genParser parse desc f fallback = (f, p)
   where
        p Nothing _c = Right (Just (RemoteConfigValue fallback))

diff --git a/Creds.hs b/Creds.hs
index a1c81517d2d88e12beb8010629bb6bc7eac5ff09..52db539843081f778969189101ea7c89344f7776 100644 (file)
--- a/Creds.hs
+++ b/Creds.hs
@@ -1,6 +1,6 @@
 {- Credentials storage
  -
- - Copyright 2012-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -30,7 +30,7 @@ import Utility.FileMode
 import Crypto
 import Types.Remote (RemoteConfig, RemoteConfigField)
 import Types.ProposedAccepted
-import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher, encryptionConfigParser)
+import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher, parseEncryptionConfig)
 import Utility.Env (getEnv)
 
 import qualified Data.ByteString.Lazy.Char8 as L
@@ -79,8 +79,7 @@ setRemoteCredPair encsetup c gc storage mcreds = case mcreds of
        storeconfig creds key Nothing =
                return $ M.insert key (Accepted (toB64 $ encodeCredPair creds)) c
        
-       pc = either (const mempty) id
-               (parseRemoteConfig c encryptionConfigParser)
+       pc = either (const mempty) id (parseEncryptionConfig c)
 
 {- Gets a remote's credpair, from the environment if set, otherwise
  - from the cache in gitAnnexCredsDir, or failing that, from the

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index b3421e2a04f532831b86b0311d137126f0baf381..d70c50e2f43658c272f44496325bf9d1cdcbf37d 100644 (file)
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -42,7 +42,8 @@ remote = specialRemoteType $ RemoteType
        { typename = "directory"
        , enumerate = const (findSpecialRemotes "directory")
        , generate = gen
-       , configParser = [optionalStringParser directoryField]
+       , configParser = mkRemoteConfigParser
+               [optionalStringParser directoryField]
        , setup = directorySetup
        , exportSupported = exportIsSupported
        , importSupported = importIsSupported

diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 507a2ffd14ee9f25d0b30711649a71849c9572e8..497c967e0aaa19f0effdb91875415f44d02dedc4 100644 (file)
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -66,7 +66,8 @@ remote = specialRemoteType $ RemoteType
        -- and will call our gen on them.
        , enumerate = const (return [])
        , generate = gen
-       , configParser = [optionalStringParser gitRepoField]
+       , configParser = mkRemoteConfigParser
+               [optionalStringParser gitRepoField]
        , setup = gCryptSetup
        , exportSupported = exportUnsupported
        , importSupported = importUnsupported
@@ -104,8 +105,9 @@ gen baser u c gc rs = do
                v <- M.lookup u' <$> readRemoteLog
                case (Git.remoteName baser, v) of
                        (Just remotename, Just c') -> do
-                               pc <- either giveup return $
-                                       parseRemoteConfig c' (configParser remote)
+                               pc <- either giveup return
+                                       . parseRemoteConfig c'
+                                       =<< configParser remote
                                setGcryptEncryption pc remotename
                                storeUUIDIn (remoteConfig baser "uuid") u'
                                setConfig (Git.GCrypt.remoteConfigKey "gcrypt-id" remotename) gcryptid
@@ -214,8 +216,8 @@ gCryptSetup _ mu _ c gc = go $ fromProposedAccepted <$> M.lookup gitRepoField c
                                | Git.repoLocation r == url -> noop
                                | otherwise -> error "Another remote with the same name already exists."                
 
-               pc <- either giveup return $
-                       parseRemoteConfig c' (configParser remote)
+               pc <- either giveup return . parseRemoteConfig c'
+                       =<< configParser remote
                setGcryptEncryption pc remotename
 
                {- Run a git fetch and a push to the git repo in order to get

diff --git a/Remote/Git.hs b/Remote/Git.hs
index c910a5c52445ee24bea334c85fc05ae458711773..11995a71753e7035c705f3607beb3e96617313f3 100644 (file)
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -80,7 +80,8 @@ remote = RemoteType
        { typename = "git"
        , enumerate = list
        , generate = gen
-       , configParser = [optionalStringParser locationField]
+       , configParser = mkRemoteConfigParser
+               [optionalStringParser locationField]
        , setup = gitSetup
        , exportSupported = exportUnsupported
        , importSupported = importUnsupported

diff --git a/Remote/GitLFS.hs b/Remote/GitLFS.hs
index 8ed0586ebcb482337a077b35101e36d5db6c343d..0f99ddb507118f0a6db957b002cf3313144a8439 100644 (file)
--- a/Remote/GitLFS.hs
+++ b/Remote/GitLFS.hs
@@ -60,7 +60,8 @@ remote = specialRemoteType $ RemoteType
        -- and will call our gen on them.
        , enumerate = const (return [])
        , generate = gen
-       , configParser = [optionalStringParser urlField]
+       , configParser = mkRemoteConfigParser
+               [optionalStringParser urlField]
        , setup = mySetup
        , exportSupported = exportUnsupported
        , importSupported = importUnsupported
@@ -133,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
        case (isEncrypted pc, Git.GCrypt.urlPrefix `isPrefixOf` url) of
                (False, False) -> noop
                (True, True) -> Remote.GCrypt.setGcryptEncryption pc remotename

diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs
index cff59e7312e54eb320842c1bddc64302dd40c274..7fc11283d942d96caa7beb1dc4b5135fa5bbb650 100644 (file)
--- a/Remote/Helper/Chunked.hs
+++ b/Remote/Helper/Chunked.hs
@@ -10,7 +10,7 @@ module Remote.Helper.Chunked (
        ChunkConfig(..),
        noChunks,
        describeChunkConfig,
-       chunkConfigParser,
+       chunkConfigParsers,
        getChunkConfig,
        storeChunks,
        removeChunks,
@@ -49,8 +49,8 @@ noChunks :: ChunkConfig -> Bool
 noChunks NoChunks = True
 noChunks _ = False
 
-chunkConfigParser :: [RemoteConfigParser]
-chunkConfigParser =
+chunkConfigParsers :: [RemoteConfigFieldParser]
+chunkConfigParsers =
        [ optionalStringParser chunksizeField
        , optionalStringParser chunkField
        ]

diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index dda8020ac5682df42c2d14e50e3094fb9704f240..cb8cee8074a23237e8570cc41088cedd22a27fb3 100644 (file)
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -12,7 +12,7 @@ module Remote.Helper.Encryptable (
        encryptionSetup,
        noEncryptionUsed,
        encryptionAlreadySetup,
-       encryptionConfigParser,
+       encryptionConfigParsers,
        parseEncryptionConfig,
        remoteCipher,
        remoteCipher',
@@ -51,8 +51,8 @@ noEncryptionUsed = NoEncryption
 encryptionAlreadySetup :: EncryptionIsSetup
 encryptionAlreadySetup = EncryptionIsSetup
 
-encryptionConfigParser :: [RemoteConfigParser]
-encryptionConfigParser =
+encryptionConfigParsers :: [RemoteConfigFieldParser]
+encryptionConfigParsers =
        [ (encryptionField, \v c -> Just  . RemoteConfigValue <$> parseEncryptionMethod (fmap fromProposedAccepted v) c)
        , optionalStringParser cipherField
        , optionalStringParser cipherkeysField
@@ -66,11 +66,13 @@ encryptionConfigParser =
        ]
 
 encryptionConfigs :: S.Set RemoteConfigField
-encryptionConfigs = S.fromList (map fst encryptionConfigParser)
+encryptionConfigs = S.fromList (map fst encryptionConfigParsers)
 
 -- Parse only encryption fields, ignoring all others.
 parseEncryptionConfig :: RemoteConfig -> Either String ParsedRemoteConfig
-parseEncryptionConfig c = parseRemoteConfig (M.restrictKeys c encryptionConfigs) encryptionConfigParser
+parseEncryptionConfig c = parseRemoteConfig
+       (M.restrictKeys c encryptionConfigs)
+       (RemoteConfigParser encryptionConfigParsers False)
 
 parseEncryptionMethod :: Maybe String -> RemoteConfig -> Either String EncryptionMethod
 parseEncryptionMethod (Just "none") _ = Right NoneEncryption

diff --git a/Remote/Helper/ExportImport.hs b/Remote/Helper/ExportImport.hs
index 04f41322d5eb09fa0ccf1386241bcc261f8d9cfe..2db7deb14f2d208cf0a31410de8a627be902406d 100644 (file)
--- a/Remote/Helper/ExportImport.hs
+++ b/Remote/Helper/ExportImport.hs
@@ -77,9 +77,10 @@ adjustExportImportRemoteType rt = rt
        , configParser = configparser
        }
   where
-       configparser = configParser rt ++ exportImportConfigParser
+       configparser = addRemoteConfigParser exportImportConfigParsers 
+               <$> configParser rt
        setup' st mu cp c gc = do
-               pc <- either giveup return $ parseRemoteConfig c configparser
+               pc <- either giveup return . parseRemoteConfig c =<< configparser
                let checkconfig supported configured configfield cont =
                        ifM (supported rt pc gc)
                                ( case st of
@@ -87,9 +88,9 @@ adjustExportImportRemoteType rt = rt
                                                | configured pc && isEncrypted pc ->
                                                        giveup $ "cannot enable both encryption and " ++ fromProposedAccepted configfield
                                                | otherwise -> cont
-                                       Enable oldc ->
-                                               let oldpc = either mempty id $ parseRemoteConfig oldc configparser
-                                               in if configured pc /= configured oldpc
+                                       Enable oldc -> do
+                                               oldpc <- either mempty id . parseRemoteConfig oldc <$> configparser
+                                               if configured pc /= configured oldpc
                                                        then giveup $ "cannot change " ++ fromProposedAccepted configfield ++ " of existing special remote"
                                                        else cont
                                , if configured pc
@@ -102,8 +103,8 @@ adjustExportImportRemoteType rt = rt
                                        then giveup "cannot enable importtree=yes without also enabling exporttree=yes"
                                        else setup rt st mu cp c gc
 
-exportImportConfigParser :: [RemoteConfigParser]
-exportImportConfigParser =
+exportImportConfigParsers :: [RemoteConfigFieldParser]
+exportImportConfigParsers =
        [ yesNoParser exportTreeField False
        , yesNoParser importTreeField False
        ]

diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index 26e544a22f5b19640f7518bcbea47a0fcf914cab..f4e53a1fd83028985e0b0dbaf2ded0d1afaccb29 100644 (file)
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -28,7 +28,6 @@ module Remote.Helper.Special (
        retreiveKeyFileDummy,
        removeKeyDummy,
        checkPresentDummy,
-       specialRemoteConfigParser,
        SpecialRemoteCfg(..),
        specialRemoteCfg,
        specialRemoteType,
@@ -170,11 +169,12 @@ specialRemoteCfg c = SpecialRemoteCfg (getChunkConfig c) True
 -- Modifies a base RemoteType to support chunking and encryption configs.
 specialRemoteType :: RemoteType -> RemoteType
 specialRemoteType r = r 
-       { configParser = configParser r ++ specialRemoteConfigParser
+       { configParser = addRemoteConfigParser specialRemoteConfigParsers
+               <$> configParser r
        }
 
-specialRemoteConfigParser :: [RemoteConfigParser]
-specialRemoteConfigParser = chunkConfigParser ++ encryptionConfigParser
+specialRemoteConfigParsers :: [RemoteConfigFieldParser]
+specialRemoteConfigParsers = chunkConfigParsers ++ encryptionConfigParsers
 
 -- Modifies a base Remote to support both chunking and encryption,
 -- which special remotes typically should support.

diff --git a/Remote/List.hs b/Remote/List.hs
index e1621a3a29bef0c4157747ca9cdc170282a58855..e65e9d1c7e78991b500f5a24973273ec4d2a6915 100644 (file)
--- a/Remote/List.hs
+++ b/Remote/List.hs
@@ -122,7 +122,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
-       let pc = either mempty id (parseRemoteConfig c (configParser t))
+       pc <- either mempty id . parseRemoteConfig c <$> configParser t
        generate t g u pc gc rs >>= \case
                Nothing -> return Nothing
                Just r -> Just <$> adjustExportImport (adjustReadOnly (addHooks r)) rs

diff --git a/Remote/P2P.hs b/Remote/P2P.hs
index 28c75a0be0ba7644349fdce03e4aeb1271fda398..be90ce55f64d2bfa41fc68cea2e94e1e6c8dc5dc 100644 (file)
--- a/Remote/P2P.hs
+++ b/Remote/P2P.hs
@@ -36,7 +36,7 @@ remote = RemoteType
        -- and will call chainGen on them.
        , enumerate = const (return [])
        , generate = \_ _ _ _ _ -> return Nothing
-       , configParser = []
+       , configParser = mkRemoteConfigParser []
        , setup = error "P2P remotes are set up using git-annex p2p"
        , exportSupported = exportUnsupported
        , importSupported = importUnsupported

diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 959fd4dd7efbf12ae3f0daacb6d383e98b40455f..6ff6d327daf8a906513832bee44e23f4d10821a6 100644 (file)
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -51,7 +51,7 @@ remote = specialRemoteType $ RemoteType
        { typename = "rsync"
        , enumerate = const (findSpecialRemotes "rsyncurl")
        , generate = gen
-       , configParser =
+       , configParser = mkRemoteConfigParser
                [ yesNoParser shellEscapeField True
                , optionalStringParser rsyncUrlField
                ]

diff --git a/Remote/Web.hs b/Remote/Web.hs
index 2f6ab81597731d9ac42ed728206f1bb49c976127..1df743ed3ac9ad09e234d7509231f5d405a147b9 100644 (file)
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -27,7 +27,7 @@ remote = RemoteType
        { typename = "web"
        , enumerate = list
        , generate = gen
-       , configParser = []
+       , configParser = mkRemoteConfigParser []
        , setup = error "not supported"
        , exportSupported = exportUnsupported
        , importSupported = importUnsupported

diff --git a/Types/Remote.hs b/Types/Remote.hs
index 93ee1c53adc6cd530b0ace837676adfaebcf51dc..d56fa6fd2585036fd92db354a0ae2e2b3ba54284 100644 (file)
--- 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 :: [RemoteConfigParser]
+       , configParser :: 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 5035aa036ff9c35c56535bd65dfcf02e4972a5d2..4f6bb9b8fd73e6bc6bdeea267d6782f078102278 100644 (file)
--- a/Types/RemoteConfig.hs
+++ b/Types/RemoteConfig.hs
@@ -37,4 +37,15 @@ data RemoteConfigValue where
  - Presence of fields that are not included in this list will cause
  - a parse failure.
  -}
-type RemoteConfigParser = (RemoteConfigField, Maybe (ProposedAccepted String) -> RemoteConfig -> Either String (Maybe RemoteConfigValue))
+type RemoteConfigFieldParser = (RemoteConfigField, Maybe (ProposedAccepted String) -> RemoteConfig -> Either String (Maybe RemoteConfigValue))
+
+data RemoteConfigParser = RemoteConfigParser
+       { remoteConfigFieldParsers :: [RemoteConfigFieldParser]
+       , remoteConfigRestPassthrough :: Bool
+       }
+
+mkRemoteConfigParser :: Monad m => [RemoteConfigFieldParser] -> m RemoteConfigParser
+mkRemoteConfigParser l = pure (RemoteConfigParser l False)
+
+addRemoteConfigParser :: [RemoteConfigFieldParser] -> RemoteConfigParser -> RemoteConfigParser
+addRemoteConfigParser l rpc = rpc { remoteConfigFieldParsers = remoteConfigFieldParsers rpc ++ l }