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 37d8c66febbfe39b98d59a7040a813134ea7f893 (commit)
from c17e884393b6f13ff3460ea7f7e1ba085b420eef (commit)
Summary of changes:
src/Snap/Internal/Http/Server.hs | 7 +++-
test/suite/Snap/Internal/Http/Server/Tests.hs | 39 +++++++++++++++++++++++++
2 files changed, 44 insertions(+), 2 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 37d8c66febbfe39b98d59a7040a813134ea7f893
Author: Gregory Collins <[email protected]>
Date: Wed Aug 11 15:56:17 2010 -0400
Fix http://github.com/snapframework/snap-core/issues/issue/12
diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs
index 61eb1dc..e49586f 100644
--- a/src/Snap/Internal/Http/Server.hs
+++ b/src/Snap/Internal/Http/Server.hs
@@ -469,8 +469,11 @@ receiveRequest = do
parseForm req = {-# SCC "receiveRequest/parseForm" #-}
if doIt then getIt else return req
where
- doIt = mbCT == Just "application/x-www-form-urlencoded"
- mbCT = liftM head $ Map.lookup "content-type" (rqHeaders req)
+ mbCT = liftM head $ Map.lookup "content-type" (rqHeaders req)
+ trimIt = fst . SC.spanEnd isSpace . SC.takeWhile (/= ';')
+ . SC.dropWhile isSpace
+ mbCT' = liftM trimIt mbCT
+ doIt = mbCT' == Just "application/x-www-form-urlencoded"
maximumPOSTBodySize :: Int64
maximumPOSTBodySize = 10*1024*1024
diff --git a/test/suite/Snap/Internal/Http/Server/Tests.hs
b/test/suite/Snap/Internal/Http/Server/Tests.hs
index 6fc3ca3..a5d7c37 100644
--- a/test/suite/Snap/Internal/Http/Server/Tests.hs
+++ b/test/suite/Snap/Internal/Http/Server/Tests.hs
@@ -43,6 +43,7 @@ tests = [ testHttpRequest1
, testMultiRequest
, testHttpRequest2
, testHttpRequest3
+ , testHttpRequest3'
, testHttpResponse1
, testHttpResponse2
, testHttpResponse3
@@ -271,9 +272,35 @@ testHttpRequest3 =
assertEqual "parse body" (LC.fromChunks [samplePostBody3]) body
+testHttpRequest3' :: Test
+testHttpRequest3' =
+ testCase "HttpRequest3'" $ do
+ iter <- enumBS sampleRequest3' $
+ do
+ r <- liftM fromJust $ rsm receiveRequest
+ se <- liftIO $ readIORef (rqBody r)
+ let (SomeEnumerator e) = se
+ b <- liftM fromWrap $ joinIM $ e copyingStream2stream
+ return (r,b)
+
+ (req,body) <- run iter
+
+ assertEqual "post param 1"
+ (rqParam "postparam1" req)
+ (Just ["1"])
+
+ assertEqual "post param 2"
+ (rqParam "postparam2" req)
+ (Just ["2"])
+
+ -- make sure the post body is still emitted
+ assertEqual "parse body" (LC.fromChunks [samplePostBody3]) body
+
+
samplePostBody3 :: ByteString
samplePostBody3 = "postparam1=1&postparam2=2"
+
sampleRequest3 :: ByteString
sampleRequest3 =
S.concat [ "\r\nGET /foo/bar.html?param1=abc¶m2=def%20+¶m1=abc
HTTP/1.1\r\n"
@@ -286,6 +313,18 @@ sampleRequest3 =
, samplePostBody3 ]
+sampleRequest3' :: ByteString
+sampleRequest3' =
+ S.concat [ "\r\nGET /foo/bar.html?param1=abc¶m2=def%20+¶m1=abc
HTTP/1.1\r\n"
+ , "Content-Type: application/x-www-form-urlencoded;
charset=UTF-8\r\n"
+ , "Content-Length: 25\r\n"
+ , "Multiheader: 1\r\n"
+ , "Multiheader: 2\r\n"
+ , "X-Random-Other-Header: foo\r\n bar\r\n"
+ , "\r\n"
+ , samplePostBody3 ]
+
+
rsm :: ServerMonad a -> Iteratee IO a
-----------------------------------------------------------------------
hooks/post-receive
--
snap-server
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
