on master help sign in
settingsNoParsePath
commit42a1391aa54a0c9af26828a1f665c79d0bb20d4b authorMichael Snoyman <michael@snoyman.com> dateMon 3 Feb 2014, 08:37 (13 years ago) parent20fa372
6 files changed+20−7
warp/Network/Wai/Handler/Warp.hs+1 warp/Network/Wai/Handler/Warp/Request.hs+6−4 warp/Network/Wai/Handler/Warp/RequestHeader.hs+2−1 warp/Network/Wai/Handler/Warp/Run.hs+1−1 warp/Network/Wai/Handler/Warp/Settings.hs+9 warp/warp.cabal+1−1
warp/Network/Wai/Handler/Warp.hs+1
@@ -36,6 +36,7 @@ module Network.Wai.Handler.Warp (
3636 , settingsManager
3737 , settingsFdCacheDuration
3838 , settingsBeforeMainLoop
39+ , settingsNoParsePath
3940 -- * Data types
4041 , HostPreference (..)
4142 , Port
warp/Network/Wai/Handler/Warp/Request.hs+6−4
@@ -26,6 +26,7 @@ import Network.Wai.Handler.Warp.Conduit
2626import Network.Wai.Handler.Warp.Header
2727import Network.Wai.Handler.Warp.ReadInt
2828import Network.Wai.Handler.Warp.RequestHeader
29+import Network.Wai.Handler.Warp.Settings (Settings, settingsNoParsePath)
2930import qualified Network.Wai.Handler.Warp.Timeout as Timeout
3031import Network.Wai.Handler.Warp.Types
3132import Network.Wai.Internal
@@ -41,7 +42,8 @@ maxTotalHeaderLength = 50 * 1024
4142
4243-- | Receiving a HTTP request from 'Connection' and parsing its header
4344-- to create 'Request'.
44−recvRequest :: Connection
45+recvRequest :: Settings
46+ -> Connection
4547 -> InternalInfo
4648 -> SockAddr -- ^ Peer's address.
4749 -> Source IO ByteString -- ^ Where HTTP request comes from.
@@ -52,9 +54,9 @@ recvRequest :: Connection
5254 -- 'IndexedHeader' of HTTP request for internal use, and
5355 -- leftover source (i.e. body and other HTTP reqeusts in HTTP pipelining).
5456
55−recvRequest conn ii addr src0 = do
57+recvRequest settings conn ii addr src0 = do
5658 (src, hdrlines) <- src0 $$+ headerLines
57− (method, path, query, httpversion, hdr) <- parseHeaderLines hdrlines
59+ (method, unparsedPath, path, query, httpversion, hdr) <- parseHeaderLines hdrlines
5860 let idxhdr = indexRequestHeader hdr
5961 expect = idxhdr ! idxExpect
6062 cl = idxhdr ! idxContentLength
@@ -65,7 +67,7 @@ recvRequest conn ii addr src0 = do
6567 requestMethod = method
6668 , httpVersion = httpversion
6769 , pathInfo = H.decodePathSegments path
68− , rawPathInfo = path
70+ , rawPathInfo = if settingsNoParsePath settings then unparsedPath else path
6971 , rawQueryString = query
7072 , queryString = H.parseQuery query
7173 , requestHeaders = hdr
warp/Network/Wai/Handler/Warp/RequestHeader.hs+2−1
@@ -27,6 +27,7 @@ import qualified Network.HTTP.Types.Header as HH
2727parseHeaderLines :: [ByteString]
2828 -> IO (H.Method
2929 ,ByteString -- Path
30+ ,ByteString -- Path, parsed
3031 ,ByteString -- Query
3132 ,H.HttpVersion
3233 ,H.RequestHeaders
@@ -36,7 +37,7 @@ parseHeaderLines (firstLine:otherLines) = do
3637 (method, path', query, httpversion) <- parseRequestLine firstLine
3738 let path = parsePath path'
3839 hdr = map parseHeader otherLines
39− return (method, path, query, httpversion, hdr)
40+ return (method, path', path, query, httpversion, hdr)
4041
4142----------------------------------------------------------------
4243
warp/Network/Wai/Handler/Warp/Run.hs+1−1
@@ -228,7 +228,7 @@ serveConnection conn ii addr settings app =
228228 internalError = responseLBS H.internalServerError500 [(H.hContentType, "text/plain")] "Something went wrong"
229229
230230 recvSendLoop fromClient = do
231− (req, idxhdr, getSource) <- recvRequest conn ii addr fromClient
231+ (req, idxhdr, getSource) <- recvRequest settings conn ii addr fromClient
232232 case settingsIntercept settings req of
233233 Nothing -> do
234234 -- Let the application run for as long as it wants
warp/Network/Wai/Handler/Warp/Settings.hs+9
@@ -35,6 +35,14 @@ data Settings = Settings
3535 -- Default: do nothing.
3636 --
3737 -- Since 1.3.6
38+ , settingsNoParsePath :: Bool
39+ -- ^ Perform no parsing on the rawPathInfo.
40+ --
41+ -- This is useful for writing HTTP proxies.
42+ --
43+ -- Default: False
44+ --
45+ -- Since 2.0.3
3846 }
3947
4048-- | The default settings for the Warp server. See the individual settings for
@@ -51,6 +59,7 @@ defaultSettings = Settings
5159 , settingsManager = Nothing
5260 , settingsFdCacheDuration = 10
5361 , settingsBeforeMainLoop = return ()
62+ , settingsNoParsePath = False
5463 }
5564
5665defaultExceptionHandler :: Maybe Request -> SomeException -> IO ()
warp/warp.cabal+1−1
@@ -1,5 +1,5 @@
11Name: warp
2−Version: 2.0.2.1
2+Version: 2.0.3
33Synopsis: A fast, light-weight web server for WAI applications.
44License: MIT
55License-file: LICENSE