Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Fixed early verification callback deallocation crash.

Embarrassingly, there is a bug in my verification callback support code
which leads to RTS crashes:
1. `SSLContext` is created.
2. Verification callback is installed and allocated `FunPtr` is written
   to `ctxVfCb` `IORef`.
3. An `SSL` is created using the `SSLContext`.
4. The `SSLContext` is GCed and the finalizer calls `freeHaskellFunPtr`.
5. `connect` is called on the `SSL`.
6. KABOOM! Freed verification `FunPtr` is called.

The solution is to keep a reference to the `SSLContext` in each `SSL`
created from it. This prevents verification callback from deallocation,
until there is no sessions left to call it.
  • Loading branch information...
commit 0275614104a8ce72ceac4c8ebe0100003ee7b904 1 parent 812bf8c
Mikhail Vorozhtsov mvv authored

Showing 1 changed file with 8 additions and 5 deletions. Show diff stats Hide diff stats

  1. +8 5 OpenSSL/Session.hsc
13 OpenSSL/Session.hsc
@@ -288,6 +288,7 @@ data SSL_
288 288 -- object at a time, because they aren't really in the SSL object, they are
289 289 -- waiting for the RTS to wake the Haskell thread.
290 290 data SSL = SSL { sslSem :: QSem
  291 + , sslCtx :: SSLContext
291 292 , sslPtr :: ForeignPtr SSL_
292 293 , sslFd :: Fd -- ^ Get the underlying socket Fd
293 294 , sslSocket :: Maybe Socket -- ^ Get the socket underlying an SSL connection
@@ -301,12 +302,14 @@ foreign import ccall unsafe "SSL_set_fd" _ssl_set_fd :: Ptr SSL_ -> CInt -> IO (
301 302 connection' :: SSLContext -> Fd -> Maybe Socket -> IO SSL
302 303 connection' context fd@(Fd fdInt) sock = do
303 304 sem <- newQSem 1
304   - ssl <- withContext context $ \ctx -> do
305   - ssl <- _ssl_new ctx >>= failIfNull
306   - _ssl_set_fd ssl fdInt
307   - return ssl
308   - fpssl <- newForeignPtr _ssl_free ssl
  305 + fpssl <- mask_ $ do
  306 + ssl <- withContext context $ \ctx -> do
  307 + ssl <- _ssl_new ctx >>= failIfNull
  308 + _ssl_set_fd ssl fdInt
  309 + return ssl
  310 + newForeignPtr _ssl_free ssl
309 311 return $ SSL { sslSem = sem
  312 + , sslCtx = context
310 313 , sslPtr = fpssl
311 314 , sslFd = fd
312 315 , sslSocket = sock

0 comments on commit 0275614

Please sign in to comment.
Something went wrong with that request. Please try again.