git.iko.soy/typeable/wai
on master help sign in
Multiline HTTP headers (#76)
commitdc4697c007beaf1846872744b83162e7c9406465 authorMichael Snoyman <michael@snoyman.com> dateThu 31 May 2012, 11:49 (14 years ago) parent07f735e
2 files changed+82−8
compare with master
unifiedsplit
warp/Network/Wai/Handler/Warp.hs+20−8 warp/test/main.hs+62
warp/Network/Wai/Handler/Warp.hs+20−8
@@ -58,6 +58,7 @@ module Network.Wai.Handler.Warp
5858 , T.initialize
5959#if TEST
6060 , takeHeaders
61+ , parseFirst
6162 , readInt
6263#endif
6364 ) where
@@ -487,7 +488,7 @@ takeUntil c bs =
487488parseFirst :: ByteString
488489 -> ResourceT IO (ByteString, ByteString, ByteString, H.HttpVersion)
489490parseFirst s =
490− case S.split 32 s of -- ' '
491+ case filter (not . S.null) $ S.split 32 s of -- ' '
491492 [method, query, http'] -> do
492493 let (hfirst, hsecond) = B.splitAt 5 http'
493494 if hfirst == "HTTP/"
@@ -649,11 +650,7 @@ fmap2 _ (C.Done i x) = C.Done i x
649650parseHeaderNoAttr :: ByteString -> H.Header
650651parseHeaderNoAttr s =
651652 let (k, rest) = S.breakByte 58 s -- ':'
652− restLen = S.length rest
653− -- FIXME check for colon without following space?
654− rest' = if restLen > 1 && SU.unsafeTake 2 rest == ": "
655− then SU.unsafeDrop 2 rest
656− else rest
653+ rest' = S.dropWhile (\c -> c == 32 || c == 9) $ S.drop 1 rest
657654 in (CI.mk k, rest')
658655
659656connSource :: Connection -> T.Handle -> C.Source (ResourceT IO) ByteString
@@ -756,8 +753,15 @@ takeHeaders =
756753 prepend' = prepend . S.append bs
757754 status = THStatus len' lines prepend'
758755 in C.NeedInput (push status) close
756+ -- Found a newline, but next line continues as a multiline header
757+ Just (end, True) ->
758+ let rest = S.drop (end + 1) bs
759+ prepend' = prepend . S.append (SU.unsafeTake (checkCR bs end) bs)
760+ len' = len + end
761+ status = THStatus len' lines prepend'
762+ in push status rest
759763 -- Found a newline at position end.
760− Just end ->
764+ Just (end, False) ->
761765 let start = end + 1 -- start of next chunk
762766 line
763767 -- There were some bytes before the newline, get them
@@ -786,7 +790,15 @@ takeHeaders =
786790 else C.NeedInput (push status) close
787791 where
788792 bsLen = S.length bs
789− mnl = S.elemIndex 10 bs
793+ mnl = do
794+ nl <- S.elemIndex 10 bs
795+ -- check if there are two more bytes in the bs
796+ -- if so, see if the second of those is a horizontal space
797+ if bsLen > nl + 1
798+ then
799+ let c = S.index bs (nl + 1)
800+ in Just (nl, c == 32 || c == 9)
801+ else Just (nl, False)
790802{-# INLINE takeHeaders #-}
791803
792804checkCR :: ByteString -> Int -> Int
warp/test/main.hs+62
@@ -147,6 +147,68 @@ main = hspecX $ do
147147 it "ConnectionClosedByPeer" $ runTerminateTest ConnectionClosedByPeer "GET / HTTP/1.1\r\ncontent-length: 10\r\n\r\nhello"
148148 it "IncompleteHeaders" $ runTerminateTest IncompleteHeaders "GET / HTTP/1.1\r\ncontent-length: 10\r\n"
149149
150+ describe "special input" $ do
151+ it "multiline headers" $ do
152+ iheaders <- I.newIORef []
153+ port <- getPort
154+ tid <- forkIO $ run port $ \req -> do
155+ liftIO $ I.writeIORef iheaders $ requestHeaders req
156+ return $ responseLBS status200 [] ""
157+ threadDelay 1000
158+ handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
159+ let input = S.concat
160+ [ "GET / HTTP/1.1\r\nfoo: bar\r\n baz\r\n\tbin\r\n\r\n"
161+ ]
162+ hPutStr handle input
163+ hFlush handle
164+ hClose handle
165+ threadDelay 1000
166+ killThread tid
167+ headers <- I.readIORef iheaders
168+ headers @?=
169+ [ ("foo", "bar baz\tbin")
170+ ]
171+ it "no space between colon and value" $ do
172+ iheaders <- I.newIORef []
173+ port <- getPort
174+ tid <- forkIO $ run port $ \req -> do
175+ liftIO $ I.writeIORef iheaders $ requestHeaders req
176+ return $ responseLBS status200 [] ""
177+ threadDelay 1000
178+ handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
179+ let input = S.concat
180+ [ "GET / HTTP/1.1\r\nfoo:bar\r\n\r\n"
181+ ]
182+ hPutStr handle input
183+ hFlush handle
184+ hClose handle
185+ threadDelay 1000
186+ killThread tid
187+ headers <- I.readIORef iheaders
188+ headers @?=
189+ [ ("foo", "bar")
190+ ]
191+ it "extra spaces in first line" $ do
192+ iheaders <- I.newIORef []
193+ port <- getPort
194+ tid <- forkIO $ run port $ \req -> do
195+ liftIO $ I.writeIORef iheaders $ requestHeaders req
196+ return $ responseLBS status200 [] ""
197+ threadDelay 1000
198+ handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
199+ let input = S.concat
200+ [ "GET / HTTP/1.1\r\nfoo: bar\r\n\r\n"
201+ ]
202+ hPutStr handle input
203+ hFlush handle
204+ hClose handle
205+ threadDelay 1000
206+ killThread tid
207+ headers <- I.readIORef iheaders
208+ headers @?=
209+ [ ("foo", "bar")
210+ ]
211+
150212 describe "chunked bodies" $ do
151213 it "works" $ do
152214 ifront <- I.newIORef id