From 2be4122bfc2970b6f260c74e3d1f3e4feb2e7d16 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 20 Jan 2020 16:23:35 -0400 Subject: [PATCH] include passthrough params in --describe-other-params --- Annex/SpecialRemote/Config.hs | 2 +- Command/InitRemote.hs | 32 +++++++++---------- Remote/External.hs | 11 ++++--- Remote/Helper/Encryptable.hs | 2 +- Remote/S3.hs | 9 ++++-- Types/RemoteConfig.hs | 4 +-- doc/special_remotes/S3.mdwn | 7 +++- ..._for_a_special_remote_of_a_given_type.mdwn | 6 ++++ 8 files changed, 46 insertions(+), 27 deletions(-) diff --git a/Annex/SpecialRemote/Config.hs b/Annex/SpecialRemote/Config.hs index d9d24c2c57..d4f8da22a8 100644 --- a/Annex/SpecialRemote/Config.hs +++ b/Annex/SpecialRemote/Config.hs @@ -189,7 +189,7 @@ parseRemoteConfig c rpc = where go l c' [] = let (passover, leftovers) = partition - (remoteConfigRestPassthrough rpc . fst) + (maybe (const False) fst (remoteConfigRestPassthrough rpc) . fst) (M.toList c') leftovers' = filter (notaccepted . fst) leftovers in if not (null leftovers') diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index f82946c7ba..b4c431743f 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -114,22 +114,22 @@ cleanup u name c o = do describeOtherParamsFor :: RemoteConfig -> RemoteType -> CommandPerform describeOtherParamsFor c t = do cp <- R.configParser t c - let l = mapMaybe mk $ filter notinconfig $ remoteConfigFieldParsers cp - liftIO $ forM_ l $ \(p, pd, vd) -> do - putStrLn p - putStrLn ("\t" ++ pd) - case vd of - Nothing -> return () - Just vd' -> putStrLn $ "\t(" ++ vd' ++ ")" + let l = map mk (filter notinconfig $ remoteConfigFieldParsers cp) + ++ map mk' (maybe [] snd (remoteConfigRestPassthrough cp)) + liftIO $ forM_ l $ \(p, fd, vd) -> case fd of + HiddenField -> return () + FieldDesc d -> do + putStrLn p + putStrLn ("\t" ++ d) + case vd of + Nothing -> return () + Just (ValueDesc d') -> + putStrLn $ "\t(" ++ d' ++ ")" next $ return True where notinconfig fp = not (M.member (parserForField fp) c) - mk fp = case fieldDesc fp of - HiddenField -> Nothing - FieldDesc d -> Just - ( fromProposedAccepted (parserForField fp) - , d - , case valueDesc fp of - Nothing -> Nothing - Just (ValueDesc vd) -> Just vd - ) + mk fp = ( fromProposedAccepted (parserForField fp) + , fieldDesc fp + , valueDesc fp + ) + mk' (k, v) = (k, v, Nothing) diff --git a/Remote/External.hs b/Remote/External.hs index 2ea6712586..5d54f68f08 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -792,7 +792,10 @@ lenientRemoteConfigParser = addRemoteConfigParser specialRemoteConfigParsers $ , trueFalseParser readonlyField False (FieldDesc "enable readonly mode") ] - , remoteConfigRestPassthrough = const True + , remoteConfigRestPassthrough = Just + ( const True + , [("*", FieldDesc "all other parameters are passed to external special remote program")] + ) } {- When the remote supports LISTCONFIGS, only accept the ones it listed. @@ -804,14 +807,14 @@ strictRemoteConfigParser external = listConfigs external >>= \case let s = S.fromList (map fst l) let listed f = S.member (fromProposedAccepted f) s return $ lenientRemoteConfigParser - { remoteConfigRestPassthrough = listed } + { remoteConfigRestPassthrough = Just (listed, l) } -listConfigs :: External -> Annex (Maybe [(Setting, Description)]) +listConfigs :: External -> Annex (Maybe [(Setting, FieldDesc)]) listConfigs external = handleRequest external LISTCONFIGS Nothing (collect []) where collect l req = case req of CONFIG s d -> Just $ return $ - GetNextMessage $ collect ((s, d) : l) + GetNextMessage $ collect ((s, FieldDesc d) : l) CONFIGEND -> result (Just (reverse l)) UNSUPPORTED_REQUEST -> result Nothing _ -> Nothing diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index 9b6723bf12..33ef848bb7 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -78,7 +78,7 @@ encryptionConfigs = S.fromList (map parserForField encryptionConfigParsers) parseEncryptionConfig :: RemoteConfig -> Either String ParsedRemoteConfig parseEncryptionConfig c = parseRemoteConfig (M.restrictKeys c encryptionConfigs) - (RemoteConfigParser encryptionConfigParsers (const False)) + (RemoteConfigParser encryptionConfigParsers Nothing) encryptionFieldParser :: RemoteConfigFieldParser encryptionFieldParser = RemoteConfigFieldParser diff --git a/Remote/S3.hs b/Remote/S3.hs index 0e02846377..8e925a3f91 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -102,8 +102,13 @@ remote = specialRemoteType $ RemoteType , optionalStringParser mungekeysField HiddenField , optionalStringParser AWS.s3credsField HiddenField ] - , remoteConfigRestPassthrough = \f -> - isMetaHeader f || isArchiveMetaHeader f + , remoteConfigRestPassthrough = Just + ( \f -> isMetaHeader f || isArchiveMetaHeader f + , + [ ("x-amz-meta-*", FieldDesc "http headers to add when storing on S3") + , ("x-archive-meta-*", FieldDesc "http headers to add when storing on Internet Archive") + ] + ) } , setup = s3Setup , exportSupported = exportIsSupported diff --git a/Types/RemoteConfig.hs b/Types/RemoteConfig.hs index 1f6c935be6..f0df89a10c 100644 --- a/Types/RemoteConfig.hs +++ b/Types/RemoteConfig.hs @@ -53,11 +53,11 @@ newtype ValueDesc = ValueDesc String data RemoteConfigParser = RemoteConfigParser { remoteConfigFieldParsers :: [RemoteConfigFieldParser] - , remoteConfigRestPassthrough :: RemoteConfigField -> Bool + , remoteConfigRestPassthrough :: Maybe (RemoteConfigField -> Bool, [(String, FieldDesc)]) } mkRemoteConfigParser :: Monad m => [RemoteConfigFieldParser] -> RemoteConfig -> m RemoteConfigParser -mkRemoteConfigParser l _ = pure (RemoteConfigParser l (const False)) +mkRemoteConfigParser l _ = pure (RemoteConfigParser l Nothing) addRemoteConfigParser :: [RemoteConfigFieldParser] -> RemoteConfigParser -> RemoteConfigParser addRemoteConfigParser l rpc = rpc diff --git a/doc/special_remotes/S3.mdwn b/doc/special_remotes/S3.mdwn index 2a1bb5729d..6221dd9557 100644 --- a/doc/special_remotes/S3.mdwn +++ b/doc/special_remotes/S3.mdwn @@ -140,4 +140,9 @@ the S3 remote. then use the same bucket. * `x-amz-meta-*` are passed through as http headers when storing keys - in S3. see [the Internet Archive S3 interface documentation](https://archive.org/help/abouts3.txt) for example headers. + in S3. + +* `x-archive-meta-*` are passed through as http headers when storing keys + in the Internet Archive. See + [the Internet Archive S3 interface documentation](https://archive.org/help/abouts3.txt) + for example headers. diff --git a/doc/todo/some_way_to_get_a_list_of_options_for_a_special_remote_of_a_given_type.mdwn b/doc/todo/some_way_to_get_a_list_of_options_for_a_special_remote_of_a_given_type.mdwn index 3e24a01c7f..493e7430f3 100644 --- a/doc/todo/some_way_to_get_a_list_of_options_for_a_special_remote_of_a_given_type.mdwn +++ b/doc/todo/some_way_to_get_a_list_of_options_for_a_special_remote_of_a_given_type.mdwn @@ -9,3 +9,9 @@ and indeed I get asked for e.g. encryption to be explicitly specified (why not t [[!meta author=yoh]] [[!tag projects/datalad]] + +> [[done]] as eg `git annex initremote type=rsync --describe-other-params`. +> +> External special remotes that implement LISTCONFIGS can also be queried: +> +> git annex inittype type=external externaltype=foo --describe-other-params