From 10e0e65d2e8e0b7f8adf84855b8f32c43b149456 Mon Sep 17 00:00:00 2001 From: Magnus Carlsson Date: Thu, 5 Jan 2012 11:46:12 +0100 Subject: [PATCH 1/5] Log user from basic authentication header --- src/Snap/Internal/Http/Server.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs index 313887a4..ff73ea25 100644 --- a/src/Snap/Internal/Http/Server.hs +++ b/src/Snap/Internal/Http/Server.hs @@ -238,7 +238,7 @@ logA' :: (ByteString -> IO ()) -> Request -> Response -> IO () logA' logger req rsp = do let hdrs = rqHeaders req let host = rqRemoteAddr req - let user = Nothing -- TODO we don't do authentication yet + let user = fst `fmap` rqBasicAuthentication req let (v, v') = rqVersion req let ver = S.concat [ "HTTP/", bshow v, ".", bshow v' ] let method = toBS $ show (rqMethod req) From 722b8d029b64abdd2fbe7ae32743e94d6f44f829 Mon Sep 17 00:00:00 2001 From: Gregory Collins Date: Mon, 9 Jan 2012 03:51:04 +0800 Subject: [PATCH 2/5] Limit size of http headers to 256kB --- src/Snap/Internal/Http/Server.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs index ff73ea25..a0c56e77 100644 --- a/src/Snap/Internal/Http/Server.hs +++ b/src/Snap/Internal/Http/Server.hs @@ -501,7 +501,8 @@ receiveRequest :: Iteratee ByteString IO () -> ServerMonad (Maybe Request) receiveRequest writeEnd = do debug "receiveRequest: entered" mreq <- {-# SCC "receiveRequest/parseRequest" #-} lift $ - iterateeDebugWrapper "parseRequest" parseRequest + iterateeDebugWrapper "parseRequest" $ + joinI $ takeNoMoreThan maxHeadersSize $$ parseRequest debug "receiveRequest: parseRequest returned" case mreq of @@ -514,8 +515,12 @@ receiveRequest writeEnd = do Nothing -> return Nothing - where + -------------------------------------------------------------------------- + -- TODO(gdc): make this a policy decision (expose in + -- Snap.Http.Server.Config) + maxHeadersSize = 256 * 1024 + -------------------------------------------------------------------------- -- check: did the client specify "transfer-encoding: chunked"? then we -- have to honor that. From ab166db0d8ce53b2b17dd7ab7b575573c1f9a3b4 Mon Sep 17 00:00:00 2001 From: Gregory Collins Date: Mon, 9 Jan 2012 04:02:40 +0800 Subject: [PATCH 3/5] Revert obviously busted "Limit size of http headers to 256kB" This reverts commit a522c4cf486a6c615b3e049c906d2148c71c6565. --- src/Snap/Internal/Http/Server.hs | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs index a0c56e77..ff73ea25 100644 --- a/src/Snap/Internal/Http/Server.hs +++ b/src/Snap/Internal/Http/Server.hs @@ -501,8 +501,7 @@ receiveRequest :: Iteratee ByteString IO () -> ServerMonad (Maybe Request) receiveRequest writeEnd = do debug "receiveRequest: entered" mreq <- {-# SCC "receiveRequest/parseRequest" #-} lift $ - iterateeDebugWrapper "parseRequest" $ - joinI $ takeNoMoreThan maxHeadersSize $$ parseRequest + iterateeDebugWrapper "parseRequest" parseRequest debug "receiveRequest: parseRequest returned" case mreq of @@ -515,12 +514,8 @@ receiveRequest writeEnd = do Nothing -> return Nothing - where - -------------------------------------------------------------------------- - -- TODO(gdc): make this a policy decision (expose in - -- Snap.Http.Server.Config) - maxHeadersSize = 256 * 1024 + where -------------------------------------------------------------------------- -- check: did the client specify "transfer-encoding: chunked"? then we -- have to honor that. From edabdb32c8acb81e548143854b7ccdfd123c919e Mon Sep 17 00:00:00 2001 From: Gregory Collins Date: Mon, 9 Jan 2012 04:47:10 +0800 Subject: [PATCH 4/5] Fix bug in 'Limit size of http headers to 256kB' --- src/Snap/Internal/Http/Server.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/Snap/Internal/Http/Server.hs b/src/Snap/Internal/Http/Server.hs index ff73ea25..f03c69c6 100644 --- a/src/Snap/Internal/Http/Server.hs +++ b/src/Snap/Internal/Http/Server.hs @@ -29,6 +29,7 @@ import qualified Data.ByteString.Char8 as SC import qualified Data.ByteString.Lazy as L import Data.ByteString.Internal (c2w, w2c) import qualified Data.ByteString.Nums.Careless.Int as Cvt +import Data.Enumerator.Internal import Data.Int import Data.IORef import Data.List (foldl') @@ -501,7 +502,8 @@ receiveRequest :: Iteratee ByteString IO () -> ServerMonad (Maybe Request) receiveRequest writeEnd = do debug "receiveRequest: entered" mreq <- {-# SCC "receiveRequest/parseRequest" #-} lift $ - iterateeDebugWrapper "parseRequest" parseRequest + iterateeDebugWrapper "parseRequest" $ + joinI' $ takeNoMoreThan maxHeadersSize $$ parseRequest debug "receiveRequest: parseRequest returned" case mreq of @@ -514,8 +516,12 @@ receiveRequest writeEnd = do Nothing -> return Nothing - where + -------------------------------------------------------------------------- + -- TODO(gdc): make this a policy decision (expose in + -- Snap.Http.Server.Config) + maxHeadersSize = 256 * 1024 + -------------------------------------------------------------------------- -- check: did the client specify "transfer-encoding: chunked"? then we -- have to honor that. From d25239b0753ba6f0a87dc26c9a133bef35b1ac99 Mon Sep 17 00:00:00 2001 From: Gregory Collins Date: Mon, 9 Jan 2012 04:54:20 +0800 Subject: [PATCH 5/5] Upgrade lower bound dependency of enumerator to 0.4.15 (we need Data.Enumerator.Internal) --- snap-server.cabal | 2 +- test/snap-server-testsuite.cabal | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/snap-server.cabal b/snap-server.cabal index 3b081671..cf2dbf84 100644 --- a/snap-server.cabal +++ b/snap-server.cabal @@ -111,7 +111,7 @@ Library case-insensitive >= 0.3 && < 0.5, containers >= 0.3 && < 0.5, directory-tree >= 0.10 && < 0.11, - enumerator >= 0.4.13.1 && < 0.5, + enumerator >= 0.4.15 && < 0.5, filepath >= 1.1 && < 1.4, MonadCatchIO-transformers >= 0.2.1 && < 0.3, mtl >= 2 && < 3, diff --git a/test/snap-server-testsuite.cabal b/test/snap-server-testsuite.cabal index 5ed38613..c16b33b3 100644 --- a/test/snap-server-testsuite.cabal +++ b/test/snap-server-testsuite.cabal @@ -35,7 +35,7 @@ Executable testsuite containers, directory, directory-tree, - enumerator >= 0.4.13.1 && <0.5, + enumerator >= 0.4.15 && <0.5, filepath, http-enumerator >= 0.7.1.6 && <0.8, HUnit >= 1.2 && < 2, @@ -110,7 +110,7 @@ Executable pongserver cereal >= 0.3 && < 0.4, containers, directory-tree, - enumerator >= 0.4.7 && <0.5, + enumerator >= 0.4.15 && <0.5, filepath, HUnit >= 1.2 && < 2, mtl >= 2 && <3, @@ -186,7 +186,7 @@ Executable testserver case-insensitive >= 0.3 && < 0.5, containers, directory-tree, - enumerator >= 0.4.7 && <0.5, + enumerator >= 0.4.15 && <0.5, filepath, HUnit >= 1.2 && < 2, MonadCatchIO-transformers >= 0.2.1 && < 0.3,