fix memory leak
I'm unsure why this fixed it, but it did. Seems to suggest that the memory leak is not due to a bug in my code, but that ghc didn't manage to take full advantage of laziness, or was failing to gc something it could have.
This commit is contained in:
parent
095593a9af
commit
0f4ee4f298
3 changed files with 20 additions and 38 deletions
26
P2P/Annex.hs
26
P2P/Annex.hs
|
@ -72,15 +72,15 @@ runLocal runmode runner a = case a of
|
||||||
Right b -> runner (next b)
|
Right b -> runner (next b)
|
||||||
Right Nothing -> return (Left "content not available")
|
Right Nothing -> return (Left "content not available")
|
||||||
Left e -> return (Left (show e))
|
Left e -> return (Left (show e))
|
||||||
StoreContent k af o l b next -> do
|
StoreContent k af o l getb next -> do
|
||||||
ok <- flip catchNonAsync (const $ return False) $
|
ok <- flip catchNonAsync (const $ return False) $
|
||||||
transfer download k af $
|
transfer download k af $
|
||||||
getViaTmp AlwaysVerify k $ \tmp ->
|
getViaTmp AlwaysVerify k $ \tmp ->
|
||||||
unVerified $ storefile tmp o l b
|
unVerified $ storefile tmp o l getb
|
||||||
runner (next ok)
|
runner (next ok)
|
||||||
StoreContentTo dest o l b next -> do
|
StoreContentTo dest o l getb next -> do
|
||||||
ok <- flip catchNonAsync (const $ return False) $
|
ok <- flip catchNonAsync (const $ return False) $
|
||||||
storefile dest o l b
|
storefile dest o l getb
|
||||||
runner (next ok)
|
runner (next ok)
|
||||||
SetPresent k u next -> do
|
SetPresent k u next -> do
|
||||||
v <- tryNonAsync $ logChange k u InfoPresent
|
v <- tryNonAsync $ logChange k u InfoPresent
|
||||||
|
@ -120,10 +120,14 @@ runLocal runmode runner a = case a of
|
||||||
-- Transfer logs are updated higher in the stack when
|
-- Transfer logs are updated higher in the stack when
|
||||||
-- a client.
|
-- a client.
|
||||||
Client -> ta
|
Client -> ta
|
||||||
storefile dest (Offset o) (Len l) b = liftIO $ do
|
storefile dest (Offset o) (Len l) getb = do
|
||||||
withBinaryFile dest ReadWriteMode $ \h -> do
|
v <- runner getb
|
||||||
when (o /= 0) $
|
case v of
|
||||||
hSeek h AbsoluteSeek o
|
Right b -> liftIO $ do
|
||||||
L.hPut h b
|
withBinaryFile dest ReadWriteMode $ \h -> do
|
||||||
sz <- getFileSize dest
|
when (o /= 0) $
|
||||||
return (toInteger sz == l + o)
|
hSeek h AbsoluteSeek o
|
||||||
|
L.hPut h b
|
||||||
|
sz <- liftIO $ getFileSize dest
|
||||||
|
return (toInteger sz == l + o)
|
||||||
|
Left e -> error e
|
||||||
|
|
|
@ -200,7 +200,7 @@ data LocalF c
|
||||||
| ReadContent Key AssociatedFile Offset (L.ByteString -> c)
|
| ReadContent Key AssociatedFile Offset (L.ByteString -> c)
|
||||||
-- ^ Lazily reads the content of a key. Note that the content
|
-- ^ Lazily reads the content of a key. Note that the content
|
||||||
-- may change while it's being sent.
|
-- may change while it's being sent.
|
||||||
| StoreContent Key AssociatedFile Offset Len L.ByteString (Bool -> c)
|
| StoreContent Key AssociatedFile Offset Len (Proto L.ByteString) (Bool -> c)
|
||||||
-- ^ Stores content to the key's temp file starting at an offset.
|
-- ^ Stores content to the key's temp file starting at an offset.
|
||||||
-- Once the whole content of the key has been stored, moves the
|
-- Once the whole content of the key has been stored, moves the
|
||||||
-- temp file into place as the content of the key, and returns True.
|
-- temp file into place as the content of the key, and returns True.
|
||||||
|
@ -208,7 +208,7 @@ data LocalF c
|
||||||
-- Note: The ByteString may not contain the entire remaining content
|
-- Note: The ByteString may not contain the entire remaining content
|
||||||
-- of the key. Only once the temp file size == Len has the whole
|
-- of the key. Only once the temp file size == Len has the whole
|
||||||
-- content been transferred.
|
-- content been transferred.
|
||||||
| StoreContentTo FilePath Offset Len L.ByteString (Bool -> c)
|
| StoreContentTo FilePath Offset Len (Proto L.ByteString) (Bool -> c)
|
||||||
-- ^ Stores the content to a temp file starting at an offset.
|
-- ^ Stores the content to a temp file starting at an offset.
|
||||||
-- Once the whole content of the key has been stored, returns True.
|
-- Once the whole content of the key has been stored, returns True.
|
||||||
--
|
--
|
||||||
|
@ -388,7 +388,7 @@ sendContent key af offset@(Offset n) p = do
|
||||||
net $ sendBytes len content p'
|
net $ sendBytes len content p'
|
||||||
checkSuccess
|
checkSuccess
|
||||||
|
|
||||||
receiveContent :: MeterUpdate -> Local Len -> (Offset -> Len -> L.ByteString -> Local Bool) -> (Offset -> Message) -> Proto Bool
|
receiveContent :: MeterUpdate -> Local Len -> (Offset -> Len -> Proto L.ByteString -> Local Bool) -> (Offset -> Message) -> Proto Bool
|
||||||
receiveContent p sizer storer mkmsg = do
|
receiveContent p sizer storer mkmsg = do
|
||||||
Len n <- local sizer
|
Len n <- local sizer
|
||||||
let p' = offsetMeterUpdate p (toBytesProcessed n)
|
let p' = offsetMeterUpdate p (toBytesProcessed n)
|
||||||
|
@ -397,8 +397,8 @@ receiveContent p sizer storer mkmsg = do
|
||||||
r <- net receiveMessage
|
r <- net receiveMessage
|
||||||
case r of
|
case r of
|
||||||
DATA len -> do
|
DATA len -> do
|
||||||
ok <- local . storer offset len
|
ok <- local $ storer offset len
|
||||||
=<< net (receiveBytes len p')
|
(net (receiveBytes len p'))
|
||||||
sendSuccess ok
|
sendSuccess ok
|
||||||
return ok
|
return ok
|
||||||
_ -> do
|
_ -> do
|
||||||
|
|
|
@ -4,28 +4,6 @@ Mostly working!
|
||||||
|
|
||||||
Current todo list:
|
Current todo list:
|
||||||
|
|
||||||
* copy --to peer of a 100 mb file causes the memory of the remotedaemon
|
|
||||||
to creep up from 40 mb to 136 mb. Once the transfer is done, the
|
|
||||||
remotedaemon continues using all that memory. Memory leak. Profile it.
|
|
||||||
(The sending process creeps up some initially, but stops at 45 mb used.
|
|
||||||
That could just be buffering.)
|
|
||||||
(copy --from peer does not leak on either end; the remotedaemon uses 34
|
|
||||||
mb and the receiver 44 mb.)
|
|
||||||
|
|
||||||
Profiling results: Leak is in hGetMetered, or perhaps in
|
|
||||||
the consumer of the data it reads. Graph shows `ARR_WORDS` is
|
|
||||||
the type; that must be a bytestring.
|
|
||||||
|
|
||||||
<pre> individual inherited
|
|
||||||
COST CENTRE MODULE no. entries %time %alloc %time %alloc
|
|
||||||
tryNonAsync Utility.Exception 3241 0 0.0 0.1 49.3 65.8
|
|
||||||
receiveExactly P2P.IO 3429 0 0.0 0.0 49.3 65.7
|
|
||||||
hGetMetered Utility.Metered 3430 0 49.1 65.6 49.3 65.7
|
|
||||||
</pre>
|
|
||||||
|
|
||||||
Switching to L.hGet, it still leaks, so seems hGetMetered is not at fault
|
|
||||||
and the bytestring is being buffered excessively somehow.
|
|
||||||
|
|
||||||
* When a transfer can't be done because another transfer of the same
|
* When a transfer can't be done because another transfer of the same
|
||||||
object is already in progress, the message about this is output by the
|
object is already in progress, the message about this is output by the
|
||||||
remotedaemon --debug, but not forwarded to the peer, which shows
|
remotedaemon --debug, but not forwarded to the peer, which shows
|
||||||
|
|
Loading…
Reference in a new issue