diff --git a/Annex/SpecialRemote/Config.hs b/Annex/SpecialRemote/Config.hs index 2dcefbcebf..d56e662418 100644 --- a/Annex/SpecialRemote/Config.hs +++ b/Annex/SpecialRemote/Config.hs @@ -11,6 +11,7 @@ import Common import Types.Remote (RemoteConfigField, RemoteConfig) import qualified Data.Map as M +import qualified Data.Set as S {- The name of a configured remote is stored in its config using this key. -} nameField :: RemoteConfigField @@ -35,3 +36,13 @@ typeField = "type" autoEnableField :: RemoteConfigField autoEnableField = "autoenable" +encryptionField :: RemoteConfigField +encryptionField = "encryption" + +{- A remote with sameas-uuid set will inherit these values from the config + - of that uuid. These values cannot be overridden. -} +sameasInherits :: S.Set RemoteConfigField +sameasInherits = S.fromList + [ encryptionField + -- TODO more encryption related fields + ] diff --git a/Assistant/Gpg.hs b/Assistant/Gpg.hs index 9dee19b42b..6215fba389 100644 --- a/Assistant/Gpg.hs +++ b/Assistant/Gpg.hs @@ -10,6 +10,7 @@ module Assistant.Gpg where import Utility.Gpg import Utility.UserInfo import Types.Remote (RemoteConfigField) +import Annex.SpecialRemote.Config import qualified Data.Map as M import Control.Applicative @@ -31,6 +32,6 @@ data EnableEncryption = HybridEncryption | SharedEncryption | NoEncryption {- Generates Remote configuration for encryption. -} configureEncryption :: EnableEncryption -> (RemoteConfigField, String) -configureEncryption SharedEncryption = ("encryption", "shared") -configureEncryption NoEncryption = ("encryption", "none") -configureEncryption HybridEncryption = ("encryption", "hybrid") +configureEncryption SharedEncryption = (encryptionField, "shared") +configureEncryption NoEncryption = (encryptionField, "none") +configureEncryption HybridEncryption = (encryptionField, "hybrid") diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index d1f30aeef1..a58ed212c4 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -18,6 +18,7 @@ import qualified Git import qualified Git.Command import qualified Annex import qualified Annex.SpecialRemote +import Annex.SpecialRemote.Config import Logs.UUID import Logs.Remote import Git.Remote @@ -55,7 +56,7 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $ go (Just (u, c)) = setupSpecialRemote name Rsync.remote config Nothing (Just u, R.Enable c, c) config = M.fromList - [ ("encryption", "shared") + [ (encryptionField, "shared") , ("rsyncurl", location) , ("type", "rsync") ] diff --git a/Crypto.hs b/Crypto.hs index f21cb57c94..450d1b6af4 100644 --- a/Crypto.hs +++ b/Crypto.hs @@ -45,6 +45,7 @@ import qualified Utility.Gpg as Gpg import Types.Crypto import Types.Remote import Types.Key +import Annex.SpecialRemote.Config {- The beginning of a Cipher is used for MAC'ing; the remainder is used - as the GPG symmetric encryption passphrase when using the hybrid @@ -236,7 +237,7 @@ instance LensGpgEncParams (RemoteConfig, RemoteGitConfig) where getGpgEncParams (c,gc) = getGpgEncParamsBase (c,gc) ++ {- When the remote is configured to use public-key encryption, - look up the recipient keys and add them to the option list. -} - case M.lookup "encryption" c of + case M.lookup encryptionField c of Just "pubkey" -> Gpg.pkEncTo $ maybe [] (splitc ',') $ M.lookup "cipherkeys" c Just "sharedpubkey" -> Gpg.pkEncTo $ maybe [] (splitc ',') $ M.lookup "pubkeys" c _ -> [] diff --git a/Logs/Remote.hs b/Logs/Remote.hs index 28d673b302..c99df1bab9 100644 --- a/Logs/Remote.hs +++ b/Logs/Remote.hs @@ -1,6 +1,6 @@ {- git-annex remote log - - - Copyright 2011 Joey Hess + - Copyright 2011-2019 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -22,6 +22,7 @@ import qualified Annex.Branch import Types.Remote import Logs import Logs.UUIDBased +import Annex.SpecialRemote.Config import qualified Data.Map as M import Data.Char @@ -34,14 +35,37 @@ configSet u cfg = do c <- liftIO currentVectorClock Annex.Branch.change remoteLog $ buildLogOld (byteString . encodeBS . showConfig) - . changeLog c u cfg + . changeLog c u (removeSameasInherited cfg) . parseLogOld remoteConfigParser {- Map of remotes by uuid containing key/value config maps. -} readRemoteLog :: Annex (M.Map UUID RemoteConfig) -readRemoteLog = simpleMap . parseLogOld remoteConfigParser +readRemoteLog = addSameasInherited + . simpleMap + . parseLogOld remoteConfigParser <$> Annex.Branch.get remoteLog +{- Each RemoteConfig that has a sameas-uuid inherits some fields + - from it. Such fields can only be set by inheritance; the RemoteConfig + - cannot provide values from them. -} +addSameasInherited :: M.Map UUID RemoteConfig -> M.Map UUID RemoteConfig +addSameasInherited m = M.map go m + where + go c = case toUUID <$> M.lookup sameasUUIDField c of + Nothing -> c + Just sameasuuid -> case M.lookup sameasuuid m of + Nothing -> c + Just parentc -> + M.withoutKeys c sameasInherits + `M.union` + M.restrictKeys parentc sameasInherits + +{- Remove any fields inherited from a sameas-uuid. -} +removeSameasInherited :: RemoteConfig -> RemoteConfig +removeSameasInherited c = case M.lookup sameasUUIDField c of + Nothing -> c + Just _ -> M.restrictKeys c sameasInherits + remoteConfigParser :: A.Parser RemoteConfig remoteConfigParser = keyValToConfig . words . decodeBS <$> A.takeByteString diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index e2715403af..0cb4eec8fd 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -29,6 +29,7 @@ import Config import Crypto import Types.Crypto import qualified Annex +import Annex.SpecialRemote.Config -- Used to ensure that encryption has been set up before trying to -- eg, store creds in the remote config that would need to use the @@ -55,7 +56,7 @@ encryptionSetup c gc = do maybe (genCipher cmd) (updateCipher cmd) (extractCipher c) where -- The type of encryption - encryption = M.lookup "encryption" c + encryption = M.lookup encryptionField c -- Generate a new cipher, depending on the chosen encryption scheme genCipher cmd = case encryption of _ | hasEncryptionConfig c -> cannotchange @@ -68,7 +69,7 @@ encryptionSetup c gc = do Just "pubkey" -> encsetup $ genEncryptedCipher cmd (c, gc) key PubKey Just "sharedpubkey" -> encsetup $ genSharedPubKeyCipher cmd key _ -> giveup $ "Specify " ++ intercalate " or " - (map ("encryption=" ++) + (map ((encryptionField ++ "=") ++) ["none","shared","hybrid","pubkey", "sharedpubkey"]) ++ "." key = fromMaybe (giveup "Specify keyid=...") $ M.lookup "keyid" c @@ -153,7 +154,7 @@ storeCipher cip = case cip of extractCipher :: RemoteConfig -> Maybe StorableCipher extractCipher c = case (M.lookup "cipher" c, M.lookup "cipherkeys" c <|> M.lookup "pubkeys" c, - M.lookup "encryption" c) of + 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") -> @@ -167,7 +168,7 @@ extractCipher c = case (M.lookup "cipher" c, readkeys = KeyIds . splitc ',' isEncrypted :: RemoteConfig -> Bool -isEncrypted c = case M.lookup "encryption" c of +isEncrypted c = case M.lookup encryptionField c of Just "none" -> False Just _ -> True Nothing -> hasEncryptionConfig c diff --git a/Remote/S3.hs b/Remote/S3.hs index 6f96046ec8..4853db3b2e 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -44,6 +44,7 @@ import qualified Git import qualified Annex import Config import Config.Cost +import Annex.SpecialRemote.Config import Remote.Helper.Special import Remote.Helper.Http import Remote.Helper.Messages @@ -188,7 +189,7 @@ s3Setup' ss u mcreds c gc -- IA acdepts x-amz-* as an alias for x-archive-* M.mapKeys (replace "x-archive-" "x-amz-") $ -- encryption does not make sense here - M.insert "encryption" "none" $ + M.insert encryptionField "none" $ M.insert "bucket" validbucket $ M.union c' $ -- special constraints on key names diff --git a/git-annex.cabal b/git-annex.cabal index e407025f0c..1754b156b8 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -304,7 +304,7 @@ Executable git-annex base (>= 4.11.1.0 && < 5.0), network-uri (>= 2.6), optparse-applicative (>= 0.14.1), - containers (>= 0.5.7.1), + containers (>= 0.5.8), exceptions (>= 0.6), stm (>= 2.3), mtl (>= 2),