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:
Joey Hess 2016-12-08 18:26:03 -04:00
parent 095593a9af
commit 0f4ee4f298
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
3 changed files with 20 additions and 38 deletions

View file

@ -72,15 +72,15 @@ runLocal runmode runner a = case a of
Right b -> runner (next b)
Right Nothing -> return (Left "content not available")
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) $
transfer download k af $
getViaTmp AlwaysVerify k $ \tmp ->
unVerified $ storefile tmp o l b
unVerified $ storefile tmp o l getb
runner (next ok)
StoreContentTo dest o l b next -> do
StoreContentTo dest o l getb next -> do
ok <- flip catchNonAsync (const $ return False) $
storefile dest o l b
storefile dest o l getb
runner (next ok)
SetPresent k u next -> do
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
-- a client.
Client -> ta
storefile dest (Offset o) (Len l) b = liftIO $ do
withBinaryFile dest ReadWriteMode $ \h -> do
when (o /= 0) $
hSeek h AbsoluteSeek o
L.hPut h b
sz <- getFileSize dest
return (toInteger sz == l + o)
storefile dest (Offset o) (Len l) getb = do
v <- runner getb
case v of
Right b -> liftIO $ do
withBinaryFile dest ReadWriteMode $ \h -> do
when (o /= 0) $
hSeek h AbsoluteSeek o
L.hPut h b
sz <- liftIO $ getFileSize dest
return (toInteger sz == l + o)
Left e -> error e

View file

@ -200,7 +200,7 @@ data LocalF c
| ReadContent Key AssociatedFile Offset (L.ByteString -> c)
-- ^ Lazily reads the content of a key. Note that the content
-- 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.
-- 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.
@ -208,7 +208,7 @@ data LocalF c
-- Note: The ByteString may not contain the entire remaining content
-- of the key. Only once the temp file size == Len has the whole
-- 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.
-- 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'
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
Len n <- local sizer
let p' = offsetMeterUpdate p (toBytesProcessed n)
@ -397,8 +397,8 @@ receiveContent p sizer storer mkmsg = do
r <- net receiveMessage
case r of
DATA len -> do
ok <- local . storer offset len
=<< net (receiveBytes len p')
ok <- local $ storer offset len
(net (receiveBytes len p'))
sendSuccess ok
return ok
_ -> do

View file

@ -4,28 +4,6 @@ Mostly working!
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
object is already in progress, the message about this is output by the
remotedaemon --debug, but not forwarded to the peer, which shows