diff options
Diffstat (limited to 'Remote/Helper/ChunkedEncryptable.hs')
-rw-r--r-- | Remote/Helper/ChunkedEncryptable.hs | 121 |
1 files changed, 121 insertions, 0 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 |