git.iko.soy/typeable/wai
on master help sign in
Merge pull request #124 from notogawa/MultiThreadedTLSHandshake

Multithreaded SSL/TLS handshaking.

commite033cbdfe21c0fed5c9c51889ed068454ed0b78f authorMichael Snoyman <michael@snoyman.com> dateThu 22 Nov 2012, 23:23 (14 years ago) parent8cbeb0d19a3a87
3 files changed+16−9
compare with master
unifiedsplit
warp-tls/Network/Wai/Handler/WarpTLS.hs+5−7 warp/Network/Wai/Handler/Warp.hs+1 warp/Network/Wai/Handler/Warp/Run.hs+10−2
warp-tls/Network/Wai/Handler/WarpTLS.hs+5−7
@@ -56,14 +56,11 @@ runTLSSocket tset set sock app = do
5656 , TLS.pCertificates = zip certs $ (Just pk):repeat Nothing
5757 }
5858#endif
59− runSettingsConnection set (getter params sock) app
59+ runSettingsConnectionMaker set (getter params sock) app
6060 where
61− retry :: Socket -> TLS.TLSParams -> Socket -> SomeException -> IO (Connection, SockAddr)
62− retry s a b _ = sClose s >> getter a b
63−
6461 getter params sock = do
6562 (s, sa) <- accept sock
66− handle (retry s params sock) $ do
63+ let mkConn = do
6764 (fromClient, firstBS) <- sourceSocket s C.$$+ CL.peek
6865 let toClient = sinkSocket s
6966 ifromClient <- I.newIORef fromClient
@@ -106,12 +103,13 @@ runTLSSocket tset set sock app = do
106103 sClose s
107104 , connRecv = TLS.recvData ctx
108105 }
109− return (conn, sa)
106+ return conn
110107 else do
111108 let conn = (socketConnection s)
112109 { connRecv = getNext $ fmap (fromMaybe B.empty) C.await
113110 }
114− return (conn, sa)
111+ return conn
112+ return (mkConn, sa)
115113
116114runTLS :: TLSSettings -> Settings -> Application -> IO ()
117115runTLS tset set app =
warp/Network/Wai/Handler/Warp.hs+1
@@ -38,6 +38,7 @@ module Network.Wai.Handler.Warp (
3838 -- * Connection
3939 , Connection (..)
4040 , runSettingsConnection
41+ , runSettingsConnectionMaker
4142 -- * Datatypes
4243 , Port
4344 , InvalidRequest (..)
warp/Network/Wai/Handler/Warp/Run.hs+10−2
@@ -129,7 +129,14 @@ runSettingsSocket set socket app =
129129 return (socketConnection conn, sa)
130130
131131runSettingsConnection :: Settings -> IO (Connection, SockAddr) -> Application -> IO ()
132−runSettingsConnection set getConn app = do
132+runSettingsConnection set getConn app = runSettingsConnectionMaker set getConnMaker app
133+ where
134+ getConnMaker = do
135+ (conn, sa) <- getConn
136+ return (return conn, sa)
137+
138+runSettingsConnectionMaker :: Settings -> IO (IO Connection, SockAddr) -> Application -> IO ()
139+runSettingsConnectionMaker set getConn app = do
133140 tm <- maybe (T.initialize $ settingsTimeout set * 1000000) return
134141 $ settingsManager set
135142#if SENDFILEFD
@@ -140,9 +147,10 @@ runSettingsConnection set getConn app = do
140147#endif
141148 mask $ \restore -> forever $ do
142149 allowInterrupt
143− (conn, addr) <- getConnLoop
150+ (mkConn, addr) <- getConnLoop
144151 void . forkIO $ do
145152 th <- T.registerKillThread tm
153+ conn <- mkConn
146154#if SENDFILEFD
147155 let cleaner = Cleaner th fc
148156#else