optimise case of remote that retrieves FileContent, when chunks and encryption are not being used
No need to read whole FileContent only to write it back out to a file in this case. Can just rename! Yay. Also indidentially, fixed an attempt to open a file for write that was already opened for write, which caused a crash and deadlock.
This commit is contained in:
parent
c0dc134cde
commit
53b87a859e
3 changed files with 84 additions and 50 deletions
|
@ -221,7 +221,7 @@ retrieveChunks
|
||||||
-> Key
|
-> Key
|
||||||
-> FilePath
|
-> FilePath
|
||||||
-> MeterUpdate
|
-> MeterUpdate
|
||||||
-> (Handle -> Maybe MeterUpdate -> L.ByteString -> IO ())
|
-> (Maybe Handle -> Maybe MeterUpdate -> ContentSource -> Annex Bool)
|
||||||
-> Annex Bool
|
-> Annex Bool
|
||||||
retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
|
retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
|
||||||
| noChunks chunkconfig =
|
| noChunks chunkconfig =
|
||||||
|
@ -244,7 +244,10 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
|
||||||
|
|
||||||
firstavail _ [] = return False
|
firstavail _ [] = return False
|
||||||
firstavail currsize ([]:ls) = firstavail currsize ls
|
firstavail currsize ([]:ls) = firstavail currsize ls
|
||||||
firstavail currsize ((k:ks):ls) = do
|
firstavail currsize ((k:ks):ls)
|
||||||
|
| k == basek = getunchunked
|
||||||
|
`catchNonAsyncAnnex` (const $ firstavail currsize ls)
|
||||||
|
| otherwise = do
|
||||||
let offset = resumeOffset currsize k
|
let offset = resumeOffset currsize k
|
||||||
let p = maybe basep
|
let p = maybe basep
|
||||||
(offsetMeterUpdate basep . toBytesProcessed)
|
(offsetMeterUpdate basep . toBytesProcessed)
|
||||||
|
@ -252,7 +255,7 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
|
||||||
v <- tryNonAsyncAnnex $
|
v <- tryNonAsyncAnnex $
|
||||||
retriever (encryptor k) p $ \content ->
|
retriever (encryptor k) p $ \content ->
|
||||||
bracketIO (maybe opennew openresume offset) hClose $ \h -> do
|
bracketIO (maybe opennew openresume offset) hClose $ \h -> do
|
||||||
tosink h p content
|
void $ tosink (Just h) p content
|
||||||
let sz = toBytesProcessed $
|
let sz = toBytesProcessed $
|
||||||
fromMaybe 0 $ keyChunkSize k
|
fromMaybe 0 $ keyChunkSize k
|
||||||
getrest p h sz sz ks
|
getrest p h sz sz ks
|
||||||
|
@ -266,12 +269,12 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
|
||||||
getrest _ _ _ _ [] = return True
|
getrest _ _ _ _ [] = return True
|
||||||
getrest p h sz bytesprocessed (k:ks) = do
|
getrest p h sz bytesprocessed (k:ks) = do
|
||||||
let p' = offsetMeterUpdate p bytesprocessed
|
let p' = offsetMeterUpdate p bytesprocessed
|
||||||
retriever (encryptor k) p' $ tosink h p'
|
ifM (retriever (encryptor k) p' $ tosink (Just h) p')
|
||||||
getrest p h sz (addBytesProcessed bytesprocessed sz) ks
|
( getrest p h sz (addBytesProcessed bytesprocessed sz) ks
|
||||||
|
, giveup "chunk retrieval failed"
|
||||||
|
)
|
||||||
|
|
||||||
getunchunked = bracketIO opennew hClose $ \h -> do
|
getunchunked = retriever (encryptor basek) basep $ tosink Nothing basep
|
||||||
retriever (encryptor basek) basep $ tosink h basep
|
|
||||||
return True
|
|
||||||
|
|
||||||
opennew = openBinaryFile dest WriteMode
|
opennew = openBinaryFile dest WriteMode
|
||||||
|
|
||||||
|
@ -290,13 +293,11 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
|
||||||
- it is not responsible for updating progress (often it cannot).
|
- it is not responsible for updating progress (often it cannot).
|
||||||
- Instead, the sink is passed a meter to update as it consumes
|
- Instead, the sink is passed a meter to update as it consumes
|
||||||
- the ByteString. -}
|
- the ByteString. -}
|
||||||
tosink h p (ByteContent b) = liftIO $ do
|
tosink h p content = sink h p' content
|
||||||
sink h (Just p) b
|
where
|
||||||
return True
|
p'
|
||||||
tosink h _ (FileContent f) = liftIO $ do
|
| isByteContent content = Just p
|
||||||
sink h Nothing =<< L.readFile f
|
| otherwise = Nothing
|
||||||
nukeFile f
|
|
||||||
return True
|
|
||||||
|
|
||||||
{- Can resume when the chunk's offset is at or before the end of
|
{- Can resume when the chunk's offset is at or before the end of
|
||||||
- the dest file. -}
|
- the dest file. -}
|
||||||
|
|
|
@ -18,9 +18,9 @@ module Remote.Helper.ChunkedEncryptable (
|
||||||
byteStorer,
|
byteStorer,
|
||||||
fileRetriever,
|
fileRetriever,
|
||||||
byteRetriever,
|
byteRetriever,
|
||||||
chunkedEncryptableRemote,
|
|
||||||
storeKeyDummy,
|
storeKeyDummy,
|
||||||
retreiveKeyFileDummy,
|
retreiveKeyFileDummy,
|
||||||
|
chunkedEncryptableRemote,
|
||||||
module X
|
module X
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
@ -36,6 +36,7 @@ import Annex.Content
|
||||||
import Annex.Exception
|
import Annex.Exception
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy as L
|
import qualified Data.ByteString.Lazy as L
|
||||||
|
import Control.Exception (bracket)
|
||||||
|
|
||||||
-- Use when nothing needs to be done to prepare a helper.
|
-- Use when nothing needs to be done to prepare a helper.
|
||||||
simplyPrepare :: helper -> Preparer helper
|
simplyPrepare :: helper -> Preparer helper
|
||||||
|
@ -78,6 +79,16 @@ withBytes :: ContentSource -> (L.ByteString -> Annex a) -> Annex a
|
||||||
withBytes (ByteContent b) a = a b
|
withBytes (ByteContent b) a = a b
|
||||||
withBytes (FileContent f) a = a =<< liftIO (L.readFile f)
|
withBytes (FileContent f) a = a =<< liftIO (L.readFile f)
|
||||||
|
|
||||||
|
{- 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
|
||||||
|
|
||||||
-- Modifies a base Remote to support both chunking and encryption.
|
-- Modifies a base Remote to support both chunking and encryption.
|
||||||
chunkedEncryptableRemote
|
chunkedEncryptableRemote
|
||||||
:: RemoteConfig
|
:: RemoteConfig
|
||||||
|
@ -131,17 +142,8 @@ chunkedEncryptableRemote c preparestorer prepareretriever baser = encr
|
||||||
where
|
where
|
||||||
go (Just retriever) = metered (Just p) k $ \p' ->
|
go (Just retriever) = metered (Just p) k $ \p' ->
|
||||||
retrieveChunks retriever (uuid baser) chunkconfig
|
retrieveChunks retriever (uuid baser) chunkconfig
|
||||||
enck k dest p' sink
|
enck k dest p' (sink dest enc)
|
||||||
go Nothing = return False
|
go Nothing = return False
|
||||||
sink h mp b = do
|
|
||||||
let write = case mp of
|
|
||||||
Just p' -> meteredWrite p' h
|
|
||||||
Nothing -> L.hPut h
|
|
||||||
case enc of
|
|
||||||
Nothing -> write b
|
|
||||||
Just (cipher, _) ->
|
|
||||||
decrypt cipher (feedBytes b) $
|
|
||||||
readBytes write
|
|
||||||
enck = maybe id snd enc
|
enck = maybe id snd enc
|
||||||
|
|
||||||
removeKeyGen k enc = removeChunks remover (uuid baser) chunkconfig enck k
|
removeKeyGen k enc = removeChunks remover (uuid baser) chunkconfig enck k
|
||||||
|
@ -154,12 +156,39 @@ chunkedEncryptableRemote c preparestorer prepareretriever baser = encr
|
||||||
enck = maybe id snd enc
|
enck = maybe id snd enc
|
||||||
checker = hasKey baser
|
checker = hasKey baser
|
||||||
|
|
||||||
{- The base Remote that is provided to chunkedEncryptableRemote
|
{- Sink callback for retrieveChunks. Stores the file content into the
|
||||||
- needs to have storeKey and retreiveKeyFile methods, but they are
|
- provided Handle, decrypting it first if necessary.
|
||||||
- never actually used (since chunkedEncryptableRemote replaces
|
-
|
||||||
- them). Here are some dummy ones.
|
- If the remote did not store the content using chunks, no Handle
|
||||||
|
- will be provided, and it's up to us to open the destination file.
|
||||||
|
-
|
||||||
|
- Note that when neither chunking nor encryption is used, and the remote
|
||||||
|
- provides FileContent, that file only needs to be renamed
|
||||||
|
- into place. (And it may even already be in the right place..)
|
||||||
-}
|
-}
|
||||||
storeKeyDummy :: Key -> AssociatedFile -> MeterUpdate -> Annex Bool
|
sink
|
||||||
storeKeyDummy _ _ _ = return False
|
:: FilePath
|
||||||
retreiveKeyFileDummy :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
|
-> Maybe (Cipher, EncKey)
|
||||||
retreiveKeyFileDummy _ _ _ _ = return False
|
-> Maybe Handle
|
||||||
|
-> Maybe MeterUpdate
|
||||||
|
-> ContentSource
|
||||||
|
-> Annex Bool
|
||||||
|
sink dest enc mh mp content = do
|
||||||
|
case (enc, mh, content) of
|
||||||
|
(Nothing, Nothing, FileContent f)
|
||||||
|
| f == dest -> noop
|
||||||
|
| otherwise -> liftIO $ moveFile f dest
|
||||||
|
(Just (cipher, _), _, _) ->
|
||||||
|
withBytes content $ \b ->
|
||||||
|
decrypt cipher (feedBytes b) $
|
||||||
|
readBytes write
|
||||||
|
(Nothing, _, _) -> withBytes content write
|
||||||
|
return True
|
||||||
|
where
|
||||||
|
write b = case mh of
|
||||||
|
Just h -> liftIO $ b `streamto` h
|
||||||
|
Nothing -> liftIO $ bracket opendest hClose (b `streamto`)
|
||||||
|
streamto b h = case mp of
|
||||||
|
Just p -> meteredWrite p h b
|
||||||
|
Nothing -> L.hPut h b
|
||||||
|
opendest = openBinaryFile dest WriteMode
|
||||||
|
|
|
@ -23,6 +23,10 @@ data ContentSource
|
||||||
= FileContent FilePath
|
= FileContent FilePath
|
||||||
| ByteContent L.ByteString
|
| ByteContent L.ByteString
|
||||||
|
|
||||||
|
isByteContent :: ContentSource -> Bool
|
||||||
|
isByteContent (ByteContent _) = True
|
||||||
|
isByteContent (FileContent _) = False
|
||||||
|
|
||||||
-- Action that stores a Key's content on a remote.
|
-- Action that stores a Key's content on a remote.
|
||||||
-- Can throw exceptions.
|
-- Can throw exceptions.
|
||||||
type Storer = Key -> ContentSource -> MeterUpdate -> Annex Bool
|
type Storer = Key -> ContentSource -> MeterUpdate -> Annex Bool
|
||||||
|
|
Loading…
Add table
Reference in a new issue