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 69d0c1ba70f71a5124a671bdacb66f29e10d1f13 (commit)
from 44b1f5a40a9e3a0e65e5e27bb751c31b70d97bdc (commit)
Summary of changes:
src/Snap/Internal/Http/Server.hs | 3 ++
src/Snap/Internal/Http/Server/LibevBackend.hsc | 33 +++++++++++++++++++----
2 files changed, 30 insertions(+), 6 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 69d0c1ba70f71a5124a671bdacb66f29e10d1f13
Author: Shu-yu Guo <[email protected]>
Date: Tue May 25 02:23:51 2010 -0700
Fix httperf correctness issue!
diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs
index bcd4cdf..026d328 100644
--- a/src/Snap/Internal/Http/Server.hs
+++ b/src/Snap/Internal/Http/Server.hs
@@ -309,6 +309,9 @@ httpSession writeEnd onSendFile handler = do
let rsp' = updateHeaders ins rsp
(bytesSent,_) <- sendResponse rsp' writeEnd onSendFile
+ liftIO . debug $ "Server.httpSession: sent " ++
+ (Prelude.show bytesSent) ++ " bytes"
+
maybe (logAccess req rsp')
(\_ -> logAccess req $ setContentLength bytesSent rsp')
(rspContentLength rsp')
diff --git a/src/Snap/Internal/Http/Server/LibevBackend.hsc
b/src/Snap/Internal/Http/Server/LibevBackend.hsc
index d8dd4bd..c95a6c3 100644
--- a/src/Snap/Internal/Http/Server/LibevBackend.hsc
+++ b/src/Snap/Internal/Http/Server/LibevBackend.hsc
@@ -37,7 +37,6 @@ import Data.ByteString (ByteString)
import Data.ByteString.Internal (c2w, w2c)
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString as B
-import qualified Data.ByteString.Char8 as BC
import Data.IORef
import Data.Iteratee.WrappedByteString
import Data.Set (Set)
@@ -56,6 +55,8 @@ import System.Timeout
import Snap.Iteratee
import Snap.Internal.Debug
+#include <ev.h>
+
data Backend = Backend
{ _acceptSocket :: Socket
@@ -334,6 +335,7 @@ getAddr addr =
-- everything
timerCallback :: MVar ThreadId -> TimerCallback
timerCallback tmv _ _ _ = do
+ debug "timer callback"
tid <- readMVar tmv
throwTo tid TimeoutException
@@ -469,7 +471,7 @@ withConnection backend cpu proc = go
tmr <- mkEvTimer
thrmv <- newEmptyMVar
tcb <- mkTimerCallback $ timerCallback thrmv
- evTimerInit tmr tcb 20 0
+ evTimerInit tmr tcb 0 20.0
readActive <- newIORef True
writeActive <- newIORef True
@@ -485,7 +487,7 @@ withConnection backend cpu proc = go
-- take ev_loop lock, start timer and io watchers
withMVar (_loopLock backend) $ \_ -> do
- evTimerStart lp tmr
+ evTimerAgain lp tmr
evIoStart lp evioRead
evIoStart lp evioWrite
@@ -583,6 +585,14 @@ instance Show TimeoutException where
instance Exception TimeoutException
+-- FIXME We need Aycan to give us a binding for ev_timer_again.
+--
+-- Note that it's not good enough to call this from io(Read|Write)Callback,
+-- because those seem to be edge-triggered. I've definitely had where after
+-- 20 seconds they still weren't being re-awakened.
+foreign import ccall unsafe "ev_timer_again" evTimerAgain :: EvLoopPtr ->
EvTimerPtr -> IO ()
+
+
recvData :: Connection -> Int -> IO ByteString
recvData conn n = do
dbg "entered"
@@ -592,6 +602,10 @@ recvData conn n = do
(c_read fd cstr (toEnum n))
waitForLock
+ -- we got activity, so restart timer
+ debug "restarting timer"
+ evTimerAgain lp tmr
+
dbg $ "sz returned " ++ show sz
if sz == 0
@@ -602,10 +616,11 @@ 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
-
+
dbg s = debug $ "Backend.recvData(" ++ show (_socketFd conn) ++ "): " ++ s
fd = _socketFd conn
@@ -638,6 +653,10 @@ sendData conn bs = do
(c_write fd cstr (toEnum len))
waitForLock
+ -- we got activity, so restart timer
+ debug "restarting timer"
+ evTimerAgain lp tmr
+
let n = fromEnum written
let last10 = B.drop (n-10) $ B.take n bs
@@ -652,8 +671,9 @@ sendData conn bs = do
where
io = _connWriteIOObj conn
bk = _backend conn
- lp = _evLoop bk
active = _writeActive conn
+ tmr = _timerObj conn
+ lp = _evLoop bk
looplock = _loopLock bk
async = _asyncObj bk
@@ -714,6 +734,7 @@ writeOut conn = IterateeG out
:: IO (Either SomeException ()))
case ee of
- (Left e) -> return $ Done () (EOF $ Just $ Err $ show e)
+ -- XXX Should we really be returning Done () here?
+ (Left e) -> error (show e) -- return $ Done () (EOF $ Just $ Err $
show e)
(Right _) -> return $ Cont (writeOut conn) Nothing
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
