Support for remotes that are chunkable and encryptable.

I'd have liked to keep these two concepts entirely separate,
but that are entagled: Storing a key in an encrypted and chunked remote
need to generate chunk keys, encrypt the keys, chunk the data, encrypt the
chunks, and send them to the remote. Similar for retrieval, etc.

So, here's an implemnetation of all of that.

The total win here is that every remote was implementing encrypted storage
and retrival, and now it can move into this single place. I expect this
to result in several hundred lines of code being removed from git-annex
eventually!

This commit was sponsored by Henrik Ahlgren.
This commit is contained in:
Joey Hess 2014-07-26 20:14:09 -04:00
parent d4d68f57e5
commit 1400cbb032
4 changed files with 254 additions and 15 deletions

View file

@ -0,0 +1,121 @@
{- Remotes that support both chunking and encryption.
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Remote.Helper.ChunkedEncryptable (
chunkedEncryptableRemote,
PrepareStorer,
Storer,
PrepareRetriever,
Retriever,
storeKeyDummy,
retreiveKeyFileDummy,
module X
) where
import qualified Data.ByteString.Lazy as L
import Common.Annex
import Types.Remote
import Crypto
import Config.Cost
import Utility.Metered
import Remote.Helper.Chunked as X
import Remote.Helper.Encryptable as X
import Annex.Content
import Annex.Exception
-- Prepares to store a Key, and returns a Storer action if possible.
type PrepareStorer = Key -> Annex (Maybe Storer)
-- Stores a Key, which may be encrypted and/or a chunk key.
type Storer = Key -> L.ByteString -> MeterUpdate -> IO Bool
-- Prepares to retrieve a Key, and returns a Retriever action if possible.
type PrepareRetriever = Key -> Annex (Maybe Retriever)
-- Retrieves a Key, which may be encrypted and/or a chunk key.
-- Throws exception if key is not present, or remote is not accessible.
type Retriever = Key -> IO L.ByteString
{- Modifies a base Remote to support both chunking and encryption.
-}
chunkedEncryptableRemote
:: RemoteConfig
-> PrepareStorer
-> PrepareRetriever
-> Remote
-> Remote
chunkedEncryptableRemote c preparestorer prepareretriever r = encr
where
encr = r
{ storeKey = \k _f p -> cip >>= storeKeyGen k p
, retrieveKeyFile = \k _f d p -> cip >>= retrieveKeyFileGen k d p
, retrieveKeyFileCheap = \k d -> cip >>= maybe
(retrieveKeyFileCheap r k d)
(\_ -> return False)
, removeKey = \k -> cip >>= removeKeyGen k
, hasKey = \k -> cip >>= hasKeyGen k
, cost = maybe
(cost r)
(const $ cost r + encryptedRemoteCostAdj)
(extractCipher c)
}
cip = cipherKey c
chunkconfig = chunkConfig c
gpgopts = getGpgEncParams encr
-- chunk, then encrypt, then feed to the storer
storeKeyGen k p enc = maybe (return False) go =<< preparestorer k
where
go storer = sendAnnex k rollback $ \src ->
metered (Just p) k $ \p' ->
storeChunks (uuid r) chunkconfig k src p' $
storechunk storer
rollback = void $ removeKey encr k
storechunk storer k' b p' = case enc of
Nothing -> storer k' b p'
Just (cipher, enck) ->
encrypt gpgopts cipher (feedBytes b) $
readBytes $ \encb ->
storer (enck k') encb p'
-- call retriever to get chunks; decrypt them; stream to dest file
retrieveKeyFileGen k dest p enc =
maybe (return False) go =<< prepareretriever k
where
go retriever = metered (Just p) k $ \p' ->
bracketIO (openBinaryFile dest WriteMode) hClose $ \h ->
retrieveChunks retriever (uuid r) chunkconfig enck k p' $
sink h
sink h p' b = do
let write = meteredWrite p' h
case enc of
Nothing -> write b
Just (cipher, _) ->
decrypt cipher (feedBytes b) $
readBytes write
enck = maybe id snd enc
removeKeyGen k enc = removeChunks remover (uuid r) chunkconfig enck k
where
enck = maybe id snd enc
remover = removeKey r
hasKeyGen k enc = hasKeyChunks checker (uuid r) chunkconfig enck k
where
enck = maybe id snd enc
checker = hasKey r
{- The base Remote that is provided to chunkedEncryptableRemote
- needs to have storeKey and retreiveKeyFile methods, but they are
- never actually used (since chunkedEncryptableRemote replaces
- them). Here are some dummy ones.
-}
storeKeyDummy :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool
storeKeyDummy _ _ _ = return False
retreiveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
retreiveKeyFileDummy _ _ _ _ = return False

View file

@ -70,10 +70,8 @@ encryptionSetup c = maybe genCipher updateCipher $ extractCipher c
-- remotes (while being backward-compatible).
[ "keyid", "keyid+", "keyid-", "highRandomQuality" ]
{- Modifies a Remote to support encryption.
-
- Two additional functions must be provided by the remote,
- to support storing and retrieving encrypted content. -}
{- Modifies a Remote to support encryption. -}
-- TODO: deprecated
encryptableRemote
:: RemoteConfig
-> ((Cipher, Key) -> Key -> MeterUpdate -> Annex Bool)
@ -83,23 +81,30 @@ encryptableRemote
encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r = r
{ storeKey = \k f p -> cip k >>= maybe
(storeKey r k f p)
(\enck -> storeKeyEncrypted enck k p)
(\v -> storeKeyEncrypted v k p)
, retrieveKeyFile = \k f d p -> cip k >>= maybe
(retrieveKeyFile r k f d p)
(\enck -> retrieveKeyFileEncrypted enck k d p)
(\v -> retrieveKeyFileEncrypted v k d p)
, retrieveKeyFileCheap = \k d -> cip k >>= maybe
(retrieveKeyFileCheap r k d)
(\_ -> return False)
, removeKey = withkey $ removeKey r
, hasKey = withkey $ hasKey r
, removeKey = \k -> cip k >>= maybe
(removeKey r k)
(\(_, enckey) -> removeKey r enckey)
, hasKey = \k -> cip k >>= maybe
(hasKey r k)
(\(_, enckey) -> hasKey r enckey)
, cost = maybe
(cost r)
(const $ cost r + encryptedRemoteCostAdj)
(extractCipher c)
}
where
withkey a k = cip k >>= maybe (a k) (a . snd)
cip = cipherKey c
cip k = do
v <- cipherKey c
return $ case v of
Nothing -> Nothing
Just (cipher, enck) -> Just (cipher, enck k)
{- Gets encryption Cipher. The decrypted Ciphers are cached in the Annex
- state. -}
@ -132,11 +137,11 @@ embedCreds c
| isJust (M.lookup "cipherkeys" c) && isJust (M.lookup "cipher" c) = True
| otherwise = False
{- Gets encryption Cipher, and encrypted version of Key. -}
cipherKey :: RemoteConfig -> Key -> Annex (Maybe (Cipher, Key))
cipherKey c k = fmap make <$> remoteCipher c
{- Gets encryption Cipher, and key encryptor. -}
cipherKey :: RemoteConfig -> Annex (Maybe (Cipher, EncKey))
cipherKey c = fmap make <$> remoteCipher c
where
make ciphertext = (ciphertext, encryptKey mac ciphertext k)
make ciphertext = (ciphertext, encryptKey mac ciphertext)
mac = fromMaybe defaultMac $ M.lookup "mac" c >>= readMac
{- Stores an StorableCipher in a remote's configuration. -}