Permalink
Browse files

Touch the SSLContext in a couple of other places.

  • Loading branch information...
1 parent bb94339 commit 45ebfb3fc62cc8ac4bcc5cd64da43e8a40533320 @gregorycollins gregorycollins committed Sep 18, 2012
Showing with 8 additions and 3 deletions.
  1. +8 −3 src/Snap/Internal/Http/Server/TLS.hs
@@ -174,7 +174,7 @@ endSession (NetworkSession _ aSSL _) = do
send :: IO () -> IO () -> NetworkSession -> ByteString -> IO ()
send tickleTimeout _ (NetworkSession _ aSSL sz) bs = go bs
where
- (SessionContext ssl _) = unsafeCoerce aSSL
+ (SessionContext ssl ctx) = unsafeCoerce aSSL
-- I think we have to chop the data into chunks here because HsOpenSSL
-- won't; of course, blaze-builder may already be doing this for us, but I
@@ -184,6 +184,10 @@ send tickleTimeout _ (NetworkSession _ aSSL sz) bs = go bs
else do
SSL.write ssl a
tickleTimeout
+ -- FIXME(greg): fix this properly, see above
+ -- Touch the context so that the garbage collector doesn't zap
+ -- it.
+ !_ <- contextGetCAStore ctx
go b
where
(a,b) = S.splitAt sz s
@@ -192,9 +196,10 @@ send tickleTimeout _ (NetworkSession _ aSSL sz) bs = go bs
------------------------------------------------------------------------------
recv :: IO b -> NetworkSession -> IO (Maybe ByteString)
recv _ (NetworkSession _ aSSL recvLen) = do
- b <- SSL.read ssl recvLen
+ b <- SSL.read ssl recvLen
+ !_ <- contextGetCAStore ctx
return $! if S.null b then Nothing else Just b
where
- (SessionContext ssl _) = unsafeCoerce aSSL
+ (SessionContext ssl ctx) = unsafeCoerce aSSL
#endif

0 comments on commit 45ebfb3

Please sign in to comment.