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:
parent
ea3f206fd1
commit
71ecfbfccf
45 changed files with 395 additions and 224 deletions
|
@ -12,6 +12,7 @@ module Remote.Helper.AWS where
|
|||
|
||||
import Annex.Common
|
||||
import Creds
|
||||
import Types.ProposedAccepted
|
||||
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.ByteString as B
|
||||
|
@ -23,7 +24,7 @@ creds :: UUID -> CredPairStorage
|
|||
creds u = CredPairStorage
|
||||
{ credPairFile = fromUUID u
|
||||
, credPairEnvironment = ("AWS_ACCESS_KEY_ID", "AWS_SECRET_ACCESS_KEY")
|
||||
, credPairRemoteField = "s3creds"
|
||||
, credPairRemoteField = Accepted "s3creds"
|
||||
}
|
||||
|
||||
data Service = S3 | Glacier
|
||||
|
|
|
@ -21,6 +21,7 @@ import Annex.Common
|
|||
import Utility.DataUnits
|
||||
import Types.StoreRetrieve
|
||||
import Types.Remote
|
||||
import Types.ProposedAccepted
|
||||
import Logs.Chunk
|
||||
import Utility.Metered
|
||||
import Crypto (EncKey)
|
||||
|
@ -51,16 +52,16 @@ noChunks _ = False
|
|||
getChunkConfig :: RemoteConfig -> ChunkConfig
|
||||
getChunkConfig m =
|
||||
case M.lookup chunksizeField m of
|
||||
Nothing -> case M.lookup "chunk" m of
|
||||
Nothing -> case M.lookup (Accepted "chunk") m of
|
||||
Nothing -> NoChunks
|
||||
Just v -> readsz UnpaddedChunks v "chunk"
|
||||
Just v -> readsz LegacyChunks v chunksizeField
|
||||
Just v -> readsz UnpaddedChunks (fromProposedAccepted v) (Accepted "chunk")
|
||||
Just v -> readsz LegacyChunks (fromProposedAccepted v) chunksizeField
|
||||
where
|
||||
readsz c v f = case readSize dataUnits v of
|
||||
Just size
|
||||
| size == 0 -> NoChunks
|
||||
| size > 0 -> c (fromInteger size)
|
||||
_ -> giveup $ "bad configuration " ++ f ++ "=" ++ v
|
||||
_ -> giveup $ "bad configuration " ++ fromProposedAccepted f ++ "=" ++ v
|
||||
|
||||
-- An infinite stream of chunk keys, starting from chunk 1.
|
||||
newtype ChunkKeyStream = ChunkKeyStream [Key]
|
||||
|
|
|
@ -28,6 +28,7 @@ import Types.Remote
|
|||
import Config
|
||||
import Crypto
|
||||
import Types.Crypto
|
||||
import Types.ProposedAccepted
|
||||
import qualified Annex
|
||||
import Annex.SpecialRemote.Config
|
||||
|
||||
|
@ -56,7 +57,7 @@ encryptionSetup c gc = do
|
|||
maybe (genCipher cmd) (updateCipher cmd) (extractCipher c)
|
||||
where
|
||||
-- The type of encryption
|
||||
encryption = M.lookup encryptionField c
|
||||
encryption = fromProposedAccepted <$> M.lookup encryptionField c
|
||||
-- Generate a new cipher, depending on the chosen encryption scheme
|
||||
genCipher cmd = case encryption of
|
||||
_ | hasEncryptionConfig c -> cannotchange
|
||||
|
@ -64,17 +65,18 @@ encryptionSetup c gc = do
|
|||
Just "shared" -> encsetup $ genSharedCipher cmd
|
||||
-- hybrid encryption is the default when a keyid is
|
||||
-- specified but no encryption
|
||||
_ | maybe (M.member "keyid" c) (== "hybrid") encryption ->
|
||||
_ | maybe (M.member (Accepted "keyid") c) (== "hybrid") encryption ->
|
||||
encsetup $ genEncryptedCipher cmd (c, gc) key Hybrid
|
||||
Just "pubkey" -> encsetup $ genEncryptedCipher cmd (c, gc) key PubKey
|
||||
Just "sharedpubkey" -> encsetup $ genSharedPubKeyCipher cmd key
|
||||
_ -> giveup $ "Specify " ++ intercalate " or "
|
||||
(map ((encryptionField ++ "=") ++)
|
||||
(map ((fromProposedAccepted encryptionField ++ "=") ++)
|
||||
["none","shared","hybrid","pubkey", "sharedpubkey"])
|
||||
++ "."
|
||||
key = fromMaybe (giveup "Specify keyid=...") $ M.lookup "keyid" c
|
||||
newkeys = maybe [] (\k -> [(True,k)]) (M.lookup "keyid+" c) ++
|
||||
maybe [] (\k -> [(False,k)]) (M.lookup "keyid-" c)
|
||||
key = maybe (giveup "Specify keyid=...") fromProposedAccepted $
|
||||
M.lookup (Accepted "keyid") c
|
||||
newkeys = maybe [] (\k -> [(True,fromProposedAccepted k)]) (M.lookup (Accepted "keyid+") c) ++
|
||||
maybe [] (\k -> [(False,fromProposedAccepted k)]) (M.lookup (Accepted "keyid-") c)
|
||||
cannotchange = giveup "Cannot set encryption type of existing remotes."
|
||||
-- Update an existing cipher if possible.
|
||||
updateCipher cmd v = case v of
|
||||
|
@ -92,14 +94,14 @@ encryptionSetup c gc = do
|
|||
showNote (describeCipher cipher)
|
||||
return (storeCipher cipher c', EncryptionIsSetup)
|
||||
highRandomQuality =
|
||||
(&&) (maybe True ( /= "false") $ M.lookup "highRandomQuality" c)
|
||||
(&&) (maybe True (\v -> fromProposedAccepted v /= "false") $ M.lookup (Accepted "highRandomQuality") c)
|
||||
<$> fmap not (Annex.getState Annex.fast)
|
||||
c' = foldr M.delete c
|
||||
-- git-annex used to remove 'encryption' as well, since
|
||||
-- it was redundant; we now need to keep it for
|
||||
-- public-key encryption, hence we leave it on newer
|
||||
-- remotes (while being backward-compatible).
|
||||
[ "keyid", "keyid+", "keyid-", "highRandomQuality" ]
|
||||
(map Accepted [ "keyid", "keyid+", "keyid-", "highRandomQuality" ])
|
||||
|
||||
remoteCipher :: RemoteConfig -> RemoteGitConfig -> Annex (Maybe Cipher)
|
||||
remoteCipher c gc = fmap fst <$> remoteCipher' c gc
|
||||
|
@ -129,7 +131,7 @@ remoteCipher' c gc = go $ extractCipher c
|
|||
- Not when a shared cipher is used.
|
||||
-}
|
||||
embedCreds :: RemoteConfig -> Bool
|
||||
embedCreds c = case yesNo =<< M.lookup "embedcreds" c of
|
||||
embedCreds c = case yesNo . fromProposedAccepted =<< M.lookup embedCredsField c of
|
||||
Just v -> v
|
||||
Nothing -> isJust (M.lookup cipherkeysField c) && isJust (M.lookup cipherField c)
|
||||
|
||||
|
@ -138,7 +140,8 @@ cipherKey :: RemoteConfig -> RemoteGitConfig -> Annex (Maybe (Cipher, EncKey))
|
|||
cipherKey c gc = fmap make <$> remoteCipher c gc
|
||||
where
|
||||
make ciphertext = (ciphertext, encryptKey mac ciphertext)
|
||||
mac = fromMaybe defaultMac $ M.lookup macField c >>= readMac
|
||||
mac = fromMaybe defaultMac $
|
||||
M.lookup macField c >>= readMac . fromProposedAccepted
|
||||
|
||||
{- Stores an StorableCipher in a remote's configuration. -}
|
||||
storeCipher :: StorableCipher -> RemoteConfig -> RemoteConfig
|
||||
|
@ -147,14 +150,14 @@ storeCipher cip = case cip of
|
|||
(EncryptedCipher t _ ks) -> addcipher t . storekeys ks cipherkeysField
|
||||
(SharedPubKeyCipher t ks) -> addcipher t . storekeys ks pubkeysField
|
||||
where
|
||||
addcipher t = M.insert cipherField (toB64bs t)
|
||||
storekeys (KeyIds l) n = M.insert n (intercalate "," l)
|
||||
addcipher t = M.insert cipherField (Accepted (toB64bs t))
|
||||
storekeys (KeyIds l) n = M.insert n (Accepted (intercalate "," l))
|
||||
|
||||
{- Extracts an StorableCipher from a remote's configuration. -}
|
||||
extractCipher :: RemoteConfig -> Maybe StorableCipher
|
||||
extractCipher c = case (M.lookup cipherField c,
|
||||
M.lookup cipherkeysField c <|> M.lookup pubkeysField c,
|
||||
M.lookup encryptionField c) of
|
||||
extractCipher c = case (fromProposedAccepted <$> M.lookup cipherField c,
|
||||
fromProposedAccepted <$> (M.lookup cipherkeysField c <|> M.lookup pubkeysField c),
|
||||
fromProposedAccepted <$> M.lookup encryptionField c) of
|
||||
(Just t, Just ks, encryption) | maybe True (== "hybrid") encryption ->
|
||||
Just $ EncryptedCipher (fromB64bs t) Hybrid (readkeys ks)
|
||||
(Just t, Just ks, Just "pubkey") ->
|
||||
|
@ -168,7 +171,7 @@ extractCipher c = case (M.lookup cipherField c,
|
|||
readkeys = KeyIds . splitc ','
|
||||
|
||||
isEncrypted :: RemoteConfig -> Bool
|
||||
isEncrypted c = case M.lookup encryptionField c of
|
||||
isEncrypted c = case fromProposedAccepted <$> M.lookup encryptionField c of
|
||||
Just "none" -> False
|
||||
Just _ -> True
|
||||
Nothing -> hasEncryptionConfig c
|
||||
|
|
|
@ -13,6 +13,7 @@ import Annex.Common
|
|||
import Types.Remote
|
||||
import Types.Backend
|
||||
import Types.Key
|
||||
import Types.ProposedAccepted
|
||||
import Backend
|
||||
import Remote.Helper.Encryptable (isEncrypted)
|
||||
import qualified Database.Export as Export
|
||||
|
@ -20,6 +21,7 @@ import qualified Database.ContentIdentifier as ContentIdentifier
|
|||
import Annex.Export
|
||||
import Annex.LockFile
|
||||
import Config
|
||||
import Annex.SpecialRemote.Config (exportTreeField, importTreeField)
|
||||
import Git.Types (fromRef)
|
||||
import Logs.Export
|
||||
import Logs.ContentIdentifier (recordContentIdentifier)
|
||||
|
@ -75,23 +77,26 @@ adjustExportImportRemoteType :: RemoteType -> RemoteType
|
|||
adjustExportImportRemoteType rt = rt { setup = setup' }
|
||||
where
|
||||
setup' st mu cp c gc =
|
||||
let checkconfig supported configured setting cont =
|
||||
let checkconfig supported configured configfield cont = do
|
||||
case parseProposedAccepted configfield c yesNo False "yes or no" of
|
||||
Right _ -> noop
|
||||
Left err -> giveup err
|
||||
ifM (supported rt c gc)
|
||||
( case st of
|
||||
Init
|
||||
| configured c && isEncrypted c ->
|
||||
giveup $ "cannot enable both encryption and " ++ setting
|
||||
giveup $ "cannot enable both encryption and " ++ fromProposedAccepted configfield
|
||||
| otherwise -> cont
|
||||
Enable oldc
|
||||
| configured c /= configured oldc ->
|
||||
giveup $ "cannot change " ++ setting ++ " of existing special remote"
|
||||
giveup $ "cannot change " ++ fromProposedAccepted configfield ++ " of existing special remote"
|
||||
| otherwise -> cont
|
||||
, if configured c
|
||||
then giveup $ setting ++ " is not supported by this special remote"
|
||||
then giveup $ fromProposedAccepted configfield ++ " is not supported by this special remote"
|
||||
else cont
|
||||
)
|
||||
in checkconfig exportSupported exportTree "exporttree" $
|
||||
checkconfig importSupported importTree "importtree" $
|
||||
in checkconfig exportSupported exportTree exportTreeField $
|
||||
checkconfig importSupported importTree importTreeField $
|
||||
if importTree c && not (exportTree c)
|
||||
then giveup "cannot enable importtree=yes without also enabling exporttree=yes"
|
||||
else setup rt st mu cp c gc
|
||||
|
@ -100,9 +105,9 @@ adjustExportImportRemoteType rt = rt { setup = setup' }
|
|||
--
|
||||
-- Note that all remotes with importree=yes also have exporttree=yes.
|
||||
adjustExportImport :: Remote -> RemoteStateHandle -> Annex Remote
|
||||
adjustExportImport r rs = case M.lookup "exporttree" (config r) of
|
||||
adjustExportImport r rs = case M.lookup exportTreeField (config r) of
|
||||
Nothing -> return $ notexport r
|
||||
Just c -> case yesNo c of
|
||||
Just c -> case yesNo (fromProposedAccepted c) of
|
||||
Just True -> ifM (isExportSupported r)
|
||||
( do
|
||||
exportdbv <- prepexportdb
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue