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 bcbff76cbbc7d801ed92a4638ca6daa01fe021d6 (commit)
from 13ad447b7fd872fe853b80ef7e83b2c84bc93d09 (commit)
Summary of changes:
src/Snap/Internal/Http/Server.hs | 38 +++++++++++++++--
test/suite/Snap/Internal/Http/Server/Tests.hs | 56 +++++++++++++++++++++++++
2 files changed, 90 insertions(+), 4 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 bcbff76cbbc7d801ed92a4638ca6daa01fe021d6
Author: Gregory Collins <[email protected]>
Date: Mon Aug 30 15:31:41 2010 -0400
Handle "Expect: 100-continue" properly
Fixes issue http://github.com/snapframework/snap-core/issues/15
diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs
index f60e857..efebca2 100644
--- a/src/Snap/Internal/Http/Server.hs
+++ b/src/Snap/Internal/Http/Server.hs
@@ -354,6 +354,10 @@ httpSession writeEnd' ibuf onSendFile tickle handler = do
Prelude.show (rqMethod req) ++
" " ++ SC.unpack (rqURI req) ++
" " ++ Prelude.show (rqVersion req)
+
+ -- check for Expect: 100-continue
+ checkExpect100Continue req writeEnd
+
logerr <- gets _logError
(req',rspOrig) <- lift $ handler logerr req
@@ -397,6 +401,29 @@ httpSession writeEnd' ibuf onSendFile tickle handler = do
------------------------------------------------------------------------------
+checkExpect100Continue :: Request
+ -> Iteratee IO ()
+ -> ServerMonad ()
+checkExpect100Continue req writeEnd = do
+ let mbEx = getHeaders "Expect" req
+
+ maybe (return ())
+ (\l -> if elem "100-continue" l then go else return ())
+ mbEx
+
+ where
+ go = do
+ let (major,minor) = rqVersion req
+ let hl = [ "HTTP/"
+ , bsshow major
+ , "."
+ , bsshow minor
+ , " 100 Continue\r\n\r\n" ]
+ iter <- liftIO $ enumBS (S.concat hl) writeEnd
+ liftIO $ run iter
+
+
+------------------------------------------------------------------------------
receiveRequest :: ServerMonad (Maybe Request)
receiveRequest = do
mreq <- {-# SCC "receiveRequest/parseRequest" #-} lift parseRequest
@@ -705,10 +732,6 @@ sendResponse rsp' writeEnd ibuf killBuffering onSendFile =
do
--------------------------------------------------------------------------
- bsshow = l2s . show
-
-
- --------------------------------------------------------------------------
mkHeaderString :: Response -> ByteString
mkHeaderString r =
{-# SCC "mkHeaderString" #-}
@@ -767,3 +790,10 @@ l2s = S.concat . L.toChunks
------------------------------------------------------------------------------
toBS :: String -> ByteString
toBS = S.pack . map c2w
+
+
+--------------------------------------------------------------------------
+bsshow :: (Show a) => a -> ByteString
+bsshow = l2s . show
+
+
diff --git a/test/suite/Snap/Internal/Http/Server/Tests.hs
b/test/suite/Snap/Internal/Http/Server/Tests.hs
index 4b63447..e8d2d2a 100644
--- a/test/suite/Snap/Internal/Http/Server/Tests.hs
+++ b/test/suite/Snap/Internal/Http/Server/Tests.hs
@@ -50,6 +50,7 @@ tests = [ testHttpRequest1
, testHttpResponse4
, testHttp1
, testHttp2
+ , testHttp100
, testPartialParse
, testMethodParsing
, testServerStartupShutdown
@@ -72,6 +73,17 @@ sampleRequest =
, "\r\n"
, "0123456789" ]
+sampleRequestExpectContinue :: ByteString
+sampleRequestExpectContinue =
+ S.concat [ "\r\nGET /foo/bar.html?param1=abc¶m2=def%20+¶m1=abc
HTTP/1.1\r\n"
+ , "Host: www.zabble.com:7777\r\n"
+ , "Content-Length: 10\r\n"
+ , "Expect: 100-continue\r\n"
+ , "X-Random-Other-Header: foo\r\n bar\r\n"
+ , "Cookie: foo=\"bar\\\"\"\r\n"
+ , "\r\n"
+ , "0123456789" ]
+
sampleRequest1_0 :: ByteString
sampleRequest1_0 =
S.concat [ "\r\nGET /foo/bar.html?param1=abc¶m2=def%20+¶m1=abc
HTTP/1.0\r\n"
@@ -594,6 +606,50 @@ testHttp2 = testCase "connection: close" $ do
+testHttp100 :: Test
+testHttp100 = testCase "Expect: 100-continue" $ do
+ let enumBody = enumBS sampleRequestExpectContinue
+
+ ref <- newIORef ""
+
+ let (iter,onSendFile) = mkIter ref
+
+ runHTTP "localhost"
+ "127.0.0.1"
+ 80
+ "127.0.0.1"
+ 58384
+ Nothing
+ Nothing
+ enumBody
+ iter
+ onSendFile
+ (return ())
+ echoServer2
+
+ s <- readIORef ref
+
+ let lns = LC.lines s
+
+ let ok = case lns of
+ ([ "HTTP/1.1 100 Continue\r"
+ , "\r"
+ , "HTTP/1.1 200 OK\r"
+ , "Content-Length: 10\r"
+ , d1
+ , s1
+ , "Set-Cookie: foo=bar; path=/; expires=Sat, 30-Jan-2010
00:00:00 GMT; domain=.foo.com\r"
+ , "\r"
+ , "0123456789" ]) -> (("Date" `L.isPrefixOf` d1) &&
+ ("Server" `L.isPrefixOf` s1))
+
+ _ -> False
+
+ assertBool "100 Continue" ok
+
+
+
+
pongServer :: Snap ()
pongServer = modifyResponse $ setResponseBody (enumBS "PONG") .
setContentType "text/plain" .
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
