This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap-server".
The branch, master has been updated
via db89924df300d639117af2de2f7b8a8d6a0f1d91 (commit)
via d5f59cfb8e06536efb37dcecd3e537e36df7eee8 (commit)
from cca6cfc327990abfc67a79853252649e05db0947 (commit)
Summary of changes:
src/Snap/Internal/Http/Server.hs | 18 ++++++---
src/Snap/Internal/Http/Server/LibevBackend.hs | 51 ++++++++++++-----------
src/Snap/Internal/Http/Server/SimpleBackend.hs | 41 +++++++++++--------
test/suite/Snap/Internal/Http/Server/Tests.hs | 5 +-
4 files changed, 65 insertions(+), 50 deletions(-)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit db89924df300d639117af2de2f7b8a8d6a0f1d91
Merge: d5f59cf cca6cfc
Author: Shu-yu Guo <[email protected]>
Date: Tue May 25 18:02:17 2010 -0700
Merge branch 'master' of git.snapframework.com:snap-server
commit d5f59cfb8e06536efb37dcecd3e537e36df7eee8
Author: Shu-yu Guo <[email protected]>
Date: Tue May 25 18:01:49 2010 -0700
Export tickleTimeout from backends
diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs
index 8e064a0..128394d 100644
--- a/src/Snap/Internal/Http/Server.hs
+++ b/src/Snap/Internal/Http/Server.hs
@@ -169,7 +169,7 @@ httpServe bindAddress bindPort localHostname alogPath
elogPath handler =
runHTTP localHostname laddr lport raddr rport
alog elog readEnd writeEnd (Backend.sendFile conn)
- handler
+ (Backend.tickleTimeout conn) handler
debug "Server.httpServe.runHTTP: finished"
@@ -245,9 +245,11 @@ runHTTP :: ByteString -- ^ local host name
-> Enumerator IO () -- ^ read end of socket
-> Iteratee IO () -- ^ write end of socket
-> (FilePath -> IO ()) -- ^ sendfile end
+ -> IO () -- ^ timeout tickler
-> ServerHandler -- ^ handler procedure
-> IO ()
-runHTTP lh lip lp rip rp alog elog readEnd writeEnd onSendFile handler =
+runHTTP lh lip lp rip rp alog elog
+ readEnd writeEnd onSendFile tickle handler =
go `catches` [ Handler $ \(e :: AsyncException) -> do
throwIO e
@@ -260,7 +262,8 @@ runHTTP lh lip lp rip rp alog elog readEnd writeEnd
onSendFile handler =
where
go = do
let iter = runServerMonad lh lip lp rip rp (logA alog) (logE elog) $
- httpSession writeEnd onSendFile handler
+ httpSession writeEnd onSendFile tickle
+ handler
readEnd iter >>= run
@@ -281,11 +284,14 @@ logError s = gets _logError >>= (\l -> liftIO $ l s)
-- | Runs an HTTP session.
httpSession :: Iteratee IO () -- ^ write end of socket
-> (FilePath -> IO ()) -- ^ sendfile continuation
+ -> IO () -- ^ timeout tickler
-> ServerHandler -- ^ handler procedure
-> ServerMonad ()
-httpSession writeEnd onSendFile handler = do
+httpSession writeEnd onSendFile tickle handler = do
liftIO $ debug "Server.httpSession: entered"
- mreq <- receiveRequest
+ mreq <- receiveRequest
+ -- successfully got a request, so restart timer
+ liftIO tickle
case mreq of
(Just req) -> do
@@ -320,7 +326,7 @@ httpSession writeEnd onSendFile handler = do
if cc
then return ()
- else httpSession writeEnd onSendFile handler
+ else httpSession writeEnd onSendFile tickle handler
Nothing -> return ()
diff --git a/src/Snap/Internal/Http/Server/LibevBackend.hsc
b/src/Snap/Internal/Http/Server/LibevBackend.hsc
index 3792765..d23a197 100644
--- a/src/Snap/Internal/Http/Server/LibevBackend.hsc
+++ b/src/Snap/Internal/Http/Server/LibevBackend.hsc
@@ -6,24 +6,25 @@
{-# LANGUAGE ScopedTypeVariables #-}
module Snap.Internal.Http.Server.LibevBackend
-( Backend
-, BackendTerminatedException
-, Connection
-, TimeoutException
-, name
-, debug
-, bindIt
-, new
-, stop
-, withConnection
-, sendFile
-, getReadEnd
-, getWriteEnd
-, getRemoteAddr
-, getRemotePort
-, getLocalAddr
-, getLocalPort
-) where
+ ( Backend
+ , BackendTerminatedException
+ , Connection
+ , TimeoutException
+ , name
+ , debug
+ , bindIt
+ , new
+ , stop
+ , withConnection
+ , sendFile
+ , tickleTimeout
+ , getReadEnd
+ , getWriteEnd
+ , getRemoteAddr
+ , getRemotePort
+ , getLocalAddr
+ , getLocalPort
+ ) where
---------------------------
-- TODO: document module --
@@ -594,6 +595,12 @@ instance Show TimeoutException where
instance Exception TimeoutException
+tickleTimeout :: Connection -> IO ()
+tickleTimeout conn = debug "Backend.tickleTimeout" >> evTimerAgain lp tmr
+ where
+ bk = _backend conn
+ lp = _evLoop bk
+ tmr = _timerObj conn
recvData :: Connection -> Int -> IO ByteString
recvData conn n = do
@@ -604,9 +611,7 @@ recvData conn n = do
(c_read fd cstr (toEnum n))
waitForLock
- -- we got activity, so restart timer
- debug "restarting timer"
- evTimerAgain lp tmr
+ -- we got activity, but don't do restart timer due to the
dbg $ "sz returned " ++ show sz
@@ -618,7 +623,6 @@ recvData conn n = do
io = _connReadIOObj conn
bk = _backend conn
active = _readActive conn
- tmr = _timerObj conn
lp = _evLoop bk
looplock = _loopLock bk
async = _asyncObj bk
@@ -656,8 +660,7 @@ sendData conn bs = do
waitForLock
-- we got activity, so restart timer
- debug "restarting timer"
- evTimerAgain lp tmr
+ tickleTimeout conn
let n = fromEnum written
let last10 = B.drop (n-10) $ B.take n bs
diff --git a/src/Snap/Internal/Http/Server/SimpleBackend.hsc
b/src/Snap/Internal/Http/Server/SimpleBackend.hsc
index 09b73c0..3f39c62 100644
--- a/src/Snap/Internal/Http/Server/SimpleBackend.hsc
+++ b/src/Snap/Internal/Http/Server/SimpleBackend.hsc
@@ -5,24 +5,25 @@
{-# LANGUAGE ScopedTypeVariables #-}
module Snap.Internal.Http.Server.SimpleBackend
-( Backend
-, BackendTerminatedException
-, Connection
-, TimeoutException
-, name
-, debug
-, bindIt
-, new
-, stop
-, withConnection
-, sendFile
-, getReadEnd
-, getWriteEnd
-, getRemoteAddr
-, getRemotePort
-, getLocalAddr
-, getLocalPort
-) where
+ ( Backend
+ , BackendTerminatedException
+ , Connection
+ , TimeoutException
+ , name
+ , debug
+ , bindIt
+ , new
+ , stop
+ , withConnection
+ , sendFile
+ , tickleTimeout
+ , getReadEnd
+ , getWriteEnd
+ , getRemoteAddr
+ , getRemotePort
+ , getLocalAddr
+ , getLocalPort
+ ) where
------------------------------------------------------------------------------
import Control.Concurrent
@@ -213,6 +214,10 @@ instance Show TimeoutException where
instance Exception TimeoutException
+-- FIXME placeholder
+tickleTimeout :: Connection -> IO ()
+tickleTimeout = const $ return ()
+
timeoutRecv :: Connection -> Int -> IO ByteString
timeoutRecv conn n = do
diff --git a/test/suite/Snap/Internal/Http/Server/Tests.hs
b/test/suite/Snap/Internal/Http/Server/Tests.hs
index 22ccceb..d7d7351 100644
--- a/test/suite/Snap/Internal/Http/Server/Tests.hs
+++ b/test/suite/Snap/Internal/Http/Server/Tests.hs
@@ -357,7 +357,7 @@ testHttp1 = testCase "http session" $ do
let (iter,onSendFile) = mkIter ref
runHTTP "localhost" "127.0.0.1" 80 "127.0.0.1" 58384
- Nothing Nothing enumBody iter onSendFile echoServer
+ Nothing Nothing enumBody iter onSendFile (return ()) echoServer
s <- readIORef ref
@@ -402,7 +402,7 @@ testChunkOn1_0 = testCase "transfer-encoding chunked" $ do
let (iter,onSendFile) = mkIter ref
runHTTP "localhost" "127.0.0.1" 80 "127.0.0.1" 58384
- Nothing Nothing enumBody iter onSendFile f
+ Nothing Nothing enumBody iter onSendFile (return ()) f
-- this is a pretty lame way of checking whether the output was chunked,
-- but "whatever"
@@ -451,6 +451,7 @@ testHttp2 = testCase "connection: close" $ do
enumBody
iter
onSendFile
+ (return ())
echoServer2
s <- readIORef ref
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
