on master help sign in
Fix some FD leaks in warp-tls
commit46029b42fb55871315594e81f6d03f8c6e8c54c6 authorMichael Snoyman <michael@snoyman.com> dateMon 3 Jun 2013, 10:56 (13 years ago) parent742ae46
2 files changed+9−9
warp-tls/Network/Wai/Handler/WarpTLS.hs+8−8 warp-tls/warp-tls.cabal+1−1
warp-tls/Network/Wai/Handler/WarpTLS.hs+8−8
@@ -30,7 +30,7 @@ import qualified Data.ByteString.Lazy as L
3030import Data.Conduit.Binary (sourceFileRange)
3131import qualified Data.Conduit as C
3232import qualified Data.Conduit.List as CL
33−import Control.Exception (bracket)
33+import Control.Exception (bracket, finally)
3434import qualified Network.TLS.Extra as TLSExtra
3535import qualified Data.Certificate.X509 as X509
3636import qualified Data.ByteString as B
@@ -93,6 +93,7 @@ runTLSSocket :: TLSSettings -> Settings -> Socket -> Application -> IO ()
9393runTLSSocket TLSSettings {..} set sock app = do
9494 certs <- readCertificates certFile
9595 pk <- readPrivateKey keyFile
96+ gen <- getSystemRandomGen
9697 let params =
9798 TLS.updateServerParams
9899 (\sp -> sp { TLS.serverWantClientCert = False }) $
@@ -102,9 +103,9 @@ runTLSSocket TLSSettings {..} set sock app = do
102103 , TLS.pCertificates = zip certs $ (Just pk):repeat Nothing
103104 , TLS.pLogging = tlsLogging
104105 }
105− runSettingsConnectionMaker set (getter params) app
106+ runSettingsConnectionMaker set (getter gen params) app
106107 where
107− getter params = do
108+ getter gen params = do
108109 (s, sa) <- acceptSafe sock
109110 let mkConn = do
110111 (fromClient, firstBS) <- sourceSocket s C.$$+ CL.peek
@@ -117,11 +118,10 @@ runTLSSocket TLSSettings {..} set sock app = do
117118 return bs
118119 if maybe False ((== 0x16) . fst) (firstBS >>= B.uncons)
119120 then do
120− gen <- getSystemRandomGen
121121 ctx <- TLS.contextNew
122122 TLS.Backend
123123 { TLS.backendFlush = return ()
124− , TLS.backendClose = return ()
124+ , TLS.backendClose = sClose s
125125 , TLS.backendSend = \bs -> C.yield bs C.$$ toClient
126126 , TLS.backendRecv = getNext . fmap (B.concat . L.toChunks) . CB.take
127127 }
@@ -134,9 +134,9 @@ runTLSSocket TLSSettings {..} set sock app = do
134134 , connSendFile = \fp offset len _th headers _cleaner -> do
135135 TLS.sendData ctx $ L.fromChunks headers
136136 C.runResourceT $ sourceFileRange fp (Just offset) (Just len) C.$$ CL.mapM_ (TLS.sendData ctx . L.fromChunks . return)
137− , connClose = do
138− TLS.bye ctx
139− sClose s
137+ , connClose =
138+ TLS.bye ctx `finally`
139+ TLS.contextClose ctx
140140 , connRecv = TLS.recvData ctx
141141 }
142142 return conn
warp-tls/warp-tls.cabal+1−1
@@ -1,5 +1,5 @@
11Name: warp-tls
2−Version: 1.4.1
2+Version: 1.4.1.1
33Synopsis: HTTP over SSL/TLS support for Warp via the TLS package
44License: MIT
55License-file: LICENSE