9d4a766cd7
Leverage the new chunked remotes to automatically resume downloads. Sort of like rsync, although of course not as efficient since this needs to start at a chunk boundry. But, unlike rsync, this method will work for S3, WebDAV, external special remotes, etc, etc. Only directory special remotes so far, but many more soon! This implementation will also properly handle starting a download from one remote, interrupting, and resuming from another one, and so on. (Resuming interrupted chunked uploads is similarly doable, although slightly more expensive.) This commit was sponsored by Thomas Djärv.
135 lines
3.9 KiB
Haskell
135 lines
3.9 KiB
Haskell
{- Remotes that support both chunking and encryption.
|
|
-
|
|
- Copyright 2014 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE Rank2Types #-}
|
|
|
|
module Remote.Helper.ChunkedEncryptable (
|
|
Preparer,
|
|
simplyPrepare,
|
|
checkPrepare,
|
|
Storer,
|
|
Retriever,
|
|
chunkedEncryptableRemote,
|
|
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 for and then runs an action that will act on a Key,
|
|
-- passing it a helper when the preparation is successful.
|
|
type Preparer helper = forall a. Key -> (Maybe helper -> Annex a) -> Annex a
|
|
|
|
simplyPrepare :: helper -> Preparer helper
|
|
simplyPrepare helper _ a = a $ Just helper
|
|
|
|
checkPrepare :: (Key -> Annex Bool) -> helper -> Preparer helper
|
|
checkPrepare checker helper k a = ifM (checker k)
|
|
( a (Just helper)
|
|
, a Nothing
|
|
)
|
|
|
|
-- Stores a Key, which may be encrypted and/or a chunk key.
|
|
-- May throw exceptions.
|
|
type Storer = Key -> L.ByteString -> MeterUpdate -> IO Bool
|
|
|
|
-- 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
|
|
-> Preparer Storer
|
|
-> Preparer Retriever
|
|
-> 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
|
|
|
|
safely a = catchNonAsyncAnnex a (\e -> warning (show e) >> return False)
|
|
|
|
-- chunk, then encrypt, then feed to the storer
|
|
storeKeyGen k p enc =
|
|
safely $ preparestorer k $ safely . go
|
|
where
|
|
go (Just storer) = sendAnnex k rollback $ \src ->
|
|
metered (Just p) k $ \p' ->
|
|
storeChunks (uuid r) chunkconfig k src p' $
|
|
storechunk storer
|
|
go Nothing = return False
|
|
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 =
|
|
safely $ prepareretriever k $ safely . go
|
|
where
|
|
go (Just retriever) = metered (Just p) k $ \p' ->
|
|
retrieveChunks retriever (uuid r) chunkconfig enck k dest p' sink
|
|
go Nothing = return False
|
|
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
|