git-annex/Remote/Helper/Encryptable.hs

323 lines
12 KiB
Haskell
Raw Normal View History

2011-04-17 04:40:23 +00:00
{- common functions for encryptable remotes
-
- Copyright 2011-2021 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, PackageImports #-}
glacier, S3: Fix bug that caused embedded creds to not be encypted using the remote's key. encryptionSetup must be called before setRemoteCredPair. Otherwise, the RemoteConfig doesn't have the cipher in it, and so no cipher is used to encrypt the embedded creds. This is a security fix for non-shared encryption methods! For encryption=shared, there's no security problem, just an inconsistentency in whether the embedded creds are encrypted. This is very important to get right, so used some types to help ensure that setRemoteCredPair is only run after encryptionSetup. Note that the external special remote bypasses the type safety, since creds can be set after the initial remote config, if the external special remote program requests it. Also note that IA remotes never use encryption, so encryptionSetup is not run for them at all, and again the type safety is bypassed. This leaves two open questions: 1. What to do about S3 and glacier remotes that were set up using encryption=pubkey/hybrid with embedcreds? Such a git repo has a security hole embedded in it, and this needs to be communicated to the user. Is the changelog enough? 2. enableremote won't work in such a repo, because git-annex will try to decrypt the embedded creds, which are not encrypted, so fails. This needs to be dealt with, especially for ecryption=shared repos, which are not really broken, just inconsistently configured. Noticing that problem for encryption=shared is what led to commit fbdeeeed5fa276d94be587c8916d725eddcaf546, which tried to fix the problem by not decrypting the embedded creds. This commit was sponsored by Josh Taylor.
2014-09-18 21:07:17 +00:00
module Remote.Helper.Encryptable (
EncryptionIsSetup,
encryptionSetup,
noEncryptionUsed,
encryptionAlreadySetup,
encryptionConfigParsers,
parseEncryptionConfig,
glacier, S3: Fix bug that caused embedded creds to not be encypted using the remote's key. encryptionSetup must be called before setRemoteCredPair. Otherwise, the RemoteConfig doesn't have the cipher in it, and so no cipher is used to encrypt the embedded creds. This is a security fix for non-shared encryption methods! For encryption=shared, there's no security problem, just an inconsistentency in whether the embedded creds are encrypted. This is very important to get right, so used some types to help ensure that setRemoteCredPair is only run after encryptionSetup. Note that the external special remote bypasses the type safety, since creds can be set after the initial remote config, if the external special remote program requests it. Also note that IA remotes never use encryption, so encryptionSetup is not run for them at all, and again the type safety is bypassed. This leaves two open questions: 1. What to do about S3 and glacier remotes that were set up using encryption=pubkey/hybrid with embedcreds? Such a git repo has a security hole embedded in it, and this needs to be communicated to the user. Is the changelog enough? 2. enableremote won't work in such a repo, because git-annex will try to decrypt the embedded creds, which are not encrypted, so fails. This needs to be dealt with, especially for ecryption=shared repos, which are not really broken, just inconsistently configured. Noticing that problem for encryption=shared is what led to commit fbdeeeed5fa276d94be587c8916d725eddcaf546, which tried to fix the problem by not decrypting the embedded creds. This commit was sponsored by Josh Taylor.
2014-09-18 21:07:17 +00:00
remoteCipher,
remoteCipher',
glacier, S3: Fix bug that caused embedded creds to not be encypted using the remote's key. encryptionSetup must be called before setRemoteCredPair. Otherwise, the RemoteConfig doesn't have the cipher in it, and so no cipher is used to encrypt the embedded creds. This is a security fix for non-shared encryption methods! For encryption=shared, there's no security problem, just an inconsistentency in whether the embedded creds are encrypted. This is very important to get right, so used some types to help ensure that setRemoteCredPair is only run after encryptionSetup. Note that the external special remote bypasses the type safety, since creds can be set after the initial remote config, if the external special remote program requests it. Also note that IA remotes never use encryption, so encryptionSetup is not run for them at all, and again the type safety is bypassed. This leaves two open questions: 1. What to do about S3 and glacier remotes that were set up using encryption=pubkey/hybrid with embedcreds? Such a git repo has a security hole embedded in it, and this needs to be communicated to the user. Is the changelog enough? 2. enableremote won't work in such a repo, because git-annex will try to decrypt the embedded creds, which are not encrypted, so fails. This needs to be dealt with, especially for ecryption=shared repos, which are not really broken, just inconsistently configured. Noticing that problem for encryption=shared is what led to commit fbdeeeed5fa276d94be587c8916d725eddcaf546, which tried to fix the problem by not decrypting the embedded creds. This commit was sponsored by Josh Taylor.
2014-09-18 21:07:17 +00:00
embedCreds,
cipherKey,
extractCipher,
isEncrypted,
encryptionIsEnabled,
describeEncryption,
2020-01-15 15:30:45 +00:00
encryptionField,
highRandomQualityField
glacier, S3: Fix bug that caused embedded creds to not be encypted using the remote's key. encryptionSetup must be called before setRemoteCredPair. Otherwise, the RemoteConfig doesn't have the cipher in it, and so no cipher is used to encrypt the embedded creds. This is a security fix for non-shared encryption methods! For encryption=shared, there's no security problem, just an inconsistentency in whether the embedded creds are encrypted. This is very important to get right, so used some types to help ensure that setRemoteCredPair is only run after encryptionSetup. Note that the external special remote bypasses the type safety, since creds can be set after the initial remote config, if the external special remote program requests it. Also note that IA remotes never use encryption, so encryptionSetup is not run for them at all, and again the type safety is bypassed. This leaves two open questions: 1. What to do about S3 and glacier remotes that were set up using encryption=pubkey/hybrid with embedcreds? Such a git repo has a security hole embedded in it, and this needs to be communicated to the user. Is the changelog enough? 2. enableremote won't work in such a repo, because git-annex will try to decrypt the embedded creds, which are not encrypted, so fails. This needs to be dealt with, especially for ecryption=shared repos, which are not really broken, just inconsistently configured. Noticing that problem for encryption=shared is what led to commit fbdeeeed5fa276d94be587c8916d725eddcaf546, which tried to fix the problem by not decrypting the embedded creds. This commit was sponsored by Josh Taylor.
2014-09-18 21:07:17 +00:00
) where
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Concurrent.STM
import Annex.Common
import Types.Remote
import Crypto
import Types.Crypto
import Types.ProposedAccepted
import qualified Annex
import Annex.SpecialRemote.Config
import Utility.Base64
glacier, S3: Fix bug that caused embedded creds to not be encypted using the remote's key. encryptionSetup must be called before setRemoteCredPair. Otherwise, the RemoteConfig doesn't have the cipher in it, and so no cipher is used to encrypt the embedded creds. This is a security fix for non-shared encryption methods! For encryption=shared, there's no security problem, just an inconsistentency in whether the embedded creds are encrypted. This is very important to get right, so used some types to help ensure that setRemoteCredPair is only run after encryptionSetup. Note that the external special remote bypasses the type safety, since creds can be set after the initial remote config, if the external special remote program requests it. Also note that IA remotes never use encryption, so encryptionSetup is not run for them at all, and again the type safety is bypassed. This leaves two open questions: 1. What to do about S3 and glacier remotes that were set up using encryption=pubkey/hybrid with embedcreds? Such a git repo has a security hole embedded in it, and this needs to be communicated to the user. Is the changelog enough? 2. enableremote won't work in such a repo, because git-annex will try to decrypt the embedded creds, which are not encrypted, so fails. This needs to be dealt with, especially for ecryption=shared repos, which are not really broken, just inconsistently configured. Noticing that problem for encryption=shared is what led to commit fbdeeeed5fa276d94be587c8916d725eddcaf546, which tried to fix the problem by not decrypting the embedded creds. This commit was sponsored by Josh Taylor.
2014-09-18 21:07:17 +00:00
-- 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
-- encryption setup.
data EncryptionIsSetup = EncryptionIsSetup | NoEncryption
-- Remotes that don't use encryption can use this instead of
-- encryptionSetup.
noEncryptionUsed :: EncryptionIsSetup
noEncryptionUsed = NoEncryption
-- Using this avoids the type-safe check, so you'd better be sure
-- of what you're doing.
encryptionAlreadySetup :: EncryptionIsSetup
encryptionAlreadySetup = EncryptionIsSetup
encryptionConfigParsers :: [RemoteConfigFieldParser]
encryptionConfigParsers =
[ encryptionFieldParser
, optionalStringParser cipherField HiddenField
, optionalStringParser cipherkeysField HiddenField
, optionalStringParser pubkeysField HiddenField
, yesNoParser embedCredsField Nothing
(FieldDesc "embed credentials into git repository")
, macFieldParser
, optionalStringParser (Accepted "keyid")
(FieldDesc "gpg key id")
, optionalStringParser (Accepted "keyid+")
(FieldDesc "add additional gpg key")
, optionalStringParser (Accepted "keyid-")
(FieldDesc "remove gpg key")
, highRandomQualityFieldParser
]
encryptionConfigs :: S.Set RemoteConfigField
encryptionConfigs = S.fromList (map parserForField encryptionConfigParsers)
-- Parse only encryption fields, ignoring all others.
parseEncryptionConfig :: RemoteConfig -> Either String ParsedRemoteConfig
parseEncryptionConfig c = parseRemoteConfig
(M.restrictKeys c encryptionConfigs)
(RemoteConfigParser encryptionConfigParsers Nothing)
encryptionFieldParser :: RemoteConfigFieldParser
encryptionFieldParser = RemoteConfigFieldParser
{ parserForField = encryptionField
, valueParser = \v c -> Just . RemoteConfigValue
<$> parseEncryptionMethod (fmap fromProposedAccepted v) c
, fieldDesc = FieldDesc "how to encrypt data stored in the special remote"
, valueDesc = Just $ ValueDesc $
intercalate " or " (M.keys encryptionMethods)
}
encryptionMethods :: M.Map String EncryptionMethod
encryptionMethods = M.fromList
[ ("none", NoneEncryption)
, ("shared", SharedEncryption)
, ("hybrid", HybridEncryption)
, ("pubkey", PubKeyEncryption)
, ("sharedpubkey", SharedPubKeyEncryption)
]
parseEncryptionMethod :: Maybe String -> RemoteConfig -> Either String EncryptionMethod
parseEncryptionMethod (Just s) _ = case M.lookup s encryptionMethods of
Just em -> Right em
Nothing -> Left badEncryptionMethod
-- Hybrid encryption is the default when a keyid is specified without
-- an encryption field, or when there's a cipher already but no encryption
-- field.
parseEncryptionMethod Nothing c
| M.member (Accepted "keyid") c || M.member cipherField c = Right HybridEncryption
| otherwise = Left badEncryptionMethod
badEncryptionMethod :: String
badEncryptionMethod = "Specify " ++ intercalate " or "
(map ((fromProposedAccepted encryptionField ++ "=") ++)
(M.keys encryptionMethods))
++ "."
highRandomQualityField :: RemoteConfigField
highRandomQualityField = Accepted "highRandomQuality"
highRandomQualityFieldParser :: RemoteConfigFieldParser
highRandomQualityFieldParser = RemoteConfigFieldParser
{ parserForField = highRandomQualityField
, valueParser = \v _c -> Just . RemoteConfigValue
<$> parseHighRandomQuality (fmap fromProposedAccepted v)
, fieldDesc = HiddenField
, valueDesc = Nothing
}
parseHighRandomQuality :: Maybe String -> Either String Bool
parseHighRandomQuality Nothing = Right True
parseHighRandomQuality (Just "false") = Right False
parseHighRandomQuality (Just "true") = Right True
parseHighRandomQuality _ = Left "expected highRandomQuality=true/false"
macFieldParser :: RemoteConfigFieldParser
macFieldParser = RemoteConfigFieldParser
{ parserForField = macField
, valueParser = \v _c -> Just . RemoteConfigValue <$> parseMac v
, fieldDesc = FieldDesc "how to encrypt filenames used on the remote"
, valueDesc = Just $ ValueDesc $
intercalate " or " (M.keys macMap)
}
parseMac :: Maybe (ProposedAccepted String) -> Either String Mac
parseMac Nothing = Right defaultMac
parseMac (Just (Accepted s)) = Right $ fromMaybe defaultMac (readMac s)
parseMac (Just (Proposed s)) = case readMac s of
Just mac -> Right mac
Nothing -> Left "bad mac value"
{- Encryption setup for a remote. The user must specify whether to use
- an encryption key, or not encrypt. An encrypted cipher is created, or is
- updated to be accessible to an additional encryption key. Or the user
- could opt to use a shared cipher, which is stored unencrypted. -}
encryptionSetup :: RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, EncryptionIsSetup)
encryptionSetup c gc = do
pc <- either giveup return $ parseEncryptionConfig c
gpgcmd <- gpgCmd <$> Annex.getGitConfig
maybe (genCipher pc gpgcmd) (updateCipher pc gpgcmd) (extractCipher pc)
2012-11-11 04:51:07 +00:00
where
-- The type of encryption
encryption = parseEncryptionMethod (fromProposedAccepted <$> M.lookup encryptionField c) c
-- Generate a new cipher, depending on the chosen encryption scheme
genCipher pc gpgcmd = case encryption of
Right NoneEncryption -> return (c, NoEncryption)
Right SharedEncryption -> encsetup $ genSharedCipher gpgcmd
Right HybridEncryption -> encsetup $ genEncryptedCipher gpgcmd (pc, gc) key Hybrid
Right PubKeyEncryption -> encsetup $ genEncryptedCipher gpgcmd (pc, gc) key PubKey
Right SharedPubKeyEncryption -> encsetup $ genSharedPubKeyCipher gpgcmd key
Left err -> giveup err
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 pc gpgcmd v = case v of
SharedCipher _ | encryption == Right SharedEncryption ->
return (c', EncryptionIsSetup)
EncryptedCipher _ variant _ | sameasencryption variant ->
use "encryption update" $ updateCipherKeyIds gpgcmd (pc, gc) newkeys v
SharedPubKeyCipher _ _ ->
use "encryption update" $ updateCipherKeyIds gpgcmd (pc, gc) newkeys v
_ -> cannotchange
sameasencryption variant = case encryption of
Right HybridEncryption -> variant == Hybrid
Right PubKeyEncryption -> variant == PubKey
Right _ -> False
Left _ -> True
encsetup a = use "encryption setup" . a =<< highRandomQuality
2012-11-11 04:51:07 +00:00
use m a = do
showNote (UnquotedString m)
2012-11-11 04:51:07 +00:00
cipher <- liftIO a
showNote (UnquotedString (describeCipher cipher))
return (storeCipher cipher c', EncryptionIsSetup)
highRandomQuality = ifM (Annex.getRead Annex.fast)
( return False
2020-01-15 15:30:45 +00:00
, case parseHighRandomQuality (fromProposedAccepted <$> M.lookup highRandomQualityField c) of
Left err -> giveup err
Right v -> return v
)
c' = foldr M.delete c
-- Remove configs that are only used in here to generate
-- the encryption keys, and should not be stored in
-- remote.log.
-- Older versions 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).
(map Accepted ["keyid", "keyid+", "keyid-", "highRandomQuality"])
remoteCipher :: ParsedRemoteConfig -> RemoteGitConfig -> Annex (Maybe Cipher)
remoteCipher c gc = fmap fst <$> remoteCipher' c gc
{- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex
- state. -}
remoteCipher' :: ParsedRemoteConfig -> RemoteGitConfig -> Annex (Maybe (Cipher, StorableCipher))
remoteCipher' c gc = case extractCipher c of
Nothing -> return Nothing
Just encipher -> do
cachev <- Annex.getRead Annex.ciphers
cachedciper <- liftIO $ atomically $
M.lookup encipher <$> readTMVar cachev
case cachedciper of
Just cipher -> return $ Just (cipher, encipher)
-- Not cached; decrypt it, making sure
-- to only decrypt one at a time. Avoids
-- prompting for decrypting the same thing twice
-- when this is run concurrently.
Nothing -> bracketOnError
(liftIO $ atomically $ takeTMVar cachev)
(liftIO . atomically . putTMVar cachev)
(go cachev encipher)
where
go cachev encipher cache = do
gpgcmd <- gpgCmd <$> Annex.getGitConfig
cipher <- liftIO $ decryptCipher gpgcmd (c, gc) encipher
liftIO $ atomically $ putTMVar cachev $
M.insert encipher cipher cache
return $ Just (cipher, encipher)
{- Checks if the remote's config allows storing creds in the remote's config.
-
- embedcreds=yes allows this, and embedcreds=no prevents it.
-
- If not set, the default is to only store creds when it's surely safe:
- When gpg encryption is used and the creds are encrypted using it.
- Not when a shared cipher is used.
-}
embedCreds :: ParsedRemoteConfig -> Bool
embedCreds c = case getRemoteConfigValue embedCredsField c of
Just v -> v
Nothing -> case (getRemoteConfigValue cipherkeysField c, getRemoteConfigValue cipherField c) of
2020-06-16 22:14:36 +00:00
(Just (_ :: String), Just (_ :: String)) -> True
_ -> False
{- Gets encryption Cipher, and key encryptor. -}
cipherKey :: ParsedRemoteConfig -> RemoteGitConfig -> Annex (Maybe (Cipher, EncKey))
cipherKey c gc = fmap make <$> remoteCipher c gc
2012-11-11 04:51:07 +00:00
where
make ciphertext = (ciphertext, encryptKey mac ciphertext)
mac = fromMaybe defaultMac $ getRemoteConfigValue macField c
2012-04-29 18:31:34 +00:00
{- Stores an StorableCipher in a remote's configuration. -}
storeCipher :: StorableCipher -> RemoteConfig -> RemoteConfig
storeCipher cip = case cip of
(SharedCipher t) -> addcipher t
(EncryptedCipher t _ ks) -> addcipher t . storekeys ks cipherkeysField
(SharedPubKeyCipher t ks) -> addcipher t . storekeys ks pubkeysField
2012-11-11 04:51:07 +00:00
where
addcipher t = M.insert cipherField (Accepted (decodeBS (toB64 t)))
storekeys (KeyIds l) n = M.insert n (Accepted (intercalate "," l))
2012-04-29 18:31:34 +00:00
{- Extracts an StorableCipher from a remote's configuration. -}
extractCipher :: ParsedRemoteConfig -> Maybe StorableCipher
extractCipher c = case (getRemoteConfigValue cipherField c,
(getRemoteConfigValue cipherkeysField c <|> getRemoteConfigValue pubkeysField c),
getRemoteConfigValue encryptionField c) of
(Just t, Just ks, Just HybridEncryption) ->
Just $ EncryptedCipher (fromB64 (encodeBS t)) Hybrid (readkeys ks)
(Just t, Just ks, Just PubKeyEncryption) ->
Just $ EncryptedCipher (fromB64 (encodeBS t)) PubKey (readkeys ks)
(Just t, Just ks, Just SharedPubKeyEncryption) ->
Just $ SharedPubKeyCipher (fromB64 (encodeBS t)) (readkeys ks)
(Just t, Nothing, Just SharedEncryption) ->
Just $ SharedCipher (fromB64 (encodeBS t))
_ -> Nothing
2012-11-11 04:51:07 +00:00
where
readkeys = KeyIds . splitc ','
isEncrypted :: ParsedRemoteConfig -> Bool
isEncrypted = isJust . extractCipher
-- Check if encryption is enabled. This can be done before encryption
-- is fully set up yet, so the cipher might not be present yet.
encryptionIsEnabled :: ParsedRemoteConfig -> Bool
encryptionIsEnabled c = case getRemoteConfigValue encryptionField c of
Nothing -> False
Just NoneEncryption -> False
Just _ -> True
describeEncryption :: ParsedRemoteConfig -> String
describeEncryption c = case extractCipher c of
Nothing -> "none"
Just cip -> nameCipher cip ++ " (" ++ describeCipher cip ++ ")"
nameCipher :: StorableCipher -> String
nameCipher (SharedCipher _) = "shared"
nameCipher (EncryptedCipher _ PubKey _) = "pubkey"
nameCipher (EncryptedCipher _ Hybrid _) = "hybrid"
nameCipher (SharedPubKeyCipher _ _) = "sharedpubkey"
describeCipher :: StorableCipher -> String
describeCipher c = case c of
(SharedCipher _) -> "encryption key stored in git repository"
(EncryptedCipher _ _ ks) -> showkeys ks
(SharedPubKeyCipher _ ks) -> showkeys ks
where
showkeys (KeyIds { keyIds = ks }) = "to gpg keys: " ++ unwords ks