diff options
Diffstat (limited to 'Remote/Helper')
| -rw-r--r-- | Remote/Helper/ChunkedEncryptable.hs | 121 | ||||
| -rw-r--r-- | Remote/Helper/Encryptable.hs | 33 |
2 files changed, 140 insertions, 14 deletions
diff --git a/Remote/Helper/ChunkedEncryptable.hs b/Remote/Helper/ChunkedEncryptable.hs new file mode 100644 index 000000000..740da58b9 --- /dev/null +++ b/Remote/Helper/ChunkedEncryptable.hs @@ -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 diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index c450a1084..9da5e641d 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -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. -} |