diff options
Diffstat (limited to 'Remote')
| -rw-r--r-- | Remote/Helper/Chunked.hs | 73 | ||||
| -rw-r--r-- | Remote/Helper/ChunkedEncryptable.hs | 26 |
2 files changed, 78 insertions, 21 deletions
diff --git a/Remote/Helper/Chunked.hs b/Remote/Helper/Chunked.hs index 11cd42c90..3f591ae39 100644 --- a/Remote/Helper/Chunked.hs +++ b/Remote/Helper/Chunked.hs @@ -73,6 +73,9 @@ numChunks = pred . fromJust . keyChunkNum . fst . nextChunkKeyStream - the storer action, along with a corresponding chunk key and a - progress meter update callback. - + - To support resuming, the checker is used to find the first missing + - chunk key. Storing starts from that chunk. + - - This buffers each chunk in memory, so can use a lot of memory - with a large ChunkSize. - More optimal versions of this can be written, that rely @@ -88,18 +91,31 @@ storeChunks -> FilePath -> MeterUpdate -> (Key -> L.ByteString -> MeterUpdate -> IO Bool) + -> (Key -> Annex (Either String Bool)) -> Annex Bool -storeChunks u chunkconfig k f p storer = metered (Just p) k $ \meterupdate -> - either (\e -> warning (show e) >> return False) (go meterupdate) - =<< (liftIO $ tryIO $ L.readFile f) +storeChunks u chunkconfig k f p storer checker = bracketIO open close go where - go meterupdate b = case chunkconfig of - (UnpaddedChunks chunksize) -> - gochunks meterupdate chunksize b (chunkKeyStream k chunksize) - _ -> liftIO $ storer k b meterupdate + open = tryIO $ openBinaryFile f ReadMode + + close (Right h) = hClose h + close (Left _) = noop - gochunks :: MeterUpdate -> ChunkSize -> L.ByteString -> ChunkKeyStream -> Annex Bool - gochunks meterupdate chunksize = loop zeroBytesProcessed . splitchunk + go (Left e) = do + warning (show e) + return False + go (Right h) = metered (Just p) k $ \meterupdate -> + case chunkconfig of + (UnpaddedChunks chunksize) -> do + let chunkkeys = chunkKeyStream k chunksize + (chunkkeys', startpos) <- seekResume h chunkkeys checker + b <- liftIO $ L.hGetContents h + gochunks meterupdate startpos chunksize b chunkkeys' + _ -> liftIO $ do + b <- L.hGetContents h + storer k b meterupdate + + gochunks :: MeterUpdate -> BytesProcessed -> ChunkSize -> L.ByteString -> ChunkKeyStream -> Annex Bool + gochunks meterupdate startpos chunksize = loop startpos . splitchunk where splitchunk = L.splitAt chunksize @@ -125,6 +141,45 @@ storeChunks u chunkconfig k f p storer = metered (Just p) k $ \meterupdate -> - in previous chunks. -} meterupdate' = offsetMeterUpdate meterupdate bytesprocessed +{- Check if any of the chunk keys are present. If found, seek forward + - in the Handle, so it will be read starting at the first missing chunk. + - Returns the ChunkKeyStream truncated to start at the first missing + - chunk, and the number of bytes skipped due to resuming. + - + - As an optimisation, if the file fits into a single chunk, there's no need + - to check if that chunk is present -- we know it's not, because otherwise + - the whole file would be present and there would be no reason to try to + - store it. + -} +seekResume + :: Handle + -> ChunkKeyStream + -> (Key -> Annex (Either String Bool)) + -> Annex (ChunkKeyStream, BytesProcessed) +seekResume h chunkkeys checker = do + sz <- liftIO (hFileSize h) + if sz <= fromMaybe 0 (keyChunkSize $ fst $ nextChunkKeyStream chunkkeys) + then return (chunkkeys, zeroBytesProcessed) + else check 0 chunkkeys sz + where + check pos cks sz + | pos >= sz = do + -- All chunks are already stored! + liftIO $ hSeek h AbsoluteSeek sz + return (cks', toBytesProcessed sz) + | otherwise = do + v <- checker k + case v of + Right True -> + check pos' cks' sz + _ -> do + when (pos > 0) $ + liftIO $ hSeek h AbsoluteSeek pos + return (cks, toBytesProcessed pos) + where + (k, cks') = nextChunkKeyStream cks + pos' = pos + fromMaybe 0 (keyChunkSize k) + {- Removes all chunks of a key from a remote, by calling a remover - action on each. - diff --git a/Remote/Helper/ChunkedEncryptable.hs b/Remote/Helper/ChunkedEncryptable.hs index 66e02da12..402a64891 100644 --- a/Remote/Helper/ChunkedEncryptable.hs +++ b/Remote/Helper/ChunkedEncryptable.hs @@ -60,19 +60,19 @@ chunkedEncryptableRemote -> Preparer Retriever -> Remote -> Remote -chunkedEncryptableRemote c preparestorer prepareretriever r = encr +chunkedEncryptableRemote c preparestorer prepareretriever baser = encr where - encr = r + encr = baser { 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) + (retrieveKeyFileCheap baser k d) (\_ -> return False) , removeKey = \k -> cip >>= removeKeyGen k , hasKey = \k -> cip >>= hasKeyGen k , cost = maybe - (cost r) - (const $ cost r + encryptedRemoteCostAdj) + (cost baser) + (const $ cost baser + encryptedRemoteCostAdj) (extractCipher c) } cip = cipherKey c @@ -87,8 +87,9 @@ chunkedEncryptableRemote c preparestorer prepareretriever r = encr where go (Just storer) = sendAnnex k rollback $ \src -> metered (Just p) k $ \p' -> - storeChunks (uuid r) chunkconfig k src p' $ - storechunk storer + storeChunks (uuid baser) chunkconfig k src p' + (storechunk storer) + (hasKey baser) go Nothing = return False rollback = void $ removeKey encr k storechunk storer k' b p' = case enc of @@ -103,7 +104,8 @@ chunkedEncryptableRemote c preparestorer prepareretriever r = encr safely $ prepareretriever k $ safely . go where go (Just retriever) = metered (Just p) k $ \p' -> - retrieveChunks retriever (uuid r) chunkconfig enck k dest p' sink + retrieveChunks retriever (uuid baser) chunkconfig + enck k dest p' sink go Nothing = return False sink h p' b = do let write = meteredWrite p' h @@ -114,15 +116,15 @@ chunkedEncryptableRemote c preparestorer prepareretriever r = encr readBytes write enck = maybe id snd enc - removeKeyGen k enc = removeChunks remover (uuid r) chunkconfig enck k + removeKeyGen k enc = removeChunks remover (uuid baser) chunkconfig enck k where enck = maybe id snd enc - remover = removeKey r + remover = removeKey baser - hasKeyGen k enc = hasKeyChunks checker (uuid r) chunkconfig enck k + hasKeyGen k enc = hasKeyChunks checker (uuid baser) chunkconfig enck k where enck = maybe id snd enc - checker = hasKey r + checker = hasKey baser {- The base Remote that is provided to chunkedEncryptableRemote - needs to have storeKey and retreiveKeyFile methods, but they are |