be stricter about rejecting invalid configurations for remotes

This is a first step toward that goal, using the ProposedAccepted type
in RemoteConfig lets initremote/enableremote reject bad parameters that
were passed in a remote's configuration, while avoiding enableremote
rejecting bad parameters that have already been stored in remote.log

This does not eliminate every place where a remote config is parsed and a
default value is used if the parse false. But, I did fix several
things that expected foo=yes/no and so confusingly accepted foo=true but
treated it like foo=no. There are still some fields that are parsed with
yesNo but not not checked when initializing a remote, and there are other
fields that are parsed in other ways and not checked when initializing a
remote.

This also lays groundwork for rejecting unknown/typoed config keys.
This commit is contained in:
Joey Hess 2020-01-10 14:10:20 -04:00
parent ea3f206fd1
commit 71ecfbfccf
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
45 changed files with 395 additions and 224 deletions

64
Types/ProposedAccepted.hs Normal file
View file

@ -0,0 +1,64 @@
{- proposed and accepted values
-
- Copyright 2020 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Types.ProposedAccepted where
import qualified Data.Map as M
import Test.QuickCheck
-- | A value that may be proposed, or accepted.
--
-- When parsing/validating the value, may want to error out on invalid
-- input. But if a previous version of git-annex accepted an invalid value,
-- it's too late to error out, and instead the bad value may be ignored.
data ProposedAccepted t = Proposed t | Accepted t
deriving (Show)
fromProposedAccepted :: ProposedAccepted t -> t
fromProposedAccepted (Proposed t) = t
fromProposedAccepted (Accepted t) = t
-- | Whether a value is proposed or accepted does not matter when checking
-- equality.
instance Eq t => Eq (ProposedAccepted t) where
a == b = fromProposedAccepted a == fromProposedAccepted b
-- | Order by the contained value, not by whether it's proposed or
-- accepted.
instance Ord t => Ord (ProposedAccepted t) where
compare a b = compare (fromProposedAccepted a) (fromProposedAccepted b)
instance Arbitrary t => Arbitrary (ProposedAccepted t) where
arbitrary = oneof
[ Proposed <$> arbitrary
, Accepted <$> arbitrary
]
-- | Looks up a config in the map, and parses its value if found.
--
-- Accepted values will always result in a Right, using a fallback value
-- if unable to parse.
--
-- Proposed values that cannot be parsed will result in a Left message.
parseProposedAccepted
:: ProposedAccepted String
-> M.Map (ProposedAccepted String) (ProposedAccepted v) -- config map
-> (v -> Maybe a) -- ^ parse the value
-> a -- ^ fallback used when accepted value cannot be parsed
-> String -- ^ short description of expected value
-> Either String (Maybe a)
parseProposedAccepted k m parser fallback desc =
case M.lookup k m of
Nothing -> Right Nothing
Just (Proposed v) -> case parser v of
Nothing -> Left $
"bad " ++ fromProposedAccepted k ++
" value (expected " ++ desc ++ ")"
Just a -> Right (Just a)
Just (Accepted v) -> case parser v of
Nothing -> Right (Just fallback)
Just a -> Right (Just a)

View file

@ -42,6 +42,7 @@ import Types.UrlContents
import Types.NumCopies
import Types.Export
import Types.Import
import Types.ProposedAccepted
import Config.Cost
import Utility.Metered
import Git.Types (RemoteName)
@ -49,9 +50,9 @@ import Utility.SafeCommand
import Utility.Url
import Utility.DataUnits
type RemoteConfigField = String
type RemoteConfigField = ProposedAccepted String
type RemoteConfig = M.Map RemoteConfigField String
type RemoteConfig = M.Map RemoteConfigField (ProposedAccepted String)
data SetupStage = Init | Enable RemoteConfig

View file

@ -11,9 +11,9 @@ module Types.StandardGroups where
import Types.Remote (RemoteConfig)
import Types.Group
import Types.ProposedAccepted
import qualified Data.Map as M
import Data.Maybe
type PreferredContentExpression = String
@ -71,7 +71,8 @@ associatedDirectory :: Maybe RemoteConfig -> StandardGroup -> Maybe FilePath
associatedDirectory _ SmallArchiveGroup = Just "archive"
associatedDirectory _ FullArchiveGroup = Just "archive"
associatedDirectory (Just c) PublicGroup = Just $
fromMaybe "public" $ M.lookup "preferreddir" c
maybe "public" fromProposedAccepted $
M.lookup (Accepted "preferreddir") c
associatedDirectory Nothing PublicGroup = Just "public"
associatedDirectory _ _ = Nothing