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

View file

@ -39,6 +39,7 @@ import Utility.Metered
import Utility.Url (URLString, matchStatusCodeException, matchHttpExceptionContent)
import Annex.UUID
import Remote.WebDAV.DavLocation
import Types.ProposedAccepted
remote :: RemoteType
remote = RemoteType
@ -95,9 +96,9 @@ gen r u c gc rs = new <$> remoteCost gc expensiveRemoteCost
, appendonly = False
, availability = GloballyAvailable
, remotetype = remote
, mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc rs
, mkUnavailable = gen r u (M.insert (Accepted "url") (Accepted "http://!dne!/") c) gc rs
, getInfo = includeCredsInfo c (davCreds u) $
[("url", fromMaybe "unknown" (M.lookup "url" c))]
[("url", maybe "unknown" fromProposedAccepted (M.lookup (Accepted "url") c))]
, claimUrl = Nothing
, checkUrl = Nothing
, remoteStateHandle = rs
@ -107,9 +108,9 @@ gen r u c gc rs = new <$> remoteCost gc expensiveRemoteCost
webdavSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
webdavSetup _ mu mcreds c gc = do
u <- maybe (liftIO genUUID) return mu
url <- case M.lookup "url" c of
Nothing -> giveup "Specify url="
Just url -> return url
url <- maybe (giveup "Specify url=")
(return . fromProposedAccepted)
(M.lookup (Accepted "url") c)
(c', encsetup) <- encryptionSetup c gc
creds <- maybe (getCreds c' gc u) (return . Just) mcreds
testDav url creds
@ -255,7 +256,8 @@ runExport Nothing _ = return False
runExport (Just h) a = fromMaybe False <$> liftIO (goDAV h $ safely (a h))
configUrl :: Remote -> Maybe URLString
configUrl r = fixup <$> M.lookup "url" (config r)
configUrl r = fixup . fromProposedAccepted
<$> M.lookup (Accepted "url") (config r)
where
-- box.com DAV url changed
fixup = replace "https://www.box.com/dav/" boxComUrl
@ -342,7 +344,7 @@ davCreds :: UUID -> CredPairStorage
davCreds u = CredPairStorage
{ credPairFile = fromUUID u
, credPairEnvironment = ("WEBDAV_USERNAME", "WEBDAV_PASSWORD")
, credPairRemoteField = "davcreds"
, credPairRemoteField = Accepted "davcreds"
}
{- Content-Type to use for files uploaded to WebDAV. -}