snap-server 0.5.1.3 → 0.5.1.4
raw patch · 3 files changed
+44/−39 lines, 3 files
Files
- snap-server.cabal +1/−1
- src/Snap/Internal/Http/Server/GnuTLS.hs +5/−5
- src/Snap/Internal/Http/Server/LibevBackend.hs +38/−33
snap-server.cabal view
@@ -1,5 +1,5 @@ name: snap-server-version: 0.5.1.3+version: 0.5.1.4 synopsis: A fast, iteratee-based, epoll-enabled web server for the Snap Framework description: Snap is a simple and fast web development framework and server written in
src/Snap/Internal/Http/Server/GnuTLS.hs view
@@ -141,22 +141,22 @@ createSession :: ListenSocket -> Int -> CInt -> IO () -> IO NetworkSession createSession (ListenHttps _ creds _) recvSize socket on_block = alloca $ \sPtr -> do- throwErrorIf "TLS alloacte" $ gnutls_init sPtr 1+ throwErrorIf "TLS allocate" $ gnutls_init sPtr 1 session <- peek sPtr+ finishInit session `onException` gnutls_deinit session+ where+ finishInit session = do throwErrorIf "TLS session" $ gnutls_credentials_set session 1 $ castPtr creds throwErrorIf "TLS session" $ gnutls_set_default_priority session gnutls_certificate_send_x509_rdn_sequence session 1 gnutls_session_enable_compatibility_mode session- let s = NetworkSession socket (castPtr session) $ fromIntegral recvSize- gnutls_transport_set_ptr session $ intPtrToPtr $ fromIntegral $ socket- handshake s on_block- return s+ createSession _ _ _ _ = error "Invalid socket"
src/Snap/Internal/Http/Server/LibevBackend.hs view
@@ -461,7 +461,6 @@ ra <- newMVar () wa <- newMVar () - ----------------- -- setup timer -- -----------------@@ -499,39 +498,45 @@ evAsyncSend lp $ _asyncObj backend let sinfo = SessionInfo laddr lport raddr rport $- Listen.isSecure lsock- let conn = Connection backend- lsock- fd- sinfo- ra- wa- tmr- tcb- timeoutTime- readActive- writeActive- evioRead- ioReadCb- evioWrite- ioWriteCb- tid-- bracket (Listen.createSession lsock bLOCKSIZE fd $- waitForLock True conn)- (\session -> block $ do- debug "runSession: thread killed, closing socket"+ Listen.isSecure lsock+ let conn = Connection backend+ lsock+ fd+ sinfo+ ra+ wa+ tmr+ tcb+ timeoutTime+ readActive+ writeActive+ evioRead+ ioReadCb+ evioWrite+ ioWriteCb+ tid - ignoreException $ Listen.endSession lsock session- ignoreException $ freeConnection conn- )- (\session -> do H.update tid conn (_connectionThreads backend)- handler sinfo- (enumerate conn session)- (writeOut defaultTimeout conn session)- (sendFile defaultTimeout conn session)- (tickleTimeout conn)- )+ go sinfo conn `finally` (block $ do+ debug "runSession: thread finished, freeing connection"+ ignoreException $ freeConnection conn)+ + where+ go sinfo conn =+ bracket (Listen.createSession lsock bLOCKSIZE fd $+ waitForLock True conn)+ (\session -> block $ do+ debug "runSession: session finished, cleaning up"+ ignoreException $ Listen.endSession lsock session+ )+ (\session -> do H.update (_connThread conn)+ conn+ (_connectionThreads backend)+ handler sinfo+ (enumerate conn session)+ (writeOut defaultTimeout conn session)+ (sendFile defaultTimeout conn session)+ (tickleTimeout conn)+ ) ------------------------------------------------------------------------------