Skip to content
This repository

Fix space leak caused by updateMeasure #8

Merged
merged 4 commits into from about 2 years ago

2 participants

joeyadams Vincent Hanquez
joeyadams

updateMeasure calls modifyIORef, which does not force the value. Since the Measurement is almost never examined by the program, this results in a memory leak.

In a test program I wrote, a server sending thousands of packets to a client leaks memory pretty quickly (~150 bytes per send, on my 64-bit system). After applying the space leak fix in this pull request, the program successfully sent 1000000 messages to itself using just under 10MB.

This pull request also includes a couple other improvements:

  • Use modifyMVar in the usingState function. This is more concise as well as exception-safe.

  • Minor documentation fixes.

added some commits March 10, 2012
joeyadams Fix space leak caused by updateMeasure
modifyIORef does not force the value, so if the Measurement object is updated a
bunch of times but never examined, the program will leak memory.
23e91ae
joeyadams Use modifyMVar in usingState for exception safety
Also, force the state value, to avoid potential space leaks.
c1ce196
joeyadams Add links to the 'BufferMode' type in 'client' and 'server' cbfe10e
joeyadams Fix spelling of negotiate/negotiation in documentation 3d0071d
Vincent Hanquez vincenthz merged commit 3d0071d into from March 11, 2012
Vincent Hanquez vincenthz closed this March 11, 2012
Vincent Hanquez
Owner

thanks, nice catch for the leak and nice improvements

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment

Showing 4 unique commits by 1 author.

Mar 10, 2012
joeyadams Fix space leak caused by updateMeasure
modifyIORef does not force the value, so if the Measurement object is updated a
bunch of times but never examined, the program will leak memory.
23e91ae
joeyadams Use modifyMVar in usingState for exception safety
Also, force the state value, to avoid potential space leaks.
c1ce196
joeyadams Add links to the 'BufferMode' type in 'client' and 'server' cbfe10e
joeyadams Fix spelling of negotiate/negotiation in documentation 3d0071d
This page is out of date. Refresh to see the latest.
17  Network/TLS/Context.hs
@@ -56,7 +56,7 @@ import qualified Data.ByteString as B
56 56
 
57 57
 import Control.Concurrent.MVar
58 58
 import Control.Monad.State
59  
-import Control.Exception (throwIO, Exception(), onException)
  59
+import Control.Exception (throwIO, Exception())
60 60
 import Data.IORef
61 61
 import System.IO (Handle, hSetBuffering, BufferMode(..), hFlush)
62 62
 import Prelude hiding (catch)
@@ -152,7 +152,9 @@ data TLSCtx a = TLSCtx
152 152
 	}
153 153
 
154 154
 updateMeasure :: MonadIO m => TLSCtx c -> (Measurement -> Measurement) -> m ()
155  
-updateMeasure ctx f = liftIO $ modifyIORef (ctxMeasurement ctx) f
  155
+updateMeasure ctx f = liftIO $ do
  156
+    x <- readIORef (ctxMeasurement ctx)
  157
+    writeIORef (ctxMeasurement ctx) $! f x
156 158
 
157 159
 withMeasure :: MonadIO m => TLSCtx c -> (Measurement -> IO a) -> m a
158 160
 withMeasure ctx f = liftIO (readIORef (ctxMeasurement ctx) >>= f)
@@ -209,13 +211,10 @@ throwCore = liftIO . throwIO
209 211
 
210 212
 
211 213
 usingState :: MonadIO m => TLSCtx c -> TLSSt a -> m (Either TLSError a)
212  
-usingState ctx f = liftIO (takeMVar mvar) >>= \st -> liftIO $ onException (execAndStore st) (putMVar mvar st)
213  
-	where
214  
-		mvar = ctxState ctx
215  
-		execAndStore st = do
216  
-			let (a, newst) = runTLSState f st
217  
-			putMVar mvar newst
218  
-			return a
  214
+usingState ctx f =
  215
+	liftIO $ modifyMVar (ctxState ctx) $ \st ->
  216
+		let (a, newst) = runTLSState f st
  217
+		 in newst `seq` return (newst, a)
219 218
 
220 219
 usingState_ :: MonadIO m => TLSCtx c -> TLSSt a -> m a
221 220
 usingState_ ctx f = do
12  Network/TLS/Core.hs
@@ -186,7 +186,7 @@ clientWith params rng connection flushF sendF recvF =
186 186
 	where st = (newTLSState rng) { stClientContext = True }
187 187
 
188 188
 -- | Create a new Client context with a configuration, a RNG, and a Handle.
189  
--- It reconfigures the handle buffermode to noBuffering
  189
+-- It reconfigures the handle's 'System.IO.BufferMode' to @NoBuffering@.
190 190
 client :: (MonadIO m, CryptoRandomGen g)
191 191
        => TLSParams -- ^ parameters to use for this context
192 192
        -> g         -- ^ random number generator associated with the context
@@ -202,7 +202,7 @@ serverWith params rng connection flushF sendF recvF =
202 202
 	where st = (newTLSState rng) { stClientContext = False }
203 203
 
204 204
 -- | Create a new Server context with a configuration, a RNG, and a Handle.
205  
--- It reconfigures the handle buffermode to noBuffering
  205
+-- It reconfigures the handle's 'System.IO.BufferMode' to @NoBuffering@.
206 206
 server :: (MonadIO m, CryptoRandomGen g) => TLSParams -> g -> Handle -> m (TLSCtx Handle)
207 207
 server params rng handle = liftIO $ newCtx handle params st
208 208
 	where st = (newTLSState rng) { stClientContext = False }
@@ -477,7 +477,7 @@ handshakeServer ctx = do
477 477
 		_    -> fail ("unexpected handshake received, excepting client hello and received " ++ show hss)
478 478
 
479 479
 -- | Handshake for a new TLS connection
480  
--- This is to be called at the beginning of a connection, and during renegociation
  480
+-- This is to be called at the beginning of a connection, and during renegotiation
481 481
 handshake :: MonadIO m => TLSCtx c -> m ()
482 482
 handshake ctx = do
483 483
 	cc <- usingState_ ctx (stClientContext <$> get)
@@ -500,17 +500,17 @@ sendData ctx dataToSend = checkValid ctx >> mapM_ sendDataChunk (L.toChunks data
500 500
 			sendDataChunk remain
501 501
 		| otherwise = sendPacket ctx $ AppData d
502 502
 
503  
--- | recvData get data out of Data packet, and automatically renegociate if
  503
+-- | recvData get data out of Data packet, and automatically renegotiate if
504 504
 -- a Handshake ClientHello is received
505 505
 recvData :: MonadIO m => TLSCtx c -> m B.ByteString
506 506
 recvData ctx = do
507 507
 	checkValid ctx
508 508
 	pkt <- recvPacket ctx
509 509
 	case pkt of
510  
-		-- on server context receiving a client hello == renegociation
  510
+		-- on server context receiving a client hello == renegotiation
511 511
 		Right (Handshake [ch@(ClientHello _ _ _ _ _ _)]) ->
512 512
 			handshakeServerWith ctx ch >> recvData ctx
513  
-		-- on client context, receiving a hello request == renegociation
  513
+		-- on client context, receiving a hello request == renegotiation
514 514
 		Right (Handshake [HelloRequest]) ->
515 515
 			handshakeClient ctx >> recvData ctx
516 516
 		Right (Alert [(AlertLevel_Fatal, _)]) -> do
2  Network/TLS/Receiving.hs
@@ -104,7 +104,7 @@ processServerHello (ServerHello sver ran _ _ _ ex) = do
104 104
 processServerHello _ = error "processServerHello called on wrong type"
105 105
 
106 106
 -- process the client key exchange message. the protocol expects the initial
107  
--- client version received in ClientHello, not the negociated version.
  107
+-- client version received in ClientHello, not the negotiated version.
108 108
 -- in case the version mismatch, generate a random master secret
109 109
 processClientKeyXchg :: ByteString -> TLSSt ()
110 110
 processClientKeyXchg encryptedPremaster = do
Commit_comment_tip

Tip: You can add notes to lines in a file. Hover to the left of a line to make a note

Something went wrong with that request. Please try again.